REM ======================================================================================================================= REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === REM === The SFWidgets library is one of the associated libraries. === REM === Full documentation is available on https://help.libreoffice.org/ === REM ======================================================================================================================= Option Compatible Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' SF_Register ''' =========== ''' The ScriptForge framework includes ''' the master ScriptForge library ''' a number of "associated" libraries SF* ''' any user/contributor extension wanting to fit into the framework ''' ''' The main methods in this module allow the current library to cling to ScriptForge ''' - RegisterScriptServices ''' Register the list of services implemented by the current library ''' - _NewMenu ''' Create a new menu service instance. ''' Called from SFDocuments services with CreateMenu() ''' - _NewPopupMenu ''' Create a new popup menu service instance. ''' Called from CreateScriptService() ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS REM ================================================================= DEFINITIONS REM ============================================================== PUBLIC METHODS REM ----------------------------------------------------------------------------- Public Sub RegisterScriptServices() As Variant ''' Register into ScriptForge the list of the services implemented by the current library ''' Each library pertaining to the framework must implement its own version of this method ''' ''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods ''' with 2 arguments: ''' ServiceName: the name of the service as a case-insensitive string ''' ServiceReference: the reference as an object ''' If the reference refers to a module, then return the module as an object: ''' GlobalScope.Library.Module ''' If the reference is a class instance, then return a string referring to the method ''' containing the New statement creating the instance ''' "libraryname.modulename.function" With GlobalScope.ScriptForge.SF_Services .RegisterService("Menu", "SFWidgets.SF_Register._NewMenu") ' Reference to the function initializing the service .RegisterService("PopupMenu", "SFWidgets.SF_Register._NewPopupMenu") ' id. End With End Sub ' SFWidgets.SF_Register.RegisterScriptServices REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- Public Function _NewMenu(Optional ByVal pvArgs As Variant) As Object ''' Create a new instance of the SF_Menu class ''' [called internally from SFDocuments.Document.CreateMenu() ONLY] ''' Args: ''' Component: the com.sun.star.lang.XComponent where to find the menubar to plug the new menu in ''' Header: the name/header of the menu ''' Before: the place where to put the new menu on the menubar (string or number >= 1) ''' When not found => last position ''' SubmenuChar: the delimiter used in menu trees. Default = ">" ''' Returns: the instance or Nothing Dim oMenu As Object ' Return value Dim oComponent As Object ' The document or formdocument's component - com.sun.star.lang.XComponent Dim sHeader As String ' Menu header Dim sBefore As String ' Position of menu as a string Dim iBefore As Integer ' as a number Dim sSubmenuChar As String ' Delimiter in menu trees If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Set oMenu = Nothing Check: ' Types and number of arguments are not checked because internal call only Set oComponent = pvArgs(0) sHeader = pvArgs(1) Select Case VarType(pvArgs(2)) Case V_STRING : sBefore = pvArgs(2) iBefore = 0 Case Else : sBefore = "" iBefore = pvArgs(2) End Select sSubmenuChar = pvArgs(3) Try: If Not IsNull(oComponent) Then Set oMenu = New SF_Menu With oMenu Set .[Me] = oMenu ._Initialize(oComponent, sHeader, sBefore, iBefore, sSubmenuChar) End With End If Finally: Set _NewMenu = oMenu Exit Function Catch: GoTo Finally End Function ' SFWidgets.SF_Register._NewMenu REM ----------------------------------------------------------------------------- Public Function _NewPopupMenu(Optional ByVal pvArgs As Variant) As Object ''' Create a new instance of the SF_PopupMenu class ''' Args: ''' Event: a mouse event ''' If the event has no source or is not a mouse event, the menu is displayed above ThisComponent ''' X, Y: forced coordinates ''' SubmenuChar: Delimiter used in menu trees ''' Returns: the instance or Nothing Dim oMenu As Object ' Return value Dim Event As Variant ' Mouse event Dim X As Long ' Mouse click coordinates Dim Y As Long Dim SubmenuChar As String ' Delimiter in menu trees Dim oSession As Object ' ScriptForge.SF_Session Dim vUno As Variant ' UNO type split into an array Dim sEventType As String ' Event type, must be "MouseEvent" Dim oControl As Object ' The dialog or form control view which triggered the event If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) If UBound(pvArgs) >= 0 Then Event = pvArgs(0) Else Event = Nothing If IsEmpty(Event) Then Event = Nothing If UBound(pvArgs) >= 1 Then X = pvArgs(1) Else X = 0 If UBound(pvArgs) >= 2 Then Y = pvArgs(2) Else Y = 0 If UBound(pvArgs) >= 3 Then SubmenuChar = pvArgs(3) Else SubmenuChar = "" If Not ScriptForge.SF_Utils._Validate(Event, "Event", ScriptForge.V_OBJECT) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(X, "X", ScriptForge.V_NUMERIC) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Y, "Y", ScriptForge.V_NUMERIC) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally Set oMenu = Nothing Try: Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") Set oControl = Nothing If Not IsNull(Event) Then ' Determine the X, Y coordinates vUno = Split(oSession.UnoObjectType(Event), ".") sEventType = vUno(UBound(vUno)) If UCase(sEventType) = "MOUSEEVENT" Then X = Event.X Y = Event.Y ' Determine the window peer target If oSession.HasUnoProperty(Event, "Source") Then Set oControl = Event.Source.Peer End If End If ' If not a mouse event, if no control, ... If IsNull(oControl) Then If Not IsNull(ThisComponent) Then Set oControl = ThisComponent.CurrentController.Frame.getContainerWindow() End If If Not IsNull(oControl) Then Set oMenu = New SF_PopupMenu With oMenu Set .[Me] = oMenu ._Initialize(oControl, X, Y, SubmenuChar) End With Else Set oMenu = Nothing End If Finally: Set _NewPopupMenu = oMenu Exit Function Catch: GoTo Finally End Function ' SFWidgets.SF_Register._NewPopupMenu REM ============================================== END OF SFWidgets.SF_REGISTER