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
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
|
<?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 SFDialogs 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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
REM ================================================================= DEFINITIONS
''' Event management of dialogs requires to being able to rebuild a Dialog object
''' from its com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl UNO instance
''' For that purpose, the started dialogs are buffered in a global array of _DialogCache types
Type _DialogCache
Terminated As Boolean
XUnoDialog As Object
BasicDialog As Object
End Type
REM ================================================================== EXCEPTIONS
Private Const DIALOGNOTFOUNDERROR = "DIALOGNOTFOUNDERROR"
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("Dialog", "SFDialogs.SF_Register._NewDialog") ' Reference to the function initializing the service
.RegisterEventManager("DialogEvent", "SFDialogs.SF_Register._EventManager") ' Reference to the events manager
.RegisterEventManager("NewDialog", "SFDialogs.SF_Register._NewDialogFromScratch") ' Reference to the function initializing the service
End With
End Sub ' SFDialogs.SF_Register.RegisterScriptServices
REM =========================================================== PRIVATE FUNCTIONS
REM -----------------------------------------------------------------------------
Private Function _AddDialogToCache(ByRef pvUnoDialog As Object _
, ByRef pvBasicDialog As Object _
) As Long
''' Add a new entry in the cache array with the references of the actual dialog
''' If relevant, the last entry of the cache is reused.
''' The cache is located in the global _SF_ variable
''' Args:
''' pvUnoDialog: the com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl of the dialog box
''' pvBasicDialog: its corresponding Basic object
''' Returns:
''' The index of the new or modified entry
Dim vCache As New _DialogCache ' Entry to be added
Dim lIndex As Long ' UBound of _SF_.SFDialogs
Dim vCacheArray As Variant ' Alias of _SF_.SFDialogs
Try:
vCacheArray = _SF_.SFDialogs
If IsEmpty(vCacheArray) Then vCacheArray = Array()
lIndex = UBound(vCacheArray)
If lIndex < LBound(vCacheArray) Then
ReDim vCacheArray(0 To 0)
lIndex = 0
ElseIf Not vCacheArray(lIndex).Terminated Then ' Often last entry can be reused
lIndex = lIndex + 1
ReDim Preserve vCacheArray(0 To lIndex)
End If
With vCache
.Terminated = False
Set .XUnoDialog = pvUnoDialog
Set .BasicDialog = pvBasicDialog
End With
vCacheArray(lIndex) = vCache
_SF_.SFDialogs = vCacheArray
Finally:
_AddDialogToCache = lIndex
Exit Function
End Function ' SFDialogs.SF_Register._AddDialogToCache
REM -----------------------------------------------------------------------------
Private Sub _CleanCacheEntry(ByVal plIndex As Long)
''' Clean the plIndex-th entry in the dialogs cache
''' Args:
''' plIndex: must fit within the actual boundaries of the cache, otherwise the request is ignored
Dim vCache As New _DialogCache ' Cleaned entry
With _SF_
If Not IsArray(.SFDialogs) Then Exit Sub
If plIndex < LBound(.SFDialogs) Or plIndex > UBound(.SFDialogs) Then Exit Sub
With vCache
.Terminated = True
Set .XUnoDialog = Nothing
Set .BasicDialog = Nothing
End With
.SFDialogs(plIndex) = vCache
End With
Finally:
Exit Sub
End Sub ' SFDialogs.SF_Register._CleanCacheEntry
REM -----------------------------------------------------------------------------
Public Function _EventManager(Optional ByRef pvArgs As Variant) As Object
''' Returns a Dialog or DialogControl object corresponding with the Basic dialog
''' which triggered the event in argument
''' This method should be triggered only thru the invocation of CreateScriptService
''' Args:
''' pvEvent: com.sun.star.xxx
''' Returns:
''' the output of a Dialog or DialogControl service or Nothing
''' Example:
''' Sub TriggeredByEvent(ByRef poEvent As Object)
''' Dim oDlg As Object
''' Set oDlg = CreateScriptService("SFDialogs.DialogEvent", poEvent)
''' If Not IsNull(oDlg) Then
''' ' ... (a valid dialog or one of its controls has been identified)
''' End Sub
Dim oSource As Object ' Return value
Dim oEventSource As Object ' Event UNO source
Dim vEvent As Variant ' Alias of pvArgs(0)
Dim sSourceType As String ' Implementation name of event source
Dim oDialog As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
Dim bControl As Boolean ' True when control event
' Never abort while an event is processed
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally
Set oSource = Nothing
Check:
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
If UBound(pvArgs) >= 0 Then vEvent = pvArgs(0) Else vEvent = Empty
If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally
If Not ScriptForge.SF_Session.HasUnoProperty(vEvent, "Source") Then GoTo Finally
Try:
Set oEventSource = vEvent.Source
sSourceType = ScriptForge.SF_Session.UnoObjectType(oEventSource)
Set oDialog = Nothing
Select Case True
Case sSourceType = "stardiv.Toolkit.UnoDialogControl" ' A dialog
' Search the dialog in the cache
Set oDialog = _FindDialogInCache(oEventSource)
bControl = False
Case Left(sSourceType, 16) = "stardiv.Toolkit." ' A dialog control
Set oDialog = _FindDialogInCache(oEventSource.Context)
bControl = True
Case Else
End Select
If Not IsNull(oDialog) Then
If bControl Then Set oSource = oDialog.Controls(oEventSource.Model.Name) Else Set oSource = oDialog
End If
Finally:
Set _EventManager = oSource
Exit Function
End Function ' SFDialogs.SF_Register._EventManager
REM -----------------------------------------------------------------------------
Private Function _FindDialogInCache(ByRef poDialog As Object) As Object
''' Find the dialog based on its XUnoDialog
''' The dialog must not be terminated
''' Returns:
''' The corresponding Basic dialog part or Nothing
Dim oBasicDialog As Object ' Return value
Dim oCache As _DialogCache ' Entry in the cache
Set oBasicDialog = Nothing
Try:
For Each oCache In _SF_.SFDialogs
If EqualUnoObjects(poDialog, oCache.XUnoDialog) And Not oCache.Terminated Then
Set oBasicDialog = oCache.BasicDialog
Exit For
End If
Next oCache
Finally:
Set _FindDialogInCache = oBasicDialog
Exit Function
End Function ' SFDialogs.SF_Register._FindDialogInCache
REM -----------------------------------------------------------------------------
Public Function _NewDialog(Optional ByVal pvArgs As Variant) As Object
''' Create a new instance of the SF_Dialog class
''' Args:
''' Container: either "GlobalScope" or a WindowName. Default = the active window
''' see the definition of WindowName in the description of the UI service
''' Library: the name of the library hosting the dialog. Default = "Standard"
''' DialogName: The name of the dialog
''' Library and dialog names are case-sensitive
''' Context: When called from Python, the context must be provided : XSCRIPTCONTEXT
''' Returns: the instance or Nothing
Dim oDialog As Object ' Return value
Dim vContainer As Variant ' Alias of pvArgs(0)
Dim vLibrary As Variant ' Alias of pvArgs(1)
Dim vDialogName As Variant ' Alias of pvArgs(2)
Dim oLibraries As Object ' com.sun.star.comp.sfx2.DialogLibraryContainer
Dim vContext As Variant ' com.sun.star.uno.XComponentContext
Dim oDialogProvider As Object ' com.sun.star.io.XInputStreamProvider
Dim oEnum As Object ' com.sun.star.container.XEnumeration
Dim oComp As Object ' com.sun.star.lang.XComponent
Dim oDialogControl As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
Dim vWindow As Window ' A single component
Dim sScope As String ' "application" or "document"
Dim sURI As String ' URI of the targeted dialog
Dim oUi As Object ' "UI" service
Dim bFound As Boolean ' True if WindowName is found on the desktop
Const cstService = "SFDialogs.Dialog"
Const cstGlobal = "GlobalScope"
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Check:
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs)
If UBound(pvArgs) >= 0 Then vContainer = pvArgs(0) Else vContainer = ""
If UBound(pvArgs) >= 1 Then vLibrary = pvArgs(1)
If IsEmpty(vLibrary) Then vLibrary = "Standard"
If UBound(pvArgs) >= 2 Then vDialogName = pvArgs(2) Else vDialogName = Empty ' Use Empty to force mandatory status
If Not ScriptForge.SF_Utils._Validate(vContainer, "Container", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(vLibrary, "Library", V_STRING) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(vDialogName, "DialogName", V_STRING) Then GoTo Finally
If UBound(pvArgs) >= 3 Then vContext = pvArgs(3) Else Set vContext = Nothing
If Not ScriptForge.SF_Utils._Validate(vContext, "Context", ScriptForge.V_OBJECT) Then GoTo Finally
Set oDialog = Nothing
Try:
' Determine the library container hosting the dialog
Set oUi = ScriptForge.SF_Register.CreateScriptService("UI")
Set oComp = Nothing
If VarType(vContainer) = V_STRING Then
bFound = ( UCase(vContainer) = UCase(cstGlobal) )
End If
If Not bFound Then
Select Case VarType(vContainer)
Case V_STRING
If Len(vContainer) > 0 Then
bFound = False
Set oEnum = StarDesktop.Components().createEnumeration
Do While oEnum.hasMoreElements
Set oComp = oEnum.nextElement
vWindow = oUi._IdentifyWindow(oComp)
With vWindow
' Does the current window match the argument ?
If (Len(.WindowFileName) > 0 And .WindowFileName = ScriptForge.SF_FileSystem._ConvertToUrl(vContainer)) _
Or (Len(.WindowName) > 0 And .WindowName = vContainer) _
Or (Len(.WindowTitle) > 0 And .WindowTitle = vContainer) Then
bFound = True
Exit Do
End If
End With
Loop
Else
bFound = True
Set oComp = StarDesktop.CurrentComponent
vWindow = oUi._IdentifyWindow(oComp)
End If
Case V_OBJECT ' com.sun.star.lang.XComponent
bFound = True
vWindow = oUi._IdentifyWindow(vContainer)
Set oComp = vContainer
End Select
If Not bFound Then GoTo CatchNotFound
If Len(vWindow.DocumentType) = 0 Then GoTo CatchNotFound
End If
' Determine the dialog provider
Select Case True
Case IsNull(vContext) And IsNull(oComp) ' Basic and GlobalScope
Set oDialogProvider = GetProcessServiceManager.createInstance("com.sun.star.awt.DialogProvider")
Case IsNull(vContext) And Not IsNull(oComp) ' Basic and Document
Set oDialogProvider = GetProcessServiceManager.createInstanceWithArguments("com.sun.star.awt.DialogProvider", Array(oComp))
Case Not IsNull(vContext) And IsNull(oComp) ' Python and GlobalScope
Set oDialogProvider = vContext.getServiceManager().createInstanceWithContext("com.sun.star.awt.DialogProvider", vContext)
Case Not IsNull(vContext) And Not IsNull(oComp) ' Python and Document
Set oDialogProvider = vContext.getServiceManager().createInstanceWithArguments("com.sun.star.awt.DialogProvider", Array(oComp))
End Select
' Create the graphical interface
sScope = Iif(IsNull(oComp), "application", "document")
sURI = "vnd.sun.star.script:" & vLibrary & "." & vDialogName & "?location=" & sScope
On Local Error GoTo CatchNotFound
Set oDialogControl = oDialogProvider.createDialog(sURI)
' Initialize the basic SF_Dialog instance to return to the user script
Set oDialog = New SF_Dialog
With oDialog
Set .[Me] = oDialog
If VarType(vContainer) = V_STRING Then ._Container = vContainer Else ._Container = vWindow.WindowName
._Library = vLibrary
._Name = vDialogName
Set ._DialogProvider = oDialogProvider
Set ._DialogControl = oDialogControl
._Initialize()
End With
Finally:
Set _NewDialog = oDialog
Exit Function
Catch:
GoTo Finally
CatchNotFound:
ScriptForge.SF_Exception.RaiseFatal(DIALOGNOTFOUNDERROR, "Service", cstService _
, "Container", vContainer, "Library", vLibrary, "DialogName", vDialogName)
GoTo Finally
End Function ' SFDialogs.SF_Register._NewDialog
REM -----------------------------------------------------------------------------
Private Function _NewDialogFromScratch(Optional ByVal pvArgs As Variant) As Object
''' Create a new instance of the SF_Dialog class describing a dynamically defined dialog box
''' Args:
''' DialogName: a symbolic name of the dialog to create, for information only. Not checked for unicity.
''' Place: either
''' - an array with 4 elements: (X, Y, Width, Height)
''' - a com.sun.star.awt.Rectangle [X, Y, Width, Height]
''' All elements are expressed in "Map AppFont" units.
''' Context: When called from Python, the context must be provided : XSCRIPTCONTEXT
''' Returns: the instance or Nothing
Dim oDialog As Object ' Return value
Dim vDialogName As Variant ' The name is for information only
Dim vPlace As variant ' com.sun.star.awt.rectangle or array(X, Y, Width, Height)
Dim oPlace As Object ' com.sun.star.awt.rectangle
Dim oProcessManager As Object ' com.sun.star.lang.XMultiServiceFactory
Dim bBuiltInPython As Boolean ' True when context is present
Dim oModel As Object ' com.sun.star.awt.UnoControlDialogModel
Dim oView As Object ' com.sun.star.awt.UnoControlDialog
Dim vContext As Variant ' com.sun.star.uno.XComponentContext
Const cstDialogModel = "com.sun.star.awt.UnoControlDialogModel"
Const cstDialogView = "com.sun.star.awt.UnoControlDialog"
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Check:
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs)
If UBound(pvArgs) >= 0 Then vDialogName = pvArgs(0) Else vDialogName = Empty
If UBound(pvArgs) >= 1 Then vPlace = pvArgs(1) Else vPlace = Empty ' Use Empty to force the mandatory status
If IsMissing(vDialogName) Or IsEmpty(vDialogName) Then vDialogName = "DYNDIALOG"
If UBound(pvArgs) >= 2 Then vContext = pvArgs(2) Else Set vContext = Nothing
If Not ScriptForge.SF_Utils._Validate(vDialogName, "DialogName", V_STRING) Then GoTo Finally
If IsArray(vPlace) Then
If Not ScriptForge.SF_Utils._ValidateArray(vPlace, "Place", 1, ScriptForge.V_NUMERIC, True) Then GoTo Finally
Else
If Not ScriptForge.SF_Utils._Validate(vPlace, "Place", ScriptForge.V_OBJECT) Then GoTo Finally
End If
If Not ScriptForge.SF_Utils._Validate(vContext, "Context", ScriptForge.V_OBJECT) Then GoTo Finally
Set oDialog = Nothing
Try:
' Determine the process service manager and create the dialog model
If IsNull(vContext) Then ' Basic
Set oprocessManager = GetProcessServiceManager()
Set oModel = oProcessManager.createInstance(cstDialogModel)
bBuiltInPython = False
Else ' Python
Set oprocessManager = vContext.getServiceManager()
Set oModel = oProcessManager.createInstanceWithContext(cstDialogModel, vContext)
bBuiltInPython = True
End If
oModel.Name = vDialogName
' Set dimension and position
With oModel
If IsArray(vPlace) Then
If UBound(vPlace) = 3 Then
.PositionX = vPlace(0)
.PositionY = vPlace(1)
.Width = vPlace(2)
.Height = vPlace(3)
End If
ElseIf ScriptForge.SF_Session.UnoObjectType(vPlace) = "com.sun.star.awt.Rectangle" Then
Set oPlace = vPlace
.PositionX = oPlace.X
.PositionY = oPlace.Y
.Width = oPlace.Width
.Height = oPlace.Height
Else
'Leave everything to zero
End If
End With
' Create the view and associate model and view
Set oView = oProcessManager.createInstance(cstDialogView)
oView.setModel(oModel)
' Initialize the basic SF_Dialog instance to return to the user script
Set oDialog = New SF_Dialog
With oDialog
Set .[Me] = oDialog
._Container = ""
._Library = ""
._BuiltFromScratch = True
._BuiltInPython = bBuiltInPython
._Name = vDialogName
Set ._DialogProvider = Nothing
Set ._DialogControl = oView
._Initialize()
End With
Finally:
Set _NewDialogFromScratch = oDialog
Exit Function
Catch:
GoTo Finally
End Function ' SFDialogs.SF_Register._NewDialogFromScratch
REM ============================================== END OF SFDIALOGS.SF_REGISTER
</script:module>
|
