Quelle  SF_ContextMenu.xba   Sprache: unbekannt

<?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 pr replace 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 tools to configure a context menu preset in an open document.
'''  Context menus configured at LibreOffice installation level are not included.
'''  The service provides a mean to
'''   - make temporary additions at the bottom of a context menu
'''   - replace a context menu.
'''  The changes are lost when the document is closed.
'''  The context menu may be emptied, which gives the illusion that the right-click is inactive.
'''
'''  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 local menu to make it visible and active
'''   3. If meaningful, it can be temporarily deactivated with Activate(False)
'''      In that case, the menu defined at LibreOffice level takes the lead.
'''   4. Items can be optionally added, and the menu might be made active again
'''   5, RemoveAllItems(...) optionally removes all standard and all added items
'''   6. 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 DocumentType  As String  ' "Calc", "Writer", ...
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
 DocumentType = ""
 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 ParentDocument() As Variant
''' The ParentDocument property returns a document class (or one of its subclasses) instance
 ParentDocument = _PropertyGet("ParentDocument")
End Property ' SFWidgets.SF_ContextMenu.ParentDocument (get)

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 stored in the document available for execution,
''' or, at the opposite, disable them, depending on the argument.
''' Args:
'''  Enable: When True (default), the local menu stored in the document is made active.
'''   When False, the global menu defined at LibreOffice level takes the precedence.
''' 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( _
     "Activate" _
     , "AddItem" _
     , "Execute" _
     , "RemoveAllItems" _
     )

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( _
     "ParentDocument" _
     , "ShortcutCharacter" _
     , "SubmenuCharacter" _
     )

End Function ' SFWidgets.SF_ContextMenu.Properties

REM -----------------------------------------------------------------------------
Public Sub RemoveAllItems()
''' Remove all items, both
'''  - predefined with Tools + Customize and saved in the document
'''  - added by contextmenu.AddItem()
''' Adding custom items (AddItem) remains possible.
''' This action cannot be reverted except by closing and reopening the document.
''' Example: Associate next Sub with the on-right-click event of a sheet.
'''   => The custom menu appears when right-clicking in column C, otherwise normal behaviour
'''  Sub OnRightClick1(Optional XRange) ' Xrange is a com.sun.star.table.XCellRange
'''  Dim calc, menu, bColumn
'''   Set calc = CreateScriptService("Calc", ThisComponent)
'''   Set menu = calc.ContextMenus("cell")
'''   menu.RemoveAllItems()
'''   bColumn =  ( Len(calc.Intersect("Sheet1.$C:$C", XRange.AbsoluteName)) > 0 )
'''   If bColumn Then
'''    menu.AddItem("A", Script := "vnd.sun.star.script:Standard.Module1.EnterA?language=Basic&location=document")
'''    ...
'''   End If
'''   menu.Activate(bColumn)
'''  End Sub

Dim i As Long

Const cstThisSub = "SFWidgets.ContextMenu.RemoveAllItems"
Const cstSubArgs = ""

Check:
 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)

Try:
 For i = MenuContainer.Count - 1 To 0 Step -1
  MenuContainer.removeByIndex(i)
 Next i

 With ConfigManager
  If .hasSettings(ResourceURL) Then
'   .removeSettings(ResourceURL)
   .replaceSettings(ResourceURL, MenuContainer)
  Else
   .insertSettings(ResourceURL, MenuContainer)
  End If
 End With

Finally:
 SF_Utils._ExitFunction(cstThisSub)
 Exit Sub
Catch:
 GoTo Finally
End Sub   ' SFWidgets.SF_ContextMenu.RemoveAllItems

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 oWindow As Object      ' SF_UI.Window object
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("ParentDocument")
   If Not IsNull(Component) Then
    Set oWindow = ScriptForge.SF_UI._IdentifyWindow(Component)
    If Not IsNull(oWindow) Then Set _PropertyGet = CreateScriptService(oWindow.DocumentType, Component) Else Set _PropertyGet = Nothing
   End If
  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>