| blob | 99c9dc9d0d8e29b057815e7a6b8305f5a83657c4 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Register" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === The SFWidgets library is one of the associated libraries. ===
6 REM === Full documentation is available on https://help.libreoffice.org/ ===
7 REM =======================================================================================================================
9 Option Compatible
10 Option Explicit
12 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
13 ''' SF_Register
14 ''' ===========
15 ''' The ScriptForge framework includes
16 ''' the master ScriptForge library
18 ''' any user/contributor extension wanting to fit into the framework
19 '''
20 ''' The main methods in this module allow the current library to cling to ScriptForge
21 ''' - RegisterScriptServices
22 ''' Register the list of services implemented by the current library
23 ''' - _NewMenu
24 ''' Create a new menu service instance.
25 ''' Called from SFDocuments services with doc.CreateMenu(...)
26 ''' - _NewContextMenu
27 ''' Create a new context menu service instance.
28 ''' Called from SFDocuments services with doc.ContextMenus(...)
29 ''' - _NewPopupMenu
30 ''' Create a new popup menu service instance.
32 ''' - _NewToolbar
33 ''' Create a new toolbar service instance.
34 ''' Called from SFDocuments services with doc.Toolbars(...)
35 ''' - _NewToolbarButton
36 ''' Create a new toolbarbutton service instance.
37 ''' Called from a Toolbar service with toolbar.ToolbarButtons(...)
38 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
40 REM ================================================================== EXCEPTIONS
42 REM ================================================================= DEFINITIONS
44 REM ============================================================== PUBLIC METHODS
46 REM -----------------------------------------------------------------------------
47 Public Sub RegisterScriptServices() As Variant
48 ''' Register into ScriptForge the list of the services implemented by the current library
49 ''' Each library pertaining to the framework must implement its own version of this method
50 '''
51 ''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods
53 ''' ServiceName: the name of the service as a case-insensitive string
54 ''' ServiceReference: the reference as an object
55 ''' If the reference refers to a module, then return the module as an object:
56 ''' GlobalScope.Library.Module
57 ''' If the reference is a class instance, then return a string referring to the method
58 ''' containing the New statement creating the instance
61 With GlobalScope.ScriptForge.SF_Services
62 .RegisterService("Menu", "SFWidgets.SF_Register._NewMenu") ' Reference to the function initializing the service
63 .RegisterService("ContextMenu", "SFWidgets.SF_Register._NewContextMenu") ' id.
64 .RegisterService("PopupMenu", "SFWidgets.SF_Register._NewPopupMenu") ' id.
66 .RegisterService("ToolbarButton", "SFWidgets.SF_Register._NewToolbarButton") ' id.
67 End With
69 End Sub ' SFWidgets.SF_Register.RegisterScriptServices
71 REM =========================================================== PRIVATE FUNCTIONS
73 REM -----------------------------------------------------------------------------
74 Public Function _NewContextMenu(Optional ByVal pvArgs As Variant) As Object
75 ''' Create a new instance of the SF_ContextMenu class
76 ''' Args:
78 ''' ContextMenuName: a private:resource/popupmenu/... reference
79 ''' SubmenuChar: Delimiter used in menu trees
80 ''' Returns: the instance or Nothing
82 Dim oMenu As Object ' Return value
85 Dim SubmenuChar As String ' Delimiter in menu trees
87 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
88 Set oMenu = Nothing
90 Check:
91 ' Get arguments, their check has been done upstream
92 If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
93 If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs)
98 Try:
99 If Not IsNull(Component) Then
100 Set oMenu = New SF_ContextMenu
101 With oMenu
102 Set .[Me] = oMenu
103 ._Initialize(Component, ContextMenuName, SubmenuChar)
104 End With
105 Else
106 Set oMenu = Nothing
107 End If
109 Finally:
110 Set _NewContextMenu = oMenu
111 Exit Function
112 Catch:
113 GoTo Finally
114 End Function ' SFWidgets.SF_Register._NewContextMenu
116 REM -----------------------------------------------------------------------------
117 Public Function _NewMenu(Optional ByVal pvArgs As Variant) As Object
118 ''' Create a new instance of the SF_Menu class
119 ''' [called internally from SFDocuments.Document.CreateMenu() ONLY]
120 ''' Args:
121 ''' Component: the com.sun.star.lang.XComponent where to find the menubar to plug the new menu in
122 ''' Header: the name/header of the menu
123 ''' Before: the place where to put the new menu on the menubar (string or number >= 1)
126 ''' Returns: the instance or Nothing
128 Dim oMenu As Object ' Return value
129 Dim oComponent As Object ' The document or formdocument's component - com.sun.star.lang.XComponent
130 Dim sHeader As String ' Menu header
131 Dim sBefore As String ' Position of menu as a string
132 Dim iBefore As Integer ' as a number
133 Dim sSubmenuChar As String ' Delimiter in menu trees
135 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
136 Set oMenu = Nothing
138 Check:
139 ' Types and number of arguments are not checked because internal call only
140 Set oComponent = pvArgs(0)
141 sHeader = pvArgs(1)
142 Select Case VarType(pvArgs(2))
143 Case V_STRING : sBefore = pvArgs(2)
144 iBefore = 0
145 Case Else : sBefore = ""
146 iBefore = pvArgs(2)
147 End Select
148 sSubmenuChar = pvArgs(3)
150 Try:
151 If Not IsNull(oComponent) Then
152 Set oMenu = New SF_Menu
153 With oMenu
154 Set .[Me] = oMenu
155 ._Initialize(oComponent, sHeader, sBefore, iBefore, sSubmenuChar)
156 End With
157 End If
159 Finally:
160 Set _NewMenu = oMenu
161 Exit Function
162 Catch:
163 GoTo Finally
164 End Function ' SFWidgets.SF_Register._NewMenu
166 REM -----------------------------------------------------------------------------
167 Public Function _NewPopupMenu(Optional ByVal pvArgs As Variant) As Object
168 ''' Create a new instance of the SF_PopupMenu class
169 ''' Args:
170 ''' Event: a mouse event
171 ''' If the event has no source or is not a mouse event, the menu is displayed above the actual window
172 ''' X, Y: forced coordinates
173 ''' SubmenuChar: Delimiter used in menu trees
174 ''' Returns: the instance or Nothing
176 Dim oMenu As Object ' Return value
177 Dim Event As Variant ' Mouse event
178 Dim X As Long ' Mouse click coordinates
179 Dim Y As Long
180 Dim SubmenuChar As String ' Delimiter in menu trees
181 Dim vUno As Variant ' UNO type split into an array
183 Dim oControl As Object ' The dialog or form control view which triggered the event
184 Dim oWindow As Object ' ui.Window type
185 Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session")
186 Dim oUi As Object : Set oUi = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI")
188 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
189 Set oMenu = Nothing
191 Check:
192 ' Check and get arguments, their number may vary
193 If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
194 If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs)
196 If IsEmpty(Event) Then Event = Nothing
200 If Not ScriptForge.SF_Utils._Validate(Event, "Event", ScriptForge.V_OBJECT) Then GoTo Finally
201 If Not ScriptForge.SF_Utils._Validate(X, "X", ScriptForge.V_NUMERIC) Then GoTo Finally
202 If Not ScriptForge.SF_Utils._Validate(Y, "Y", ScriptForge.V_NUMERIC) Then GoTo Finally
203 If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally
205 Try:
206 ' Find and identify the control that triggered the popup menu
207 Set oControl = Nothing
208 If Not IsNull(Event) Then
209 ' Determine the X, Y coordinates
211 sEventType = vUno(UBound(vUno))
213 X = Event.X
214 Y = Event.Y
215 ' Determine the window peer target
217 End If
218 End If
219 ' If not a mouse event, if no control, find what can be decent alternatives: (a menu header in) the actual window
220 If IsNull(oControl) Then
221 Set oWindow = oUi._IdentifyWindow(StarDesktop.getCurrentComponent()) ' A menu has been clicked necessarily in the current window
222 With oWindow
223 If Not IsNull(.Frame) Then Set oControl = .Frame.getContainerWindow()
224 End With
225 End If
227 If Not IsNull(oControl) Then
228 Set oMenu = New SF_PopupMenu
229 With oMenu
230 Set .[Me] = oMenu
231 ._Initialize(oControl, X, Y, SubmenuChar)
232 End With
233 Else
234 Set oMenu = Nothing
235 End If
237 Finally:
238 Set _NewPopupMenu = oMenu
239 Exit Function
240 Catch:
241 GoTo Finally
242 End Function ' SFWidgets.SF_Register._NewPopupMenu
244 REM -----------------------------------------------------------------------------
245 Public Function _NewToolbar(Optional ByVal pvArgs As Variant) As Object
246 ''' Create a new instance of the SF_Toolbar class
247 ''' The "Toolbar" service must not be invoked directly in a user script
248 ''' Args:
249 ''' ToolbarDesc: a proto-toolbar object type. See ScriptForge.SF_UI for a detailed description
250 ''' Returns:
251 ''' the instance or Nothing
253 Dim oToolbar As Object ' Return value
254 Dim oToolbarDesc As Object ' A proto-toolbar description
256 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
257 Set oToolbar = Nothing
259 Check:
260 Set oToolbarDesc = pvArgs(0)
262 Try:
263 Set oToolbar = New SF_Toolbar
264 With oToolbar
265 Set .[Me] = oToolbar
266 ._Initialize(oToolbarDesc)
267 End With
269 Finally:
270 Set _NewToolbar = oToolbar
271 Exit Function
272 Catch:
273 GoTo Finally
274 End Function ' SFWidgets.SF_Register._NewToolbar
276 REM -----------------------------------------------------------------------------
277 Public Function _NewToolbarButton(Optional ByVal pvArgs As Variant) As Object
278 ''' Create a new instance of the SF_ToolbarButton class
279 ''' The "ToolbarButton" service must not be invoked directly in a user script
280 ''' Args:
281 ''' ToolbarButtonDesc: a proto-toolbarButton object type. See SFWidgets.SF_Toolbar for a detailed description
282 ''' Returns:
283 ''' the instance or Nothing
285 Dim oToolbarButton As Object ' Return value
286 Dim oToolbarButtonDesc As Object ' A proto-toolbarbutton description
288 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
289 Set oToolbarButton = Nothing
291 Check:
292 Set oToolbarButtonDesc = pvArgs(0)
294 Try:
295 Set oToolbarButton = New SF_ToolbarButton
296 With oToolbarButton
297 Set .[Me] = oToolbarButton
298 ._Initialize(oToolbarButtonDesc)
299 End With
301 Finally:
302 Set _NewToolbarButton = oToolbarButton
303 Exit Function
304 Catch:
305 GoTo Finally
306 End Function ' SFWidgets.SF_Register._NewToolbarButton
309 REM ============================================== END OF SFWIDGETS.SF_REGISTER
310 </script:module>