8a4ee0fb39
Complete a predefined context menu with new items placed at its bottom. A context menu is obtained by a right-click on several areas of a document. Each area has its own context menu. Each component model has its own set of context menus. A context menu is usually predefined at LibreOffice installation. Customization is done statically with the Tools + Customize dialog. The actual new service provides a mean to make temporary additions at the bottom of a context menu. Those changes are lost when the document is closed. The name of a context menu is the last component of the resource URL: "private:resource/popupmenu/the-name-here" Context menu items are either usual items or line separators. Checkboxes or radio buttons are not supported. Items run a command or a script when clicked. The service implements 2 methods: AddItem() adds an entry in the menu hierarchy Activate() shows or hides the added entries A context menu can be defined from both Basic and Python user scripts. An update of the documentation is required. Change-Id: Id77f1f2565d75e36c09b13972330d0f83b3f1db4 Reviewed-on: https://gerrit.libreoffice.org/c/core/+/172355 Reviewed-by: Jean-Pierre Ledure <jp@ledure.be> Tested-by: Jenkins
599 lines
No EOL
30 KiB
XML
599 lines
No EOL
30 KiB
XML
<?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> |