<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Register" script:language="StarBasic" script:moduleType="normal">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 doc.CreateMenu(...)
''' - _NewContextMenu
''' Create a new context menu service instance.
''' Called from SFDocuments services with doc.ContextMenus(...)
''' - _NewPopupMenu
''' Create a new popup menu service instance.
''' Called from CreateScriptService("PopupMenu, ...)
''' - _NewToolbar
''' Create a new toolbar service instance.
''' Called from SFDocuments services with doc.Toolbars(...)
''' - _NewToolbarButton
''' Create a new toolbarbutton service instance.
''' Called from a Toolbar service with toolbar.ToolbarButtons(...)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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("ContextMenu", "SFWidgets.SF_Register._NewContextMenu") ' id.
.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 _NewContextMenu(Optional ByVal pvArgs As Variant) As Object
''' Create a new instance of the SF_ContextMenu class
''' Args:
''' Component: the document's component requesting a context menu
''' ContextMenuName: a private:resource/popupmenu/... reference
''' SubmenuChar: Delimiter used in menu trees
''' Returns: the instance or Nothing
Dim oMenu As Object ' Return value
Dim Component As Object ' The document's component requesting a context menu
Dim ContextMenuName As String ' A "private:resource/popupmenu/..." reference
Dim SubmenuChar As String ' Delimiter in menu trees
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Set oMenu = Nothing
Check:
' Get arguments, their check has been done upstream
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs)
If UBound(pvArgs) >= 0 Then Set Component = pvArgs(0) Else Set Component = Nothing
If UBound(pvArgs) >= 1 Then ContextMenuName = pvArgs(1) Else ContextMenuName = ""
If UBound(pvArgs) >= 2 Then SubmenuChar = pvArgs(2) Else SubmenuChar = ">"
Try:
If Not IsNull(Component) Then
Set oMenu = New SF_ContextMenu
With oMenu
Set .[Me] = oMenu
._Initialize(Component, ContextMenuName, SubmenuChar)
End With
Else
Set oMenu = Nothing
End If
Finally:
Set _NewContextMenu = oMenu
Exit Function
Catch:
GoTo Finally
End Function ' SFWidgets.SF_Register._NewContextMenu
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
</script:module>