574 lines
No EOL
27 KiB
XML
574 lines
No EOL
27 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_ContextMenu" 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_ContextMenu
|
|
''' ==============
|
|
''' Complete a predefined context menu with new items.
|
|
'''
|
|
''' A context menu is obtained by a right-click on several areas of a document.
|
|
''' Each area determines its own context menu.
|
|
''' (Consider right-clicking on a cell or on a sheet tab in a Calc document).
|
|
''' 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 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
|
|
''' - line separators
|
|
''' Checkboxes or radio buttons are not supported.
|
|
'''
|
|
''' A context menu is setup in next sequence:
|
|
''' 1. Define each menu item, submenu or line separator with AddItem(...)
|
|
''' 2. Activate() the menu to make it visible and active
|
|
''' 3. If meaningful, it can be temporarily deactivate with Activate(False)
|
|
''' 4. Items can be optionally added, and the menu might be made active again
|
|
''' 5. Dispose() cleans the memory resources
|
|
'''
|
|
''' Definitions:
|
|
''' SubmenuCharacter: the character or the character string that identifies how menus are cascading
|
|
''' Default = ">"
|
|
''' Can be set when invoking the ContextMenu service
|
|
''' ShortcutCharacter: the underline access key character
|
|
''' Default = "~"
|
|
'''
|
|
''' Service invocation:
|
|
''' From a document, calc, writer, formdocument or datasheet service:
|
|
''' Dim MenusList As Variant, oCtxMenu As Object
|
|
''' MenusList = doc.ContextMenus()
|
|
''' ' Returns a list of available context menus as strings
|
|
''' Set oCtxMenu = doc.ContextMenus(ContextMenuName, SubmenuChar = ">>")
|
|
''' ' Returns a context menu service instance
|
|
'''
|
|
''' Menus and submenus
|
|
''' To create a context 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 > ------ (line separator)
|
|
''' 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", Command := ...)
|
|
''' .AddItem("Item B>Item B.1", Script := ...)
|
|
''' .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>---")
|
|
''' .AddItem("Item C>Item C.2>Item C.2.1", ...)
|
|
''' .AddItem("Item C>Item C.2>Item C.2.2", ...)
|
|
''' End With
|
|
'''
|
|
''' Example: Add 2 items to the general context menu of a Writer document
|
|
''' Sub SetContextMenu(oWriter As Object)
|
|
''' Dim oMenu As Object
|
|
''' Set oMenu = oWriter.ContextMenus("text")
|
|
''' With oMenu
|
|
''' .AddItem("About", Command := ".uno:About")
|
|
''' .AddItem("Run", Script := "vnd.sun.star.script:Standard.Module1.MyFunction?language=Basic&location=document")
|
|
''' ' MyFunction is a Sub without argument
|
|
''' .Activate()
|
|
''' .Dispose()
|
|
''' End With
|
|
''' End Sub
|
|
'''
|
|
'''
|
|
''' Detailed user documentation:
|
|
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_contextmenu.html?DbPAR=BASIC
|
|
'''
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
REM ============================================================= PRIVATE MEMBERS
|
|
|
|
Private [Me] As Object
|
|
Private ObjectType As String ' Must be ContextMenu
|
|
Private ServiceName As String
|
|
|
|
|
|
' Menu descriptors
|
|
Private Component As Object ' com.sun.star.lang.XComponent
|
|
Private ResourceURL As String ' private:resource/popupmenu/...
|
|
Private ConfigManager As Object ' com.sun.star.ui.XUIConfigurationManager
|
|
Private MenuTree As Variant ' Dictionary nodename - com.sun.star.ui.ItemDescriptor pair
|
|
Private SubmenuChar As String ' Delimiter in menu trees
|
|
Private MenuContainer As Object ' com.sun.star.container.XIndexAccess
|
|
|
|
REM ============================================================ MODULE CONSTANTS
|
|
|
|
Private Const _UnderlineAccessKeyChar = "~"
|
|
Private Const _DefaultSubmenuChar = ">"
|
|
Private Const _SeparatorChar = "---"
|
|
Private Const cstUnoPrefix = ".uno:"
|
|
|
|
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Initialize()
|
|
Set [Me] = Nothing
|
|
ObjectType = "ContextMenu"
|
|
ServiceName = "SFWidgets.ContextMenu"
|
|
Set Component = Nothing
|
|
Set ConfigManager = Nothing
|
|
ResourceURL = ""
|
|
Set MenuTree = Nothing
|
|
SubmenuChar = _DefaultSubmenuChar
|
|
Set MenuContainer = Nothing
|
|
End Sub ' SFWidgets.SF_ContextMenu Constructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Terminate()
|
|
Call Class_Initialize()
|
|
End Sub ' SFWidgets.SF_ContextMenu Destructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Dispose() As Variant
|
|
If Not IsNull(MenuTree) Then Set MenuTree = MenuTree.Dispose()
|
|
Call Class_Terminate()
|
|
Set Dispose = Nothing
|
|
End Function ' SFWidgets.SF_ContextMenu 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_ContextMenu.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_ContextMenu.SubmenuCharacter (get)
|
|
|
|
REM ===================================================================== METHODS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub Activate(Optional ByVal Enable As Variant) As Variant
|
|
''' Make the added items of the context menu available for execution,
|
|
''' or, at the opposite, disable them, depending on the argument.
|
|
''' Args:
|
|
''' Enable: When True (default), the new items of the context menu are made visible.
|
|
''' When False, they are suppressed.
|
|
''' Returns:
|
|
''' None
|
|
''' Examples:
|
|
''' Sub SetContextMenu(oWriter As Object) ' oWriter is a SFDocuments.SF_Writer service instance
|
|
''' Dim oMenu As Object
|
|
''' Set oMenu = oWriter.ContextMenus("text")
|
|
''' With oMenu
|
|
''' .AddItem("About", Command := ".uno:About")
|
|
''' .AddItem("Run", Script := "vnd.sun.star.script:Standard.Module1.MyFunction?language=Basic&location=document")
|
|
''' ' MyFunction is a Sub without argument
|
|
''' .Activate()
|
|
''' .Dispose() ' Do not dispose() if you plan later on to Activate(Enable := False) the context menu
|
|
''' End With
|
|
''' End Sub
|
|
|
|
Dim bSettings As Boolean ' When True, the menu is already stored
|
|
|
|
Const cstThisSub = "SFWidgets.ContextMenu.Activate"
|
|
Const cstSubArgs = "[Enable=True]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(Enable) Or IsEmpty(Enable) Then Enable = True
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not ScriptForge.SF_Utils._Validate(Enable, "Enable", ScriptForge.V_BOOLEAN) Then GoTo Catch
|
|
End If
|
|
If IsNull(ConfigManager) Or IsNull(MenuContainer) Then GoTo Finally
|
|
|
|
Try:
|
|
With ConfigManager
|
|
bSettings = .hasSettings(ResourceURL)
|
|
If Enable And bSettings Then
|
|
.replaceSettings(ResourceURL, MenuContainer)
|
|
ElseIf Enable And Not bSettings Then
|
|
.insertSettings(ResourceURL, MenuContainer)
|
|
ElseIf Not Enable And bSettings Then
|
|
.removeSettings(ResourceURL)
|
|
Else
|
|
' Nothing to deactivate
|
|
End If
|
|
End With
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' SFWidgets.SF_ContextMenu.Activate
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub AddItem(Optional ByVal MenuItem As Variant _
|
|
, Optional ByVal Command As Variant _
|
|
, Optional ByVal Script As Variant _
|
|
) As Integer
|
|
''' Insert in the context 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
|
|
''' 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
|
|
''' No argument will be passed to the called script.
|
|
''' Arguments Command and Script are mutually exclusive.
|
|
''' Returns:
|
|
''' None
|
|
''' Examples:
|
|
''' myMenu.AddItem("Menu top>Item 1", Command := "About")
|
|
''' myMenu.AddItem("Menu top>Item 2", Script := "vnd.sun.star.script:myLib.Module1.ThisSub?language=Basic&location=document")
|
|
|
|
Dim sCommand As String ' Alias of either Command or Script
|
|
Dim vSplit As Variant ' Split menu item
|
|
Dim sMenu As String ' Submenu where to attach the new item, as a string
|
|
Dim oMenu As Object ' Submenu where to attach the new item, as an object
|
|
Dim sName As String ' The text displayed in the menu box
|
|
Dim vEntry As Variant ' com.sun.star.ui.ItemDescriptor
|
|
|
|
Const cstThisSub = "SFWidgets.ContextMenu.AddItem"
|
|
Const cstSubArgs = "MenuItem, [Command=""""], [Script=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
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(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
|
|
End If
|
|
|
|
Try:
|
|
' Run through the upper menu tree
|
|
vSplit = _SplitMenuItem(MenuItem)
|
|
|
|
' Create and determine the menu to which to attach the new item
|
|
sMenu = vSplit(0)
|
|
Set oMenu = _GetContextMenu(sMenu) ' Run through the upper menu tree and retain the last branch
|
|
|
|
' Insert the new item
|
|
sName = vSplit(1)
|
|
With ScriptForge.SF_Utils
|
|
vEntry = Array( ._MakePropertyValue("Type", Iif(sName = _SeparatorChar, _
|
|
com.sun.star.ui.ItemType.SEPARATOR_LINE, _
|
|
com.sun.star.ui.ItemType.DEFAULT)) _
|
|
, ._MakePropertyValue("Label", Iif(sName = _SeparatorChar, "", sName)) _
|
|
, ._MakePropertyValue("CommandURL", sCommand) _
|
|
, ._MakePropertyValue("HelpURL", "") _
|
|
, ._MakePropertyValue("Style", _
|
|
Iif(Len(Script) > 0, 0, com.sun.star.ui.ItemStyle.ICON)) _
|
|
, ._MakePropertyValue("ItemDescriptorContainer", Null) _
|
|
)
|
|
oMenu.insertByIndex(oMenu.Count, vEntry)
|
|
End With
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' SFWidgets.SF_ContextMenu.AddItem
|
|
|
|
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.ContextMenu.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_ContextMenu.GetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Methods() As Variant
|
|
''' Return the list of public methods of the Model service as an array
|
|
|
|
Methods = Array( _
|
|
"AddItem" _
|
|
, "Execute" _
|
|
)
|
|
|
|
End Function ' SFWidgets.SF_ContextMenu.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_ContextMenu.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.ContextMenu.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_ContextMenu.SetProperty
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _GetContextMenu(ByVal psSubmenu As String) As Object
|
|
''' Get the context menu node corresponding with the string in argument
|
|
''' A context menu entry is represented by a set of property values
|
|
''' grouped as a ItemDescriptor entry in above array.
|
|
''' The menu node is stored in a com.cun.star.ItemDescriptor service
|
|
''' If the menu entry exists, it is found in the MenuTree dictionary
|
|
''' If it does not exist, it is created recursively.
|
|
''' Args:
|
|
''' psSubmenu: a string like "A>B"
|
|
''' Returns
|
|
''' A com.sun.star.container.XIndexAccess object
|
|
''' Example
|
|
''' If psSubmenu = "A>B>C>D", and the initial menu container is empty,
|
|
''' - "A", "A>B", "A>B>C", "A>B>C>D" should be created
|
|
''' - the popup menu corresponding with "A>B>C>D" should be returned
|
|
|
|
Dim oContext As Object ' Return value
|
|
Dim vSplit As Variant ' An array as returned by Split()
|
|
Dim sMenu As String ' The left part of psSubmenu
|
|
Dim vMenu As Variant ' Array of property values => com.sun.star.ui.ItemDescriptor
|
|
Dim oLastMenu As Object ' com.sun.star.ui.ItemDescriptor.ItemDescriptorContainer
|
|
Dim oNewMenu As Object ' com.sun.star.ui.ItemDescriptor.ItemDescriptorContainer
|
|
Dim i As Long
|
|
|
|
Set oContext = Nothing
|
|
|
|
Try:
|
|
With ScriptForge.SF_Utils
|
|
If Len(psSubmenu) = 0 Then ' Menu starts at the root
|
|
Set oContext = MenuContainer
|
|
ElseIf MenuTree.Exists(psSubmenu) Then ' Shortcut: if the submenu exists, get it directly
|
|
Set oContext = ._GetPropertyValue(MenuTree.Item(psSubmenu), "ItemDescriptorContainer")
|
|
Else ' Build the tree
|
|
vSplit = Split(psSubmenu, SubmenuChar)
|
|
' Search the successive submenus in the MenuTree dictionary, If not found, create a new entry
|
|
Set oLastMenu = MenuContainer
|
|
For i = 0 To UBound(vSplit)
|
|
sMenu = Join(ScriptForge.SF_Array.Slice(vSplit, 0, i), SubmenuChar)
|
|
If MenuTree.Exists(sMenu) Then
|
|
Set oNewMenu = ._GetPropertyValue(MenuTree.Item(sMenu), "ItemDescriptorContainer")
|
|
Else
|
|
' Insert the new menu tree item at the bottom of the tree branch
|
|
Set oNewMenu = MenuContainer.createInstanceWithContext(GetDefaultContext())
|
|
vMenu = Array( ._MakePropertyValue("Type", com.sun.star.ui.ItemType.DEFAULT) _
|
|
, ._MakePropertyValue("Label", vSplit(i)) _
|
|
, ._MakePropertyValue("CommandURL", "") _
|
|
, ._MakePropertyValue("HelpURL", "") _
|
|
, ._MakePropertyValue("Style", 0) _
|
|
, ._MakePropertyValue("ItemDescriptorContainer", oNewMenu) _
|
|
)
|
|
oLastMenu.insertByIndex(oLastMenu.Count, vMenu)
|
|
MenuTree.Add(sMenu, vMenu)
|
|
End If
|
|
Set oLastMenu = oNewMenu
|
|
Next i
|
|
Set oContext = oLastMenu
|
|
End If
|
|
End With
|
|
|
|
Finally:
|
|
Set _GetContextMenu = oContext
|
|
Exit Function
|
|
End Function ' SFWidgets.SF_ContextMenu._GetContextMenu
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub _Initialize(ByRef poComponent As Object _
|
|
, ByVal psContextMenuName As String _
|
|
, ByVal psSubmenuChar As String _
|
|
)
|
|
''' Complete the object creation process:
|
|
''' - Initialize the dictionary
|
|
''' - initialize the root popup menu
|
|
''' - store the arguments for later use
|
|
''' Args:
|
|
''' Component: the document's component requesting a context menu
|
|
''' ContextMenuName: a private:resource/popupmenu/... reference
|
|
''' SubmenuChar: Delimiter used in menu trees
|
|
|
|
Dim oSupplier As Object ' /singletons/com.sun.star.ui.theModuleUIConfigurationManagerSupplier
|
|
Dim sComponentType As String ' Argument to determine the system config manager, ex. "com.sun.star.text.TextDocument"
|
|
Dim MainConfigManager As Object ' com.sun.star.ui.XUIConfigurationManager
|
|
|
|
Try:
|
|
' Initialize the dictionary
|
|
Set MenuTree = ScriptForge.SF_Services.CreateScriptService("Dictionary", True) ' with case-sensitive comparison of keys
|
|
|
|
' Identify the container of the menu tree
|
|
' The container is taken either from the system configuration manager of from the local (= in document) one
|
|
' It is saved in the local version when the menu is Executed()
|
|
Set oSupplier = ScriptForge.SF_Utils._GetUNOService("ModuleUIConfigurationManagerSupplier")
|
|
sComponentType = ScriptForge.SF_UI._GetConfigurationManager(poComponent)
|
|
Set MainConfigManager = oSupplier.getUIConfigurationManager(sComponentType)
|
|
Set ConfigManager = poComponent.getUIConfigurationManager(sComponentType)
|
|
' Copy from system config manager if not found in local (= in document) one
|
|
If ConfigManager.hasSettings(psContextMenuName) Then
|
|
Set MenuContainer = ConfigManager.getSettings(psContextMenuName, true)
|
|
Else
|
|
Set MenuContainer = MainConfigManager.getSettings(psContextMenuName, true)
|
|
End If
|
|
|
|
' Store the private instance properties
|
|
Set Component = poComponent
|
|
ResourceURL = psContextMenuName
|
|
If Len(psSubmenuChar) > 0 Then SubmenuChar = psSubmenuChar
|
|
|
|
Finally:
|
|
Exit Sub
|
|
End Sub ' SFWidgets.SF_ContextMenu._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.ContextMenu.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_ContextMenu._PropertyGet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _Repr() As String
|
|
''' Convert the SF_ContextMenu instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
|
''' Args:
|
|
''' Return:
|
|
''' "[ContextMenu]: Name, Menu entries
|
|
_Repr = "[ContextMenu]: " & ResourceURL & ", " & SF_String.Represent(MenuTree.Keys())
|
|
|
|
End Function ' SFWidgets.SF_ContextMenu._Repr
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _SplitMenuItem(ByVal psMenuItem As String ) As Variant
|
|
''' Split a menu item given as a string and delimited by the submenu character
|
|
''' Args:
|
|
''' psMenuItem: a string like "A>B>C"
|
|
''' Returns:
|
|
''' An array: [0] = "A>B"
|
|
''' [1] = "C"
|
|
|
|
Dim vReturn(0 To 1) As String ' Return value
|
|
Dim vMenus() As Variant ' Array of menus
|
|
|
|
Try:
|
|
vMenus = Split(psMenuItem, SubmenuChar)
|
|
vReturn(1) = vMenus(UBound(vMenus))
|
|
vReturn(0) = Left(psMenuItem, Len(psMenuItem) - Iif(UBound(vMenus) > 0, Len(SubmenuChar), 0) - Len(vReturn(1)))
|
|
|
|
Finally:
|
|
_SplitMenuItem = vReturn
|
|
End Function ' SFWidgets.SF_ContextMenu._SplitMenuItem
|
|
|
|
REM ============================================ END OF SFWIDGETS.SF_CONTEXTMENU
|
|
</script:module> |