1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
|
<?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.
.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
</script:module>
|
