| blob | 1f8329ed14238da57e716dffd6ada0193f7133e6 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Toolbar" 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 ClassModule
12 Option Explicit
14 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
15 ''' SF_Toolbar
16 ''' ==========
17 ''' Hide/show a toolbar related to a component/document.
18 '''
19 ''' Each component has its own set of toolbars, depending on the component type
20 ''' (Calc, Writer, Basic IDE, ...).
21 ''' In the context of the actual class, a toolbar is presumed defined statically:
22 ''' - either by the application
23 ''' - or by a customization done by the user.
24 ''' The definition of a toolbar can be stored in the application configuration files
25 ''' or in a specific document.
26 ''' Changes made by scripts to toolbars stored in the application are persistent.
27 ''' They are valid for all documents of the same type.
28 '''
29 ''' Note that the menubar and the statusbar are not considered toolbars in this context.
30 '''
31 ''' A toolbar consists in a series of graphical controls to trigger actions.
32 ''' The "Toolbar" service gives access to the "ToolbarButton" service to manage
33 ''' the individual buttons belonging to the toolbar.
34 '''
35 ''' The name of a toolbar is either:
36 ''' - its so-called UIName when it is available,
37 ''' - or the last component of the resource URL: "private:resource/toolbar/the-name-here"
38 '''
39 ''' Service invocation:
40 ''' The Toolbars() method returns the list of available toolbar names
41 ''' The Toolbars(toolbarname) returns a Toolbar service
42 ''' It is available from
43 ''' - the UI service to access the toolbars of the Basic IDE ("BASICIDE"),
45 ''' - the Document, Calc, Writer, Datasheet, FormDocument services to access
46 ''' their respective set of toolbars.
47 ''' Example:
48 ''' Dim oCalc As Object, oToolbar As Object
51 '''
52 '''
53 ''' Detailed user documentation:
54 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/toolbar.html?DbPAR=BASIC
55 '''
56 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
58 REM ================================================================== EXCEPTIONS
60 REM ============================================================= PRIVATE MEMBERS
62 Private [Me] As Object
63 Private ObjectType As String ' Must be TOOLBAR
64 Private ServiceName As String
66 Private _Component As Object ' com.sun.star.lang.XComponent
67 Private _ResourceURL As String ' Toolbar internal name
69 Private _UIConfigurationManager As Object ' com.sun.star.ui.XUIConfigurationManager
71 Private _Storage As Long ' One of the toolbar location constants
72 Private _LayoutManager As Object ' com.sun.star.comp.framework.LayoutManager
74 Private _ToolbarButtons As Object ' SF_Dictionary of toolbar buttons
76 Type _ToolbarButton
77 Toolbar As Object ' The actual SF_Toolbar object instance
78 Index As Long ' Entry number in buttons lists
79 Label As String ' Label (static description)
80 AccessibleName As String ' Name found in accessible context
81 Element As Object ' com.sun.star.ui.XUIElement
82 End Type
84 REM ============================================================ MODULE CONSTANTS
86 ' Toolbar locations
88 Private Const cstCUSTOMTOOLBAR = 1 ' Toolbar added by user and stored in the LibreOffice application
91 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
93 REM -----------------------------------------------------------------------------
94 Private Sub Class_Initialize()
95 Set [Me] = Nothing
98 Set _Component = Nothing
99 _ResourceURL = ""
100 _UIName = ""
101 Set _UIConfigurationManager = Nothing
102 _ElementsInfoIndex = -1
103 _Storage = 0
104 Set _LayoutManager = Nothing
105 Set _ToolbarButtons = Nothing
106 End Sub ' SFWidgets.SF_Toolbar Constructor
108 REM -----------------------------------------------------------------------------
109 Private Sub Class_Terminate()
110 Call Class_Initialize()
111 End Sub ' SFWidgets.SF_Toolbar Destructor
113 REM -----------------------------------------------------------------------------
114 Public Function Dispose() As Variant
115 Call Class_Terminate()
116 Set Dispose = Nothing
117 End Function ' SFWidgets.SF_Toolbar Explicit Destructor
119 REM ================================================================== PROPERTIES
121 REM -----------------------------------------------------------------------------
122 Property Get BuiltIn() As Boolean
123 ''' Returns True when the toolbar is part of the set of standard toolbars shipped with the application.
124 ''' Example:
125 ''' MsgBox myToolbar.BuiltIn
129 End Property ' SFWidgets.SF_Toolbar.BuiltIn (get)
131 REM -----------------------------------------------------------------------------
132 Property Get Docked() As Variant
133 ''' Returns True when the toolbar is active in the window and Docked.
134 ''' Example:
135 ''' MsgBox myToolbar.Docked
139 End Property ' SFWidgets.SF_Toolbar.Docked (get)
141 REM -----------------------------------------------------------------------------
142 Property Get HasGlobalScope() As Boolean
143 ''' Returns True when the toolbar is available in all documents of the same type
144 ''' Example:
145 ''' MsgBox myToolbar.HasGlobalScope
149 End Property ' SFWidgets.SF_Toolbar.HasGlobalScope (get)
151 REM -----------------------------------------------------------------------------
152 Property Get Name() As String
153 ''' Returns the name of the toolbar
154 ''' Example:
155 ''' MsgBox myToolbar.Name
159 End Property ' SFWidgets.SF_Toolbar.Name (get)
161 REM -----------------------------------------------------------------------------
162 Property Get ResourceURL() As String
163 ''' Returns URL of the toolbar, in the form private:toolbar/xxx
164 ''' Example:
165 ''' MsgBox myToolbar.ResourceURL
169 End Property ' SFWidgets.SF_Toolbar.ResourceURL (get)
171 REM -----------------------------------------------------------------------------
172 Property Get Visible() As Variant
173 ''' Returns True when the toolbar is active in the window and visible.
174 ''' Example:
175 ''' MsgBox myToolbar.Visible
179 End Property ' SFWidgets.SF_Toolbar.Visible (get)
181 REM -----------------------------------------------------------------------------
182 Property Let Visible(ByVal pvVisible As Variant)
183 ''' Sets the visible status of the toolbar.
184 ''' When the toolbar is not yet active i the window, it is first created.
185 ''' Example:
186 ''' myToolbar.Visible = True
190 End Property ' SFWidgets.SF_Toolbar.Visible (let)
192 REM -----------------------------------------------------------------------------
193 Property Get XUIElement() As Variant
194 ''' Returns the com.sun.star.ui.XUIElement UNO object corresponding with the toolbar
195 ''' Example:
196 ''' MsgBox myToolbar.XUIElement
200 End Property ' SFWidgets.SF_Toolbar.XUIElement (get)
202 REM ===================================================================== METHODS
204 REM -----------------------------------------------------------------------------
205 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
206 ''' Return the actual value of the given property
207 ''' Args:
208 ''' PropertyName: the name of the property as a string
209 ''' Returns:
210 ''' The actual value of the property
211 ''' If the property does not exist, returns Null
212 ''' Exceptions:
213 ''' see the exceptions of the individual properties
214 ''' Examples:
218 Const cstSubArgs = ""
220 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
221 GetProperty = Null
223 Check:
224 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
225 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
226 End If
228 Try:
229 GetProperty = _PropertyGet(PropertyName)
231 Finally:
232 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
233 Exit Function
234 Catch:
235 GoTo Finally
236 End Function ' SFWidgets.SF_Toolbar.GetProperty
238 REM -----------------------------------------------------------------------------
239 Public Function Methods() As Variant
240 ''' Return the list of public methods of the Model service as an array
242 Methods = Array( _
244 )
246 End Function ' SFWidgets.SF_Toolbar.Methods
248 REM -----------------------------------------------------------------------------
249 Public Function Properties() As Variant
250 ''' Return the list or properties of the Timer a.AddItem("B>B1")class as an array
252 Properties = Array( _
260 )
262 End Function ' SFWidgets.SF_Toolbar.Properties
264 REM -----------------------------------------------------------------------------
265 Public Function SetProperty(Optional ByVal PropertyName As Variant _
266 , Optional ByRef Value As Variant _
267 ) As Boolean
268 ''' Set a new value to the given property
269 ''' Args:
270 ''' PropertyName: the name of the property as a string
271 ''' Value: its new value
272 ''' Exceptions
273 ''' ARGUMENTERROR The property does not exist
278 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
279 SetProperty = False
281 Check:
282 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
283 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
284 End If
286 Try:
287 SetProperty = _PropertySet(PropertyName, Value)
289 Finally:
290 SF_Utils._ExitFunction(cstThisSub)
291 Exit Function
292 Catch:
293 GoTo Finally
294 End Function ' SFWidgets.SF_Toolbar.SetProperty
296 REM -----------------------------------------------------------------------------
297 Public Function ToolbarButtons(Optional ByVal ButtonName As Variant) As Variant
298 ''' Returns either a list of the available toolbar button names in the actual toolbar
299 ''' or a ToolbarButton object instance.
300 ''' Args:
301 ''' ButtonName: the usual name of one of the available buttons in the actual toolbar
302 ''' Returns:
303 ''' A zero-based array of button names when the argument is absent,
304 ''' or a new ToolbarButton object instance.
305 ''' An inactive toolbar has no buttons => the actual method forces the toolbar to be made visible first.
310 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
312 Check:
313 If IsMissing(ButtonName) Or IsEmpty(ButtonName) Then ButtonName = ""
314 ' Store button descriptions in cache
315 _CollectAllButtons()
316 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
317 If VarType(ButtonName) = V_STRING Then
319 If Not ScriptForge.SF_Utils._Validate(ButtonName, "ButtonName", V_STRING, _ToolbarButtons.Keys()) Then GoTo Finally
320 End If
321 Else
322 If Not ScriptForge.SF_Utils._Validate(ButtonName, "ButtonName", V_STRING) Then GoTo Finally ' Manage here the VarType error
323 End If
324 End If
326 Try:
327 If Len(ButtonName) = 0 Then
328 ToolbarButtons = _ToolbarButtons.Keys()
329 Else
330 ToolbarButtons = CreateScriptService("SFWidgets.ToolbarButton", _ToolbarButtons.Item(ButtonName))
331 End If
333 Finally:
334 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
335 Exit Function
336 Catch:
337 GoTo Finally
338 End Function ' SFWidgets.SF_Toolbar.ToolbarButtons
340 REM =========================================================== PRIVATE FUNCTIONS
342 REM -----------------------------------------------------------------------------
343 Private Sub _CollectAllButtons()
344 ''' Stores a SF_Dictionary object instance, with
345 ''' - key = name of the button
346 ''' - item = a _ButtonDesc object type
347 ''' into _ToolbarButtons, a cache for all buttons.
348 ''' The toolbar is made visible before collecting the buttons.
349 '''
350 ''' The name of the buttons is derived either from:
351 ''' - the Label property of the static toolbar and toolbar buttons definitions
352 ''' - or the AccessibleName property of the AccessibleContext of the button
353 ''' whichever is found first.
354 ''' Separators are skipped.
355 ''' If there are homonyms (>= 2 buttons having the same name), only the 1st one is retained.
357 Dim oElement As Object ' com.sun.star.ui.XUIElement
358 Dim oSettings As Object ' com.sun.star.container.XIndexAccess
359 Dim vProperties() As Variant ' Array of property values
361 Dim oAccessible As Object ' com.sun.star.accessibility.XAccessible
362 Dim sLabel As String ' Label in static description
363 Dim sAccessibleName As String ' Name in AccessibleContext
364 Dim sButtonName As String ' Key part in dictionary entry
365 Dim oButton As Object ' Item part in dictionary entry
366 Dim i As Long
368 On Local Error GoTo Catch
369 If Not IsNull(_ToolbarButtons) Then GoTo Finally ' Do not redo the job if already done
371 Try:
372 ' Force the visibility of the toolbar
373 Visible = True
375 Set _ToolbarButtons = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Dictionary", True) ' with case-sensitive comparison of keys
376 Set oElement = _LayoutManager.getElement(_ResourceURL)
377 Set oSettings = oElement.getSettings(True)
379 With oSettings
381 vProperties = .getByIndex(i)
385 If Len(sLabel) = 0 Then
386 Set oAccessible = oElement.RealInterface.AccessibleContext.getAccessibleChild(i)
387 sAccessibleName = oAccessible.AccessibleName
388 Else
389 sAccessibleName = ""
390 End If
391 ' Store in dictionary
394 Set oButton = New _ToolbarButton
395 With oButton
396 Set .Toolbar = [Me]
397 .Index = i
398 .Label = sLabel
399 .AccessibleName = sAccessibleName
400 Set .Element = oElement
401 End With
402 With _ToolbarButtons
403 If Not .Exists(sButtonName) Then .Add(sButtonName, oButton)
404 End With
405 End If
406 End If
407 Next i
408 End With
410 Finally:
411 Exit Sub
412 Catch:
413 ' _ToolbarButtons is left unchanged
414 GoTo Finally
415 End Sub ' SFWidgets.SF_Toolbar._CollectAllButtons
417 REM -----------------------------------------------------------------------------
418 Public Sub _Initialize(ByRef poToolbar As Object)
419 ''' Complete the object creation process:
420 ''' - Initialize the toolbar descriptioner use
421 ''' Args:
422 ''' poToolbar: the toolbar description as a ui._Toolbr object
424 Try:
425 ' Store the static description
426 With poToolbar
427 _Component = .Component
428 _ResourceURL = .ResourceURL
429 _UIName = .UIName
430 _UIConfigurationManager = .UIConfigurationManager
431 _ElementsInfoIndex = .ElementsInfoIndex
432 _Storage = .Storage
433 End With
435 ' Complement
437 Set _LayoutManager = _Component.CurrentController.Frame.LayoutManager
439 Finally:
440 Exit Sub
441 End Sub ' SFWidgets.SF_Toolbar._Initialize
443 REM -----------------------------------------------------------------------------
444 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
445 ''' Return the value of the named property
446 ''' Args:
447 ''' psProperty: the name of the property
449 Dim vGet As Variant ' Return value
450 Dim oElement As Object ' com.sun.star.ui.XUIElement
451 Dim cstThisSub As String
452 Const cstSubArgs = ""
455 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
457 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
458 _PropertyGet = Null
460 Select Case UCase(psProperty)
462 _PropertyGet = ( _Storage = cstBUILTINTOOLBAR )
464 Set oElement = _LayoutManager.getElement(_ResourceURL)
465 If Not IsNull(oElement) Then _PropertyGet = _LayoutManager.isElementDocked(_ResourceURL) Else _PropertyGet = False
467 _PropertyGet = ( _Storage = cstBUILTINTOOLBAR Or _Storage = cstCUSTOMTOOLBAR )
469 _PropertyGet = _UIName
471 _PropertyGet = _ResourceURL
473 Set oElement = _LayoutManager.getElement(_ResourceURL)
474 If Not IsNull(oElement) Then _PropertyGet = _LayoutManager.isElementVisible(_ResourceURL) Else _PropertyGet = False
476 _PropertyGet = _LayoutManager.getElement(_ResourceURL)
477 Case Else
478 _PropertyGet = Null
479 End Select
481 Finally:
482 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
483 Exit Function
484 Catch:
485 GoTo Finally
486 End Function ' SFWidgets.SF_Toolbar._PropertyGet
488 REM -----------------------------------------------------------------------------
489 Private Function _PropertySet(Optional ByVal psProperty As String _
490 , Optional ByVal pvValue As Variant _
491 ) As Boolean
492 ''' Set the new value of the named property
493 ''' Args:
494 ''' psProperty: the name of the property
495 ''' pvValue: the new value of the given property
497 Dim bSet As Boolean ' Return value
498 Dim oElement As Object ' com.sun.star.ui.XUIElement
499 Dim bVisible As Boolean ' Actual Visible state
501 Dim cstThisSub As String
504 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
505 bSet = False
508 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
510 bSet = True
511 Select Case UCase(psProperty)
513 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Catch
514 With _LayoutManager
515 Set oElement = .getElement(_ResourceURL)
516 If Not IsNull(oElement) Then bVisible = .isElementVisible(_ResourceURL) Else bVisible = False
517 ' If there is no change, do nothing
518 If Not bVisible = pvValue Then
519 If IsNull(oElement) And pvValue Then .createElement(_ResourceURL)
520 If pvValue Then .showElement(_ResourceURL) Else .hideElement(_ResourceURL)
521 End If
522 End With
523 Case Else
524 bSet = False
525 End Select
527 Finally:
528 _PropertySet = bSet
529 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
530 Exit Function
531 Catch:
532 bSet = False
533 GoTo Finally
534 End Function ' SFWidgets.SF_Toolbar._PropertySet
536 REM -----------------------------------------------------------------------------
537 Private Function _Repr() As String
538 ''' Convert the SF_Toolbar instance to a readable string, typically for debugging purposes (DebugPrint ...)
539 ''' Args:
540 ''' Return:
541 ''' "[Toolbar]: Name, Type (dialogname)
544 End Function ' SFWidgets.SF_Toolbar._Repr
546 REM ============================================ END OF SFWIDGETS.SF_TOOLBAR
547 </script:module>