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_Toolbar ''' ========== ''' Hide/show a toolbar related to a component/document. ''' ''' Each component has its own set of toolbars, depending on the component type ''' (Calc, Writer, Basic IDE, ...). ''' In the context of the actual class, a toolbar is presumed defined statically: ''' - either by the application ''' - or by a customization done by the user. ''' The definition of a toolbar can be stored in the application configuration files ''' or in a specific document. ''' Changes made by scripts to toolbars stored in the application are persistent. ''' They are valid for all documents of the same type. ''' ''' Note that the menubar and the statusbar are not considered toolbars in this context. ''' ''' 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. ''' ''' The name of a toolbar is either: ''' - its so-called UIName when it is available, ''' - or the last component of the resource URL: "private:resource/toolbar/the-name-here" ''' ''' Service invocation: ''' The Toolbars() method returns the list of available toolbar names ''' The Toolbars(toolbarname) returns a Toolbar service ''' It is available from ''' - the UI service to access the toolbars of the Basic IDE ("BASICIDE"), ''' the start center ("WELCOMESCREEN") or the active window ''' - the Document, Calc, Writer, Datasheet, FormDocument services to access ''' their respective set of toolbars. ''' Example: ''' Dim oCalc As Object, oToolbar As Object ''' Set oCalc = CreateScriptService("Calc", "myFile.ods") ''' Set oToolbar = oCalc.Toolbars("findbar") REM ================================================================== EXCEPTIONS REM ============================================================= PRIVATE MEMBERS Private [Me] As Object Private ObjectType As String ' Must be TOOLBAR Private ServiceName As String Private _Component As Object ' com.sun.star.lang.XComponent Private _ResourceURL As String ' Toolbar internal name Private _UIName As String ' Toolbar external name, may be "" Private _UIConfigurationManager As Object ' com.sun.star.ui.XUIConfigurationManager Private _ElementsInfoIndex As Long ' Index of the toolbar in the getElementsInfo(0) array Private _Storage As Long ' One of the toolbar location constants Private _LayoutManager As Object ' com.sun.star.comp.framework.LayoutManager Private _ToolbarButtons As Object ' SF_Dictionary of toolbar buttons Type _ToolbarButton Toolbar As Object ' The actual SF_Toolbar object instance Index As Long ' Entry number in buttons lists Label As String ' Label (static description) AccessibleName As String ' Name found in accessible context Element As Object ' com.sun.star.ui.XUIElement End Type REM ============================================================ MODULE CONSTANTS ' Toolbar locations Private Const cstBUILTINTOOLBAR = 0 ' Standard toolbar Private Const cstCUSTOMTOOLBAR = 1 ' Toolbar added by user and stored in the LibreOffice application Private Const cstCUSTOMDOCTOOLBAR = 2 ' Toolbar added by user solely for a single document REM ====================================================== CONSTRUCTOR/DESTRUCTOR REM ----------------------------------------------------------------------------- Private Sub Class_Initialize() Set [Me] = Nothing ObjectType = "TOOLBAR" ServiceName = "SFWidgets.Toolbar" Set _Component = Nothing _ResourceURL = "" _UIName = "" Set _UIConfigurationManager = Nothing _ElementsInfoIndex = -1 _Storage = 0 Set _LayoutManager = Nothing Set _ToolbarButtons = Nothing End Sub ' SFWidgets.SF_Toolbar Constructor REM ----------------------------------------------------------------------------- Private Sub Class_Terminate() Call Class_Initialize() End Sub ' SFWidgets.SF_Toolbar Destructor REM ----------------------------------------------------------------------------- Public Function Dispose() As Variant Call Class_Terminate() Set Dispose = Nothing End Function ' SFWidgets.SF_Toolbar Explicit Destructor REM ================================================================== PROPERTIES REM ----------------------------------------------------------------------------- Property Get BuiltIn() As Boolean ''' Returns True when the toolbar is part of the set of standard toolbars shipped with the application. ''' Example: ''' MsgBox myToolbar.BuiltIn BuiltIn = _PropertyGet("BuiltIn") End Property ' SFWidgets.SF_Toolbar.BuiltIn (get) REM ----------------------------------------------------------------------------- Property Get Docked() As Variant ''' Returns True when the toolbar is active in the window and Docked. ''' Example: ''' MsgBox myToolbar.Docked Docked = _PropertyGet("Docked") End Property ' SFWidgets.SF_Toolbar.Docked (get) REM ----------------------------------------------------------------------------- Property Get HasGlobalScope() As Boolean ''' Returns True when the toolbar is available in all documents of the same type ''' Example: ''' MsgBox myToolbar.HasGlobalScope HasGlobalScope = _PropertyGet("HasGlobalScope") End Property ' SFWidgets.SF_Toolbar.HasGlobalScope (get) REM ----------------------------------------------------------------------------- Property Get Name() As String ''' Returns the name of the toolbar ''' Example: ''' MsgBox myToolbar.Name Name = _PropertyGet("Name") End Property ' SFWidgets.SF_Toolbar.Name (get) REM ----------------------------------------------------------------------------- Property Get ResourceURL() As String ''' Returns URL of the toolbar, in the form private:toolbar/xxx ''' Example: ''' MsgBox myToolbar.ResourceURL ResourceURL = _PropertyGet("ResourceURL") End Property ' SFWidgets.SF_Toolbar.ResourceURL (get) REM ----------------------------------------------------------------------------- Property Get Visible() As Variant ''' Returns True when the toolbar is active in the window and visible. ''' Example: ''' MsgBox myToolbar.Visible Visible = _PropertyGet("Visible") End Property ' SFWidgets.SF_Toolbar.Visible (get) REM ----------------------------------------------------------------------------- Property Let Visible(ByVal pvVisible As Variant) ''' Sets the visible status of the toolbar. ''' When the toolbar is not yet active i the window, it is first created. ''' Example: ''' myToolbar.Visible = True _PropertySet("Visible", pvVisible) End Property ' SFWidgets.SF_Toolbar.Visible (let) REM ----------------------------------------------------------------------------- Property Get XUIElement() As Variant ''' Returns the com.sun.star.ui.XUIElement UNO object corresponding with the toolbar ''' Example: ''' MsgBox myToolbar.XUIElement XUIElement = _PropertyGet("XUIElement") End Property ' SFWidgets.SF_Toolbar.XUIElement (get) REM ===================================================================== METHODS 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.Toolbar.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_Toolbar.GetProperty REM ----------------------------------------------------------------------------- Public Function Methods() As Variant ''' Return the list of public methods of the Model service as an array Methods = Array( _ "ToolbarButtons" _ ) End Function ' SFWidgets.SF_Toolbar.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( _ "BuiltIn" _ , "Docked" _ , "HasGlobalScope" _ , "Name" _ , "ResourceURL" _ , "Visible" _ , "XUIElement" _ ) End Function ' SFWidgets.SF_Toolbar.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.Toolbar.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_Toolbar.SetProperty REM ----------------------------------------------------------------------------- Public Function ToolbarButtons(Optional ByVal ButtonName As Variant) As Variant ''' Returns either a list of the available toolbar button names in the actual toolbar ''' or a ToolbarButton object instance. ''' Args: ''' ButtonName: the usual name of one of the available buttons in the actual toolbar ''' Returns: ''' A zero-based array of button names when the argument is absent, ''' or a new ToolbarButton object instance. ''' An inactive toolbar has no buttons => the actual method forces the toolbar to be made visible first. Const cstThisSub = "SFWidgets.Toolbar.ToolbarButtons" Const cstSubArgs = "[ButtonName=""""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If IsMissing(ButtonName) Or IsEmpty(ButtonName) Then ButtonName = "" ' Store button descriptions in cache _CollectAllButtons() If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If VarType(ButtonName) = V_STRING Then If Len(ButtonName) > 0 Then If Not ScriptForge.SF_Utils._Validate(ButtonName, "ButtonName", V_STRING, _ToolbarButtons.Keys()) Then GoTo Finally End If Else If Not ScriptForge.SF_Utils._Validate(ButtonName, "ButtonName", V_STRING) Then GoTo Finally ' Manage here the VarType error End If End If Try: If Len(ButtonName) = 0 Then ToolbarButtons = _ToolbarButtons.Keys() Else ToolbarButtons = CreateScriptService("SFWidgets.ToolbarButton", _ToolbarButtons.Item(ButtonName)) End If Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFWidgets.SF_Toolbar.ToolbarButtons REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- Private Sub _CollectAllButtons() ''' Stores a SF_Dictionary object instance, with ''' - key = name of the button ''' - item = a _ButtonDesc object type ''' into _ToolbarButtons, a cache for all buttons. ''' The toolbar is made visible before collecting the buttons. ''' ''' The name of the buttons is derived either from: ''' - the Label property of the static toolbar and toolbar buttons definitions ''' - or the AccessibleName property of the AccessibleContext of the button ''' whichever is found first. ''' Separators are skipped. ''' If there are homonyms (>= 2 buttons having the same name), only the 1st one is retained. Dim oElement As Object ' com.sun.star.ui.XUIElement Dim oSettings As Object ' com.sun.star.container.XIndexAccess Dim vProperties() As Variant ' Array of property values Dim iType As Integer ' Separators have type = 1, others have Type = 0 Dim oAccessible As Object ' com.sun.star.accessibility.XAccessible Dim sLabel As String ' Label in static description Dim sAccessibleName As String ' Name in AccessibleContext Dim sButtonName As String ' Key part in dictionary entry Dim oButton As Object ' Item part in dictionary entry Dim i As Long On Local Error GoTo Catch If Not IsNull(_ToolbarButtons) Then GoTo Finally ' Do not redo the job if already done Try: ' Force the visibility of the toolbar Visible = True Set _ToolbarButtons = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Dictionary") Set oElement = _LayoutManager.getElement(_ResourceURL) Set oSettings = oElement.getSettings(True) With oSettings For i = 0 To .Count - 1 vProperties = .getByIndex(i) iType = ScriptForge.SF_Utils._GetPropertyValue(vProperties, "Type") If iType = 0 Then ' Usual button sLabel = ScriptForge.SF_Utils._GetPropertyValue(vProperties, "Label") If Len(sLabel) = 0 Then Set oAccessible = oElement.RealInterface.AccessibleContext.getAccessibleChild(i) sAccessibleName = oAccessible.AccessibleName Else sAccessibleName = "" End If ' Store in dictionary sButtonName = sLabel & sAccessibleName ' At least 1 of them is blank If Len(sButtonName) > 0 Then Set oButton = New _ToolbarButton With oButton Set .Toolbar = [Me] .Index = i .Label = sLabel .AccessibleName = sAccessibleName Set .Element = oElement End With With _ToolbarButtons If Not .Exists(sButtonName) Then .Add(sButtonName, oButton) End With End If End If Next i End With Finally: Exit Sub Catch: ' _ToolbarButtons is left unchanged GoTo Finally End Sub ' SFWidgets.SF_Toolbar._CollectAllButtons REM ----------------------------------------------------------------------------- Public Sub _Initialize(ByRef poToolbar As Object) ''' Complete the object creation process: ''' - Initialize the toolbar descriptioner use ''' Args: ''' poToolbar: the toolbar description as a ui._Toolbr object Try: ' Store the static description With poToolbar _Component = .Component _ResourceURL = .ResourceURL _UIName = .UIName _UIConfigurationManager = .UIConfigurationManager _ElementsInfoIndex = .ElementsInfoIndex _Storage = .Storage End With ' Complement If Len(_UIName) = 0 Then _UIName = Split(_ResourceURL, "/")(2) Set _LayoutManager = _Component.CurrentController.Frame.LayoutManager Finally: Exit Sub End Sub ' SFWidgets.SF_Toolbar._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 oElement As Object ' com.sun.star.ui.XUIElement Dim cstThisSub As String Const cstSubArgs = "" cstThisSub = "SFWidgets.Toolbar.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("BuiltIn") _PropertyGet = ( _Storage = cstBUILTINTOOLBAR ) Case UCase("Docked") Set oElement = _LayoutManager.getElement(_ResourceURL) If Not IsNull(oElement) Then _PropertyGet = _LayoutManager.isElementDocked(_ResourceURL) Else _PropertyGet = False Case UCase("HasGlobalScope") _PropertyGet = ( _Storage = cstBUILTINTOOLBAR Or _Storage = cstCUSTOMTOOLBAR ) Case UCase("Name") _PropertyGet = _UIName Case UCase("ResourceURL") _PropertyGet = _ResourceURL Case UCase("Visible") Set oElement = _LayoutManager.getElement(_ResourceURL) If Not IsNull(oElement) Then _PropertyGet = _LayoutManager.isElementVisible(_ResourceURL) Else _PropertyGet = False Case UCase("XUIElement") _PropertyGet = _LayoutManager.getElement(_ResourceURL) Case Else _PropertyGet = Null End Select Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFWidgets.SF_Toolbar._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 oElement As Object ' com.sun.star.ui.XUIElement Dim bVisible As Boolean ' Actual Visible state Dim cstThisSub As String Const cstSubArgs = "Value" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bSet = False cstThisSub = "SFWidgets.Toolbar.set" & psProperty ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) bSet = True Select Case UCase(psProperty) Case UCase("Visible") If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Catch With _LayoutManager Set oElement = .getElement(_ResourceURL) If Not IsNull(oElement) Then bVisible = .isElementVisible(_ResourceURL) Else bVisible = False ' If there is no change, do nothing If Not bVisible = pvValue Then If IsNull(oElement) And pvValue Then .createElement(_ResourceURL) If pvValue Then .showElement(_ResourceURL) Else .hideElement(_ResourceURL) End If End With Case Else bSet = False End Select Finally: _PropertySet = bSet ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: bSet = False GoTo Finally End Function ' SFWidgets.SF_Toolbar._PropertySet REM ----------------------------------------------------------------------------- Private Function _Repr() As String ''' Convert the SF_Toolbar instance to a readable string, typically for debugging purposes (DebugPrint ...) ''' Args: ''' Return: ''' "[Toolbar]: Name, Type (dialogname) _Repr = "[Toolbar]: " & _UIName & " - " & _ResourceURL End Function ' SFWidgets.SF_Toolbar._Repr REM ============================================ END OF SFWIDGETS.SF_TOOLBAR