8a4ee0fb39
Complete a predefined context menu with new items placed at its bottom. A context menu is obtained by a right-click on several areas of a document. Each area has its own context menu. Each component model has its own set of context menus. A context menu is usually predefined at LibreOffice installation. Customization is done statically with the Tools + Customize dialog. The actual new service provides a mean to make temporary additions at the bottom of a context menu. Those changes are lost when the document is closed. The name of a context menu is the last component of the resource URL: "private:resource/popupmenu/the-name-here" Context menu items are either usual items or line separators. Checkboxes or radio buttons are not supported. Items run a command or a script when clicked. The service implements 2 methods: AddItem() adds an entry in the menu hierarchy Activate() shows or hides the added entries A context menu can be defined from both Basic and Python user scripts. An update of the documentation is required. Change-Id: Id77f1f2565d75e36c09b13972330d0f83b3f1db4 Reviewed-on: https://gerrit.libreoffice.org/c/core/+/172355 Reviewed-by: Jean-Pierre Ledure <jp@ledure.be> Tested-by: Jenkins
571 lines
No EOL
24 KiB
XML
571 lines
No EOL
24 KiB
XML
<?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")
|
|
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> |