diff options
| author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
|---|---|---|
| committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
| commit | ed5640d8b587fbcfed7dd7967f3de04b37a76f26 (patch) | |
| tree | 7a5f7c6c9d02226d7471cb3cc8fbbf631b415303 /wizards/source/sfwidgets/SF_Menu.xba | |
| parent | Initial commit. (diff) | |
| download | libreoffice-ed5640d8b587fbcfed7dd7967f3de04b37a76f26.tar.xz libreoffice-ed5640d8b587fbcfed7dd7967f3de04b37a76f26.zip | |
Adding upstream version 4:7.4.7.upstream/4%7.4.7upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'wizards/source/sfwidgets/SF_Menu.xba')
| -rw-r--r-- | wizards/source/sfwidgets/SF_Menu.xba | 590 |
1 files changed, 590 insertions, 0 deletions
diff --git a/wizards/source/sfwidgets/SF_Menu.xba b/wizards/source/sfwidgets/SF_Menu.xba new file mode 100644 index 000000000..e21168536 --- /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 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 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 |