| blob | c457a62f1cad013787461bbb59b025ce8acaf48f |
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
52 REM ================================================================== EXCEPTIONS
54 REM ============================================================= PRIVATE MEMBERS
56 Private [Me] As Object
57 Private ObjectType As String ' Must be TOOLBAR
58 Private ServiceName As String
60 Private _Component As Object ' com.sun.star.lang.XComponent
61 Private _ResourceURL As String ' Toolbar internal name
63 Private _UIConfigurationManager As Object ' com.sun.star.ui.XUIConfigurationManager
65 Private _Storage As Long ' One of the toolbar location constants
66 Private _LayoutManager As Object ' com.sun.star.comp.framework.LayoutManager
68 Private _ToolbarButtons As Object ' SF_Dictionary of toolbar buttons
70 Type _ToolbarButton
71 Toolbar As Object ' The actual SF_Toolbar object instance
72 Index As Long ' Entry number in buttons lists
73 Label As String ' Label (static description)
74 AccessibleName As String ' Name found in accessible context
75 Element As Object ' com.sun.star.ui.XUIElement
76 End Type
78 REM ============================================================ MODULE CONSTANTS
80 ' Toolbar locations
82 Private Const cstCUSTOMTOOLBAR = 1 ' Toolbar added by user and stored in the LibreOffice application
85 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
87 REM -----------------------------------------------------------------------------
88 Private Sub Class_Initialize()
89 Set [Me] = Nothing
92 Set _Component = Nothing
93 _ResourceURL = ""
94 _UIName = ""
95 Set _UIConfigurationManager = Nothing
96 _ElementsInfoIndex = -1
97 _Storage = 0
98 Set _LayoutManager = Nothing
99 Set _ToolbarButtons = Nothing
100 End Sub ' SFWidgets.SF_Toolbar Constructor
102 REM -----------------------------------------------------------------------------
103 Private Sub Class_Terminate()
104 Call Class_Initialize()
105 End Sub ' SFWidgets.SF_Toolbar Destructor
107 REM -----------------------------------------------------------------------------
108 Public Function Dispose() As Variant
109 Call Class_Terminate()
110 Set Dispose = Nothing
111 End Function ' SFWidgets.SF_Toolbar Explicit Destructor
113 REM ================================================================== PROPERTIES
115 REM -----------------------------------------------------------------------------
116 Property Get BuiltIn() As Boolean
117 ''' Returns True when the toolbar is part of the set of standard toolbars shipped with the application.
118 ''' Example:
119 ''' MsgBox myToolbar.BuiltIn
123 End Property ' SFWidgets.SF_Toolbar.BuiltIn (get)
125 REM -----------------------------------------------------------------------------
126 Property Get Docked() As Variant
127 ''' Returns True when the toolbar is active in the window and Docked.
128 ''' Example:
129 ''' MsgBox myToolbar.Docked
133 End Property ' SFWidgets.SF_Toolbar.Docked (get)
135 REM -----------------------------------------------------------------------------
136 Property Get HasGlobalScope() As Boolean
137 ''' Returns True when the toolbar is available in all documents of the same type
138 ''' Example:
139 ''' MsgBox myToolbar.HasGlobalScope
143 End Property ' SFWidgets.SF_Toolbar.HasGlobalScope (get)
145 REM -----------------------------------------------------------------------------
146 Property Get Name() As String
147 ''' Returns the name of the toolbar
148 ''' Example:
149 ''' MsgBox myToolbar.Name
153 End Property ' SFWidgets.SF_Toolbar.Name (get)
155 REM -----------------------------------------------------------------------------
156 Property Get ResourceURL() As String
157 ''' Returns URL of the toolbar, in the form private:toolbar/xxx
158 ''' Example:
159 ''' MsgBox myToolbar.ResourceURL
163 End Property ' SFWidgets.SF_Toolbar.ResourceURL (get)
165 REM -----------------------------------------------------------------------------
166 Property Get Visible() As Variant
167 ''' Returns True when the toolbar is active in the window and visible.
168 ''' Example:
169 ''' MsgBox myToolbar.Visible
173 End Property ' SFWidgets.SF_Toolbar.Visible (get)
175 REM -----------------------------------------------------------------------------
176 Property Let Visible(ByVal pvVisible As Variant)
177 ''' Sets the visible status of the toolbar.
178 ''' When the toolbar is not yet active i the window, it is first created.
179 ''' Example:
180 ''' myToolbar.Visible = True
184 End Property ' SFWidgets.SF_Toolbar.Visible (let)
186 REM -----------------------------------------------------------------------------
187 Property Get XUIElement() As Variant
188 ''' Returns the com.sun.star.ui.XUIElement UNO object corresponding with the toolbar
189 ''' Example:
190 ''' MsgBox myToolbar.XUIElement
194 End Property ' SFWidgets.SF_Toolbar.XUIElement (get)
196 REM ===================================================================== METHODS
198 REM -----------------------------------------------------------------------------
199 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
200 ''' Return the actual value of the given property
201 ''' Args:
202 ''' PropertyName: the name of the property as a string
203 ''' Returns:
204 ''' The actual value of the property
205 ''' If the property does not exist, returns Null
206 ''' Exceptions:
207 ''' see the exceptions of the individual properties
208 ''' Examples:
212 Const cstSubArgs = ""
214 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
215 GetProperty = Null
217 Check:
218 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
219 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
220 End If
222 Try:
223 GetProperty = _PropertyGet(PropertyName)
225 Finally:
226 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
227 Exit Function
228 Catch:
229 GoTo Finally
230 End Function ' SFWidgets.SF_Toolbar.GetProperty
232 REM -----------------------------------------------------------------------------
233 Public Function Methods() As Variant
234 ''' Return the list of public methods of the Model service as an array
236 Methods = Array( _
238 )
240 End Function ' SFWidgets.SF_Toolbar.Methods
242 REM -----------------------------------------------------------------------------
243 Public Function Properties() As Variant
244 ''' Return the list or properties of the Timer a.AddItem("B>B1")class as an array
246 Properties = Array( _
254 )
256 End Function ' SFWidgets.SF_Toolbar.Properties
258 REM -----------------------------------------------------------------------------
259 Public Function SetProperty(Optional ByVal PropertyName As Variant _
260 , Optional ByRef Value As Variant _
261 ) As Boolean
262 ''' Set a new value to the given property
263 ''' Args:
264 ''' PropertyName: the name of the property as a string
265 ''' Value: its new value
266 ''' Exceptions
267 ''' ARGUMENTERROR The property does not exist
272 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
273 SetProperty = False
275 Check:
276 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
277 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
278 End If
280 Try:
281 SetProperty = _PropertySet(PropertyName, Value)
283 Finally:
284 SF_Utils._ExitFunction(cstThisSub)
285 Exit Function
286 Catch:
287 GoTo Finally
288 End Function ' SFWidgets.SF_Toolbar.SetProperty
290 REM -----------------------------------------------------------------------------
291 Public Function ToolbarButtons(Optional ByVal ButtonName As Variant) As Variant
292 ''' Returns either a list of the available toolbar button names in the actual toolbar
293 ''' or a ToolbarButton object instance.
294 ''' Args:
295 ''' ButtonName: the usual name of one of the available buttons in the actual toolbar
296 ''' Returns:
297 ''' A zero-based array of button names when the argument is absent,
298 ''' or a new ToolbarButton object instance.
299 ''' An inactive toolbar has no buttons => the actual method forces the toolbar to be made visible first.
304 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
306 Check:
307 If IsMissing(ButtonName) Or IsEmpty(ButtonName) Then ButtonName = ""
308 ' Store button descriptions in cache
309 _CollectAllButtons()
310 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
311 If VarType(ButtonName) = V_STRING Then
313 If Not ScriptForge.SF_Utils._Validate(ButtonName, "ButtonName", V_STRING, _ToolbarButtons.Keys()) Then GoTo Finally
314 End If
315 Else
316 If Not ScriptForge.SF_Utils._Validate(ButtonName, "ButtonName", V_STRING) Then GoTo Finally ' Manage here the VarType error
317 End If
318 End If
320 Try:
321 If Len(ButtonName) = 0 Then
322 ToolbarButtons = _ToolbarButtons.Keys()
323 Else
324 ToolbarButtons = CreateScriptService("SFWidgets.ToolbarButton", _ToolbarButtons.Item(ButtonName))
325 End If
327 Finally:
328 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
329 Exit Function
330 Catch:
331 GoTo Finally
332 End Function ' SFWidgets.SF_Toolbar.ToolbarButtons
334 REM =========================================================== PRIVATE FUNCTIONS
336 REM -----------------------------------------------------------------------------
337 Private Sub _CollectAllButtons()
338 ''' Stores a SF_Dictionary object instance, with
339 ''' - key = name of the button
340 ''' - item = a _ButtonDesc object type
341 ''' into _ToolbarButtons, a cache for all buttons.
342 ''' The toolbar is made visible before collecting the buttons.
343 '''
344 ''' The name of the buttons is derived either from:
345 ''' - the Label property of the static toolbar and toolbar buttons definitions
346 ''' - or the AccessibleName property of the AccessibleContext of the button
347 ''' whichever is found first.
348 ''' Separators are skipped.
349 ''' If there are homonyms (>= 2 buttons having the same name), only the 1st one is retained.
351 Dim oElement As Object ' com.sun.star.ui.XUIElement
352 Dim oSettings As Object ' com.sun.star.container.XIndexAccess
353 Dim vProperties() As Variant ' Array of property values
355 Dim oAccessible As Object ' com.sun.star.accessibility.XAccessible
356 Dim sLabel As String ' Label in static description
357 Dim sAccessibleName As String ' Name in AccessibleContext
358 Dim sButtonName As String ' Key part in dictionary entry
359 Dim oButton As Object ' Item part in dictionary entry
360 Dim i As Long
362 On Local Error GoTo Catch
363 If Not IsNull(_ToolbarButtons) Then GoTo Finally ' Do not redo the job if already done
365 Try:
366 ' Force the visibility of the toolbar
367 Visible = True
369 Set _ToolbarButtons = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Dictionary")
370 Set oElement = _LayoutManager.getElement(_ResourceURL)
371 Set oSettings = oElement.getSettings(True)
373 With oSettings
375 vProperties = .getByIndex(i)
379 If Len(sLabel) = 0 Then
380 Set oAccessible = oElement.RealInterface.AccessibleContext.getAccessibleChild(i)
381 sAccessibleName = oAccessible.AccessibleName
382 Else
383 sAccessibleName = ""
384 End If
385 ' Store in dictionary
388 Set oButton = New _ToolbarButton
389 With oButton
390 Set .Toolbar = [Me]
391 .Index = i
392 .Label = sLabel
393 .AccessibleName = sAccessibleName
394 Set .Element = oElement
395 End With
396 With _ToolbarButtons
397 If Not .Exists(sButtonName) Then .Add(sButtonName, oButton)
398 End With
399 End If
400 End If
401 Next i
402 End With
404 Finally:
405 Exit Sub
406 Catch:
407 ' _ToolbarButtons is left unchanged
408 GoTo Finally
409 End Sub ' SFWidgets.SF_Toolbar._CollectAllButtons
411 REM -----------------------------------------------------------------------------
412 Public Sub _Initialize(ByRef poToolbar As Object)
413 ''' Complete the object creation process:
414 ''' - Initialize the toolbar descriptioner use
415 ''' Args:
416 ''' poToolbar: the toolbar description as a ui._Toolbr object
418 Try:
419 ' Store the static description
420 With poToolbar
421 _Component = .Component
422 _ResourceURL = .ResourceURL
423 _UIName = .UIName
424 _UIConfigurationManager = .UIConfigurationManager
425 _ElementsInfoIndex = .ElementsInfoIndex
426 _Storage = .Storage
427 End With
429 ' Complement
431 Set _LayoutManager = _Component.CurrentController.Frame.LayoutManager
433 Finally:
434 Exit Sub
435 End Sub ' SFWidgets.SF_Toolbar._Initialize
437 REM -----------------------------------------------------------------------------
438 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
439 ''' Return the value of the named property
440 ''' Args:
441 ''' psProperty: the name of the property
443 Dim vGet As Variant ' Return value
444 Dim oElement As Object ' com.sun.star.ui.XUIElement
445 Dim cstThisSub As String
446 Const cstSubArgs = ""
449 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
451 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
452 _PropertyGet = Null
454 Select Case UCase(psProperty)
456 _PropertyGet = ( _Storage = cstBUILTINTOOLBAR )
458 Set oElement = _LayoutManager.getElement(_ResourceURL)
459 If Not IsNull(oElement) Then _PropertyGet = _LayoutManager.isElementDocked(_ResourceURL) Else _PropertyGet = False
461 _PropertyGet = ( _Storage = cstBUILTINTOOLBAR Or _Storage = cstCUSTOMTOOLBAR )
463 _PropertyGet = _UIName
465 _PropertyGet = _ResourceURL
467 Set oElement = _LayoutManager.getElement(_ResourceURL)
468 If Not IsNull(oElement) Then _PropertyGet = _LayoutManager.isElementVisible(_ResourceURL) Else _PropertyGet = False
470 _PropertyGet = _LayoutManager.getElement(_ResourceURL)
471 Case Else
472 _PropertyGet = Null
473 End Select
475 Finally:
476 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
477 Exit Function
478 Catch:
479 GoTo Finally
480 End Function ' SFWidgets.SF_Toolbar._PropertyGet
482 REM -----------------------------------------------------------------------------
483 Private Function _PropertySet(Optional ByVal psProperty As String _
484 , Optional ByVal pvValue As Variant _
485 ) As Boolean
486 ''' Set the new value of the named property
487 ''' Args:
488 ''' psProperty: the name of the property
489 ''' pvValue: the new value of the given property
491 Dim bSet As Boolean ' Return value
492 Dim oElement As Object ' com.sun.star.ui.XUIElement
493 Dim bVisible As Boolean ' Actual Visible state
495 Dim cstThisSub As String
498 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
499 bSet = False
502 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
504 bSet = True
505 Select Case UCase(psProperty)
507 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Catch
508 With _LayoutManager
509 Set oElement = .getElement(_ResourceURL)
510 If Not IsNull(oElement) Then bVisible = .isElementVisible(_ResourceURL) Else bVisible = False
511 ' If there is no change, do nothing
512 If Not bVisible = pvValue Then
513 If IsNull(oElement) And pvValue Then .createElement(_ResourceURL)
514 If pvValue Then .showElement(_ResourceURL) Else .hideElement(_ResourceURL)
515 End If
516 End With
517 Case Else
518 bSet = False
519 End Select
521 Finally:
522 _PropertySet = bSet
523 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
524 Exit Function
525 Catch:
526 bSet = False
527 GoTo Finally
528 End Function ' SFWidgets.SF_Toolbar._PropertySet
530 REM -----------------------------------------------------------------------------
531 Private Function _Repr() As String
532 ''' Convert the SF_Toolbar instance to a readable string, typically for debugging purposes (DebugPrint ...)
533 ''' Args:
534 ''' Return:
535 ''' "[Toolbar]: Name, Type (dialogname)
538 End Function ' SFWidgets.SF_Toolbar._Repr
540 REM ============================================ END OF SFWIDGETS.SF_TOOLBAR
541 </script:module>