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. .RegisterService("Toolbar", "SFWidgets.SF_Register._NewToolbar") ' id. .RegisterService("ToolbarButton", "SFWidgets.SF_Register._NewToolbarButton") ' 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 the actual window ''' 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 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 Dim oWindow As Object ' ui.Window type Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session") Dim oUi As Object : Set oUi = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI") If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Set oMenu = Nothing Check: ' Check and get arguments, their number may vary 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 Try: ' Find and identify the control that triggered the popup menu 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, find what can be decent alternatives: (a menu header in) the actual window If IsNull(oControl) Then Set oWindow = oUi._IdentifyWindow(StarDesktop.getCurrentComponent()) ' A menu has been clicked necessarily in the current window With oWindow If Not IsNull(.Frame) Then Set oControl = .Frame.getContainerWindow() End With 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 ----------------------------------------------------------------------------- Public Function _NewToolbar(Optional ByVal pvArgs As Variant) As Object ''' Create a new instance of the SF_Toolbar class ''' The "Toolbar" service must not be invoked directly in a user script ''' Args: ''' ToolbarDesc: a proto-toolbar object type. See ScriptForge.SF_UI for a detailed description ''' Returns: ''' the instance or Nothing Dim oToolbar As Object ' Return value Dim oToolbarDesc As Object ' A proto-toolbar description If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Set oToolbar = Nothing Check: Set oToolbarDesc = pvArgs(0) Try: Set oToolbar = New SF_Toolbar With oToolbar Set .[Me] = oToolbar ._Initialize(oToolbarDesc) End With Finally: Set _NewToolbar = oToolbar Exit Function Catch: GoTo Finally End Function ' SFWidgets.SF_Register._NewToolbar REM ----------------------------------------------------------------------------- Public Function _NewToolbarButton(Optional ByVal pvArgs As Variant) As Object ''' Create a new instance of the SF_ToolbarButton class ''' The "ToolbarButton" service must not be invoked directly in a user script ''' Args: ''' ToolbarButtonDesc: a proto-toolbarButton object type. See SFWidgets.SF_Toolbar for a detailed description ''' Returns: ''' the instance or Nothing Dim oToolbarButton As Object ' Return value Dim oToolbarButtonDesc As Object ' A proto-toolbarbutton description If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Set oToolbarButton = Nothing Check: Set oToolbarButtonDesc = pvArgs(0) Try: Set oToolbarButton = New SF_ToolbarButton With oToolbarButton Set .[Me] = oToolbarButton ._Initialize(oToolbarButtonDesc) End With Finally: Set _NewToolbarButton = oToolbarButton Exit Function Catch: GoTo Finally End Function ' SFWidgets.SF_Register._NewToolbarButton REM ============================================== END OF SFWIDGETS.SF_REGISTER