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
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
|
<?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 SFDocuments 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 ================================================================== EXCEPTIONS
REM ================================================================= DEFINITIONS
''' Strategy for management of Form and FormControl events:
''' ------------------------------------------------------
''' At the contrary of Dialogs and DialogControls, which are always started from some code,
''' Forms and FormControls will be initiated most often by the user, even if the SFDocuments library
''' allows to start forms programmatically
'''
''' For Forms started programmatically, the corresponding objects are built top-down
''' Event management of forms and their controls requires to being able to rebuild Form
''' and FormControl objects bottom-up
'''
''' To avoid multiple rebuilds requested by multiple events,
''' 1. The active form objects are cached in a global array of _FormCache types
''' 2. FormControl objects are cached in Form objects
''' 3. The bottom-up rebuild is executed only once, at instance creation
Type _FormCache
Terminated As Boolean
XUnoForm As Object
BasicForm As Object
End Type
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("Document", "SFDocuments.SF_Register._NewDocument") ' Reference to the function initializing the service
.RegisterService("Calc", "SFDocuments.SF_Register._NewDocument") ' Same references, distinction is made inside the function
.RegisterService("Base", "SFDocuments.SF_Register._NewDocument") ' Same references, distinction is made inside the function
.RegisterEventManager("DocumentEvent", "SFDocuments.SF_Register._EventManager") ' Reference to the events manager
.RegisterEventManager("FormEvent", "SFDocuments.SF_Register._FormEventManager")' Reference to the form and controls events manager
End With
End Sub ' SFDocuments.SF_Register.RegisterScriptServices
REM =========================================================== PRIVATE FUNCTIONS
REM -----------------------------------------------------------------------------
Private Function _AddFormToCache(ByRef pvUnoForm As Object _
, ByRef pvBasicForm As Object _
) As Long
''' Add a new entry in the cache array with the references of the actual Form
''' If relevant, the last entry of the cache is reused.
''' The cache is located in the global _SF_ variable
''' Args:
''' pvUnoForm: com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
''' pvBasicForm: its corresponding Basic object
''' Returns:
''' The index of the new or modified entry
Dim vCache As New _FormCache ' Entry to be added
Dim lIndex As Long ' UBound of _SF_.SFForms
Dim vCacheArray As Variant ' Alias of _SF_.SFForms
Try:
vCacheArray = _SF_.SFForms
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 .XUnoForm = pvUnoForm
Set .BasicForm = pvBasicForm
End With
Set vCacheArray(lIndex) = vCache
_SF_.SFForms = vCacheArray
Finally:
_AddFormToCache = lIndex
Exit Function
End Function ' SFDocuments.SF_Register._AddFormToCache
REM -----------------------------------------------------------------------------
Private Sub _CleanCacheEntry(ByVal plIndex As Long)
''' Clean the plIndex-th entry in the Forms cache
''' Args:
''' plIndex: must fit within the actual boundaries of the cache, otherwise the request is ignored
Dim vCache As New _FormCache ' Cleaned entry
With _SF_
If Not IsArray(.SFForms) Then Exit Sub
If plIndex < LBound(.SFForms) Or plIndex > UBound(.SFForms) Then Exit Sub
With vCache
.Terminated = True
Set .XUnoForm = Nothing
Set .BasicForm = Nothing
End With
.SFForms(plIndex) = vCache
End With
Finally:
Exit Sub
End Sub ' SFDocuments.SF_Register._CleanCacheEntry
REM -----------------------------------------------------------------------------
Public Function _EventManager(Optional ByRef pvArgs As Variant) As Object
''' Returns a Document, Calc or Base object corresponding with the active component
''' which triggered the event in argument
''' This method should be triggered only thru the invocation of CreateScriptService
''' Args:
''' pvEvent: com.sun.star.document.DocumentEvent
''' Returns:
''' the output of a Document, Calc, ... service or Nothing
''' Example:
''' Sub TriggeredByEvent(ByRef poEvent As Object)
''' Dim oDoc As Object
''' Set oDoc = CreateScriptService("SFDocuments.DocumentEvent", poEvent)
''' If Not IsNull(oDoc) Then
''' ' ... (a valid document has been identified)
''' End Sub
Dim oSource As Object ' Return value
Dim vEvent As Variant ' Alias of pvArgs(0)
' 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 Set vEvent = Empty
If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally
Try:
If ScriptForge.SF_Session.UnoObjectType(vEvent) = "com.sun.star.document.DocumentEvent" Then
Set oSource = SF_Register._NewDocument(vEvent.Source)
End If
Finally:
Set _EventManager = oSource
Exit Function
End Function ' SFDocuments.SF_Register._EventManager
REM -----------------------------------------------------------------------------
Private Function _FindFormInCache(ByRef poForm As Object) As Object
''' Find the Form based on its XUnoForm
''' The Form must not be terminated
''' Returns:
''' The corresponding Basic Form part or Nothing
Dim oBasicForm As Object ' Return value
Dim oCache As _FormCache ' Entry in the cache
Set oBasicForm = Nothing
Try:
With _SF_
If Not IsEmpty(.SFForms) Then
For Each oCache In .SFForms
If EqualUnoObjects(poForm, oCache.XUnoForm) And Not oCache.Terminated Then
Set oBasicForm = oCache.BasicForm
Exit For
End If
Next oCache
End If
End With
Finally:
Set _FindFormInCache = oBasicForm
Exit Function
End Function ' SFDocuments.SF_Register._FindFormInCache
REM -----------------------------------------------------------------------------
Public Function _FormEventManager(Optional ByRef pvArgs As Variant) As Object
''' Returns a Form or FormControl object corresponding with the form or control
''' which triggered the event in argument
''' This method should be triggered only thru the invocation of CreateScriptService
''' Args:
''' pvEvent: com.sun.star.lang.EventObject
''' Returns:
''' the output of a Form, FormControl service or Nothing
''' Example:
''' Sub TriggeredByEvent(ByRef poEvent As Object)
''' Dim oForm As Object
''' Set oForm = CreateScriptService("SFDocuments.FormEvent", poEvent)
''' If Not IsNull(oForm) Then
''' ' ... (a valid form or subform has been identified)
''' End Sub
Dim oSource As Object ' Return value
Dim vEvent As Variant ' Alias of pvArgs(0)
Dim oControlModel As Object ' com.sun.star.awt.XControlModel
Dim oParent As Object ' com.sun.star.form.OGridControlModel or com.sun.star.comp.forms.ODatabaseForm
Dim sParentType As String ' "com.sun.star.form.OGridControlModel" or "com.sun.star.comp.forms.ODatabaseForm"
Dim oSFParent As Object ' The parent as a ScriptForge instance: SF_Form or SF_FormControl
Dim oSFForm As Object ' The grand-parent SF_Form instance
Dim oSession As Object : Set oSession = ScriptForge.SF_Session
' 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 Set vEvent = Empty
If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally
Try:
If oSession.HasUnoProperty(vEvent, "Source") Then
' FORM EVENT
If oSession.UnoObjectType(vEvent.Source) = "com.sun.star.comp.forms.ODatabaseForm" Then
Set oSource = SF_Register._NewForm(vEvent.Source, pbForceInit := True)
' CONTROL EVENT
Else
' A SF_FormControl instance is always created from its parent, either a form, a subform or a table control
Set oControlModel = vEvent.Source.Model ' The event source is a control view com.sun.star.awt.XControl
Set oParent = oControlModel.Parent
sParentType = oSession.UnoObjectType(oParent)
Select Case sParentType
Case "com.sun.star.form.OGridControlModel"
Set oSFForm = SF_Register._NewForm(oParent.Parent, pbForceInit := True)
Set oSFParent = oSFForm.Controls(oParent.Name)
Case "com.sun.star.comp.forms.ODatabaseForm"
Set oSFParent = SF_Register._NewForm(oParent, pbForceInit := True)
End Select
' The final instance is derived from its parent instance
Set oSource = oSFParent.Controls(oControlModel.Name)
End If
End If
Finally:
Set _FormEventManager = oSource
Exit Function
End Function ' SFDocuments.SF_Register._FormEventManager
REM -----------------------------------------------------------------------------
Public Function _GetEventScriptCode(poObject As Object _
, ByVal psEvent As String _
, ByVal psName As String _
) As String
''' Extract from the parent of poObject the Basic script linked to psEvent.
''' Helper function common to forms and form controls
''' Args:
''' poObject: a com.sun.star.form.XForm or XControl object
''' psEvent: the "On..." name of the event
''' psName: the name of the object to be identified from the parent object
''' Returns:
''' The script to trigger when psEvent occurs
''' See Scripting Framework URI Specification : https://wiki.openoffice.org/wiki/Documentation/DevGuide/Scripting/Scripting_Framework_URI_Specification
Dim vEvents As Variant ' List of available events in the parent object
' Array of com.sun.star.script.ScriptEventDescriptor
Dim sEvent As String ' The targeted event name
Dim oParent As Object ' The parent object
Dim lIndex As Long ' The index of the targeted event in the events list of the parent object
Dim sName As String ' The corrected UNO event name
Dim i As Long
_GetEventScriptCode = ""
On Local Error GoTo Catch
If Not ScriptForge.SF_Session.HasUnoMethod(poObject, "getParent") Then GoTo Finally
Try:
' Find form index i.e. find control via getByIndex()
' The name is known (= psName) but getByIndex() is not in the same sequence as getElementNames()
Set oParent = poObject.getParent()
lIndex = -1
For i = 0 To oParent.getCount() - 1
sName = oParent.getByIndex(i).Name
If (sName = psName) Then
lIndex = i
Exit For
End If
Next i
If lIndex < 0 Then GoTo Finally ' Not found, should not happen
' Find script triggered by event
vEvents = oParent.getScriptEvents(lIndex) ' Returns an array
' Fix historical typo error
sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4), "errorOccurred", "errorOccured")
For i = 0 To UBound(vEvents)
If vEvents(i).EventMethod = sEvent Then
_GetEventScriptCode = vEvents(i).ScriptCode
Exit For
End If
Next i
Finally:
Exit Function
Catch:
GoTo Finally
End Function ' SFDocuments.SF_Register._GetEventScriptCode
REM -----------------------------------------------------------------------------
Public Function _NewDocument(Optional ByVal pvArgs As Variant) As Object
''' Create a new instance of the (super) SF_Document class or of one of its subclasses (SF_Calc, ...)
' Args:
''' WindowName: see the definition of WindowName in the description of the UI service
''' If absent, the document is presumed to be in the active window
''' If WindowName is an object, it must be a component
''' (com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument)
''' Returns: the instance or Nothing
Dim oDocument As Object ' Return value
Dim oSuperDocument As Object ' Companion superclass document
Dim vWindowName As Variant ' Alias of pvArgs(0)
Dim oEnum As Object ' com.sun.star.container.XEnumeration
Dim oComp As Object ' com.sun.star.lang.XComponent
Dim vWindow As Window ' A single component
Dim oUi As Object ' "UI" service
Dim bFound As Boolean ' True if the document is found on the desktop
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) ' Needed when _NewDocument called from _EventManager
If UBound(pvArgs) >= 0 Then vWindowName = pvArgs(0) Else vWindowName = ""
If Not ScriptForge.SF_Utils._Validate(vWindowName, "WindowName", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
Set oDocument = Nothing
Try:
Set oUi = ScriptForge.SF_Register.CreateScriptService("UI")
Select Case VarType(vWindowName)
Case V_STRING
If Len(vWindowName) > 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(vWindowName)) _
Or (Len(.WindowName) > 0 And .WindowName = vWindowName) _
Or (Len(.WindowTitle) > 0 And .WindowTitle = vWindowName) Then
bFound = True
Exit Do
End If
End With
Loop
Else
bFound = True
vWindow = oUi._IdentifyWindow(StarDesktop.CurrentComponent)
End If
Case ScriptForge.V_OBJECT ' com.sun.star.lang.XComponent
bFound = True
vWindow = oUi._IdentifyWindow(vWindowName)
End Select
If bFound And Not IsNull(vWindow.Frame) And Len(vWindow.DocumentType) > 0 Then
' Create the right subclass and associate to it a new instance of the superclass
Select Case vWindow.DocumentType
Case "Base"
Set oDocument = New SF_Base
Set oSuperDocument = New SF_Document
Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
Set oSuperDocument.[_SubClass] = oDocument
Case "Calc"
Set oDocument = New SF_Calc
Set oSuperDocument = New SF_Document
Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned
Set oSuperDocument.[_SubClass] = oDocument
Case Else ' Only superclass
Set oDocument = New SF_Document
Set oSuperDocument = oDocument
End Select
With oDocument ' Initialize attributes of subclass
Set .[Me] = oDocument
Set ._Component = vWindow.Component
' Initialize specific attributes
Select Case vWindow.DocumentType
Case "Base"
Set ._DataSource = ._Component.DataSource
Case Else
End Select
End With
With oSuperDocument ' Initialize attributes of superclass
Set .[Me] = oSuperDocument
Set ._Component = vWindow.Component
Set ._Frame = vWindow.Frame
._WindowName = vWindow.WindowName
._WindowTitle = vWindow.WindowTitle
._WindowFileName = vWindow.WindowFileName
._DocumentType = vWindow.DocumentType
End With
End If
Finally:
Set _NewDocument = oDocument
Exit Function
Catch:
GoTo Finally
End Function ' SFDocuments.SF_Register._NewDocument
REM -----------------------------------------------------------------------------
Public Function _NewForm(ByRef poForm As Object _
, Optional pbForceInit As Boolean _
) As Object
''' Returns an existing or a new SF_Form instance based on the argument
''' If the instance is new (not found in cache), the minimal members are initialized
''' Args:
''' poForm: com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
''' pbForceInit: when True, initialize the form instance. Default = False
''' Returns:
''' A SF_Form instance
Dim oForm As Object ' Return value
Try:
Set oForm = SF_Register._FindFormInCache(poForm)
If IsNull(oForm) Then ' Not found
If IsMissing(pbForceInit) Or IsEmpty(pbForceInit) Then pbForceInit = False
Set oForm = New SF_Form
With oForm
._Name = poForm.Name
Set .[Me] = oForm
Set ._Form = poForm
If pbForceInit Then ._Initialize()
End With
End If
Finally:
Set _NewForm = oForm
Exit Function
End Function ' SFDocuments.SF_Register._NewForm
REM -----------------------------------------------------------------------------
Public Function _RegisterEventScript(poObject As Object _
, ByVal psEvent As String _
, ByVal psListener As String _
, ByVal psScriptCode As String _
, ByVal psName As String _
) As Boolean
''' Register a script event (psEvent) to poObject (Form, SubForm or Control)
''' Args:
''' poObject: a com.sun.star.form.XForm or XControl object
''' psEvent: the "On..." name of the event
''' psListener: the listener name corresponding with the event
''' psScriptCode: The script to trigger when psEvent occurs
''' See Scripting Framework URI Specification : https://wiki.openoffice.org/wiki/Documentation/DevGuide/Scripting/Scripting_Framework_URI_Specification
''' psName: the name of the object to associate with the event
''' Returns:
''' True when successful
Dim oEvent As Object ' com.sun.star.script.ScriptEventDescriptor
Dim sEvent As String ' The targeted event name
Dim oParent As Object ' The parent object
Dim lIndex As Long ' The index of the targeted event in the events list of the parent object
Dim sName As String ' The corrected UNO event name
Dim i As Long
_RegisterEventScript = False
On Local Error GoTo Catch
If Not ScriptForge.SF_Session.HasUnoMethod(poObject, "getParent") Then GoTo Finally
Try:
' Find object's internal index i.e. how to reach it via getByIndex()
Set oParent = poObject.getParent()
lIndex = -1
For i = 0 To oParent.getCount() - 1
sName = oParent.getByIndex(i).Name
If (sName = psName) Then
lIndex = i
Exit For
End If
Next i
If lIndex < 0 Then GoTo Finally ' Not found, should not happen
' Fix historical typo error
sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4), "errorOccurred", "errorOccured")
' Apply new script code. Erasing it is done with a specific UNO method
If psScriptCode = "" Then
oParent.revokeScriptEvent(lIndex, psListener, sEvent, "")
Else
Set oEvent = CreateUnoStruct("com.sun.star.script.ScriptEventDescriptor")
With oEvent
.ListenerType = psListener
.EventMethod = sEvent
.ScriptType = "Script" ' Better than "Basic"
.ScriptCode = psScriptCode
End With
oParent.registerScriptEvent(lIndex, oEvent)
End If
_RegisterEventScript = True
Finally:
Exit Function
Catch:
GoTo Finally
End Function ' SFDocuments.SF_Register._RegisterEventScript
REM ============================================== END OF SFDOCUMENTS.SF_REGISTER
</script:module>
|
