| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190 |
- <?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 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 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
- 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
- Set oMenu = Nothing
- 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 ============================================== END OF SFWidgets.SF_REGISTER
- </script:module>
|
