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
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
|
<?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_ToolbarButton" 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 ClassModule
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_ToolbarButton
''' ================
''' Hide/show toolbar elements, read and update their current behaviour..
'''
''' A toolbar consists in a series of graphical controls to trigger actions.
''' The "Toolbar" service gives access to the "ToolbarButton" service to manage
''' the individual buttons belonging to the toolbar.
'''
''' Changes made by scripts to buttons belonging to toolbars stored in the application
''' are persistent. They are valid for all documents of the same type.
'''
''' The name of a toolbar button is either:
''' - in custom toolbars, a predefined name given at its creation,
''' - in standard toolbars, a localized name as read in the Tools + Customize ... dialog box
'''
''' Service invocation:
''' It is available only from an active Toolbar service.
''' Example:
''' Dim oCalc As Object, oToolbar As Object, oToolbarButton As Object
''' Set oCalc = CreateScriptService("Calc", "myFile.ods")
''' Set oToolbar = oCalc.Toolbars("findbar")
''' Set oToolbarButton = oToolbar.ToolbarButtons("Find Next")
REM ================================================================== EXCEPTIONS
REM ============================================================= PRIVATE MEMBERS
Private [Me] As Object
Private ObjectType As String ' Must be TOOLBARBUTTON
Private ServiceName As String
Private [_Parent] As Object ' SF_Toolbar instance owning the button
Private _Index As Long ' Entry number in buttons lists
Private _Label As String ' Label (static description)
Private _AccessibleName As String ' Name found in accessible context
Private _Element As Object ' com.sun.star.ui.XUIElement
Private _CommandURL As String ' Uno command or script
Private _Height As Long ' Height may be cached
Private _Width As Long ' Width may be cached
REM ============================================================ MODULE CONSTANTS
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
REM -----------------------------------------------------------------------------
Private Sub Class_Initialize()
Set [Me] = Nothing
ObjectType = "TOOLBARBUTTON"
ServiceName = "SFWidgets.ToolbarButton"
Set [_Parent] = Nothing
_Index = -1
_Label = ""
_AccessibleName = ""
Set _Element = Nothing
_CommandURL = ""
_Height = 0
_Width = 0
End Sub ' SFWidgets.SF_ToolbarButton Constructor
REM -----------------------------------------------------------------------------
Private Sub Class_Terminate()
Call Class_Initialize()
End Sub ' SFWidgets.SF_ToolbarButton Destructor
REM -----------------------------------------------------------------------------
Public Function Dispose() As Variant
Call Class_Terminate()
Set Dispose = Nothing
End Function ' SFWidgets.SF_ToolbarButton Explicit Destructor
REM ================================================================== PROPERTIES
REM -----------------------------------------------------------------------------
Property Get Caption() As String
''' Returns the name of the button
''' Example:
''' MsgBox myButton.Caption
Caption = _PropertyGet("Caption")
End Property ' SFWidgets.SF_ToolbarButton.Caption (get)
REM -----------------------------------------------------------------------------
Property Get Height() As Long
''' Returns the height in pixels of the button
''' Example:
''' MsgBox myButton.Height
Height = _PropertyGet("Height")
End Property ' SFWidgets.SF_ToolbarButton.Height (get)
REM -----------------------------------------------------------------------------
Property Get Index() As Long
''' Returns the index of the button
''' - in the Settings (com.sun.star.container.XIndexAccess) of the parent toolbar
''' - in the AccessibleContext (com.sun.star.comp.toolkit.AccessibleToolBox) of the parent toolbar
''' Both should be identical: the range number of the button in the toolbar, hidden buttons and separators included.
''' Example:
''' MsgBox myButton.Index
Index = _PropertyGet("Index")
End Property ' SFWidgets.SF_ToolbarButton.Index (get)
REM -----------------------------------------------------------------------------
Property Get OnClick() As Variant
''' Returns the UNO command or the script (expressed in the scripting framework_URI notation) run when the button is clicked
''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
''' Note that no event object is passed to the script.
''' Example:
''' MsgBox myButton.OnClick
OnClick = _PropertyGet("OnClick")
End Property ' SFWidgets.SF_ToolbarButton.OnClick (get)
REM -----------------------------------------------------------------------------
Property Let OnClick(ByVal pvOnClick As Variant)
''' Sets the UNO command or the script (expressed in the scripting framework_URI notation) to trigger when the button is clicked
''' It is highly recommended to not modify standard buttons.
''' Example:
''' myButton.OnClick = ".uno:About"
''' myButton.OnClick = "vnd.sun.star.script:XrayTool._Main.Xray?language=Basic&location=application"
_PropertySet("OnClick", pvOnClick)
End Property ' SFWidgets.SF_ToolbarButton.OnClick (let)
REM -----------------------------------------------------------------------------
Property Get Parent() As Object
''' Returns the parent toolbar as a SF_Toolbar object instance
''' Example:
''' Set oToolbar = myButton.Parent
Set Parent = _PropertyGet("Parent")
End Property ' SFWidgets.SF_ToolbarButton.Parent (get)
REM -----------------------------------------------------------------------------
Property Get TipText() As Variant
''' Specifies the text that appears in a screentip when you hold the mouse pointer over the button
''' Example:
''' MsgBox myButton.TipText
TipText = _PropertyGet("TipText")
End Property ' SFWidgets.SF_ToolbarButton.TipText (get)
REM -----------------------------------------------------------------------------
Property Let TipText(ByVal pvTipText As Variant)
''' Sets the screentip associated with the actual toolbar button
''' It is highly recommended to not modify standard buttons.
''' Example:
''' myButton.TipText = "Click here"
_PropertySet("TipText", pvTipText)
End Property ' SFWidgets.SF_ToolbarButton.TipText (let)
REM -----------------------------------------------------------------------------
Property Get Visible() As Variant
''' Returns True when the toolbar button is visible. Otherwise False.
''' Example:
''' MsgBox myButton.Visible
Visible = _PropertyGet("Visible")
End Property ' SFWidgets.SF_ToolbarButton.Visible (get)
REM -----------------------------------------------------------------------------
Property Let Visible(ByVal pvVisible As Variant)
''' Sets the visible status of the toolbar button.
''' Example:
''' myButton.Visible = True
_PropertySet("Visible", pvVisible)
End Property ' SFWidgets.SF_ToolbarButton.Visible (let)
REM -----------------------------------------------------------------------------
Property Get Width() As Long
''' Returns the width in pixels of the button
''' Example:
''' MsgBox myButton.Width
Width = _PropertyGet("Width")
End Property ' SFWidgets.SF_ToolbarButton.Width (get)
REM -----------------------------------------------------------------------------
Property Get X() As Long
''' Returns the X (horizontal) coordinate in pixels of the top-left corner of the button
''' Example:
''' MsgBox myButton.X
X = _PropertyGet("X")
End Property ' SFWidgets.SF_ToolbarButton.X (get)
REM -----------------------------------------------------------------------------
Property Get Y() As Long
''' Returns the Y (vertical) coordinate in pixels of the top-left corner of the button
''' Example:
''' MsgBox myButton.Y
Y = _PropertyGet("Y")
End Property ' SFWidgets.SF_ToolbarButton.Y (get)
REM ===================================================================== METHODS
REM -----------------------------------------------------------------------------
Public Function Execute() As Variant
''' Execute the command stored in the toolbar button.
''' The command can be a UNO command or a Basic/Python script (expressed in the scripting framework_URI notation)
''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
''' No argument is passed to the script to execute.
''' Args:
''' Returns:
''' The output of the script or Null
''' Examples:
''' result = myButton.Execute()
Dim vResult As Variant ' Return value
Dim sCommand As String ' Command associated with button
Dim oFrame As Object ' com.sun.star.comp.framework.Frame
Dim oDispatcher As Object ' com.sun.star.frame.DispatchHelper
Dim vScript As Variant ' Split command in script/argument
Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session")
Dim oArgs() As new com.sun.star.beans.PropertyValue
Const cstUnoPrefix = ".uno:"
Const cstThisSub = "SFWidgets.ToolbarButton.Execute"
Const cstSubArgs = ""
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
vResult = Null
Check:
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
Try:
sCommand = GetProperty("OnClick")
If Len(sCommand) > 0 Then
' A button has been clicked necessarily in the current window (Document) or one of its subcomponents (FormDocument)
Set oFrame = StarDesktop.ActiveFrame
If oFrame.Frames.Count > 0 Then Set oFrame = oFrame.getActiveFrame()
' Command or script ?
If ScriptForge.SF_String.StartsWith(sCommand, cstUnoPrefix) Then
' Execute uno command
Set oDispatcher = ScriptForge.SF_Utils._GetUNOService("DispatchHelper")
oDispatcher.executeDispatch(oFrame, sCommand, "", 0, oArgs())
oFrame.activate()
Else
' Execute script
vResult = oSession._ExecuteScript(sCommand)
End If
End If
Finally:
Execute = vResult
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SFWidgets.SF_ToolbarButton.Execute
REM -----------------------------------------------------------------------------
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
''' Return the actual value of the given property
''' Args:
''' PropertyName: the name of the property as a string
''' Returns:
''' The actual value of the property
''' If the property does not exist, returns Null
''' Exceptions:
''' see the exceptions of the individual properties
''' Examples:
''' myToolbar.GetProperty("Visible")
Const cstThisSub = "SFWidgets.ToolbarButton.GetProperty"
Const cstSubArgs = ""
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
GetProperty = Null
Check:
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
End If
Try:
GetProperty = _PropertyGet(PropertyName)
Finally:
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SFWidgets.SF_ToolbarButton.GetProperty
REM -----------------------------------------------------------------------------
Public Function Methods() As Variant
''' Return the list of public methods of the Model service as an array
Methods = Array( _
"Execute" _
)
End Function ' SFWidgets.SF_ToolbarButton.Methods
REM -----------------------------------------------------------------------------
Public Function Properties() As Variant
''' Return the list or properties of the Timer a.AddItem("B>B1")class as an array
Properties = Array( _
"Caption" _
, "Height" _
, "Index" _
, "OnClick" _
, "Parent" _
, "TipText" _
, "Visible" _
, "Width" _
, "X" _
, "Y" _
)
End Function ' SFWidgets.SF_ToolbarButton.Properties
REM -----------------------------------------------------------------------------
Public Function SetProperty(Optional ByVal PropertyName As Variant _
, Optional ByRef Value As Variant _
) As Boolean
''' Set a new value to the given property
''' Args:
''' PropertyName: the name of the property as a string
''' Value: its new value
''' Exceptions
''' ARGUMENTERROR The property does not exist
Const cstThisSub = "SFWidgets.ToolbarButton.SetProperty"
Const cstSubArgs = "PropertyName, Value"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
SetProperty = False
Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
End If
Try:
SetProperty = _PropertySet(PropertyName, Value)
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SFWidgets.SF_ToolbarButton.SetProperty
REM =========================================================== PRIVATE FUNCTIONS
REM -----------------------------------------------------------------------------
Private Function _GetPosition() As Object
''' Determine the position of the top-left corner of the actual button.
''' Returns:
''' a com.sun.star.awt.Rectangle structure
Dim oElement As Object ' com.sun.star.ui.XUIElement
Dim oAccessible As Object ' com.sun.star.comp.toolkit.AccessibleToolBoxItem
Dim oAccessibleButton As Object ' com.sun.star.comp.toolkit.AccessibleToolBoxItem
Dim oAccessibleParent As Object ' com.sun.star.comp.toolkit.AccessibleToolBoxItem
Dim oRect As Object ' Return value As com.sun.star.awt.Rectangle
Try:
Set oElement = _Element.GetSettings(True).getByIndex(_Index)
Set oRect = CreateUnoStruct("com.sun.star.awt.Rectangle")
If ScriptForge.SF_Utils._GetPropertyValue(oElement, "IsVisible") Then
Set oAccessible = _Element.getRealInterface().getAccessibleContext() ' Toolbar level
Set oAccessibleParent = oAccessible.getAccessibleParent() ' Window level
Set oAccessibleButton = oAccessible.getAccessibleChild(_Index) ' Toolbar button level
' The X and Y coordinates are always computed correctly when the toolbar is docked.
' When the toolbar is floating, the Y ordinate may be overestimated with the height of
' the tabbed bar or similar. However no mean has been found to get that height via code.
With oRect
.X = oAccessible.Location.X + oAccessibleButton.Location.X + oAccessibleParent.PosSize.X
.Y = oAccessible.Location.Y + oAccessibleButton.Location.Y + oAccessibleParent.PosSize.Y
.Height = oAccessibleButton.Size.Height
.Width = oAccessibleButton.Size.Width
End With
Else
With oRect
.X = -1 : .Y = -1 : .Height = 0 : .Width = 0
End With
End If
Finally:
Set _GetPosition = oRect
Exit Function
End Function ' SFWidgets.SF_ToolbarButton._GetPosition
REM -----------------------------------------------------------------------------
Public Sub _Initialize(ByRef poToolbarButton As Object)
''' Complete the object creation process:
''' - Initialize the toolbar descriptioner use
''' Args:
''' poToolbarButton: the toolbar description as a ui._Toolbr object
Try:
' Store the static description
With poToolbarButton
Set [_Parent] = .Toolbar
_Index = .Index
_Label = .Label
_AccessibleName = .AccessibleName
Set _Element = .Element
End With
' Complement
_CommandURL = ScriptForge.SF_Utils._GetPropertyValue(_Element.getSettings(True).getByIndex(_Index), "CommandURL")
Finally:
Exit Sub
End Sub ' SFWidgets.SF_ToolbarButton._Initialize
REM -----------------------------------------------------------------------------
Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
''' Return the value of the named property
''' Args:
''' psProperty: the name of the property
Dim vGet As Variant ' Return value
Dim sTooltip As String ' ToolTip text
Dim oElement As Object ' com.sun.star.ui.XUIElement
Dim cstThisSub As String
Const cstSubArgs = ""
cstThisSub = "SFWidgets.ToolbarButton.get" & psProperty
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
_PropertyGet = Null
Select Case UCase(psProperty)
Case UCase("Caption")
_PropertyGet = Iif(Len(_Label) > 0, _Label, _AccessibleName)
Case UCase("Height")
If _Height > 0 Then _PropertyGet = _Height else _PropertyGet = _GetPosition().Height
Case UCase("Index")
_PropertyGet = _Index
Case UCase("OnClick")
Set oElement = _Element.GetSettings(True).getByIndex(_Index)
_PropertyGet = ScriptForge.SF_Utils._GetPropertyValue(oElement, "CommandURL")
Case UCase("Parent")
Set _PropertyGet = [_Parent]
Case UCase("TipText")
Set oElement = _Element.GetSettings(True).getByIndex(_Index)
sTooltip = ScriptForge.SF_Utils._GetPropertyValue(oElement, "Tooltip")
If Len(sTooltip) > 0 Then _PropertyGet = sTooltip Else _PropertyGet = Iif(Len(_Label) > 0, _Label, _AccessibleName)
Case UCase("Visible")
Set oElement = _Element.GetSettings(True).getByIndex(_Index)
_PropertyGet = ScriptForge.SF_Utils._GetPropertyValue(oElement, "IsVisible")
Case UCase("Width")
If _Width > 0 Then _PropertyGet = _Width else _PropertyGet = _GetPosition().Width
Case UCase("X")
_PropertyGet = _GetPosition().X
Case UCase("Y")
_PropertyGet = _GetPosition().Y
Case Else
_PropertyGet = Null
End Select
Finally:
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SFWidgets.SF_ToolbarButton._PropertyGet
REM -----------------------------------------------------------------------------
Private Function _PropertySet(Optional ByVal psProperty As String _
, Optional ByVal pvValue As Variant _
) As Boolean
''' Set the new value of the named property
''' Args:
''' psProperty: the name of the property
''' pvValue: the new value of the given property
Dim bSet As Boolean ' Return value
Dim oSettings As Object ' com.sun.star.container.XIndexAccess
Dim vProperties As Variant ' Array of PropertyValues
Dim bVisible As Boolean ' Actual Visible state
Dim cstThisSub As String
Const cstSubArgs = "Value"
Check:
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bSet = False
cstThisSub = "SFWidgets.ToolbarButton.set" & psProperty
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
Try:
bSet = True
Set oSettings = _Element.getSettings(True)
vProperties = oSettings.getByIndex(_Index)
Select Case UCase(psProperty)
Case UCase("OnClick")
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Catch
ScriptForge.SF_Utils._SetPropertyValue(vProperties, "CommandURL", pvValue)
Case UCase("TipText")
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Catch
ScriptForge.SF_Utils._SetPropertyValue(vProperties, "Tooltip", pvValue)
Case UCase("Visible")
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Catch
ScriptForge.SF_Utils._SetPropertyValue(vProperties, "IsVisible", pvValue)
Case Else
bSet = False
End Select
oSettings.replaceByIndex(_Index, vProperties)
_Element.setSettings(oSettings)
Finally:
_PropertySet = bSet
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
bSet = False
GoTo Finally
End Function ' SFWidgets.SF_ToolbarButton._PropertySet
REM -----------------------------------------------------------------------------
Private Function _Repr() As String
''' Convert the SF_ToolbarButton instance to a readable string, typically for debugging purposes (DebugPrint ...)
''' Args:
''' Return:
''' "[Toolbar]: Name, Type (dialogname)
_Repr = "[ToolbarButton]: " & Iif(Len(_Label) > 0, _Label, _AccessibleName) & " - " & _CommandURL
End Function ' SFWidgets.SF_ToolbarButton._Repr
REM ============================================ END OF SFWIDGETS.SF_TOOLBARBUTTON
</script:module>
|
