| blob | 58c594f066124aa6049d0a0a80fcf2fde408d7ce |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_ToolbarButton" 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_ToolbarButton
16 ''' ================
17 ''' Hide/show toolbar elements, read and update their current behaviour..
18 '''
19 ''' A toolbar consists in a series of graphical controls to trigger actions.
20 ''' The "Toolbar" service gives access to the "ToolbarButton" service to manage
21 ''' the individual buttons belonging to the toolbar.
22 '''
23 ''' Changes made by scripts to buttons belonging to toolbars stored in the application
24 ''' are persistent. They are valid for all documents of the same type.
25 '''
26 ''' The name of a toolbar button is either:
27 ''' - in custom toolbars, a predefined name given at its creation,
28 ''' - in standard toolbars, a localized name as read in the Tools + Customize ... dialog box
29 '''
30 ''' Service invocation:
31 ''' It is available only from an active Toolbar service.
32 ''' Example:
33 ''' Dim oCalc As Object, oToolbar As Object, oToolbarButton As Object
38 REM ================================================================== EXCEPTIONS
40 REM ============================================================= PRIVATE MEMBERS
42 Private [Me] As Object
43 Private ObjectType As String ' Must be TOOLBARBUTTON
44 Private ServiceName As String
45 Private [_Parent] As Object ' SF_Toolbar instance owning the button
47 Private _Index As Long ' Entry number in buttons lists
48 Private _Label As String ' Label (static description)
49 Private _AccessibleName As String ' Name found in accessible context
50 Private _Element As Object ' com.sun.star.ui.XUIElement
52 Private _CommandURL As String ' Uno command or script
54 Private _Height As Long ' Height may be cached
55 Private _Width As Long ' Width may be cached
57 REM ============================================================ MODULE CONSTANTS
59 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
61 REM -----------------------------------------------------------------------------
62 Private Sub Class_Initialize()
63 Set [Me] = Nothing
66 Set [_Parent] = Nothing
67 _Index = -1
68 _Label = ""
69 _AccessibleName = ""
70 Set _Element = Nothing
71 _CommandURL = ""
72 _Height = 0
73 _Width = 0
74 End Sub ' SFWidgets.SF_ToolbarButton Constructor
76 REM -----------------------------------------------------------------------------
77 Private Sub Class_Terminate()
78 Call Class_Initialize()
79 End Sub ' SFWidgets.SF_ToolbarButton Destructor
81 REM -----------------------------------------------------------------------------
82 Public Function Dispose() As Variant
83 Call Class_Terminate()
84 Set Dispose = Nothing
85 End Function ' SFWidgets.SF_ToolbarButton Explicit Destructor
87 REM ================================================================== PROPERTIES
89 REM -----------------------------------------------------------------------------
90 Property Get Caption() As String
91 ''' Returns the name of the button
92 ''' Example:
93 ''' MsgBox myButton.Caption
97 End Property ' SFWidgets.SF_ToolbarButton.Caption (get)
99 REM -----------------------------------------------------------------------------
100 Property Get Height() As Long
101 ''' Returns the height in pixels of the button
102 ''' Example:
103 ''' MsgBox myButton.Height
107 End Property ' SFWidgets.SF_ToolbarButton.Height (get)
109 REM -----------------------------------------------------------------------------
110 Property Get Index() As Long
111 ''' Returns the index of the button
112 ''' - in the Settings (com.sun.star.container.XIndexAccess) of the parent toolbar
113 ''' - in the AccessibleContext (com.sun.star.comp.toolkit.AccessibleToolBox) of the parent toolbar
114 ''' Both should be identical: the range number of the button in the toolbar, hidden buttons and separators included.
115 ''' Example:
116 ''' MsgBox myButton.Index
120 End Property ' SFWidgets.SF_ToolbarButton.Index (get)
122 REM -----------------------------------------------------------------------------
123 Property Get OnClick() As Variant
124 ''' Returns the UNO command or the script (expressed in the scripting framework_URI notation) run when the button is clicked
125 ''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
126 ''' Note that no event object is passed to the script.
127 ''' Example:
128 ''' MsgBox myButton.OnClick
132 End Property ' SFWidgets.SF_ToolbarButton.OnClick (get)
134 REM -----------------------------------------------------------------------------
135 Property Let OnClick(ByVal pvOnClick As Variant)
136 ''' Sets the UNO command or the script (expressed in the scripting framework_URI notation) to trigger when the button is clicked
137 ''' It is highly recommended to not modify standard buttons.
138 ''' Example:
140 ''' myButton.OnClick = "vnd.sun.star.script:XrayTool._Main.Xray?language=Basic&location=application"
144 End Property ' SFWidgets.SF_ToolbarButton.OnClick (let)
146 REM -----------------------------------------------------------------------------
147 Property Get Parent() As Object
148 ''' Returns the parent toolbar as a SF_Toolbar object instance
149 ''' Example:
150 ''' Set oToolbar = myButton.Parent
154 End Property ' SFWidgets.SF_ToolbarButton.Parent (get)
156 REM -----------------------------------------------------------------------------
157 Property Get TipText() As Variant
158 ''' Specifies the text that appears in a screentip when you hold the mouse pointer over the button
159 ''' Example:
160 ''' MsgBox myButton.TipText
164 End Property ' SFWidgets.SF_ToolbarButton.TipText (get)
166 REM -----------------------------------------------------------------------------
167 Property Let TipText(ByVal pvTipText As Variant)
168 ''' Sets the screentip associated with the actual toolbar button
169 ''' It is highly recommended to not modify standard buttons.
170 ''' Example:
175 End Property ' SFWidgets.SF_ToolbarButton.TipText (let)
177 REM -----------------------------------------------------------------------------
178 Property Get Visible() As Variant
179 ''' Returns True when the toolbar button is visible. Otherwise False.
180 ''' Example:
181 ''' MsgBox myButton.Visible
185 End Property ' SFWidgets.SF_ToolbarButton.Visible (get)
187 REM -----------------------------------------------------------------------------
188 Property Let Visible(ByVal pvVisible As Variant)
189 ''' Sets the visible status of the toolbar button.
190 ''' Example:
191 ''' myButton.Visible = True
195 End Property ' SFWidgets.SF_ToolbarButton.Visible (let)
197 REM -----------------------------------------------------------------------------
198 Property Get Width() As Long
199 ''' Returns the width in pixels of the button
200 ''' Example:
201 ''' MsgBox myButton.Width
205 End Property ' SFWidgets.SF_ToolbarButton.Width (get)
207 REM -----------------------------------------------------------------------------
208 Property Get X() As Long
209 ''' Returns the X (horizontal) coordinate in pixels of the top-left corner of the button
210 ''' Example:
211 ''' MsgBox myButton.X
215 End Property ' SFWidgets.SF_ToolbarButton.X (get)
217 REM -----------------------------------------------------------------------------
218 Property Get Y() As Long
219 ''' Returns the Y (vertical) coordinate in pixels of the top-left corner of the button
220 ''' Example:
221 ''' MsgBox myButton.Y
225 End Property ' SFWidgets.SF_ToolbarButton.Y (get)
227 REM ===================================================================== METHODS
229 REM -----------------------------------------------------------------------------
230 Public Function Execute() As Variant
231 ''' Execute the command stored in the toolbar button.
232 ''' The command can be a UNO command or a Basic/Python script (expressed in the scripting framework_URI notation)
233 ''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
234 ''' No argument is passed to the script to execute.
235 ''' Args:
236 ''' Returns:
237 ''' The output of the script or Null
238 ''' Examples:
239 ''' result = myButton.Execute()
241 Dim vResult As Variant ' Return value
242 Dim sCommand As String ' Command associated with button
243 Dim oFrame As Object ' com.sun.star.comp.framework.Frame
244 Dim oDispatcher As Object ' com.sun.star.frame.DispatchHelper
245 Dim vScript As Variant ' Split command in script/argument
246 Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session")
247 Dim oArgs() As new com.sun.star.beans.PropertyValue
251 Const cstSubArgs = ""
253 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
254 vResult = Null
256 Check:
257 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
259 Try:
262 ' A button has been clicked necessarily in the current window (Document) or one of its subcomponents (FormDocument)
263 Set oFrame = StarDesktop.ActiveFrame
265 ' Command or script ?
266 If ScriptForge.SF_String.StartsWith(sCommand, cstUnoPrefix) Then
267 ' Execute uno command
270 oFrame.activate()
271 Else
272 ' Execute script
273 vResult = oSession._ExecuteScript(sCommand)
274 End If
275 End If
277 Finally:
278 Execute = vResult
279 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
280 Exit Function
281 Catch:
282 GoTo Finally
283 End Function ' SFWidgets.SF_ToolbarButton.Execute
285 REM -----------------------------------------------------------------------------
286 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
287 ''' Return the actual value of the given property
288 ''' Args:
289 ''' PropertyName: the name of the property as a string
290 ''' Returns:
291 ''' The actual value of the property
292 ''' If the property does not exist, returns Null
293 ''' Exceptions:
294 ''' see the exceptions of the individual properties
295 ''' Examples:
299 Const cstSubArgs = ""
301 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
302 GetProperty = Null
304 Check:
305 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
306 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
307 End If
309 Try:
310 GetProperty = _PropertyGet(PropertyName)
312 Finally:
313 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
314 Exit Function
315 Catch:
316 GoTo Finally
317 End Function ' SFWidgets.SF_ToolbarButton.GetProperty
319 REM -----------------------------------------------------------------------------
320 Public Function Methods() As Variant
321 ''' Return the list of public methods of the Model service as an array
323 Methods = Array( _
325 )
327 End Function ' SFWidgets.SF_ToolbarButton.Methods
329 REM -----------------------------------------------------------------------------
330 Public Function Properties() As Variant
331 ''' Return the list or properties of the Timer a.AddItem("B>B1")class as an array
333 Properties = Array( _
344 )
346 End Function ' SFWidgets.SF_ToolbarButton.Properties
348 REM -----------------------------------------------------------------------------
349 Public Function SetProperty(Optional ByVal PropertyName As Variant _
350 , Optional ByRef Value As Variant _
351 ) As Boolean
352 ''' Set a new value to the given property
353 ''' Args:
354 ''' PropertyName: the name of the property as a string
355 ''' Value: its new value
356 ''' Exceptions
357 ''' ARGUMENTERROR The property does not exist
362 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
363 SetProperty = False
365 Check:
366 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
367 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
368 End If
370 Try:
371 SetProperty = _PropertySet(PropertyName, Value)
373 Finally:
374 SF_Utils._ExitFunction(cstThisSub)
375 Exit Function
376 Catch:
377 GoTo Finally
378 End Function ' SFWidgets.SF_ToolbarButton.SetProperty
380 REM =========================================================== PRIVATE FUNCTIONS
382 REM -----------------------------------------------------------------------------
383 Private Function _GetPosition() As Object
384 ''' Determine the position of the top-left corner of the actual button.
385 ''' Returns:
386 ''' a com.sun.star.awt.Rectangle structure
388 Dim oElement As Object ' com.sun.star.ui.XUIElement
389 Dim oAccessible As Object ' com.sun.star.comp.toolkit.AccessibleToolBoxItem
390 Dim oAccessibleButton As Object ' com.sun.star.comp.toolkit.AccessibleToolBoxItem
391 Dim oAccessibleParent As Object ' com.sun.star.comp.toolkit.AccessibleToolBoxItem
392 Dim oRect As Object ' Return value As com.sun.star.awt.Rectangle
394 Try:
395 Set oElement = _Element.GetSettings(True).getByIndex(_Index)
398 Set oAccessible = _Element.getRealInterface().getAccessibleContext() ' Toolbar level
399 Set oAccessibleParent = oAccessible.getAccessibleParent() ' Window level
400 Set oAccessibleButton = oAccessible.getAccessibleChild(_Index) ' Toolbar button level
401 ' The X and Y coordinates are always computed correctly when the toolbar is docked.
402 ' When the toolbar is floating, the Y ordinate may be overestimated with the height of
403 ' the tabbed bar or similar. However no mean has been found to get that height via code.
404 With oRect
405 .X = oAccessible.Location.X + oAccessibleButton.Location.X + oAccessibleParent.PosSize.X
406 .Y = oAccessible.Location.Y + oAccessibleButton.Location.Y + oAccessibleParent.PosSize.Y
407 .Height = oAccessibleButton.Size.Height
408 .Width = oAccessibleButton.Size.Width
409 End With
410 Else
411 With oRect
413 End With
414 End If
416 Finally:
417 Set _GetPosition = oRect
418 Exit Function
419 End Function ' SFWidgets.SF_ToolbarButton._GetPosition
421 REM -----------------------------------------------------------------------------
422 Public Sub _Initialize(ByRef poToolbarButton As Object)
423 ''' Complete the object creation process:
424 ''' - Initialize the toolbar descriptioner use
425 ''' Args:
426 ''' poToolbarButton: the toolbar description as a ui._Toolbr object
428 Try:
429 ' Store the static description
430 With poToolbarButton
431 Set [_Parent] = .Toolbar
432 _Index = .Index
433 _Label = .Label
434 _AccessibleName = .AccessibleName
435 Set _Element = .Element
436 End With
438 ' Complement
439 _CommandURL = ScriptForge.SF_Utils._GetPropertyValue(_Element.getSettings(True).getByIndex(_Index), "CommandURL")
441 Finally:
442 Exit Sub
443 End Sub ' SFWidgets.SF_ToolbarButton._Initialize
445 REM -----------------------------------------------------------------------------
446 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
447 ''' Return the value of the named property
448 ''' Args:
449 ''' psProperty: the name of the property
451 Dim vGet As Variant ' Return value
452 Dim sTooltip As String ' ToolTip text
453 Dim oElement As Object ' com.sun.star.ui.XUIElement
454 Dim cstThisSub As String
455 Const cstSubArgs = ""
458 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
460 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
461 _PropertyGet = Null
463 Select Case UCase(psProperty)
469 _PropertyGet = _Index
471 Set oElement = _Element.GetSettings(True).getByIndex(_Index)
474 Set _PropertyGet = [_Parent]
476 Set oElement = _Element.GetSettings(True).getByIndex(_Index)
478 If Len(sTooltip) > 0 Then _PropertyGet = sTooltip Else _PropertyGet = Iif(Len(_Label) > 0, _Label, _AccessibleName)
480 Set oElement = _Element.GetSettings(True).getByIndex(_Index)
485 _PropertyGet = _GetPosition().X
487 _PropertyGet = _GetPosition().Y
488 Case Else
489 _PropertyGet = Null
490 End Select
492 Finally:
493 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
494 Exit Function
495 Catch:
496 GoTo Finally
497 End Function ' SFWidgets.SF_ToolbarButton._PropertyGet
499 REM -----------------------------------------------------------------------------
500 Private Function _PropertySet(Optional ByVal psProperty As String _
501 , Optional ByVal pvValue As Variant _
502 ) As Boolean
503 ''' Set the new value of the named property
504 ''' Args:
505 ''' psProperty: the name of the property
506 ''' pvValue: the new value of the given property
508 Dim bSet As Boolean ' Return value
509 Dim oSettings As Object ' com.sun.star.container.XIndexAccess
510 Dim vProperties As Variant ' Array of PropertyValues
511 Dim bVisible As Boolean ' Actual Visible state
513 Dim cstThisSub As String
516 Check:
517 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
518 bSet = False
521 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
523 Try:
524 bSet = True
525 Set oSettings = _Element.getSettings(True)
526 vProperties = oSettings.getByIndex(_Index)
528 Select Case UCase(psProperty)
536 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Catch
538 Case Else
539 bSet = False
540 End Select
542 oSettings.replaceByIndex(_Index, vProperties)
543 _Element.setSettings(oSettings)
545 Finally:
546 _PropertySet = bSet
547 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
548 Exit Function
549 Catch:
550 bSet = False
551 GoTo Finally
552 End Function ' SFWidgets.SF_ToolbarButton._PropertySet
554 REM -----------------------------------------------------------------------------
555 Private Function _Repr() As String
556 ''' Convert the SF_ToolbarButton instance to a readable string, typically for debugging purposes (DebugPrint ...)
557 ''' Args:
558 ''' Return:
559 ''' "[Toolbar]: Name, Type (dialogname)
560 _Repr = "[ToolbarButton]: " & Iif(Len(_Label) > 0, _Label, _AccessibleName) & " - " & _CommandURL
562 End Function ' SFWidgets.SF_ToolbarButton._Repr
564 REM ============================================ END OF SFWIDGETS.SF_TOOLBARBUTTON
565 </script:module>