diff options
Diffstat (limited to 'wizards/source/sfwidgets')
| -rw-r--r-- | wizards/source/sfwidgets/SF_Menu.xba | 598 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_MenuListener.xba | 131 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_PopupMenu.xba | 801 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_Register.xba | 257 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_Toolbar.xba | 541 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_ToolbarButton.xba | 565 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/__License.xba | 26 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/dialog.xlb | 3 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/script.xlb | 11 |
9 files changed, 2933 insertions, 0 deletions
diff --git a/wizards/source/sfwidgets/SF_Menu.xba b/wizards/source/sfwidgets/SF_Menu.xba new file mode 100644 index 0000000000..85d505904d --- /dev/null +++ b/wizards/source/sfwidgets/SF_Menu.xba @@ -0,0 +1,598 @@ +<?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_Menu" 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_Menu +''' ============ +''' Display a menu in the menubar of a document or a form document. +''' After use, the menu will not be saved neither in the application settings, nor in the document. +''' +''' The menu will be displayed, as usual, when its header in the menubar is clicked. +''' When one of its items is selected, there are 3 alternative options: +''' - a UNO command (like ".uno:About") is triggered +''' - a user script is run receiving a standard argument defined in this service +''' - one of above combined with a toggle of the status of the item +''' +''' The menu is described from top to bottom. Each menu item receives a numeric and a string identifier. +''' +''' Menu items are either: +''' - usual items +''' - checkboxes +''' - radio buttons +''' - a menu separator +''' Menu items can be decorated with icons and tooltips. +''' +''' Definitions: +''' SubmenuCharacter: the character or the character string that identifies how menus are cascading +''' Default = ">" +''' Can be set when invoking the Menu service +''' ShortcutCharacter: the underline access key character +''' Default = "~" +''' +''' Menus and submenus +''' To create a menu with submenus, use the character defined in the +''' SubmenuCharacter property while creating the menu entry to define where it will be +''' placed. For instance, consider the following menu/submenu hierarchy. +''' Item A +''' Item B > Item B.1 +''' Item B.2 +''' ------ (line separator) +''' Item C > Item C.1 > Item C.1.1 +''' Item C.1.2 +''' Item C > Item C.2 > Item C.2.1 +''' Item C.2.2 +''' Next code will create the menu/submenu hierarchy +''' With myMenu +''' .AddItem("Item A") +''' .AddItem("Item B>Item B.1") +''' .AddItem("Item B>Item B.2") +''' .AddItem("---") +''' .AddItem("Item C>Item C.1>Item C.1.1") +''' .AddItem("Item C>Item C.1>Item C.1.2") +''' .AddItem("Item C>Item C.2>Item C.2.1") +''' .AddItem("Item C>Item C.2>Item C.2.2") +''' End With +''' +''' Service invocation: +''' Dim ui As Object, oDoc As Object, myMenu As Object +''' Set ui = CreateScriptService("UI") +''' Set oDoc = ui.GetDocument(ThisComponent) +''' Set myMenu = oDoc.CreateMenu("My own menu") +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/SF_Menu.html?DbPAR=BASIC +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private ObjectType As String ' Must be MENU +Private ServiceName As String + + +' Menu descriptors +Private Component As Object ' the com.sun.star.lang.XComponent hosting the menu in its menubar +Private MenuBar As Object ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar +Private SubmenuChar As String ' Delimiter in menu trees +Private MenuHeader As String ' Header of the menu +Private MenuId As Integer ' Menu numeric identifier in the menubar +Private MenuPosition As Integer ' Position of the menu on the menubar >= 1 +Private PopupMenu As Object ' The underlying popup menu as a SF_PopupMenu object + +REM ============================================================ MODULE CONSTANTS + +Private Const _UnderlineAccessKeyChar = "~" +Private Const _DefaultSubmenuChar = ">" +Private Const cstUnoPrefix = ".uno:" +Private Const cstScriptArg = ":::" +Private Const cstNormal = "N" +Private Const cstCheck = "C" +Private Const cstRadio = "R" + +REM ====================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + ObjectType = "MENU" + ServiceName = "SFWidgets.Menu" + Set Component = Nothing + Set MenuBar = Nothing + SubmenuChar = _DefaultSubmenuChar + MenuHeader = "" + MenuId = -1 + MenuPosition = 0 + Set PopupMenu = Nothing +End Sub ' SFWidgets.SF_Menu Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' SFWidgets.SF_Menu Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + PopupMenu.Dispose() + Call Class_Terminate() + Set Dispose = Nothing +End Function ' SFWidgets.SF_Menu Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get ShortcutCharacter() As Variant +''' The ShortcutCharacter property specifies character preceding the underline access key + ShortcutCharacter = _PropertyGet("ShortcutCharacter") +End Property ' SFWidgets.SF_Menu.ShortcutCharacter (get) + +REM ----------------------------------------------------------------------------- +Property Get SubmenuCharacter() As Variant +''' The SubmenuCharacter property specifies the character string indicating +''' a sub-menu in a popup menu item + SubmenuCharacter = _PropertyGet("SubmenuCharacter") +End Property ' SFWidgets.SF_Menu.SubmenuCharacter (get) + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function AddCheckBox(Optional ByVal MenuItem As Variant _ + , Optional ByVal Name As Variant _ + , Optional ByVal Status As Variant _ + , Optional ByVal Icon As Variant _ + , Optional ByVal Tooltip As Variant _ + , Optional ByVal Command As Variant _ + , Optional ByVal Script As Variant _ + ) As Integer +''' Insert in the popup menu a new entry as a checkbox +''' Args: +''' MenuItem: The text to be displayed in the menu entry. +''' It determines also the hierarchy of the popup menu +''' It is made up of all the components (separated by the "SubmenuCharacter") of the menu branch +''' Example: A>B>C means "C" is a new entry in submenu "A => B =>" +''' If the last component is equal to the "SeparatorCharacter", a line separator is inserted +''' Name: The name identifying the item. Default = the last component of MenuItem. +''' Status: when True the item is selected. Default = False +''' Icon: The path name of the icon to be displayed, without leading path separator +''' The icons are stored in one of the <install folder>/share/config/images_*.zip files +''' The exact file depends on the user options about the current icon set +''' Use the (normal) slash "/" as path separator +''' Example: "cmd/sc_cut.png" +''' Tooltip: The help text to be displayed as a tooltip +''' Command: A menu command like ".uno:About". The validity of the command is not checked. +''' Script: a Basic or Python script (determined by its URI notation) to be run when the item is clicked +''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification +''' Next string argument will be passed to the called script : a comma-separated string of 4 components: +''' - the menu header +''' - the name of the clicked menu item +''' - the numeric identifier of the clicked menu item +''' - "1" when the status is "checked", otherwise "0" +''' Arguments Command and Script are mutually exclusive. +''' Returns: +''' The numeric identification of the newly inserted item +''' Examples: +''' Dim iId As Integer +''' iId = myMenu.AddCheckBox("Menu top>Checkbox item", Status := True, Command := "Bold") + +Dim iId As Integer ' Return value +Dim sCommand As String ' Alias of either Command or Script + + +Const cstThisSub = "SFWidgets.Menu.AddCheckBox" +Const cstSubArgs = "MenuItem, [Name=""""], [Status=False], [Icon=""""], [Tooltip=""""], [Command=""""], [Script=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + iId = 0 + +Check: + If IsMissing(Name) Or IsEmpty(Name) Then Name = "" + If IsMissing(Status) Or IsEmpty(Status) Then Status = False + If IsMissing(Icon) Or IsEmpty(Icon) Then Icon = "" + If IsMissing(Tooltip) Or IsEmpty(Tooltip) Then Tooltip = "" + If IsMissing(Command) Or IsEmpty(Command) Then Command = "" + If IsMissing(Script) Or IsEmpty(Script) Then Script = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(MenuItem, "MenuItem", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Status, "Status", ScriptForge.V_BOOLEAN) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Icon, "Icon", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Tooltip, "Tooltip", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Script, "Script", V_STRING) Then GoTo Catch + End If + + If Len(Command) > 0 Then + If Left(Command, Len(cstUnoPrefix)) = cstUnoPrefix Then sCommand = Command Else sCommand = cstUnoPrefix & Command + Else + sCommand = Script & cstScriptArg & MenuHeader + End If + +Try: + iId = PopupMenu._AddItem(MenuItem, Name, cstCheck, Status, Icon, Tooltip, sCommand) + +Finally: + AddCheckBox = iId + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_Menu.AddCheckBox + +REM ----------------------------------------------------------------------------- +Public Function AddItem(Optional ByVal MenuItem As Variant _ + , Optional ByVal Name As Variant _ + , Optional ByVal Icon As Variant _ + , Optional ByVal Tooltip As Variant _ + , Optional ByVal Command As Variant _ + , Optional ByVal Script As Variant _ + ) As Integer +''' Insert in the popup menu a new entry +''' Args: +''' MenuItem: The text to be displayed in the menu entry. +''' It determines also the hierarchy of the popup menu +''' It is made up of all the components (separated by the "SubmenuCharacter") of the menu branch +''' Example: A>B>C means "C" is a new entry in submenu "A => B =>" +''' If the last component is equal to "---", a line separator is inserted and all other arguments are ignored +''' Name: The name identifying the item. Default = the last component of MenuItem. +''' Icon: The path name of the icon to be displayed, without leading path separator +''' The icons are stored in one of the <install folder>/share/config/images_*.zip files +''' The exact file depends on the user options about the current icon set +''' Use the (normal) slash "/" as path separator +''' Example: "cmd/sc_cut.png" +''' Tooltip: The help text to be displayed as a tooltip +''' Command: A menu command like ".uno:About". The validity of the command is not checked. +''' Script: a Basic or Python script (determined by its URI notation) to be run when the item is clicked +''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification +''' Next string argument will be passed to the called script : a comma-separated string of 4 components: +''' - the menu header +''' - the name of the clicked menu item +''' - the numeric identifier of the clicked menu item +''' - "0" +''' Arguments Command and Script are mutually exclusive. +''' Returns: +''' The numeric identification of the newly inserted item +''' Examples: +''' Dim iId1 As Integer, iId2 As Integer +''' iId1 = myMenu.AddItem("Menu top>Normal item 1", Icon := "cmd.sc_cut.png", Command := "About") +''' iId2 = myMenu.AddItem("Menu top>Normal item 2", Script := "vnd.sun.star.script:myLib.Module1.ThisSub?language=Basic&location=document") + +Dim iId As Integer ' Return value +Dim sCommand As String ' Alias of either Command or Script + +Const cstThisSub = "SFWidgets.Menu.AddItem" +Const cstSubArgs = "MenuItem, [Name=""""], [Icon=""""], [Tooltip=""""], [Command=""""], [Script=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + iId = 0 + +Check: + If IsMissing(Name) Or IsEmpty(Name) Then Name = "" + If IsMissing(Icon) Or IsEmpty(Icon) Then Icon = "" + If IsMissing(Tooltip) Or IsEmpty(Tooltip) Then Tooltip = "" + If IsMissing(Command) Or IsEmpty(Command) Then Command = "" + If IsMissing(Script) Or IsEmpty(Script) Then Script = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(MenuItem, "MenuItem", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Icon, "Icon", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Tooltip, "Tooltip", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Script, "Script", V_STRING) Then GoTo Catch + End If + + If Len(Command) > 0 Then + If Left(Command, Len(cstUnoPrefix)) = cstUnoPrefix Then sCommand = Command Else sCommand = cstUnoPrefix & Command + Else + sCommand = Script & cstScriptArg & MenuHeader + End If + +Try: + iId = PopupMenu._AddItem(MenuItem, Name, cstNormal, False, Icon, Tooltip, sCommand) + +Finally: + AddItem = iId + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_Menu.AddItem + +REM ----------------------------------------------------------------------------- +Public Function AddRadioButton(Optional ByVal MenuItem As Variant _ + , Optional ByVal Name As Variant _ + , Optional ByVal Status As Variant _ + , Optional ByVal Icon As Variant _ + , Optional ByVal Tooltip As Variant _ + , Optional ByVal Command As Variant _ + , Optional ByVal Script As Variant _ + ) As Integer +''' Insert in the popup menu a new entry as a radio button +''' Args: +''' MenuItem: The text to be displayed in the menu entry. +''' It determines also the hieAddCheckBoxrarchy of the popup menu +''' It is made up of all the components (separated by the "SubmenuCharacter") of the menu branch +''' Example: A>B>C means "C" is a new entry in submenu "A => B =>" +''' If the last component is equal to the "SeparatorCharacter", a line separator is inserted +''' Name: The name identifying the item. Default = the last component of MenuItem. +''' Status: when True the item is selected. Default = False +''' Icon: The path name of the icon to be displayed, without leading path separator +''' The icons are stored in one of the <install folder>/share/config/images_*.zip files +''' The exact file depends on the user options about the current icon set +''' Use the (normal) slash "/" as path separator +''' Example: "cmd/sc_cut.png" +''' Tooltip: The help text to be displayed as a tooltip +''' Command: A menu command like ".uno:About". The validity of the command is not checked. +''' Script: a Basic or Python script (determined by its URI notation) to be run when the item is clicked +''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification +''' Next string argument will be passed to the called script : a comma-separated string of 4 components: +''' - the menu header +''' - the name of the clicked menu item +''' - the numeric identifier of theclicked menu item +''' - "1" when the status is "checked", otherwise "0" +''' Arguments Command and Script are mutually exclusive. +''' Returns: +''' The numeric identification of the newly inserted item +''' Examples: +''' Dim iId As Integer +''' iId = myMenu.AddRadioButton("Menu top>Radio item", Status := True, Command := "Bold") + +Dim iId As Integer ' Return value +Dim sCommand As String ' Alias of either Command or Script + +Const cstThisSub = "SFWidgets.Menu.AddRadioButton" +Const cstSubArgs = "MenuItem, [Name=""""], [Status=False], [Icon=""""], [Tooltip=""""], [Command=""""], [Script=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + iId = 0 + +Check: + If IsMissing(Name) Or IsEmpty(Name) Then Name = "" + If IsMissing(Status) Or IsEmpty(Status) Then Status = False + If IsMissing(Icon) Or IsEmpty(Icon) Then Icon = "" + If IsMissing(Tooltip) Or IsEmpty(Tooltip) Then Tooltip = "" + If IsMissing(Command) Or IsEmpty(Command) Then Command = "" + If IsMissing(Script) Or IsEmpty(Script) Then Script = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(MenuItem, "MenuItem", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Status, "Status", ScriptForge.V_BOOLEAN) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Icon, "Icon", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Tooltip, "Tooltip", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Script, "Script", V_STRING) Then GoTo Catch + End If + + If Len(Command) > 0 Then + If Left(Command, Len(cstUnoPrefix)) = cstUnoPrefix Then sCommand = Command Else sCommand = cstUnoPrefix & Command + Else + sCommand = Script & cstScriptArg & MenuHeader + End If + +Try: + iId = PopupMenu._AddItem(MenuItem, Name, cstRadio, Status, Icon, Tooltip, sCommand) + +Finally: + AddRadioButton = iId + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_Menu.AddRadioButton + +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: +''' myModel.GetProperty("MyProperty") + +Const cstThisSub = "SFWidgets.Menu.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_Menu.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Model service as an array + + Methods = Array( _ + "AddCheckBox" _ + , "AddItem" _ + , "AddRadioButton" _ + ) + +End Function ' SFWidgets.SF_Menu.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( _ + "ShortcutCharacter" _ + , "SubmenuCharacter" _ + ) + +End Function ' SFWidgets.SF_Menu.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.Menu.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_Menu.SetProperty + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Public Sub _Initialize(ByRef poComponent As Object _ + , psMenuHeader As String _ + , psBefore As String _ + , piBefore As Integer _ + , psSubmenuChar As String _ + ) +''' Complete the object creation process: +''' - Initialize the internal properties +''' - Initialize the menubar +''' - Determine the position and the internal id of the new menu +''' - Create the menu and its attached popup menu +''' Args: +''' poComponent: the parent component where the menubar is to be searched for +''' psMenuHeader: the header of the new menu. May or not contain a tilde "~" +''' psBefore, piBefore: the menu before which to create the new menu, as a string or as a number +''' psSubmenuChar: the submenus separator + +Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager +Dim sName As String ' Menu name +Dim iMenuId As Integer ' Menu identifier +Dim oWindow As Object ' ui.Window type +Dim oUi As Object : Set oUi = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI") +Dim i As Integer +Const cstTilde = "~" + +Check: + ' How does the window look on top of which a menu is requested ? + Set oWindow = oUi._IdentifyWindow(poComponent) + With oWindow + If Not IsNull(.Frame) Then Set oLayout = .Frame.LayoutManager Else GoTo Finally + End With + +Try: + ' Initialize the menubar + Set MenuBar = oLayout.getElement("private:resource/menubar/menubar").XMenuBar + + ' Determine the new menu identifier and its position + ' Identifier = largest current identifier + 1 + MenuHeader = psMenuHeader + With MenuBar + For i = 0 To .ItemCount - 1 + iMenuId = .getItemId(i) + If iMenuId >= MenuId Then MenuId = iMenuId + 1 + If piBefore > 0 And piBefore = i + 1 Then + MenuPosition = piBefore + Else + sName = .getItemText(iMenuId) + If sName = psBefore Or Replace(sName, cstTilde, "") = psBefore Then MenuPosition = i + 1 + End If + Next i + If MenuPosition = 0 Then MenuPosition = .ItemCount + 1 + End With + + ' Store the submenu character + If Len(psSubmenuChar) > 0 Then SubmenuChar = psSubmenuChar + + ' Create the menu and the attached top popup menu + MenuBar.insertItem(MenuId, MenuHeader, 0, MenuPosition - 1) + PopupMenu = SFWidgets.SF_Register._NewPopupMenu(Array(Nothing, 0, 0, SubmenuChar)) + PopupMenu.MenubarMenu = True ' Special indicator for menus depending on menubar + MenuBar.setPopupMenu(MenuId, PopupMenu.MenuRoot) + + ' Initialize the listener on the top branch + SFWidgets.SF_MenuListener.SetMenuListener(PopupMenu.MenuRoot) + +Finally: + Exit Sub +End Sub ' SFWidgets.SF_Menu._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 cstThisSub As String +Const cstSubArgs = "" + + cstThisSub = "SFWidgets.Menu.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("ShortcutCharacter") + _PropertyGet = _UnderlineAccessKeyChar + Case UCase("SubmenuCharacter") + _PropertyGet = SubmenuChar + Case Else + _PropertyGet = Null + End Select + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_Menu._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the SF_Menu instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[Menu]: Name, Type (dialogname) + _Repr = "[Menu]: " & SF_String.Represent(PopupMenu.MenuTree.Keys()) & ", " & SF_String.Represent(PopupMenu.MenuIdentification.Items()) + +End Function ' SFWidgets.SF_Menu._Repr + +REM ============================================ END OF SFWIDGETS.SF_MENU +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfwidgets/SF_MenuListener.xba b/wizards/source/sfwidgets/SF_MenuListener.xba new file mode 100644 index 0000000000..cb7839de58 --- /dev/null +++ b/wizards/source/sfwidgets/SF_MenuListener.xba @@ -0,0 +1,131 @@ +<?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_MenuListener" 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 Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_MenuListener +''' =============== +''' The current module is dedicated to the management of menu events + listeners, triggered by user actions, +''' which cannot be defined with the Basic IDE +''' +''' Concerned listeners: +''' com.sun.star.awt.XMenuListener +''' allowing a user to select a menu command in user menus preset in the menubar +''' +''' The described events/listeners are processed by UNO listeners +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ============================================================= PRIVATE MEMBERS + +Dim MenuListener As Object ' com.sun.star.awt.XMenuListener + +REM =========================================================== PRIVATE CONSTANTS + +Private Const _MenuListenerPrefix = "_SFMENU_" +Private Const _MenuListener = "com.sun.star.awt.XMenuListener" +Private Const cstUnoPrefix = ".uno:" +Private Const cstScriptArg = ":::" + +REM ================================================================== EXCEPTIONS + +REM ============================================================== PUBLIC METHODS + +REM ----------------------------------------------------------------------------- +Public Sub SetMenuListener(poSubmenu As Object) +''' Arm a menu listener on a submenu +''' Args: +''' poSubmenu: the targeted submenu + +Try: + If IsNull(MenuListener) Then Set MenuListener = CreateUnoListener(_MenuListenerPrefix, _MenuListener) + poSubmenu.addMenuListener(MenuListener) + +Finally: + Exit Sub +End Sub ' SFWidgets.SF_MenuListener.SetMenuListener + +REM ============================================================= PRIVATE METHODS + +REM ----------------------------------------------------------------------------- +Sub _SFMENU_itemSelected(Optional poEvent As Object) ' com.sun.star.awt.MenuEvent +''' Execute the command or the script associated with the actually selected item +''' When a script, next argument is provided: +''' a comma-separated string with 4 components +''' - the menu header +''' - the name of the selected menu entry (without tilde "~") +''' - the numeric identifier of the selected menu entry +''' - the new status of the selected menu entry ("0" or "1"). Always "0" for usual items. + +Dim iMenuId As Integer +Dim oMenu As Object ' stardiv.Toolkit.VCLXPopupMenu +Dim sCommand As String ' Command associated with menu entry +Dim bType As Boolean ' True when status is meaningful: item is radio button or checkbox +Dim bStatus As Boolean ' Status of the menu item, always False for normal items +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 + + On Local Error GoTo Catch ' Avoid stopping event scripts + +Try: + iMenuId = poEvent.MenuId + oMenu = poEvent.Source + + With oMenu + ' Collect command (script or menu command) and status radiobuttons and checkboxes + sCommand = .getCommand(iMenuId) + bStatus = .isItemChecked(iMenuId) + End With + + If Len(sCommand) > 0 Then + ' A menu 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 Left(sCommand, Len(cstUnoPrefix)) = cstUnoPrefix Then + ' Execute uno command + Set oDispatcher = ScriptForge.SF_Utils._GetUNOService("DispatchHelper") + oDispatcher.executeDispatch(oFrame, sCommand, "", 0, oArgs()) + oFrame.activate() + Else + ' Execute script + vScript = Split(sCommand, cstScriptArg) + oSession._ExecuteScript(vScript(0), vScript(1) & "," & Iif(bStatus, "1", "0")) ' Return value is ignored + End If + End If + +Finally: + Exit Sub +Catch: + GoTo Finally +End Sub ' SFWidgets.SF_MenuListener._SFMENU_itemSelected + +REM ----------------------------------------------------------------------------- +Sub _SFMENU_itemHighlighted(Optional poEvent As Object) ' com.sun.star.awt.MenuEvent + Exit Sub +End Sub ' SFWidgets.SF_MenuListener._SFMENU_itemHighlighted + +Sub _SFMENU_itemActivated(Optional poEvent As Object) ' com.sun.star.awt.MenuEvent + Exit Sub +End Sub ' SFWidgets.SF_MenuListener._SFMENU_itemActivated + +Sub _SFMENU_itemDeactivated(Optional poEvent As Object) ' com.sun.star.awt.MenuEvent + Exit Sub +End Sub ' SFWidgets.SF_MenuListener._SFMENU_itemDeactivated + +Sub _SFMENU_disposing(Optional poEvent As Object) ' com.sun.star.awt.MenuEvent + Exit Sub +End Sub ' SFWidgets.SF_MenuListener._SFMENU_disposing + +REM ============================================ END OF SFWIDGETS.SF_MENULISTENER +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfwidgets/SF_PopupMenu.xba b/wizards/source/sfwidgets/SF_PopupMenu.xba new file mode 100644 index 0000000000..3d5ba65a80 --- /dev/null +++ b/wizards/source/sfwidgets/SF_PopupMenu.xba @@ -0,0 +1,801 @@ +<?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_PopupMenu" 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_PopupMenu +''' ============ +''' Display a popup menu anywhere and any time +''' +''' A popup menu is usually triggered by a mouse action (typically a right-click) on a dialog, a form +''' or one of their controls. In this case the menu will be displayed below the clicked area. +''' When triggered by other events, including in the normal flow of a user script, the script should +''' provide the coordinates of the topleft edge of the menu versus the actual component. +''' +''' The menu is described from top to bottom. Each menu item receives a numeric and a string identifier. +''' The Execute() method returns the item selected by the user. +''' +''' Menu items are either: +''' - usual items +''' - checkboxes +''' - radio buttons +''' - a menu separator +''' Menu items can be decorated with icons and tooltips. +''' +''' Definitions: +''' SubmenuCharacter: the character or the character string that identifies how menus are cascading +''' Default = ">" +''' Can be set when invoking the PopupMenu service +''' ShortcutCharacter: the underline access key character +''' Default = "~" +''' +''' Service invocation: +''' Sub OpenMenu(Optional poMouseEvent As Object) +''' Dim myMenu As Object +''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poMouseEvent, , , ">>") ' Usual case +''' ' or +''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", , X, Y, " | ") ' Use X and Y coordinates to place the menu +''' +''' Menus and submenus +''' To create a popup menu with submenus, use the character defined in the +''' SubmenuCharacter property while creating the menu entry to define where it will be +''' placed. For instance, consider the following menu/submenu hierarchy. +''' Item A +''' Item B > Item B.1 +''' Item B.2 +''' ------ (line separator) +''' Item C > Item C.1 > Item C.1.1 +''' Item C.1.2 +''' Item C > Item C.2 > Item C.2.1 +''' Item C.2.2 +''' Next code will create the menu/submenu hierarchy +''' With myMenu +''' .AddItem("Item A") +''' .AddItem("Item B>Item B.1") +''' .AddItem("Item B>Item B.2") +''' .AddItem("---") +''' .AddItem("Item C>Item C.1>Item C.1.1") +''' .AddItem("Item C>Item C.1>Item C.1.2") +''' .AddItem("Item C>Item C.2>Item C.2.1") +''' .AddItem("Item C>Item C.2>Item C.2.2") +''' End With +''' +''' Example 1: simulate a subset of the View menu in the menubar of the Basic IDE +''' Sub OpenMenu(Optional poMouseEvent As Object) +''' Dim myMenu As Object, vChoice As Variant +''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poMouseEvent) +''' With myMenu +''' .AddCheckBox("View>Toolbars>Dialog") +''' .AddCheckBox("View>Toolbars>Find", Status := True) +''' .AddCheckBox("View>Status Bar", Status := True) +''' .AddItem("View>Full Screen", Name := "FULLSCREEN") +''' vChoice = .Execute(False) ' When 1st checkbox is clicked, return "Dialog" +''' ' When last item is clicked, return "FULLSCREEN" +''' .Dispose() +''' End With +''' +''' Example 2: jump to another sheet of a Calc document +''' ' Link next Sub to the "Mouse button released" event of a form control of a Calc sheet +''' Sub JumpToSheet(Optional poEvent As Object) +''' Dim myMenu As Object, sChoice As String, myDoc As Object, vSheets As Variant, sSheet As String +''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poEvent) +''' Set myDoc = CreateScriptService("Calc", ThisComponent) +''' vSheets = myDoc.Sheets +''' For Each sSheet In vSheets +''' myMenu.AddItem(sSheet) +''' Next sSheet +''' sChoice = myMenu.Execute(False) ' Return sheet name, not sheet index +''' If sChoice <> "" Then myDoc.Activate(sChoice) +''' myDoc.Dispose() +''' myMenu.Dispose() +''' End Sub +''' +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_popupmenu.html?DbPAR=BASIC +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private ObjectType As String ' Must be POPUPMENU +Private ServiceName As String + + +' Menu descriptors +Private MenuTree As Variant ' Dictionary treename - XPopupMenu pair +Private MenuIdentification As Variant ' Dictionary item ID - item name +Private SubmenuChar As String ' Delimiter in menu trees +Private MenuRoot As Object ' stardiv.vcl.PopupMenu or com.sun.star.awt.XPopupMenu +Private LastItem As Integer ' Every item has its entry number. This is the last one +Private Rectangle As Object ' com.sun.star.awt.Rectangle +Private PeerWindow As Object ' com.sun.star.awt.XWindowPeer +Private MenubarMenu As Boolean ' When True, the actual popup menu depends on a menubar item + +REM ============================================================ MODULE CONSTANTS + +Private Const _UnderlineAccessKeyChar = "~" +Private Const _DefaultSubmenuChar = ">" +Private Const _SeparatorChar = "---" +Private Const _IconsDirectory = "private:graphicrepository/" ' Refers to <install folder>/share/config/images_*.zip. +Private Const cstUnoPrefix = ".uno:" +Private Const cstNormal = "N" +Private Const cstCheck = "C" +Private Const cstRadio = "R" + +REM ====================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + ObjectType = "POPUPMENU" + ServiceName = "SFWidgets.PopupMenu" + Set MenuTree = Nothing + Set MenuIdentification = Nothing + SubmenuChar = _DefaultSubmenuChar + Set MenuRoot = Nothing + LastItem = 0 + Set Rectangle = Nothing + Set PeerWindow = Nothing + MenubarMenu = False +End Sub ' SFWidgets.SF_PopupMenu Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' SFWidgets.SF_PopupMenu Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + If Not IsNull(MenuTree) Then Set MenuTree = MenuTree.Dispose() + If Not IsNull(MenuIdentification) Then Set MenuIdentification = MenuIdentification.Dispose() + Call Class_Terminate() + Set Dispose = Nothing +End Function ' SFWidgets.SF_PopupMenu Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get ShortcutCharacter() As Variant +''' The ShortcutCharacter property specifies character preceding the underline access key + ShortcutCharacter = _PropertyGet("ShortcutCharacter") +End Property ' SFWidgets.SF_PopupMenu.ShortcutCharacter (get) + +REM ----------------------------------------------------------------------------- +Property Get SubmenuCharacter() As Variant +''' The SubmenuCharacter property specifies the character string indicating +''' a sub-menu in a popup menu item + SubmenuCharacter = _PropertyGet("SubmenuCharacter") +End Property ' SFWidgets.SF_PopupMenu.SubmenuCharacter (get) + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function AddCheckBox(Optional ByVal MenuItem As Variant _ + , Optional ByVal Name As Variant _ + , Optional ByVal Status As Variant _ + , Optional ByVal Icon As Variant _ + , Optional ByVal Tooltip As Variant _ + ) As Integer +''' Insert in the popup menu a new entry +''' Args: +''' MenuItem: The text to be displayed in the menu entry. +''' It determines also the hierarchy of the popup menu +''' It is made up of all the components (separated by the "SubmenuCharacter") of the menu branch +''' Example: A>B>C means "C" is a new entry in submenu "A => B =>" +''' If the last component is equal to the "SeparatorCharacter", a line separator is inserted +''' Name: The name to be returned by the Execute() method if this item is clicked +''' Default = the last component of MenuItem +''' Status: when True the item is selected. Default = False +''' Icon: The path name of the icon to be displayed, without leading path separator +''' The icons are stored in one of the <install folder>/share/config/images_*.zip files +''' The exact file depends on the user options about the current icon set +''' Use the (normal) slash "/" as path separator +''' Example: "cmd/sc_cut.png" +''' Tooltip: The help text to be displayed as a tooltip +''' Returns: +''' The numeric identification of the newly inserted item +''' Examples: +''' Dim myMenu As Object, iId As Integer +''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poEvent) +''' iId = myMenu.AddCheckBox("Menu top>Checkbox item", Status := True) + +Dim iId As Integer ' Return value + +Const cstThisSub = "SFWidgets.PopupMenu.AddCheckBox" +Const cstSubArgs = "MenuItem, [Name=""""], [Status=False], [Icon=""""], [Tooltip=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + iId = 0 + +Check: + If IsMissing(Name) Or IsEmpty(Name) Then Name = "" + If IsMissing(Status) Or IsEmpty(Status) Then Status = False + If IsMissing(Icon) Or IsEmpty(Icon) Then Icon = "" + If IsMissing(Tooltip) Or IsEmpty(Tooltip) Then Tooltip = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(MenuItem, "MenuItem", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Status, "Status", ScriptForge.V_BOOLEAN) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Icon, "Icon", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Tooltip, "Tooltip", V_STRING) Then GoTo Catch + End If + +Try: + iId = _AddItem(MenuItem, Name, cstCheck, Status, Icon, Tooltip) + +Finally: + AddCheckBox = iId + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_PopupMenu.AddCheckBox + +REM ----------------------------------------------------------------------------- +Public Function AddItem(Optional ByVal MenuItem As Variant _ + , Optional ByVal Name As Variant _ + , Optional ByVal Icon As Variant _ + , Optional ByVal Tooltip As Variant _ + ) As Integer +''' Insert in the popup menu a new entry +''' Args: +''' MenuItem: The text to be displayed in the menu entry. +''' It determines also the hierarchy of the popup menu +''' It is made up of all the components (separated by the "SubmenuCharacter") of the menu branch +''' Example: A>B>C means "C" is a new entry in submenu "A => B =>" +''' If the last component is equal to "---", a line separator is inserted and all other arguments are ignored +''' Name: The name to be returned by the Execute() method if this item is clicked +''' Default = the last component of MenuItem +''' Icon: The path name of the icon to be displayed, without leading path separator +''' The icons are stored in one of the <install folder>/share/config/images_*.zip files +''' The exact file depends on the user options about the current icon set +''' Use the (normal) slash "/" as path separator +''' Example: "cmd/sc_cut.png" +''' Tooltip: The help text to be displayed as a tooltip +''' Returns: +''' The numeric identification of the newly inserted item +''' Examples: +''' Dim myMenu As Object, iId As Integer +''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poEvent) +''' iId = myMenu.AddItem("Menu top>Normal item", Icon := "cmd.sc_cut.png") + +Dim iId As Integer ' Return value + +Const cstThisSub = "SFWidgets.PopupMenu.AddItem" +Const cstSubArgs = "MenuItem, [Name=""""], [Icon=""""], [Tooltip=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + iId = 0 + +Check: + If IsMissing(Name) Or IsEmpty(Name) Then Name = "" + If IsMissing(Icon) Or IsEmpty(Icon) Then Icon = "" + If IsMissing(Tooltip) Or IsEmpty(Tooltip) Then Tooltip = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(MenuItem, "MenuItem", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Icon, "Icon", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Tooltip, "Tooltip", V_STRING) Then GoTo Catch + End If + +Try: + iId = _AddItem(MenuItem, Name, cstNormal, False, Icon, Tooltip) + +Finally: + AddItem = iId + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_PopupMenu.AddItem + +REM ----------------------------------------------------------------------------- +Public Function AddRadioButton(Optional ByVal MenuItem As Variant _ + , Optional ByVal Name As Variant _ + , Optional ByVal Status As Variant _ + , Optional ByVal Icon As Variant _ + , Optional ByVal Tooltip As Variant _ + ) As Integer +''' Insert in the popup menu a new entry as a radio button +''' Args: +''' MenuItem: The text to be displayed in the menu entry. +''' It determines also the hieAddCheckBoxrarchy of the popup menu +''' It is made up of all the components (separated by the "SubmenuCharacter") of the menu branch +''' Example: A>B>C means "C" is a new entry in submenu "A => B =>" +''' If the last component is equal to the "SeparatorCharacter", a line separator is inserted +''' Name: The name to be returned by the Execute() method if this item is clicked +''' Default = the last component of MenuItem +''' Status: when True the item is selected. Default = False +''' Icon: The path name of the icon to be displayed, without leading path separator +''' The icons are stored in one of the <install folder>/share/config/images_*.zip files +''' The exact file depends on the user options about the current icon set +''' Use the (normal) slash "/" as path separator +''' Example: "cmd/sc_cut.png" +''' Tooltip: The help text to be displayed as a tooltip +''' Returns: +''' The numeric identification of the newly inserted item +''' Examples: +''' Dim myMenu As Object, iId As Integer +''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poEvent) +''' iId = myMenu.AddRadioButton("Menu top>Radio item", Status := True) + +Dim iId As Integer ' Return value + +Const cstThisSub = "SFWidgets.PopupMenu.AddRadioButton" +Const cstSubArgs = "MenuItem, [Name=""""], [Status=False], [Icon=""""], [Tooltip=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + iId = 0 + +Check: + If IsMissing(Name) Or IsEmpty(Name) Then Name = "" + If IsMissing(Status) Or IsEmpty(Status) Then Status = False + If IsMissing(Icon) Or IsEmpty(Icon) Then Icon = "" + If IsMissing(Tooltip) Or IsEmpty(Tooltip) Then Tooltip = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(MenuItem, "MenuItem", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Status, "Status", ScriptForge.V_BOOLEAN) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Icon, "Icon", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Tooltip, "Tooltip", V_STRING) Then GoTo Catch + End If + +Try: + iId = _AddItem(MenuItem, Name, cstRadio, Status, Icon, Tooltip) + +Finally: + AddRadioButton = iId + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_PopupMenu.AddRadioButton + +REM ----------------------------------------------------------------------------- +Public Function Execute(Optional ByVal ReturnId As Variant) As Variant +''' Display the popup menu and return the menu item clicked by the user +''' Args: +''' ReturnId: When True (default), return the unique ID of the clicked item, otherwise return its name +''' Returns: +''' The numeric identification of clicked item or its name +''' The returned value is 0 or "" (depending on ReturnId) when the menu is cancelled +''' Examples: +''' Sub OpenMenu(Optional poMouseEvent As Object) +''' Dim myMenu As Object, vChoice As Variant +''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poMouseEvent) +''' With myMenu +''' .AddCheckBox("View>Toolbars>Dialog") +''' .AddCheckBox("View>Toolbars>Find", STatus := True) +''' .AddCheckBox("View>Status Bar", STatus := True) +''' .AddItem("View>Full Screen", Name := "FULLSCREEN") +''' vChoice = .Execute(False) ' When 1st checkbox is clicked, return "Dialog" +''' ' When last item is clicked, return "FULLSCREEN" +''' End With + +Dim vMenuItem As Variant ' Return value + +Const cstThisSub = "SFWidgets.PopupMenu.Execute" +Const cstSubArgs = "[ReturnId=True]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vMenuItem = 0 + +Check: + If IsMissing(ReturnId) Or IsEmpty(ReturnId) Then ReturnId = True + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(ReturnId, "ReturnId", ScriptForge.V_BOOLEAN) Then GoTo Catch + End If + If Not ReturnId Then vMenuItem = "" + +Try: + vMenuItem = MenuRoot.Execute(PeerWindow, Rectangle, com.sun.star.awt.PopupMenuDirection.EXECUTE_DEFAULT) + If Not ReturnId Then vMenuItem = MenuIdentification.Item(CStr(vMenuItem)) + +Finally: + Execute = vMenuItem + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_PopupMenu.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: +''' myModel.GetProperty("MyProperty") + +Const cstThisSub = "SFWidgets.PopupMenu.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_PopupMenu.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Model service as an array + + Methods = Array( _ + "AddCheckBox" _ + , "AddItem" _ + , "AddRadioButton" _ + , "Execute" _ + ) + +End Function ' SFWidgets.SF_PopupMenu.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( _ + "ShortcutCharacter" _ + , "SubmenuCharacter" _ + ) + +End Function ' SFWidgets.SF_PopupMenu.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.PopupMenu.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_PopupMenu.SetProperty + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Public Function _AddItem(ByVal MenuItem As String _ + , ByVal Name As String _ + , ByVal ItemType As String _ + , ByVal Status As Boolean _ + , ByVal Icon As String _ + , ByVal Tooltip As String _ + , Optional ByVal Command As String _ + ) As Integer +''' Insert in the popup menu a new entry +''' Args: +''' MenuItem: The text to be displayed in the menu entry. +''' It determines also the hierarchy of the popup menu +''' It is made up of all the components (separated by the "SubmenuCharacter") of the menu branch +''' Example: A>B>C means "C" is a new entry in submenu "A => B =>" +''' If the last component is equal to the "SeparatorCharacter", a line separator is inserted +''' Name: The name to be returned by the Execute() method if this item is clicked +''' Default = the last component of MenuItem +''' ItemType: "N"(ormal, "C"(heck) or "R"(adio) +''' Status: when True the item is selected +''' Icon: The path name of the icon to be displayed, without leading path separator +''' The icons are stored in one of the <install folder>/share/config/images_*.zip files +''' The exact file depends on the user options about the current icon set +''' Use the (normal) slash "/" as path separator +''' Example: "cmd/sc_cut.png" +''' Tooltip: The help text to be displayed as a tooltip +''' Command: only for menubar menus +''' Either a uo command like ".uno:About" +''' or a script to be run: script URI ::: string argument to be passed to the script +''' Returns: +''' The numeric identification of the newly inserted item + +Dim iId As Integer ' Return value +Dim vSplit As Variant ' Split menu item +Dim sMenu As String ' Submenu where to attach the new item, as a string +Dim oMenu As Object ' Submenu where to attach the new item, as an object +Dim sName As String ' The text displayed in the menu box +Dim oImage As Object ' com.sun.star.graphic.XGraphic +Dim sCommand As String ' Alias of Command completed with arguments +Const cstCommandSep = "," + + On Local Error GoTo Catch + iId = 0 + If IsMissing(Command) Then Command = "" + +Try: + ' Run through the upper menu tree + vSplit = _SplitMenuItem(MenuItem) + + ' Create and determine the menu to which to attach the new item + sMenu = vSplit(0) + Set oMenu = _GetPopupMenu(sMenu) ' Run through the upper menu tree and retain the last branch + + ' Insert the new item + LastItem = LastItem + 1 + sName = vSplit(1) + + With oMenu + If sName = _SeparatorChar Then + .insertSeparator(-1) + Else + Select Case ItemType + Case cstNormal + .insertItem(LastItem, sName, 0, -1) + Case cstCheck + .insertItem(LastItem, sName, com.sun.star.awt.MenuItemStyle.CHECKABLE + com.sun.star.awt.MenuItemStyle.AUTOCHECK, -1) + .checkItem(LastItem, Status) + Case cstRadio + .insertItem(LastItem, sName, com.sun.star.awt.MenuItemStyle.RADIOCHECK + com.sun.star.awt.MenuItemStyle.AUTOCHECK, -1) + .checkItem(LastItem, Status) + End Select + + ' Store the ID - Name relation + If Len(Name) = 0 Then Name = Replace(sName, _UnderlineAccessKeyChar, "") + MenuIdentification.Add(CStr(LastItem), Name) + + ' Add the icon when relevant + If Len(Icon) > 0 Then + Set oImage = _GetImageFromUrl(_IconsDirectory & Icon) + If Not IsNull(oImage) Then .setItemImage(LastItem, oImage, False) + End If + + ' Add the tooltip when relevant + If Len(Tooltip) > 0 Then .setTipHelpText(LastItem, Tooltip) + + ' Add the command: UNO command or script to run - menubar menus only + If Len(Command) > 0 Then + If Left(Command, Len(cstUnoPrefix)) = cstUnoPrefix Then + sCommand = Command + Else + sCommand = Command & cstCommandSep & Name & cstCommandSep & CStr(LastItem) + End If + .setCommand(LastItem, sCommand) + End If + End If + End With + + iId = LastItem + +Finally: + _AddItem = iId + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_PopupMenu._AddItem + +REM ----------------------------------------------------------------------------- +Private Function _GetImageFromURL(ByVal psUrl as String) As Object +''' Returns a com.sun.star.graphic.XGraphic instance based on the given URL +''' The returned object is intended to be inserted as an icon in the popup menu +''' Derived from "Useful Macro Information For OpenOffice" By Andrew Pitonyak + +Dim vMediaProperties As Variant ' Array of com.sun.star.beans.PropertyValue +Dim oGraphicProvider As Object ' com.sun.star.graphic.GraphicProvider +Dim oImage As Object ' Return value + + On Local Error GoTo Catch ' Ignore errors + Set oImage = Nothing + +Try: + ' Create graphic provider instance to load images from files. + Set oGraphicProvider = CreateUnoService("com.sun.star.graphic.GraphicProvider") + + ' Set the URL property so graphic provider is able to load the image + Set vMediaProperties = Array(ScriptForge.SF_Utils._MakePropertyValue("URL", psURL)) + + ' Retrieve the com.sun.star.graphic.XGraphic instance + Set oImage = oGraphicProvider.queryGraphic(vMediaProperties) + +Finally: + Set _GetImageFromUrl = oImage + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_PopupMenu._GetImageFromUrl + +REM ----------------------------------------------------------------------------- +Private Function _GetPopupMenu(ByVal psSubmenu As String) As Object +''' Get the com.sun.star.awt.XPopupMenu object corresponding with the string in argument +''' If the menu exists, it is found in the MenuTree dictionary +''' If it does not exist, it is created recursively. +''' Args: +''' psSubmenu: a string like "A>B" +''' Returns +''' A com.sun.star.awt.XpopupMenu object +''' Example +''' If psSubmenu = "A>B>C>D", and only the root menu exists, +''' - "A", "A>B", "A>B>C", "A>B>C>D" should be created +''' - the popup menu corresponding with "A>B>C>D" should be returned + +Dim oPopup As Object ' Return value +Dim vSplit As Variant ' An array as returned by _SplitMenuItem() +Dim sMenu As String ' The left part of psSubmenu +Dim oMenu As Object ' com.sun.star.awt.XpopupMenu +Dim oLastMenu As Object ' com.sun.star.awt.XpopupMenu +Dim i As Long + + Set oPopup = Nothing + Set oLastMenu = MenuRoot +Try: + If Len(psSubmenu) = 0 Then ' Menu starts at the root + Set oPopup = MenuRoot + ElseIf MenuTree.Exists(psSubmenu) Then ' Shortcut: if the submenu exists, get it directly + Set oPopup = MenuTree.Item(psSubmenu) + Else ' Build the tree + vSplit = Split(psSubmenu, SubmenuChar) + ' Search the successive submenus in the MenuTree dictionary, If not found, create a new entry + For i = 0 To UBound(vSplit) + sMenu = Join(ScriptForge.SF_Array.Slice(vSplit, 0, i), SubmenuChar) + If MenuTree.Exists(sMenu) Then + Set oLastMenu = MenuTree.Item(sMenu) + Else + ' Insert the new menu tree item + LastItem = LastItem + 1 + oLastMenu.insertItem(LastItem, vSplit(i), 0, -1) + Set oMenu = CreateUnoService("stardiv.vcl.PopupMenu") + If MenubarMenu Then SFWidgets.SF_MenuListener.SetMenuListener(oMenu) + MenuTree.Add(sMenu, oMenu) + oLastMenu.setPopupMenu(LastItem, oMenu) + Set oLastMenu = oMenu + End If + Next i + Set oPopup = oLastMenu + End If + +Finally: + Set _GetPopupMenu = oPopup + Exit Function +End Function ' SFWidgets.SF_PopupMenu._GetPopupMenu + +REM ----------------------------------------------------------------------------- +Public Sub _Initialize(ByRef poPeer As Object _ + , plXPos As Long _ + , plYPos As Long _ + , psSubmenuChar As String _ + ) +''' Complete the object creation process: +''' - Initialize the dictionaries +''' - initialize the root popup menu +''' - initialize the display area +''' - store the arguments for later use +''' Args: +''' poPeer: a peer window +''' plXPos, plYPos: the coordinates + +Try: + ' Initialize the dictionaries + With ScriptForge.SF_Services + Set MenuTree = .CreateScriptService("Dictionary") + Set MenuIdentification = .CreateScriptService("Dictionary") + End With + + ' Initialize the root of the menu tree + Set MenuRoot = CreateUnoService("stardiv.vcl.PopupMenu") + + ' Setup the display area + Set Rectangle = New com.sun.star.awt.Rectangle + Rectangle.X = plXPos + Rectangle.Y = plYPos + + ' Keep the targeted window + Set PeerWindow = poPeer + + ' Store the submenu character + If Len(psSubmenuChar) > 0 Then SubmenuChar = psSubmenuChar + +Finally: + Exit Sub +End Sub ' SFWidgets.SF_PopupMenu._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 cstThisSub As String +Const cstSubArgs = "" + + cstThisSub = "SFWidgets.PopupMenu.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("ShortcutCharacter") + _PropertyGet = _UnderlineAccessKeyChar + Case UCase("SubmenuCharacter") + _PropertyGet = SubmenuChar + Case Else + _PropertyGet = Null + End Select + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_PopupMenu._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the SF_PopupMenu instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[PopupMenu]: Name, Type (dialogname) + _Repr = "[PopupMenu]: " & SF_String.Represent(MenuTree.Keys()) & ", " & SF_String.Represent(MenuIdentification.Items()) + +End Function ' SFWidgets.SF_PopupMenu._Repr + +REM ----------------------------------------------------------------------------- +Private Function _SplitMenuItem(ByVal psMenuItem As String ) As Variant +''' Split a menu item given as a string and delimited by the submenu character +''' Args: +''' psMenuItem: a string like "A>B>C" +''' Returns: +''' An array: [0] = "A>B" +''' [1] = "C" + +Dim vReturn(0 To 1) As String ' Return value +Dim vMenus() As Variant ' Array of menus + +Try: + vMenus = Split(psMenuItem, SubmenuChar) + vReturn(1) = vMenus(UBound(vMenus)) + vReturn(0) = Left(psMenuItem, Len(psMenuItem) - Iif(UBound(vMenus) > 0, Len(SubmenuChar), 0) - Len(vReturn(1))) + +Finally: + _SplitMenuItem = vReturn +End Function ' SFWidgets.SF_PopupMenu._SplitMenuItem + +REM ============================================ END OF SFWIDGETS.SF_POPUPMENU +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfwidgets/SF_Register.xba b/wizards/source/sfwidgets/SF_Register.xba new file mode 100644 index 0000000000..d2c4245131 --- /dev/null +++ b/wizards/source/sfwidgets/SF_Register.xba @@ -0,0 +1,257 @@ +<?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_Register" 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 Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Register +''' =========== +''' The ScriptForge framework includes +''' the master ScriptForge library +''' a number of "associated" libraries SF* +''' any user/contributor extension wanting to fit into the framework +''' +''' The main methods in this module allow the current library to cling to ScriptForge +''' - RegisterScriptServices +''' Register the list of services implemented by the current library +''' - _NewMenu +''' Create a new menu service instance. +''' Called from SFDocuments services with CreateMenu() +''' - _NewPopupMenu +''' Create a new popup menu service instance. +''' Called from CreateScriptService() +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +REM ================================================================= DEFINITIONS + +REM ============================================================== PUBLIC METHODS + +REM ----------------------------------------------------------------------------- +Public Sub RegisterScriptServices() As Variant +''' Register into ScriptForge the list of the services implemented by the current library +''' Each library pertaining to the framework must implement its own version of this method +''' +''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods +''' with 2 arguments: +''' ServiceName: the name of the service as a case-insensitive string +''' ServiceReference: the reference as an object +''' If the reference refers to a module, then return the module as an object: +''' GlobalScope.Library.Module +''' If the reference is a class instance, then return a string referring to the method +''' containing the New statement creating the instance +''' "libraryname.modulename.function" + + With GlobalScope.ScriptForge.SF_Services + .RegisterService("Menu", "SFWidgets.SF_Register._NewMenu") ' Reference to the function initializing the service + .RegisterService("PopupMenu", "SFWidgets.SF_Register._NewPopupMenu") ' id. + .RegisterService("Toolbar", "SFWidgets.SF_Register._NewToolbar") ' id. + .RegisterService("ToolbarButton", "SFWidgets.SF_Register._NewToolbarButton") ' id. + End With + +End Sub ' SFWidgets.SF_Register.RegisterScriptServices + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Public Function _NewMenu(Optional ByVal pvArgs As Variant) As Object +''' Create a new instance of the SF_Menu class +''' [called internally from SFDocuments.Document.CreateMenu() ONLY] +''' Args: +''' Component: the com.sun.star.lang.XComponent where to find the menubar to plug the new menu in +''' Header: the name/header of the menu +''' Before: the place where to put the new menu on the menubar (string or number >= 1) +''' When not found => last position +''' SubmenuChar: the delimiter used in menu trees. Default = ">" +''' Returns: the instance or Nothing + +Dim oMenu As Object ' Return value +Dim oComponent As Object ' The document or formdocument's component - com.sun.star.lang.XComponent +Dim sHeader As String ' Menu header +Dim sBefore As String ' Position of menu as a string +Dim iBefore As Integer ' as a number +Dim sSubmenuChar As String ' Delimiter in menu trees + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oMenu = Nothing + +Check: + ' Types and number of arguments are not checked because internal call only + Set oComponent = pvArgs(0) + sHeader = pvArgs(1) + Select Case VarType(pvArgs(2)) + Case V_STRING : sBefore = pvArgs(2) + iBefore = 0 + Case Else : sBefore = "" + iBefore = pvArgs(2) + End Select + sSubmenuChar = pvArgs(3) + +Try: + If Not IsNull(oComponent) Then + Set oMenu = New SF_Menu + With oMenu + Set .[Me] = oMenu + ._Initialize(oComponent, sHeader, sBefore, iBefore, sSubmenuChar) + End With + End If + +Finally: + Set _NewMenu = oMenu + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_Register._NewMenu + +REM ----------------------------------------------------------------------------- +Public Function _NewPopupMenu(Optional ByVal pvArgs As Variant) As Object +''' Create a new instance of the SF_PopupMenu class +''' Args: +''' Event: a mouse event +''' If the event has no source or is not a mouse event, the menu is displayed above the actual window +''' X, Y: forced coordinates +''' SubmenuChar: Delimiter used in menu trees +''' Returns: the instance or Nothing + +Dim oMenu As Object ' Return value +Dim Event As Variant ' Mouse event +Dim X As Long ' Mouse click coordinates +Dim Y As Long +Dim SubmenuChar As String ' Delimiter in menu trees +Dim vUno As Variant ' UNO type split into an array +Dim sEventType As String ' Event type, must be "MouseEvent" +Dim oControl As Object ' The dialog or form control view which triggered the event +Dim oWindow As Object ' ui.Window type +Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session") +Dim oUi As Object : Set oUi = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI") + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oMenu = Nothing + +Check: + ' Check and get arguments, their number may vary + If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() + If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) + If UBound(pvArgs) >= 0 Then Event = pvArgs(0) Else Event = Nothing + If IsEmpty(Event) Then Event = Nothing + If UBound(pvArgs) >= 1 Then X = pvArgs(1) Else X = 0 + If UBound(pvArgs) >= 2 Then Y = pvArgs(2) Else Y = 0 + If UBound(pvArgs) >= 3 Then SubmenuChar = pvArgs(3) Else SubmenuChar = "" + If Not ScriptForge.SF_Utils._Validate(Event, "Event", ScriptForge.V_OBJECT) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(X, "X", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Y, "Y", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally + +Try: + ' Find and identify the control that triggered the popup menu + Set oControl = Nothing + If Not IsNull(Event) Then + ' Determine the X, Y coordinates + vUno = Split(oSession.UnoObjectType(Event), ".") + sEventType = vUno(UBound(vUno)) + If UCase(sEventType) = "MOUSEEVENT" Then + X = Event.X + Y = Event.Y + ' Determine the window peer target + If oSession.HasUnoProperty(Event, "Source") Then Set oControl = Event.Source.Peer + End If + End If + ' If not a mouse event, if no control, find what can be decent alternatives: (a menu header in) the actual window + If IsNull(oControl) Then + Set oWindow = oUi._IdentifyWindow(StarDesktop.getCurrentComponent()) ' A menu has been clicked necessarily in the current window + With oWindow + If Not IsNull(.Frame) Then Set oControl = .Frame.getContainerWindow() + End With + End If + + If Not IsNull(oControl) Then + Set oMenu = New SF_PopupMenu + With oMenu + Set .[Me] = oMenu + ._Initialize(oControl, X, Y, SubmenuChar) + End With + Else + Set oMenu = Nothing + End If + +Finally: + Set _NewPopupMenu = oMenu + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_Register._NewPopupMenu + +REM ----------------------------------------------------------------------------- +Public Function _NewToolbar(Optional ByVal pvArgs As Variant) As Object +''' Create a new instance of the SF_Toolbar class +''' The "Toolbar" service must not be invoked directly in a user script +''' Args: +''' ToolbarDesc: a proto-toolbar object type. See ScriptForge.SF_UI for a detailed description +''' Returns: +''' the instance or Nothing + +Dim oToolbar As Object ' Return value +Dim oToolbarDesc As Object ' A proto-toolbar description + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oToolbar = Nothing + +Check: + Set oToolbarDesc = pvArgs(0) + +Try: + Set oToolbar = New SF_Toolbar + With oToolbar + Set .[Me] = oToolbar + ._Initialize(oToolbarDesc) + End With + +Finally: + Set _NewToolbar = oToolbar + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_Register._NewToolbar + +REM ----------------------------------------------------------------------------- +Public Function _NewToolbarButton(Optional ByVal pvArgs As Variant) As Object +''' Create a new instance of the SF_ToolbarButton class +''' The "ToolbarButton" service must not be invoked directly in a user script +''' Args: +''' ToolbarButtonDesc: a proto-toolbarButton object type. See SFWidgets.SF_Toolbar for a detailed description +''' Returns: +''' the instance or Nothing + +Dim oToolbarButton As Object ' Return value +Dim oToolbarButtonDesc As Object ' A proto-toolbarbutton description + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oToolbarButton = Nothing + +Check: + Set oToolbarButtonDesc = pvArgs(0) + +Try: + Set oToolbarButton = New SF_ToolbarButton + With oToolbarButton + Set .[Me] = oToolbarButton + ._Initialize(oToolbarButtonDesc) + End With + +Finally: + Set _NewToolbarButton = oToolbarButton + Exit Function +Catch: + GoTo Finally +End Function ' SFWidgets.SF_Register._NewToolbarButton + + +REM ============================================== END OF SFWIDGETS.SF_REGISTER +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfwidgets/SF_Toolbar.xba b/wizards/source/sfwidgets/SF_Toolbar.xba new file mode 100644 index 0000000000..c457a62f1c --- /dev/null +++ b/wizards/source/sfwidgets/SF_Toolbar.xba @@ -0,0 +1,541 @@ +<?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_Toolbar" 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_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 +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfwidgets/SF_ToolbarButton.xba b/wizards/source/sfwidgets/SF_ToolbarButton.xba new file mode 100644 index 0000000000..58c594f066 --- /dev/null +++ b/wizards/source/sfwidgets/SF_ToolbarButton.xba @@ -0,0 +1,565 @@ +<?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>
\ No newline at end of file diff --git a/wizards/source/sfwidgets/__License.xba b/wizards/source/sfwidgets/__License.xba new file mode 100644 index 0000000000..0d0990e37a --- /dev/null +++ b/wizards/source/sfwidgets/__License.xba @@ -0,0 +1,26 @@ +<?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="__License" script:language="StarBasic" script:moduleType="normal"> +''' Copyright 2019-2022 Jean-Pierre LEDURE, Rafael LIMA, Alain ROMEDENNE + +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 ======================================================================================================================= + +''' ScriptForge is distributed in the hope that it will be useful, +''' but WITHOUT ANY WARRANTY; without even the implied warranty of +''' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +''' ScriptForge is free software; you can redistribute it and/or modify it under the terms of either (at your option): + +''' 1) The Mozilla Public License, v. 2.0. If a copy of the MPL was not +''' distributed with this file, you can obtain one at http://mozilla.org/MPL/2.0/ . + +''' 2) The GNU Lesser General Public License as published by +''' the Free Software Foundation, either version 3 of the License, or +''' (at your option) any later version. If a copy of the LGPL was not +''' distributed with this file, see http://www.gnu.org/licenses/ . + +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfwidgets/dialog.xlb b/wizards/source/sfwidgets/dialog.xlb new file mode 100644 index 0000000000..5d45468be1 --- /dev/null +++ b/wizards/source/sfwidgets/dialog.xlb @@ -0,0 +1,3 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd"> +<library:library xmlns:library="http://openoffice.org/2000/library" library:name="SFWidgets" library:readonly="false" library:passwordprotected="false"/>
\ No newline at end of file diff --git a/wizards/source/sfwidgets/script.xlb b/wizards/source/sfwidgets/script.xlb new file mode 100644 index 0000000000..06975e6fc5 --- /dev/null +++ b/wizards/source/sfwidgets/script.xlb @@ -0,0 +1,11 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd"> +<library:library xmlns:library="http://openoffice.org/2000/library" library:name="SFWidgets" library:readonly="false" library:passwordprotected="false"> + <library:element library:name="__License"/> + <library:element library:name="SF_Register"/> + <library:element library:name="SF_PopupMenu"/> + <library:element library:name="SF_Menu"/> + <library:element library:name="SF_MenuListener"/> + <library:element library:name="SF_Toolbar"/> + <library:element library:name="SF_ToolbarButton"/> +</library:library>
\ No newline at end of file |