Current File : //proc/self/root/lib/libreoffice/share/basic/SFWidgets/SF_ToolbarButton.xba
<?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>
Mini Shell