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