diff options
Diffstat (limited to 'wizards/source')
| -rw-r--r-- | wizards/source/scriptforge/SF_Services.xba | 2 | ||||
| -rw-r--r-- | wizards/source/scriptforge/SF_Session.xba | 9 | ||||
| -rw-r--r-- | wizards/source/scriptforge/python/scriptforge.py | 39 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Base.xba | 18 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Calc.xba | 21 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Document.xba | 134 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Writer.xba | 15 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_Menu.xba | 590 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_MenuListener.xba | 128 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_PopupMenu.xba | 82 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_Register.xba | 64 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/script.xlb | 2 |
12 files changed, 1069 insertions, 35 deletions
diff --git a/wizards/source/scriptforge/SF_Services.xba b/wizards/source/scriptforge/SF_Services.xba index 74bc110c9371..a2a96cb088c6 100644 --- a/wizards/source/scriptforge/SF_Services.xba +++ b/wizards/source/scriptforge/SF_Services.xba @@ -130,7 +130,7 @@ Try: sLibrary = "SFDocuments" Case "dialog", "dialogevent" : sLibrary = "SFDialogs" Case "database" : sLibrary = "SFDatabases" - Case "popupmenu" : sLibrary = "SFWidgets" + Case "menu", "popupmenu" : sLibrary = "SFWidgets" Case Else End Select Else diff --git a/wizards/source/scriptforge/SF_Session.xba b/wizards/source/scriptforge/SF_Session.xba index db3cb9449889..f02a958768ce 100644 --- a/wizards/source/scriptforge/SF_Session.xba +++ b/wizards/source/scriptforge/SF_Session.xba @@ -994,12 +994,13 @@ REM =========================================================== PRIVATE FUNCTION REM ----------------------------------------------------------------------------- Private Function _ExecuteScript(ByVal psScript As String _ - , ByRef poEvent As Object _ + , Optional ByRef pvArg As Variant _ ) As Variant ''' Execute the script expressed in the scripting framework_URI notation ''' Args: ''' psScript: read https://wiki.openoffice.org/wiki/Documentation/DevGuide/Scripting/Scripting_Framework_URI_Specification -''' poEvent: the event object which triggered the execution. It is given as argument to the called script +''' pvArg: the unique argument to pass to the called script. +''' It is often an event object that triggered the execution of the script. ''' Returns: ''' The return value after the script execution. May be ignored for events @@ -1020,9 +1021,9 @@ Try: sScript = vStrings(0) : sLanguage = vStrings(1) : sScope = vStrings(2) ' Execute script If UCase(sLanguage) = "BASIC" Then - _ExecuteScript = ExecuteBasicScript(sScope, sScript, poEvent) + _ExecuteScript = ExecuteBasicScript(sScope, sScript, pvArg) Else ' Python - _ExecuteScript = ExecutePythonScript(sScope, sScript, poEvent) + _ExecuteScript = ExecutePythonScript(sScope, sScript, pvArg) End If End If diff --git a/wizards/source/scriptforge/python/scriptforge.py b/wizards/source/scriptforge/python/scriptforge.py index 9dc95d21f715..18334f3684c8 100644 --- a/wizards/source/scriptforge/python/scriptforge.py +++ b/wizards/source/scriptforge/python/scriptforge.py @@ -1774,12 +1774,18 @@ class SFDocuments: def CloseDocument(self, saveask = True): return self.ExecMethod(self.vbMethod, 'CloseDocument', saveask) + def CreateMenu(self, menuheader, before = '', submenuchar = '>'): + return self.ExecMethod(self.vbMethod, 'CreateMenu', menuheader, before, submenuchar) + def ExportAsPDF(self, filename, overwrite = False, pages = '', password = '', watermark = ''): return self.ExecMethod(self.vbMethod, 'ExportAsPDF', filename, overwrite, pages, password, watermark) def PrintOut(self, pages = '', copies = 1): return self.ExecMethod(self.vbMethod, 'PrintOut', pages, copies) + def RemoveMenu(self, menuheader): + return self.ExecMethod(self.vbMethod, 'RemoveMenu', menuheader) + def RunCommand(self, command): return self.ExecMethod(self.vbMethod, 'RunCommand', command) @@ -2230,6 +2236,39 @@ class SFWidgets: pass # ######################################################################### + # SF_Menu CLASS + # ######################################################################### + class SF_Menu(SFServices): + """ + 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. + """ + # Mandatory class properties for service registration + serviceimplementation = 'basic' + servicename = 'SFWidgets.Menu' + servicesynonyms = ('menu', 'sfwidgets.menu') + serviceproperties = dict(ShortcutCharacter = False, SubmenuCharacter = False) + + def AddCheckBox(self, menuitem, name = '', status = False, icon = '', tooltip = '', + command = '', script = ''): + return self.ExecMethod(self.vbMethod, 'AddCheckBox', menuitem, name, status, icon, tooltip, + command, script) + + def AddItem(self, menuitem, name = '', icon = '', tooltip = '', command = '', script = ''): + return self.ExecMethod(self.vbMethod, 'AddItem', menuitem, name, icon, tooltip, command, script) + + def AddRadioButton(self, menuitem, name = '', status = False, icon = '', tooltip = '', + command = '', script = ''): + return self.ExecMethod(self.vbMethod, 'AddRadioButton', menuitem, name, status, icon, tooltip, + command, script) + + # ######################################################################### # SF_PopupMenu CLASS # ######################################################################### class SF_PopupMenu(SFServices): diff --git a/wizards/source/sfdocuments/SF_Base.xba b/wizards/source/sfdocuments/SF_Base.xba index efdc57be9b4d..0199341bb5da 100644 --- a/wizards/source/sfdocuments/SF_Base.xba +++ b/wizards/source/sfdocuments/SF_Base.xba @@ -120,7 +120,7 @@ Check: If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally - If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", ScriptForge.V_BOOLEAN) Then GoTo Finally End If Try: @@ -442,12 +442,15 @@ Public Function Methods() As Variant Methods = Array( _ "Activate" _ , "CloseDocument" _ + , "CloseFormDocument" _ + , "CreateMenu" _ , "FormDocuments" _ , "Forms" _ , "GetDatabase" _ , "IsLoaded" _ , "OpenFormDocument" _ , "PrintOut" _ + , "RemoveMenu" _ , "RunCommand" _ , "Save" _ , "SaveAs" _ @@ -792,6 +795,19 @@ Public Function Activate() As Boolean End Function ' SFDocuments.SF_Base.Activate REM ----------------------------------------------------------------------------- +Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ + , Optional ByVal Before As Variant _ + , Optional ByVal SubmenuChar As Variant _ + ) As Object + Set CreateMenu = [_Super].CreateMenu(MenuHeader, Before, SubmenuChar) +End Function ' SFDocuments.SF_Base.CreateMenu + +REM ----------------------------------------------------------------------------- +Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean + RemoveMenu = [_Super].RemoveMenu(MenuHeader) +End Function ' SFDocuments.SF_Base.RemoveMenu + +REM ----------------------------------------------------------------------------- Public Sub RunCommand(Optional ByVal Command As Variant) [_Super].RunCommand(Command) End Sub ' SFDocuments.SF_Base.RunCommand diff --git a/wizards/source/sfdocuments/SF_Calc.xba b/wizards/source/sfdocuments/SF_Calc.xba index e5b35e4afa12..f22a64642e36 100644 --- a/wizards/source/sfdocuments/SF_Calc.xba +++ b/wizards/source/sfdocuments/SF_Calc.xba @@ -1647,6 +1647,7 @@ Public Function Methods() As Variant , "CopyToCell" _ , "CopyToRange" _ , "CreateChart" _ + , "CreateMenu" _ , "DAvg" _ , "DCount" _ , "DMax" _ @@ -1665,6 +1666,7 @@ Public Function Methods() As Variant , "OpenRangeSelector" _ , "Printf" _ , "PrintOut" _ + , "RemoveMenu" _ , "RemoveSheet" _ , "RenameSheet" _ , "RunCommand" _ @@ -2889,9 +2891,9 @@ Check: If Not ScriptForge.SF_Utils._ValidateArray(SortKeys, "SortKeys", 1, V_NUMERIC, True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._ValidateArray(SortOrder, "SortOrder", 1, V_STRING, True) Then GoTo Finally - If Not ScriptForge.SF_Utils._Validate(ContainsHeader, "ContainsHeader", V_BOOLEAN) Then GoTo Finally - If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally - If Not ScriptForge.SF_Utils._Validate(SortColumns, "SortColumns", V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(ContainsHeader, "ContainsHeader", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SortColumns, "SortColumns", ScriptForge.V_BOOLEAN) Then GoTo Finally End If Set oRangeAddress = _ParseAddress(Range) If Len(DestinationCell) > 0 Then Set oDestRange = _ParseAddress(DestinationCell) @@ -3068,6 +3070,14 @@ Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean End Function ' SFDocuments.SF_Calc.CloseDocument REM ----------------------------------------------------------------------------- +Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ + , Optional ByVal Before As Variant _ + , Optional ByVal SubmenuChar As Variant _ + ) As Object + Set CreateMenu = [_Super].CreateMenu(MenuHeader, Before, SubmenuChar) +End Function ' SFDocuments.SF_Calc.CreateMenu + +REM ----------------------------------------------------------------------------- Public Function ExportAsPDF(Optional ByVal FileName As Variant _ , Optional ByVal Overwrite As Variant _ , Optional ByVal Pages As Variant _ @@ -3078,6 +3088,11 @@ Public Function ExportAsPDF(Optional ByVal FileName As Variant _ End Function ' SFDocuments.SF_Calc.ExportAsPDF REM ----------------------------------------------------------------------------- +Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean + RemoveMenu = [_Super].RemoveMenu(MenuHeader) +End Function ' SFDocuments.SF_Calc.RemoveMenu + +REM ----------------------------------------------------------------------------- Public Sub RunCommand(Optional ByVal Command As Variant) [_Super].RunCommand(Command) End Sub ' SFDocuments.SF_Calc.RunCommand diff --git a/wizards/source/sfdocuments/SF_Document.xba b/wizards/source/sfdocuments/SF_Document.xba index 00aa22fc08b4..37c4e4e6bbe7 100644 --- a/wizards/source/sfdocuments/SF_Document.xba +++ b/wizards/source/sfdocuments/SF_Document.xba @@ -436,7 +436,7 @@ Check: If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally - If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", ScriptForge.V_BOOLEAN) Then GoTo Finally End If Try: @@ -460,6 +460,63 @@ Catch: End Function ' SFDocuments.SF_Document.CloseDocument REM ----------------------------------------------------------------------------- +Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ + , Optional ByVal Before As Variant _ + , Optional ByVal SubmenuChar As Variant _ + , Optional ByRef _Document As Variant _ + ) As Object +''' Create a new menu entry in the document's menubar +''' The menu is not intended to be saved neither in the LibreOffice global environment, nor in the document +''' The method returns a SFWidgets.Menu instance. Its methods let define the menu further. +''' Args: +''' MenuHeader: 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 = ">" +''' _Document: undocumented argument to designate the document where the menu will be located +''' Returns: +''' A SFWidgets.Menu instance or Nothing +''' Examples: +''' Dim oMenu As Object +''' Set oMenu = oDoc.CreateMenu("My menu", Before := "Styles") +''' With oMenu +''' .AddItem("Item 1", Command := "About") +''' '... +''' .Dispose() ' When definition is complete, the menu instance may be disposed +''' End With +''' ' ... + +Dim oMenu As Object ' return value +Const cstThisSub = "SFDocuments.Document.CreateMenu" +Const cstSubArgs = "MenuHeader, [Before=""""], [SubmenuChar="">""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oMenu = Nothing + +Check: + If IsMissing(Before) Or IsEmpty(Before) Then Before = "" + If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = "" + If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component + + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Before, "Before", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally + End If + +Try: + Set oMenu = ScriptForge.SF_Services.CreateScriptService("SFWidgets.Menu", _Document, MenuHeader, Before, SubmenuChar) + +Finally: + Set CreateMenu = oMenu + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.CreateMenu + +REM ----------------------------------------------------------------------------- Public Function ExportAsPDF(Optional ByVal FileName As Variant _ , Optional ByVal Overwrite As Variant _ , Optional ByVal Pages As Variant _ @@ -502,7 +559,7 @@ Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally - If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally If Not SF_Utils._Validate(Pages, "Pages", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(Watermark, "Watermark", V_STRING) Then GoTo Finally @@ -596,8 +653,10 @@ Public Function Methods() As Variant Methods = Array( _ "Activate" _ , "CloseDocument" _ + , "CreateMenu" _ , "ExportAsPDF" _ , "PrintOut" _ + , "RemoveMenu" _ , "RunCommand" _ , "Save" _ , "SaveAs" _ @@ -687,6 +746,73 @@ Public Function Properties() As Variant End Function ' SFDocuments.SF_Document.Properties REM ----------------------------------------------------------------------------- +Public Function RemoveMenu(Optional ByVal MenuHeader As Variant _ + , Optional ByRef _Document As Variant _ +) As Boolean +''' Remove a menu entry in the document's menubar +''' The removal is not intended to be saved neither in the LibreOffice global environment, nor in the document +''' Args: +''' MenuHeader: the name/header of the menu, without tilde "~", as a case-sensitive string +''' _Document: undocumented argument to designate the document where the menu is located +''' Returns: +''' True when successful +''' Examples: +''' oDoc.RemoveMenu("File") +''' ' ... + +Dim bRemove As Boolean ' Return value +Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager +Dim oMenuBar As Object ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar +Dim sName As String ' Menu name +Dim iMenuId As Integer ' Menu identifier +Dim iMenuPosition As Integer ' Menu position >= 0 +Dim i As Integer +Const cstTilde = "~" + +Const cstThisSub = "SFDocuments.Document.RemoveMenu" +Const cstSubArgs = "MenuHeader" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bRemove = False + +Check: + If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally + End If + +Try: + Set oLayout = _Document.CurrentController.Frame.LayoutManager + Set oMenuBar = oLayout.getElement("private:resource/menubar/menubar").XMenuBar + + ' Search the menu identifier to remove by its name, Mark its position + With oMenuBar + iMenuPosition = -1 + For i = 0 To .ItemCount - 1 + iMenuId = .getItemId(i) + sName = Replace(.getItemText(iMenuId), cstTilde, "") + If MenuHeader= sName Then + iMenuPosition = i + Exit For + End If + Next i + ' Remove the found menu item + If iMenuPosition >= 0 Then + .removeItem(iMenuPosition, 1) + bRemove = True + End If + End With + +Finally: + RemoveMenu = bRemove + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.RemoveMenu + +REM ----------------------------------------------------------------------------- Public Sub RunCommand(Optional ByVal Command As Variant) ''' Run on the document the given menu command. The command is executed without arguments ''' A few typical commands: @@ -811,7 +937,7 @@ Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally - If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(FilterName, "FilterName", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally @@ -910,7 +1036,7 @@ Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally - If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(FilterName, "FilterName", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally diff --git a/wizards/source/sfdocuments/SF_Writer.xba b/wizards/source/sfdocuments/SF_Writer.xba index 4acdd5c750f0..96ed289f92ff 100644 --- a/wizards/source/sfdocuments/SF_Writer.xba +++ b/wizards/source/sfdocuments/SF_Writer.xba @@ -219,9 +219,11 @@ Public Function Methods() As Variant Methods = Array( _ "Activate" _ , "CloseDocument" _ + , "CreateMenu" _ , "ExportAsPDF" _ , "Forms" _ , "PrintOut" _ + , "RemoveMenu" _ , "RunCommand" _ , "Save" _ , "SaveAs" _ @@ -493,6 +495,14 @@ Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean End Function ' SFDocuments.SF_Writer.CloseDocument REM ----------------------------------------------------------------------------- +Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ + , Optional ByVal Before As Variant _ + , Optional ByVal SubmenuChar As Variant _ + ) As Object + Set CreateMenu = [_Super].CreateMenu(MenuHeader, Before, SubmenuChar) +End Function ' SFDocuments.SF_Writer.CreateMenu + +REM ----------------------------------------------------------------------------- Public Function ExportAsPDF(Optional ByVal FileName As Variant _ , Optional ByVal Overwrite As Variant _ , Optional ByVal Pages As Variant _ @@ -503,6 +513,11 @@ Public Function ExportAsPDF(Optional ByVal FileName As Variant _ End Function ' SFDocuments.SF_Writer.ExportAsPDF REM ----------------------------------------------------------------------------- +Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean + RemoveMenu = [_Super].RemoveMenu(MenuHeader) +End Function ' SFDocuments.SF_Writer.RemoveMenu + +REM ----------------------------------------------------------------------------- Public Sub RunCommand(Optional ByVal Command As Variant) [_Super].RunCommand(Command) End Sub ' SFDocuments.SF_Writer.RunCommand diff --git a/wizards/source/sfwidgets/SF_Menu.xba b/wizards/source/sfwidgets/SF_Menu.xba new file mode 100644 index 000000000000..308e959d1cee --- /dev/null +++ b/wizards/source/sfwidgets/SF_Menu.xba @@ -0,0 +1,590 @@ +<?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 ObjectoDoc 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.openoffice.org/wiki/Documentation/DevGuide/Scripting/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", otherwide "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.openoffice.org/wiki/Documentation/DevGuide/Scripting/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.openoffice.org/wiki/Documentation/DevGuide/Scripting/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", otherwide "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 i As Integer +Const cstTilde = "~" + +Try: + ' Initialize the menubar + Set oLayout = poComponent.CurrentController.Frame.LayoutManager + 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 000000000000..0b1f2b6fd0e5 --- /dev/null +++ b/wizards/source/sfwidgets/SF_MenuListener.xba @@ -0,0 +1,128 @@ +<?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 oSession As Object ' SF_Session service +Dim vScript As Variant ' Split command in script/argument +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 radiobttons and checkboxes + sCommand = .getCommand(iMenuId) + bStatus = .isItemChecked(iMenuId) + End With + + If Len(sCommand) > 0 Then + If Left(sCommand, Len(cstUnoPrefix)) = cstUnoPrefix Then + ' Execute uno command + Set oFrame = StarDesktop.CurrentComponent.CurrentController.Frame ' A menu has been clicked necessarily in the current window + Set oDispatcher = ScriptForge.SF_Utils._GetUNOService("DispatchHelper") + oDispatcher.executeDispatch(oFrame, sCommand, "", 0, oArgs()) + Else + ' Execute script + Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") + 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 SFDIALOGS.SF_DIALOGLISTENER +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfwidgets/SF_PopupMenu.xba b/wizards/source/sfwidgets/SF_PopupMenu.xba index 8f231983551a..3d5ba65a80f8 100644 --- a/wizards/source/sfwidgets/SF_PopupMenu.xba +++ b/wizards/source/sfwidgets/SF_PopupMenu.xba @@ -22,7 +22,7 @@ Option Explicit ''' 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. +''' The Execute() method returns the item selected by the user. ''' ''' Menu items are either: ''' - usual items @@ -34,7 +34,7 @@ Option Explicit ''' Definitions: ''' SubmenuCharacter: the character or the character string that identifies how menus are cascading ''' Default = ">" -''' Can be set when invocating the PopupMenu service +''' Can be set when invoking the PopupMenu service ''' ShortcutCharacter: the underline access key character ''' Default = "~" ''' @@ -45,14 +45,38 @@ Option Explicit ''' ' or ''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", , X, Y, " | ") ' Use X and Y coordinates to place the menu ''' -''' Example 1: simulate an extract of the View menu in the menubar of the Basic IDE +''' 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) +''' .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" @@ -74,7 +98,7 @@ Option Explicit ''' 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 @@ -98,6 +122,7 @@ Private MenuRoot As Object ' stardiv.vcl.PopupMenu or com.sun.star.awt.X 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 @@ -105,6 +130,7 @@ 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" @@ -122,6 +148,8 @@ Private Sub Class_Initialize() Set MenuRoot = Nothing LastItem = 0 Set Rectangle = Nothing + Set PeerWindow = Nothing + MenubarMenu = False End Sub ' SFWidgets.SF_PopupMenu Constructor REM ----------------------------------------------------------------------------- @@ -187,7 +215,7 @@ Public Function AddCheckBox(Optional ByVal MenuItem As Variant _ Dim iId As Integer ' Return value Const cstThisSub = "SFWidgets.PopupMenu.AddCheckBox" -Const cstSubArgs = "MenuItem, [Name = """"], [Status = False], [Icon = """"], [Tooltip = """"]" +Const cstSubArgs = "MenuItem, [Name=""""], [Status=False], [Icon=""""], [Tooltip=""""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch iId = 0 @@ -228,7 +256,7 @@ Public Function AddItem(Optional ByVal MenuItem As Variant _ ''' 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 +''' 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 @@ -247,7 +275,7 @@ Public Function AddItem(Optional ByVal MenuItem As Variant _ Dim iId As Integer ' Return value Const cstThisSub = "SFWidgets.PopupMenu.AddItem" -Const cstSubArgs = "MenuItem, [Name = """"], [Icon = """"], [Tooltip = """"]" +Const cstSubArgs = "MenuItem, [Name=""""], [Icon=""""], [Tooltip=""""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch iId = 0 @@ -307,7 +335,7 @@ Public Function AddRadioButton(Optional ByVal MenuItem As Variant _ Dim iId As Integer ' Return value Const cstThisSub = "SFWidgets.PopupMenu.AddRadioButton" -Const cstSubArgs = "MenuItem, [Name = """"], [Status = False], [Icon = """"], [Tooltip = """"]" +Const cstSubArgs = "MenuItem, [Name=""""], [Status=False], [Icon=""""], [Tooltip=""""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch iId = 0 @@ -360,7 +388,7 @@ Public Function Execute(Optional ByVal ReturnId As Variant) As Variant Dim vMenuItem As Variant ' Return value Const cstThisSub = "SFWidgets.PopupMenu.Execute" -Const cstSubArgs = "[ReturnId = True]" +Const cstSubArgs = "[ReturnId=True]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch vMenuItem = 0 @@ -374,7 +402,7 @@ Check: Try: vMenuItem = MenuRoot.Execute(PeerWindow, Rectangle, com.sun.star.awt.PopupMenuDirection.EXECUTE_DEFAULT) - If Not ReturnId Then vMenuItem = MenuIdentification.Item(Str(vMenuItem)) + If Not ReturnId Then vMenuItem = MenuIdentification.Item(CStr(vMenuItem)) Finally: Execute = vMenuItem @@ -483,6 +511,7 @@ Public Function _AddItem(ByVal MenuItem 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: @@ -501,6 +530,9 @@ Public Function _AddItem(ByVal MenuItem As String _ ''' 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 @@ -510,9 +542,12 @@ 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 @@ -534,16 +569,16 @@ Try: Case cstNormal .insertItem(LastItem, sName, 0, -1) Case cstCheck - .insertItem(LastItem, sName, com.sun.star.awt.MenuItemStyle.CHECKABLE, -1) + .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, -1) + .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(Str(LastItem), Name) + MenuIdentification.Add(CStr(LastItem), Name) ' Add the icon when relevant If Len(Icon) > 0 Then @@ -553,6 +588,16 @@ Try: ' 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 @@ -566,7 +611,7 @@ Catch: End Function ' SFWidgets.SF_PopupMenu._AddItem REM ----------------------------------------------------------------------------- -Private Function _GetImageFromURL(psUrl as String) As Object +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 @@ -593,7 +638,7 @@ Finally: Exit Function Catch: GoTo Finally -End Function ' SFWidgets.SF°PopupMenu._GetImageFromUrl +End Function ' SFWidgets.SF_PopupMenu._GetImageFromUrl REM ----------------------------------------------------------------------------- Private Function _GetPopupMenu(ByVal psSubmenu As String) As Object @@ -635,6 +680,7 @@ Try: 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 @@ -722,7 +768,7 @@ End Function ' SFWidgets.SF_PopupMenu._PropertyGet REM ----------------------------------------------------------------------------- Private Function _Repr() As String -''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Convert the SF_PopupMenu instance to a readable string, typically for debugging purposes (DebugPrint ...) ''' Args: ''' Return: ''' "[PopupMenu]: Name, Type (dialogname) diff --git a/wizards/source/sfwidgets/SF_Register.xba b/wizards/source/sfwidgets/SF_Register.xba index 4dbb84f03104..2c58b858d1e9 100644 --- a/wizards/source/sfwidgets/SF_Register.xba +++ b/wizards/source/sfwidgets/SF_Register.xba @@ -20,8 +20,12 @@ Option Explicit ''' 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 +''' Create a new popup menu service instance. +''' Called from CreateScriptService() ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS @@ -46,7 +50,8 @@ Public Sub RegisterScriptServices() As Variant ''' "libraryname.modulename.function" With GlobalScope.ScriptForge.SF_Services - .RegisterService("PopupMenu", "SFWidgets.SF_Register._NewPopupMenu") ' Reference to the function initializing the service + .RegisterService("Menu", "SFWidgets.SF_Register._NewMenu") ' Reference to the function initializing the service + .RegisterService("PopupMenu", "SFWidgets.SF_Register._NewPopupMenu") ' id. End With End Sub ' SFWidgets.SF_Register.RegisterScriptServices @@ -54,13 +59,63 @@ 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: +''' Args: ''' Event: a mouse event ''' If the event has no source or is not a mouse event, the menu is displayed above ThisComponent ''' X, Y: forced coordinates -''' SubmenuChar: Delimiter in menu trees +''' SubmenuChar: Delimiter used in menu trees ''' Returns: the instance or Nothing Dim oMenu As Object ' Return value @@ -86,6 +141,7 @@ Check: 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 Set oMenu = Nothing Try: diff --git a/wizards/source/sfwidgets/script.xlb b/wizards/source/sfwidgets/script.xlb index a32c363d4ac6..40e9f4c23df2 100644 --- a/wizards/source/sfwidgets/script.xlb +++ b/wizards/source/sfwidgets/script.xlb @@ -4,4 +4,6 @@ <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:library>
\ No newline at end of file |