1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
|
<?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>
|
