Quelle  SF_ToolbarButton.xba   Sprache: unbekannt

<?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")
'''
'''
'''  Detailed user documentation:
'''   https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/toolbarcontrol.html?DbPAR=BASIC
'''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

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")

 ' The button must be visible
 If ScriptForge.SF_Utils._GetPropertyValue(oElement, "IsVisible") Then
  Set oAccessible = [_Parent]._GetAccessibleContext(_Element)    ' 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. However no mean has been found to get that height via code.
  With oRect
   ' See bug https://bugs.documentfoundation.org/show_bug.cgi?id=168409
   ' Finding the button coordinates is release-dependent due to phase-out of unpublished API
   Select case ScriptForge.SF_Platform._GetProductName(True) ' Get a sortable release number
    Case <= 25.8
     .X = oAccessible.Location.X + oAccessibleButton.Location.X + oAccessibleParent.PosSize.X
     .Y = oAccessible.Location.Y + oAccessibleButton.Location.Y + oAccessibleParent.PosSize.Y
    Case Else  ' >= 26.2
     .X = oAccessible.LocationOnScreen.X + oAccessibleButton.Location.X - oAccessibleParent.LocationOnScreen.X
     .Y = oAccessible.LocationOnScreen.Y + oAccessibleButton.Location.Y - oAccessibleParent.LocationOnScreen.Y
   End Select
   If _Height = 0 Then _Height = oAccessibleButton.Size.Height
   .Height = _Height
   If _Width = 0 Then _Width = oAccessibleButton.Size.Width
   .Width = _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>