| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598 |
- <?xml version="1.0" encoding="UTF-8"?>
- <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
- <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Menu" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
- REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
- REM === The SFWidgets library is one of the associated libraries. ===
- REM === Full documentation is available on https://help.libreoffice.org/ ===
- REM =======================================================================================================================
- Option Compatible
- Option ClassModule
- Option Explicit
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- ''' SF_Menu
- ''' ============
- ''' Display a menu in the menubar of a document or a form document.
- ''' After use, the menu will not be saved neither in the application settings, nor in the document.
- '''
- ''' The menu will be displayed, as usual, when its header in the menubar is clicked.
- ''' When one of its items is selected, there are 3 alternative options:
- ''' - a UNO command (like ".uno:About") is triggered
- ''' - a user script is run receiving a standard argument defined in this service
- ''' - one of above combined with a toggle of the status of the item
- '''
- ''' The menu is described from top to bottom. Each menu item receives a numeric and a string identifier.
- '''
- ''' Menu items are either:
- ''' - usual items
- ''' - checkboxes
- ''' - radio buttons
- ''' - a menu separator
- ''' Menu items can be decorated with icons and tooltips.
- '''
- ''' Definitions:
- ''' SubmenuCharacter: the character or the character string that identifies how menus are cascading
- ''' Default = ">"
- ''' Can be set when invoking the Menu service
- ''' ShortcutCharacter: the underline access key character
- ''' Default = "~"
- '''
- ''' Menus and submenus
- ''' To create a menu with submenus, use the character defined in the
- ''' SubmenuCharacter property while creating the menu entry to define where it will be
- ''' placed. For instance, consider the following menu/submenu hierarchy.
- ''' Item A
- ''' Item B > Item B.1
- ''' Item B.2
- ''' ------ (line separator)
- ''' Item C > Item C.1 > Item C.1.1
- ''' Item C.1.2
- ''' Item C > Item C.2 > Item C.2.1
- ''' Item C.2.2
- ''' Next code will create the menu/submenu hierarchy
- ''' With myMenu
- ''' .AddItem("Item A")
- ''' .AddItem("Item B>Item B.1")
- ''' .AddItem("Item B>Item B.2")
- ''' .AddItem("---")
- ''' .AddItem("Item C>Item C.1>Item C.1.1")
- ''' .AddItem("Item C>Item C.1>Item C.1.2")
- ''' .AddItem("Item C>Item C.2>Item C.2.1")
- ''' .AddItem("Item C>Item C.2>Item C.2.2")
- ''' End With
- '''
- ''' Service invocation:
- ''' Dim ui As Object, oDoc As Object, myMenu As Object
- ''' Set ui = CreateScriptService("UI")
- ''' Set oDoc = ui.GetDocument(ThisComponent)
- ''' Set myMenu = oDoc.CreateMenu("My own menu")
- '''
- ''' Detailed user documentation:
- ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/SF_Menu.html?DbPAR=BASIC
- '''
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- REM ================================================================== EXCEPTIONS
- REM ============================================================= PRIVATE MEMBERS
- Private [Me] As Object
- Private ObjectType As String ' Must be MENU
- Private ServiceName As String
- ' Menu descriptors
- Private Component As Object ' the com.sun.star.lang.XComponent hosting the menu in its menubar
- Private MenuBar As Object ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar
- Private SubmenuChar As String ' Delimiter in menu trees
- Private MenuHeader As String ' Header of the menu
- Private MenuId As Integer ' Menu numeric identifier in the menubar
- Private MenuPosition As Integer ' Position of the menu on the menubar >= 1
- Private PopupMenu As Object ' The underlying popup menu as a SF_PopupMenu object
- REM ============================================================ MODULE CONSTANTS
- Private Const _UnderlineAccessKeyChar = "~"
- Private Const _DefaultSubmenuChar = ">"
- Private Const cstUnoPrefix = ".uno:"
- Private Const cstScriptArg = ":::"
- Private Const cstNormal = "N"
- Private Const cstCheck = "C"
- Private Const cstRadio = "R"
- REM ====================================================== CONSTRUCTOR/DESTRUCTOR
- REM -----------------------------------------------------------------------------
- Private Sub Class_Initialize()
- Set [Me] = Nothing
- ObjectType = "MENU"
- ServiceName = "SFWidgets.Menu"
- Set Component = Nothing
- Set MenuBar = Nothing
- SubmenuChar = _DefaultSubmenuChar
- MenuHeader = ""
- MenuId = -1
- MenuPosition = 0
- Set PopupMenu = Nothing
- End Sub ' SFWidgets.SF_Menu Constructor
- REM -----------------------------------------------------------------------------
- Private Sub Class_Terminate()
- Call Class_Initialize()
- End Sub ' SFWidgets.SF_Menu Destructor
- REM -----------------------------------------------------------------------------
- Public Function Dispose() As Variant
- PopupMenu.Dispose()
- Call Class_Terminate()
- Set Dispose = Nothing
- End Function ' SFWidgets.SF_Menu Explicit Destructor
- REM ================================================================== PROPERTIES
- REM -----------------------------------------------------------------------------
- Property Get ShortcutCharacter() As Variant
- ''' The ShortcutCharacter property specifies character preceding the underline access key
- ShortcutCharacter = _PropertyGet("ShortcutCharacter")
- End Property ' SFWidgets.SF_Menu.ShortcutCharacter (get)
- REM -----------------------------------------------------------------------------
- Property Get SubmenuCharacter() As Variant
- ''' The SubmenuCharacter property specifies the character string indicating
- ''' a sub-menu in a popup menu item
- SubmenuCharacter = _PropertyGet("SubmenuCharacter")
- End Property ' SFWidgets.SF_Menu.SubmenuCharacter (get)
- REM ===================================================================== METHODS
- REM -----------------------------------------------------------------------------
- Public Function AddCheckBox(Optional ByVal MenuItem As Variant _
- , Optional ByVal Name As Variant _
- , Optional ByVal Status As Variant _
- , Optional ByVal Icon As Variant _
- , Optional ByVal Tooltip As Variant _
- , Optional ByVal Command As Variant _
- , Optional ByVal Script As Variant _
- ) As Integer
- ''' Insert in the popup menu a new entry as a checkbox
- ''' Args:
- ''' MenuItem: The text to be displayed in the menu entry.
- ''' It determines also the hierarchy of the popup menu
- ''' It is made up of all the components (separated by the "SubmenuCharacter") of the menu branch
- ''' Example: A>B>C means "C" is a new entry in submenu "A => B =>"
- ''' If the last component is equal to the "SeparatorCharacter", a line separator is inserted
- ''' Name: The name identifying the item. Default = the last component of MenuItem.
- ''' Status: when True the item is selected. Default = False
- ''' Icon: The path name of the icon to be displayed, without leading path separator
- ''' The icons are stored in one of the <install folder>/share/config/images_*.zip files
- ''' The exact file depends on the user options about the current icon set
- ''' Use the (normal) slash "/" as path separator
- ''' Example: "cmd/sc_cut.png"
- ''' Tooltip: The help text to be displayed as a tooltip
- ''' Command: A menu command like ".uno:About". The validity of the command is not checked.
- ''' Script: a Basic or Python script (determined by its URI notation) to be run when the item is clicked
- ''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
- ''' Next string argument will be passed to the called script : a comma-separated string of 4 components:
- ''' - the menu header
- ''' - the name of the clicked menu item
- ''' - the numeric identifier of the clicked menu item
- ''' - "1" when the status is "checked", otherwise "0"
- ''' Arguments Command and Script are mutually exclusive.
- ''' Returns:
- ''' The numeric identification of the newly inserted item
- ''' Examples:
- ''' Dim iId As Integer
- ''' iId = myMenu.AddCheckBox("Menu top>Checkbox item", Status := True, Command := "Bold")
- Dim iId As Integer ' Return value
- Dim sCommand As String ' Alias of either Command or Script
- Const cstThisSub = "SFWidgets.Menu.AddCheckBox"
- Const cstSubArgs = "MenuItem, [Name=""""], [Status=False], [Icon=""""], [Tooltip=""""], [Command=""""], [Script=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- iId = 0
- Check:
- If IsMissing(Name) Or IsEmpty(Name) Then Name = ""
- If IsMissing(Status) Or IsEmpty(Status) Then Status = False
- If IsMissing(Icon) Or IsEmpty(Icon) Then Icon = ""
- If IsMissing(Tooltip) Or IsEmpty(Tooltip) Then Tooltip = ""
- If IsMissing(Command) Or IsEmpty(Command) Then Command = ""
- If IsMissing(Script) Or IsEmpty(Script) Then Script = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not ScriptForge.SF_Utils._Validate(MenuItem, "MenuItem", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Status, "Status", ScriptForge.V_BOOLEAN) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Icon, "Icon", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Tooltip, "Tooltip", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Script, "Script", V_STRING) Then GoTo Catch
- End If
- If Len(Command) > 0 Then
- If Left(Command, Len(cstUnoPrefix)) = cstUnoPrefix Then sCommand = Command Else sCommand = cstUnoPrefix & Command
- Else
- sCommand = Script & cstScriptArg & MenuHeader
- End If
- Try:
- iId = PopupMenu._AddItem(MenuItem, Name, cstCheck, Status, Icon, Tooltip, sCommand)
- Finally:
- AddCheckBox = iId
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFWidgets.SF_Menu.AddCheckBox
- REM -----------------------------------------------------------------------------
- Public Function AddItem(Optional ByVal MenuItem As Variant _
- , Optional ByVal Name As Variant _
- , Optional ByVal Icon As Variant _
- , Optional ByVal Tooltip As Variant _
- , Optional ByVal Command As Variant _
- , Optional ByVal Script As Variant _
- ) As Integer
- ''' Insert in the popup menu a new entry
- ''' Args:
- ''' MenuItem: The text to be displayed in the menu entry.
- ''' It determines also the hierarchy of the popup menu
- ''' It is made up of all the components (separated by the "SubmenuCharacter") of the menu branch
- ''' Example: A>B>C means "C" is a new entry in submenu "A => B =>"
- ''' If the last component is equal to "---", a line separator is inserted and all other arguments are ignored
- ''' Name: The name identifying the item. Default = the last component of MenuItem.
- ''' Icon: The path name of the icon to be displayed, without leading path separator
- ''' The icons are stored in one of the <install folder>/share/config/images_*.zip files
- ''' The exact file depends on the user options about the current icon set
- ''' Use the (normal) slash "/" as path separator
- ''' Example: "cmd/sc_cut.png"
- ''' Tooltip: The help text to be displayed as a tooltip
- ''' Command: A menu command like ".uno:About". The validity of the command is not checked.
- ''' Script: a Basic or Python script (determined by its URI notation) to be run when the item is clicked
- ''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
- ''' Next string argument will be passed to the called script : a comma-separated string of 4 components:
- ''' - the menu header
- ''' - the name of the clicked menu item
- ''' - the numeric identifier of the clicked menu item
- ''' - "0"
- ''' Arguments Command and Script are mutually exclusive.
- ''' Returns:
- ''' The numeric identification of the newly inserted item
- ''' Examples:
- ''' Dim iId1 As Integer, iId2 As Integer
- ''' iId1 = myMenu.AddItem("Menu top>Normal item 1", Icon := "cmd.sc_cut.png", Command := "About")
- ''' iId2 = myMenu.AddItem("Menu top>Normal item 2", Script := "vnd.sun.star.script:myLib.Module1.ThisSub?language=Basic&location=document")
- Dim iId As Integer ' Return value
- Dim sCommand As String ' Alias of either Command or Script
- Const cstThisSub = "SFWidgets.Menu.AddItem"
- Const cstSubArgs = "MenuItem, [Name=""""], [Icon=""""], [Tooltip=""""], [Command=""""], [Script=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- iId = 0
- Check:
- If IsMissing(Name) Or IsEmpty(Name) Then Name = ""
- If IsMissing(Icon) Or IsEmpty(Icon) Then Icon = ""
- If IsMissing(Tooltip) Or IsEmpty(Tooltip) Then Tooltip = ""
- If IsMissing(Command) Or IsEmpty(Command) Then Command = ""
- If IsMissing(Script) Or IsEmpty(Script) Then Script = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not ScriptForge.SF_Utils._Validate(MenuItem, "MenuItem", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Icon, "Icon", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Tooltip, "Tooltip", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Script, "Script", V_STRING) Then GoTo Catch
- End If
- If Len(Command) > 0 Then
- If Left(Command, Len(cstUnoPrefix)) = cstUnoPrefix Then sCommand = Command Else sCommand = cstUnoPrefix & Command
- Else
- sCommand = Script & cstScriptArg & MenuHeader
- End If
- Try:
- iId = PopupMenu._AddItem(MenuItem, Name, cstNormal, False, Icon, Tooltip, sCommand)
- Finally:
- AddItem = iId
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFWidgets.SF_Menu.AddItem
- REM -----------------------------------------------------------------------------
- Public Function AddRadioButton(Optional ByVal MenuItem As Variant _
- , Optional ByVal Name As Variant _
- , Optional ByVal Status As Variant _
- , Optional ByVal Icon As Variant _
- , Optional ByVal Tooltip As Variant _
- , Optional ByVal Command As Variant _
- , Optional ByVal Script As Variant _
- ) As Integer
- ''' Insert in the popup menu a new entry as a radio button
- ''' Args:
- ''' MenuItem: The text to be displayed in the menu entry.
- ''' It determines also the hieAddCheckBoxrarchy of the popup menu
- ''' It is made up of all the components (separated by the "SubmenuCharacter") of the menu branch
- ''' Example: A>B>C means "C" is a new entry in submenu "A => B =>"
- ''' If the last component is equal to the "SeparatorCharacter", a line separator is inserted
- ''' Name: The name identifying the item. Default = the last component of MenuItem.
- ''' Status: when True the item is selected. Default = False
- ''' Icon: The path name of the icon to be displayed, without leading path separator
- ''' The icons are stored in one of the <install folder>/share/config/images_*.zip files
- ''' The exact file depends on the user options about the current icon set
- ''' Use the (normal) slash "/" as path separator
- ''' Example: "cmd/sc_cut.png"
- ''' Tooltip: The help text to be displayed as a tooltip
- ''' Command: A menu command like ".uno:About". The validity of the command is not checked.
- ''' Script: a Basic or Python script (determined by its URI notation) to be run when the item is clicked
- ''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Scripting_Framework#Scripting_Framework_URI_Specification
- ''' Next string argument will be passed to the called script : a comma-separated string of 4 components:
- ''' - the menu header
- ''' - the name of the clicked menu item
- ''' - the numeric identifier of theclicked menu item
- ''' - "1" when the status is "checked", otherwise "0"
- ''' Arguments Command and Script are mutually exclusive.
- ''' Returns:
- ''' The numeric identification of the newly inserted item
- ''' Examples:
- ''' Dim iId As Integer
- ''' iId = myMenu.AddRadioButton("Menu top>Radio item", Status := True, Command := "Bold")
- Dim iId As Integer ' Return value
- Dim sCommand As String ' Alias of either Command or Script
- Const cstThisSub = "SFWidgets.Menu.AddRadioButton"
- Const cstSubArgs = "MenuItem, [Name=""""], [Status=False], [Icon=""""], [Tooltip=""""], [Command=""""], [Script=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- iId = 0
- Check:
- If IsMissing(Name) Or IsEmpty(Name) Then Name = ""
- If IsMissing(Status) Or IsEmpty(Status) Then Status = False
- If IsMissing(Icon) Or IsEmpty(Icon) Then Icon = ""
- If IsMissing(Tooltip) Or IsEmpty(Tooltip) Then Tooltip = ""
- If IsMissing(Command) Or IsEmpty(Command) Then Command = ""
- If IsMissing(Script) Or IsEmpty(Script) Then Script = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not ScriptForge.SF_Utils._Validate(MenuItem, "MenuItem", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Status, "Status", ScriptForge.V_BOOLEAN) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Icon, "Icon", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Tooltip, "Tooltip", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Script, "Script", V_STRING) Then GoTo Catch
- End If
- If Len(Command) > 0 Then
- If Left(Command, Len(cstUnoPrefix)) = cstUnoPrefix Then sCommand = Command Else sCommand = cstUnoPrefix & Command
- Else
- sCommand = Script & cstScriptArg & MenuHeader
- End If
- Try:
- iId = PopupMenu._AddItem(MenuItem, Name, cstRadio, Status, Icon, Tooltip, sCommand)
- Finally:
- AddRadioButton = iId
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFWidgets.SF_Menu.AddRadioButton
- REM -----------------------------------------------------------------------------
- Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
- ''' Return the actual value of the given property
- ''' Args:
- ''' PropertyName: the name of the property as a string
- ''' Returns:
- ''' The actual value of the property
- ''' If the property does not exist, returns Null
- ''' Exceptions:
- ''' see the exceptions of the individual properties
- ''' Examples:
- ''' myModel.GetProperty("MyProperty")
- Const cstThisSub = "SFWidgets.Menu.GetProperty"
- Const cstSubArgs = ""
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- GetProperty = Null
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
- End If
- Try:
- GetProperty = _PropertyGet(PropertyName)
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFWidgets.SF_Menu.GetProperty
- REM -----------------------------------------------------------------------------
- Public Function Methods() As Variant
- ''' Return the list of public methods of the Model service as an array
- Methods = Array( _
- "AddCheckBox" _
- , "AddItem" _
- , "AddRadioButton" _
- )
- End Function ' SFWidgets.SF_Menu.Methods
- REM -----------------------------------------------------------------------------
- Public Function Properties() As Variant
- ''' Return the list or properties of the Timer a.AddItem("B>B1")class as an array
- Properties = Array( _
- "ShortcutCharacter" _
- , "SubmenuCharacter" _
- )
- End Function ' SFWidgets.SF_Menu.Properties
- REM -----------------------------------------------------------------------------
- Public Function SetProperty(Optional ByVal PropertyName As Variant _
- , Optional ByRef Value As Variant _
- ) As Boolean
- ''' Set a new value to the given property
- ''' Args:
- ''' PropertyName: the name of the property as a string
- ''' Value: its new value
- ''' Exceptions
- ''' ARGUMENTERROR The property does not exist
- Const cstThisSub = "SFWidgets.Menu.SetProperty"
- Const cstSubArgs = "PropertyName, Value"
- If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- SetProperty = False
- Check:
- If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
- End If
- Try:
- SetProperty = _PropertySet(PropertyName, Value)
- Finally:
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFWidgets.SF_Menu.SetProperty
- REM =========================================================== PRIVATE FUNCTIONS
- REM -----------------------------------------------------------------------------
- Public Sub _Initialize(ByRef poComponent As Object _
- , psMenuHeader As String _
- , psBefore As String _
- , piBefore As Integer _
- , psSubmenuChar As String _
- )
- ''' Complete the object creation process:
- ''' - Initialize the internal properties
- ''' - Initialize the menubar
- ''' - Determine the position and the internal id of the new menu
- ''' - Create the menu and its attached popup menu
- ''' Args:
- ''' poComponent: the parent component where the menubar is to be searched for
- ''' psMenuHeader: the header of the new menu. May or not contain a tilde "~"
- ''' psBefore, piBefore: the menu before which to create the new menu, as a string or as a number
- ''' psSubmenuChar: the submenus separator
- Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager
- Dim sName As String ' Menu name
- Dim iMenuId As Integer ' Menu identifier
- Dim oWindow As Object ' ui.Window type
- Dim oUi As Object : Set oUi = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI")
- Dim i As Integer
- Const cstTilde = "~"
- Check:
- ' How does the window look on top of which a menu is requested ?
- Set oWindow = oUi._IdentifyWindow(poComponent)
- With oWindow
- If Not IsNull(.Frame) Then Set oLayout = .Frame.LayoutManager Else GoTo Finally
- End With
- Try:
- ' Initialize the menubar
- Set MenuBar = oLayout.getElement("private:resource/menubar/menubar").XMenuBar
- ' Determine the new menu identifier and its position
- ' Identifier = largest current identifier + 1
- MenuHeader = psMenuHeader
- With MenuBar
- For i = 0 To .ItemCount - 1
- iMenuId = .getItemId(i)
- If iMenuId >= MenuId Then MenuId = iMenuId + 1
- If piBefore > 0 And piBefore = i + 1 Then
- MenuPosition = piBefore
- Else
- sName = .getItemText(iMenuId)
- If sName = psBefore Or Replace(sName, cstTilde, "") = psBefore Then MenuPosition = i + 1
- End If
- Next i
- If MenuPosition = 0 Then MenuPosition = .ItemCount + 1
- End With
- ' Store the submenu character
- If Len(psSubmenuChar) > 0 Then SubmenuChar = psSubmenuChar
- ' Create the menu and the attached top popup menu
- MenuBar.insertItem(MenuId, MenuHeader, 0, MenuPosition - 1)
- PopupMenu = SFWidgets.SF_Register._NewPopupMenu(Array(Nothing, 0, 0, SubmenuChar))
- PopupMenu.MenubarMenu = True ' Special indicator for menus depending on menubar
- MenuBar.setPopupMenu(MenuId, PopupMenu.MenuRoot)
- ' Initialize the listener on the top branch
- SFWidgets.SF_MenuListener.SetMenuListener(PopupMenu.MenuRoot)
- Finally:
- Exit Sub
- End Sub ' SFWidgets.SF_Menu._Initialize
- REM -----------------------------------------------------------------------------
- Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
- ''' Return the value of the named property
- ''' Args:
- ''' psProperty: the name of the property
- Dim vGet As Variant ' Return value
- Dim cstThisSub As String
- Const cstSubArgs = ""
- cstThisSub = "SFWidgets.Menu.get" & psProperty
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
- _PropertyGet = Null
- Select Case UCase(psProperty)
- Case UCase("ShortcutCharacter")
- _PropertyGet = _UnderlineAccessKeyChar
- Case UCase("SubmenuCharacter")
- _PropertyGet = SubmenuChar
- Case Else
- _PropertyGet = Null
- End Select
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFWidgets.SF_Menu._PropertyGet
- REM -----------------------------------------------------------------------------
- Private Function _Repr() As String
- ''' Convert the SF_Menu instance to a readable string, typically for debugging purposes (DebugPrint ...)
- ''' Args:
- ''' Return:
- ''' "[Menu]: Name, Type (dialogname)
- _Repr = "[Menu]: " & SF_String.Represent(PopupMenu.MenuTree.Keys()) & ", " & SF_String.Represent(PopupMenu.MenuIdentification.Items())
- End Function ' SFWidgets.SF_Menu._Repr
- REM ============================================ END OF SFWIDGETS.SF_MENU
- </script:module>
|
