update
This commit is contained in:
Jane
@@ -0,0 +1,598 @@
|
||||
<?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>
|
||||
@@ -0,0 +1,128 @@
|
||||
<?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_MenuListener" 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 Explicit
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
''' SF_MenuListener
|
||||
''' ===============
|
||||
''' The current module is dedicated to the management of menu events + listeners, triggered by user actions,
|
||||
''' which cannot be defined with the Basic IDE
|
||||
'''
|
||||
''' Concerned listeners:
|
||||
''' com.sun.star.awt.XMenuListener
|
||||
''' allowing a user to select a menu command in user menus preset in the menubar
|
||||
'''
|
||||
''' The described events/listeners are processed by UNO listeners
|
||||
'''
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
REM ============================================================= PRIVATE MEMBERS
|
||||
|
||||
Dim MenuListener As Object ' com.sun.star.awt.XMenuListener
|
||||
|
||||
REM =========================================================== PRIVATE CONSTANTS
|
||||
|
||||
Private Const _MenuListenerPrefix = "_SFMENU_"
|
||||
Private Const _MenuListener = "com.sun.star.awt.XMenuListener"
|
||||
Private Const cstUnoPrefix = ".uno:"
|
||||
Private Const cstScriptArg = ":::"
|
||||
|
||||
REM ================================================================== EXCEPTIONS
|
||||
|
||||
REM ============================================================== PUBLIC METHODS
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Sub SetMenuListener(poSubmenu As Object)
|
||||
''' Arm a menu listener on a submenu
|
||||
''' Args:
|
||||
''' poSubmenu: the targeted submenu
|
||||
|
||||
Try:
|
||||
If IsNull(MenuListener) Then Set MenuListener = CreateUnoListener(_MenuListenerPrefix, _MenuListener)
|
||||
poSubmenu.addMenuListener(MenuListener)
|
||||
|
||||
Finally:
|
||||
Exit Sub
|
||||
End Sub ' SFWidgets.SF_MenuListener.SetMenuListener
|
||||
|
||||
REM ============================================================= PRIVATE METHODS
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Sub _SFMENU_itemSelected(Optional poEvent As Object) ' com.sun.star.awt.MenuEvent
|
||||
''' Execute the command or the script associated with the actually selected item
|
||||
''' When a script, next argument is provided:
|
||||
''' a comma-separated string with 4 components
|
||||
''' - the menu header
|
||||
''' - the name of the selected menu entry (without tilde "~")
|
||||
''' - the numeric identifier of the selected menu entry
|
||||
''' - the new status of the selected menu entry ("0" or "1"). Always "0" for usual items.
|
||||
|
||||
Dim iMenuId As Integer
|
||||
Dim oMenu As Object ' stardiv.Toolkit.VCLXPopupMenu
|
||||
Dim sCommand As String ' Command associated with menu entry
|
||||
Dim bType As Boolean ' True when status is meaningful: item is radio button or checkbox
|
||||
Dim bStatus As Boolean ' Status of the menu item, always False for normal items
|
||||
Dim oFrame As Object ' com.sun.star.comp.framework.Frame
|
||||
Dim oDispatcher As Object ' com.sun.star.frame.DispatchHelper
|
||||
Dim vScript As Variant ' Split command in script/argument
|
||||
Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session")
|
||||
Dim oArgs() As new com.sun.star.beans.PropertyValue
|
||||
|
||||
On Local Error GoTo Catch ' Avoid stopping event scripts
|
||||
|
||||
Try:
|
||||
iMenuId = poEvent.MenuId
|
||||
oMenu = poEvent.Source
|
||||
|
||||
With oMenu
|
||||
' Collect command (script or menu command) and status radiobuttons and checkboxes
|
||||
sCommand = .getCommand(iMenuId)
|
||||
bStatus = .isItemChecked(iMenuId)
|
||||
End With
|
||||
|
||||
If Len(sCommand) > 0 Then
|
||||
Set oFrame = StarDesktop.ActiveFrame ' A menu has been clicked necessarily in the current window
|
||||
If Left(sCommand, Len(cstUnoPrefix)) = cstUnoPrefix Then
|
||||
' Execute uno command
|
||||
Set oDispatcher = ScriptForge.SF_Utils._GetUNOService("DispatchHelper")
|
||||
oDispatcher.executeDispatch(oFrame, sCommand, "", 0, oArgs())
|
||||
oFrame.activate()
|
||||
Else
|
||||
' Execute script
|
||||
vScript = Split(sCommand, cstScriptArg)
|
||||
oSession._ExecuteScript(vScript(0), vScript(1) & "," & Iif(bStatus, "1", "0")) ' Return value is ignored
|
||||
End If
|
||||
End If
|
||||
|
||||
Finally:
|
||||
Exit Sub
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Sub ' SFWidgets.SF_MenuListener._SFMENU_itemSelected
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Sub _SFMENU_itemHighlighted(Optional poEvent As Object) ' com.sun.star.awt.MenuEvent
|
||||
Exit Sub
|
||||
End Sub ' SFWidgets.SF_MenuListener._SFMENU_itemHighlighted
|
||||
|
||||
Sub _SFMENU_itemActivated(Optional poEvent As Object) ' com.sun.star.awt.MenuEvent
|
||||
Exit Sub
|
||||
End Sub ' SFWidgets.SF_MenuListener._SFMENU_itemActivated
|
||||
|
||||
Sub _SFMENU_itemDeactivated(Optional poEvent As Object) ' com.sun.star.awt.MenuEvent
|
||||
Exit Sub
|
||||
End Sub ' SFWidgets.SF_MenuListener._SFMENU_itemDeactivated
|
||||
|
||||
Sub _SFMENU_disposing(Optional poEvent As Object) ' com.sun.star.awt.MenuEvent
|
||||
Exit Sub
|
||||
End Sub ' SFWidgets.SF_MenuListener._SFMENU_disposing
|
||||
|
||||
REM ============================================ END OF SFDIALOGS.SF_DIALOGLISTENER
|
||||
</script:module>
|
||||
@@ -0,0 +1,801 @@
|
||||
<?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_PopupMenu" 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_PopupMenu
|
||||
''' ============
|
||||
''' Display a popup menu anywhere and any time
|
||||
'''
|
||||
''' A popup menu is usually triggered by a mouse action (typically a right-click) on a dialog, a form
|
||||
''' or one of their controls. In this case the menu will be displayed below the clicked area.
|
||||
''' When triggered by other events, including in the normal flow of a user script, the script should
|
||||
''' provide the coordinates of the topleft edge of the menu versus the actual component.
|
||||
'''
|
||||
''' The menu is described from top to bottom. Each menu item receives a numeric and a string identifier.
|
||||
''' The Execute() method returns the item selected by the user.
|
||||
'''
|
||||
''' 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 PopupMenu service
|
||||
''' ShortcutCharacter: the underline access key character
|
||||
''' Default = "~"
|
||||
'''
|
||||
''' Service invocation:
|
||||
''' Sub OpenMenu(Optional poMouseEvent As Object)
|
||||
''' Dim myMenu As Object
|
||||
''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poMouseEvent, , , ">>") ' Usual case
|
||||
''' ' or
|
||||
''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", , X, Y, " | ") ' Use X and Y coordinates to place the menu
|
||||
'''
|
||||
''' Menus and submenus
|
||||
''' To create a popup 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
|
||||
'''
|
||||
''' Example 1: simulate a subset of the View menu in the menubar of the Basic IDE
|
||||
''' Sub OpenMenu(Optional poMouseEvent As Object)
|
||||
''' Dim myMenu As Object, vChoice As Variant
|
||||
''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poMouseEvent)
|
||||
''' With myMenu
|
||||
''' .AddCheckBox("View>Toolbars>Dialog")
|
||||
''' .AddCheckBox("View>Toolbars>Find", Status := True)
|
||||
''' .AddCheckBox("View>Status Bar", Status := True)
|
||||
''' .AddItem("View>Full Screen", Name := "FULLSCREEN")
|
||||
''' vChoice = .Execute(False) ' When 1st checkbox is clicked, return "Dialog"
|
||||
''' ' When last item is clicked, return "FULLSCREEN"
|
||||
''' .Dispose()
|
||||
''' End With
|
||||
'''
|
||||
''' Example 2: jump to another sheet of a Calc document
|
||||
''' ' Link next Sub to the "Mouse button released" event of a form control of a Calc sheet
|
||||
''' Sub JumpToSheet(Optional poEvent As Object)
|
||||
''' Dim myMenu As Object, sChoice As String, myDoc As Object, vSheets As Variant, sSheet As String
|
||||
''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poEvent)
|
||||
''' Set myDoc = CreateScriptService("Calc", ThisComponent)
|
||||
''' vSheets = myDoc.Sheets
|
||||
''' For Each sSheet In vSheets
|
||||
''' myMenu.AddItem(sSheet)
|
||||
''' Next sSheet
|
||||
''' sChoice = myMenu.Execute(False) ' Return sheet name, not sheet index
|
||||
''' If sChoice <> "" Then myDoc.Activate(sChoice)
|
||||
''' myDoc.Dispose()
|
||||
''' myMenu.Dispose()
|
||||
''' End Sub
|
||||
'''
|
||||
'''
|
||||
''' Detailed user documentation:
|
||||
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_popupmenu.html?DbPAR=BASIC
|
||||
'''
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
REM ================================================================== EXCEPTIONS
|
||||
|
||||
REM ============================================================= PRIVATE MEMBERS
|
||||
|
||||
Private [Me] As Object
|
||||
Private ObjectType As String ' Must be POPUPMENU
|
||||
Private ServiceName As String
|
||||
|
||||
|
||||
' Menu descriptors
|
||||
Private MenuTree As Variant ' Dictionary treename - XPopupMenu pair
|
||||
Private MenuIdentification As Variant ' Dictionary item ID - item name
|
||||
Private SubmenuChar As String ' Delimiter in menu trees
|
||||
Private MenuRoot As Object ' stardiv.vcl.PopupMenu or com.sun.star.awt.XPopupMenu
|
||||
Private LastItem As Integer ' Every item has its entry number. This is the last one
|
||||
Private Rectangle As Object ' com.sun.star.awt.Rectangle
|
||||
Private PeerWindow As Object ' com.sun.star.awt.XWindowPeer
|
||||
Private MenubarMenu As Boolean ' When True, the actual popup menu depends on a menubar item
|
||||
|
||||
REM ============================================================ MODULE CONSTANTS
|
||||
|
||||
Private Const _UnderlineAccessKeyChar = "~"
|
||||
Private Const _DefaultSubmenuChar = ">"
|
||||
Private Const _SeparatorChar = "---"
|
||||
Private Const _IconsDirectory = "private:graphicrepository/" ' Refers to <install folder>/share/config/images_*.zip.
|
||||
Private Const cstUnoPrefix = ".uno:"
|
||||
Private Const cstNormal = "N"
|
||||
Private Const cstCheck = "C"
|
||||
Private Const cstRadio = "R"
|
||||
|
||||
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
Set [Me] = Nothing
|
||||
ObjectType = "POPUPMENU"
|
||||
ServiceName = "SFWidgets.PopupMenu"
|
||||
Set MenuTree = Nothing
|
||||
Set MenuIdentification = Nothing
|
||||
SubmenuChar = _DefaultSubmenuChar
|
||||
Set MenuRoot = Nothing
|
||||
LastItem = 0
|
||||
Set Rectangle = Nothing
|
||||
Set PeerWindow = Nothing
|
||||
MenubarMenu = False
|
||||
End Sub ' SFWidgets.SF_PopupMenu Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
Call Class_Initialize()
|
||||
End Sub ' SFWidgets.SF_PopupMenu Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function Dispose() As Variant
|
||||
If Not IsNull(MenuTree) Then Set MenuTree = MenuTree.Dispose()
|
||||
If Not IsNull(MenuIdentification) Then Set MenuIdentification = MenuIdentification.Dispose()
|
||||
Call Class_Terminate()
|
||||
Set Dispose = Nothing
|
||||
End Function ' SFWidgets.SF_PopupMenu 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_PopupMenu.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_PopupMenu.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 _
|
||||
) 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 the "SeparatorCharacter", a line separator is inserted
|
||||
''' Name: The name to be returned by the Execute() method if this item is clicked
|
||||
''' 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
|
||||
''' Returns:
|
||||
''' The numeric identification of the newly inserted item
|
||||
''' Examples:
|
||||
''' Dim myMenu As Object, iId As Integer
|
||||
''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poEvent)
|
||||
''' iId = myMenu.AddCheckBox("Menu top>Checkbox item", Status := True)
|
||||
|
||||
Dim iId As Integer ' Return value
|
||||
|
||||
Const cstThisSub = "SFWidgets.PopupMenu.AddCheckBox"
|
||||
Const cstSubArgs = "MenuItem, [Name=""""], [Status=False], [Icon=""""], [Tooltip=""""]"
|
||||
|
||||
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 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
|
||||
End If
|
||||
|
||||
Try:
|
||||
iId = _AddItem(MenuItem, Name, cstCheck, Status, Icon, Tooltip)
|
||||
|
||||
Finally:
|
||||
AddCheckBox = iId
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFWidgets.SF_PopupMenu.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 _
|
||||
) 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 to be returned by the Execute() method if this item is clicked
|
||||
''' 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
|
||||
''' Returns:
|
||||
''' The numeric identification of the newly inserted item
|
||||
''' Examples:
|
||||
''' Dim myMenu As Object, iId As Integer
|
||||
''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poEvent)
|
||||
''' iId = myMenu.AddItem("Menu top>Normal item", Icon := "cmd.sc_cut.png")
|
||||
|
||||
Dim iId As Integer ' Return value
|
||||
|
||||
Const cstThisSub = "SFWidgets.PopupMenu.AddItem"
|
||||
Const cstSubArgs = "MenuItem, [Name=""""], [Icon=""""], [Tooltip=""""]"
|
||||
|
||||
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 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
|
||||
End If
|
||||
|
||||
Try:
|
||||
iId = _AddItem(MenuItem, Name, cstNormal, False, Icon, Tooltip)
|
||||
|
||||
Finally:
|
||||
AddItem = iId
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFWidgets.SF_PopupMenu.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 _
|
||||
) 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 to be returned by the Execute() method if this item is clicked
|
||||
''' 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
|
||||
''' Returns:
|
||||
''' The numeric identification of the newly inserted item
|
||||
''' Examples:
|
||||
''' Dim myMenu As Object, iId As Integer
|
||||
''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poEvent)
|
||||
''' iId = myMenu.AddRadioButton("Menu top>Radio item", Status := True)
|
||||
|
||||
Dim iId As Integer ' Return value
|
||||
|
||||
Const cstThisSub = "SFWidgets.PopupMenu.AddRadioButton"
|
||||
Const cstSubArgs = "MenuItem, [Name=""""], [Status=False], [Icon=""""], [Tooltip=""""]"
|
||||
|
||||
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 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
|
||||
End If
|
||||
|
||||
Try:
|
||||
iId = _AddItem(MenuItem, Name, cstRadio, Status, Icon, Tooltip)
|
||||
|
||||
Finally:
|
||||
AddRadioButton = iId
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFWidgets.SF_PopupMenu.AddRadioButton
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function Execute(Optional ByVal ReturnId As Variant) As Variant
|
||||
''' Display the popup menu and return the menu item clicked by the user
|
||||
''' Args:
|
||||
''' ReturnId: When True (default), return the unique ID of the clicked item, otherwise return its name
|
||||
''' Returns:
|
||||
''' The numeric identification of clicked item or its name
|
||||
''' The returned value is 0 or "" (depending on ReturnId) when the menu is cancelled
|
||||
''' Examples:
|
||||
''' Sub OpenMenu(Optional poMouseEvent As Object)
|
||||
''' Dim myMenu As Object, vChoice As Variant
|
||||
''' Set myMenu = CreateScriptService("SFWidgets.PopupMenu", poMouseEvent)
|
||||
''' With myMenu
|
||||
''' .AddCheckBox("View>Toolbars>Dialog")
|
||||
''' .AddCheckBox("View>Toolbars>Find", STatus := True)
|
||||
''' .AddCheckBox("View>Status Bar", STatus := True)
|
||||
''' .AddItem("View>Full Screen", Name := "FULLSCREEN")
|
||||
''' vChoice = .Execute(False) ' When 1st checkbox is clicked, return "Dialog"
|
||||
''' ' When last item is clicked, return "FULLSCREEN"
|
||||
''' End With
|
||||
|
||||
Dim vMenuItem As Variant ' Return value
|
||||
|
||||
Const cstThisSub = "SFWidgets.PopupMenu.Execute"
|
||||
Const cstSubArgs = "[ReturnId=True]"
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
vMenuItem = 0
|
||||
|
||||
Check:
|
||||
If IsMissing(ReturnId) Or IsEmpty(ReturnId) Then ReturnId = True
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not ScriptForge.SF_Utils._Validate(ReturnId, "ReturnId", ScriptForge.V_BOOLEAN) Then GoTo Catch
|
||||
End If
|
||||
If Not ReturnId Then vMenuItem = ""
|
||||
|
||||
Try:
|
||||
vMenuItem = MenuRoot.Execute(PeerWindow, Rectangle, com.sun.star.awt.PopupMenuDirection.EXECUTE_DEFAULT)
|
||||
If Not ReturnId Then vMenuItem = MenuIdentification.Item(CStr(vMenuItem))
|
||||
|
||||
Finally:
|
||||
Execute = vMenuItem
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFWidgets.SF_PopupMenu.Execute
|
||||
|
||||
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.PopupMenu.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_PopupMenu.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" _
|
||||
, "Execute" _
|
||||
)
|
||||
|
||||
End Function ' SFWidgets.SF_PopupMenu.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_PopupMenu.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.PopupMenu.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_PopupMenu.SetProperty
|
||||
|
||||
REM =========================================================== PRIVATE FUNCTIONS
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _AddItem(ByVal MenuItem As String _
|
||||
, ByVal Name As String _
|
||||
, ByVal ItemType As String _
|
||||
, ByVal Status As Boolean _
|
||||
, ByVal Icon As String _
|
||||
, ByVal Tooltip As String _
|
||||
, Optional ByVal Command As String _
|
||||
) 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 the "SeparatorCharacter", a line separator is inserted
|
||||
''' Name: The name to be returned by the Execute() method if this item is clicked
|
||||
''' Default = the last component of MenuItem
|
||||
''' ItemType: "N"(ormal, "C"(heck) or "R"(adio)
|
||||
''' Status: when True the item is selected
|
||||
''' 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: only for menubar menus
|
||||
''' Either a uo command like ".uno:About"
|
||||
''' or a script to be run: script URI ::: string argument to be passed to the script
|
||||
''' Returns:
|
||||
''' The numeric identification of the newly inserted item
|
||||
|
||||
Dim iId As Integer ' Return value
|
||||
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 oImage As Object ' com.sun.star.graphic.XGraphic
|
||||
Dim sCommand As String ' Alias of Command completed with arguments
|
||||
Const cstCommandSep = ","
|
||||
|
||||
On Local Error GoTo Catch
|
||||
iId = 0
|
||||
If IsMissing(Command) Then Command = ""
|
||||
|
||||
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 = _GetPopupMenu(sMenu) ' Run through the upper menu tree and retain the last branch
|
||||
|
||||
' Insert the new item
|
||||
LastItem = LastItem + 1
|
||||
sName = vSplit(1)
|
||||
|
||||
With oMenu
|
||||
If sName = _SeparatorChar Then
|
||||
.insertSeparator(-1)
|
||||
Else
|
||||
Select Case ItemType
|
||||
Case cstNormal
|
||||
.insertItem(LastItem, sName, 0, -1)
|
||||
Case cstCheck
|
||||
.insertItem(LastItem, sName, com.sun.star.awt.MenuItemStyle.CHECKABLE + com.sun.star.awt.MenuItemStyle.AUTOCHECK, -1)
|
||||
.checkItem(LastItem, Status)
|
||||
Case cstRadio
|
||||
.insertItem(LastItem, sName, com.sun.star.awt.MenuItemStyle.RADIOCHECK + com.sun.star.awt.MenuItemStyle.AUTOCHECK, -1)
|
||||
.checkItem(LastItem, Status)
|
||||
End Select
|
||||
|
||||
' Store the ID - Name relation
|
||||
If Len(Name) = 0 Then Name = Replace(sName, _UnderlineAccessKeyChar, "")
|
||||
MenuIdentification.Add(CStr(LastItem), Name)
|
||||
|
||||
' Add the icon when relevant
|
||||
If Len(Icon) > 0 Then
|
||||
Set oImage = _GetImageFromUrl(_IconsDirectory & Icon)
|
||||
If Not IsNull(oImage) Then .setItemImage(LastItem, oImage, False)
|
||||
End If
|
||||
|
||||
' Add the tooltip when relevant
|
||||
If Len(Tooltip) > 0 Then .setTipHelpText(LastItem, Tooltip)
|
||||
|
||||
' Add the command: UNO command or script to run - menubar menus only
|
||||
If Len(Command) > 0 Then
|
||||
If Left(Command, Len(cstUnoPrefix)) = cstUnoPrefix Then
|
||||
sCommand = Command
|
||||
Else
|
||||
sCommand = Command & cstCommandSep & Name & cstCommandSep & CStr(LastItem)
|
||||
End If
|
||||
.setCommand(LastItem, sCommand)
|
||||
End If
|
||||
End If
|
||||
End With
|
||||
|
||||
iId = LastItem
|
||||
|
||||
Finally:
|
||||
_AddItem = iId
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFWidgets.SF_PopupMenu._AddItem
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _GetImageFromURL(ByVal psUrl as String) As Object
|
||||
''' Returns a com.sun.star.graphic.XGraphic instance based on the given URL
|
||||
''' The returned object is intended to be inserted as an icon in the popup menu
|
||||
''' Derived from "Useful Macro Information For OpenOffice" By Andrew Pitonyak
|
||||
|
||||
Dim vMediaProperties As Variant ' Array of com.sun.star.beans.PropertyValue
|
||||
Dim oGraphicProvider As Object ' com.sun.star.graphic.GraphicProvider
|
||||
Dim oImage As Object ' Return value
|
||||
|
||||
On Local Error GoTo Catch ' Ignore errors
|
||||
Set oImage = Nothing
|
||||
|
||||
Try:
|
||||
' Create graphic provider instance to load images from files.
|
||||
Set oGraphicProvider = CreateUnoService("com.sun.star.graphic.GraphicProvider")
|
||||
|
||||
' Set the URL property so graphic provider is able to load the image
|
||||
Set vMediaProperties = Array(ScriptForge.SF_Utils._MakePropertyValue("URL", psURL))
|
||||
|
||||
' Retrieve the com.sun.star.graphic.XGraphic instance
|
||||
Set oImage = oGraphicProvider.queryGraphic(vMediaProperties)
|
||||
|
||||
Finally:
|
||||
Set _GetImageFromUrl = oImage
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFWidgets.SF_PopupMenu._GetImageFromUrl
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _GetPopupMenu(ByVal psSubmenu As String) As Object
|
||||
''' Get the com.sun.star.awt.XPopupMenu object corresponding with the string in argument
|
||||
''' If the menu 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.awt.XpopupMenu object
|
||||
''' Example
|
||||
''' If psSubmenu = "A>B>C>D", and only the root menu exists,
|
||||
''' - "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 oPopup As Object ' Return value
|
||||
Dim vSplit As Variant ' An array as returned by _SplitMenuItem()
|
||||
Dim sMenu As String ' The left part of psSubmenu
|
||||
Dim oMenu As Object ' com.sun.star.awt.XpopupMenu
|
||||
Dim oLastMenu As Object ' com.sun.star.awt.XpopupMenu
|
||||
Dim i As Long
|
||||
|
||||
Set oPopup = Nothing
|
||||
Set oLastMenu = MenuRoot
|
||||
Try:
|
||||
If Len(psSubmenu) = 0 Then ' Menu starts at the root
|
||||
Set oPopup = MenuRoot
|
||||
ElseIf MenuTree.Exists(psSubmenu) Then ' Shortcut: if the submenu exists, get it directly
|
||||
Set oPopup = MenuTree.Item(psSubmenu)
|
||||
Else ' Build the tree
|
||||
vSplit = Split(psSubmenu, SubmenuChar)
|
||||
' Search the successive submenus in the MenuTree dictionary, If not found, create a new entry
|
||||
For i = 0 To UBound(vSplit)
|
||||
sMenu = Join(ScriptForge.SF_Array.Slice(vSplit, 0, i), SubmenuChar)
|
||||
If MenuTree.Exists(sMenu) Then
|
||||
Set oLastMenu = MenuTree.Item(sMenu)
|
||||
Else
|
||||
' Insert the new menu tree item
|
||||
LastItem = LastItem + 1
|
||||
oLastMenu.insertItem(LastItem, vSplit(i), 0, -1)
|
||||
Set oMenu = CreateUnoService("stardiv.vcl.PopupMenu")
|
||||
If MenubarMenu Then SFWidgets.SF_MenuListener.SetMenuListener(oMenu)
|
||||
MenuTree.Add(sMenu, oMenu)
|
||||
oLastMenu.setPopupMenu(LastItem, oMenu)
|
||||
Set oLastMenu = oMenu
|
||||
End If
|
||||
Next i
|
||||
Set oPopup = oLastMenu
|
||||
End If
|
||||
|
||||
Finally:
|
||||
Set _GetPopupMenu = oPopup
|
||||
Exit Function
|
||||
End Function ' SFWidgets.SF_PopupMenu._GetPopupMenu
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Sub _Initialize(ByRef poPeer As Object _
|
||||
, plXPos As Long _
|
||||
, plYPos As Long _
|
||||
, psSubmenuChar As String _
|
||||
)
|
||||
''' Complete the object creation process:
|
||||
''' - Initialize the dictionaries
|
||||
''' - initialize the root popup menu
|
||||
''' - initialize the display area
|
||||
''' - store the arguments for later use
|
||||
''' Args:
|
||||
''' poPeer: a peer window
|
||||
''' plXPos, plYPos: the coordinates
|
||||
|
||||
Try:
|
||||
' Initialize the dictionaries
|
||||
With ScriptForge.SF_Services
|
||||
Set MenuTree = .CreateScriptService("Dictionary")
|
||||
Set MenuIdentification = .CreateScriptService("Dictionary")
|
||||
End With
|
||||
|
||||
' Initialize the root of the menu tree
|
||||
Set MenuRoot = CreateUnoService("stardiv.vcl.PopupMenu")
|
||||
|
||||
' Setup the display area
|
||||
Set Rectangle = New com.sun.star.awt.Rectangle
|
||||
Rectangle.X = plXPos
|
||||
Rectangle.Y = plYPos
|
||||
|
||||
' Keep the targeted window
|
||||
Set PeerWindow = poPeer
|
||||
|
||||
' Store the submenu character
|
||||
If Len(psSubmenuChar) > 0 Then SubmenuChar = psSubmenuChar
|
||||
|
||||
Finally:
|
||||
Exit Sub
|
||||
End Sub ' SFWidgets.SF_PopupMenu._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.PopupMenu.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_PopupMenu._PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _Repr() As String
|
||||
''' Convert the SF_PopupMenu instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
||||
''' Args:
|
||||
''' Return:
|
||||
''' "[PopupMenu]: Name, Type (dialogname)
|
||||
_Repr = "[PopupMenu]: " & SF_String.Represent(MenuTree.Keys()) & ", " & SF_String.Represent(MenuIdentification.Items())
|
||||
|
||||
End Function ' SFWidgets.SF_PopupMenu._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_PopupMenu._SplitMenuItem
|
||||
|
||||
REM ============================================ END OF SFWIDGETS.SF_POPUPMENU
|
||||
</script:module>
|
||||
@@ -0,0 +1,190 @@
|
||||
<?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_Register" 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 Explicit
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
''' SF_Register
|
||||
''' ===========
|
||||
''' The ScriptForge framework includes
|
||||
''' the master ScriptForge library
|
||||
''' a number of "associated" libraries SF*
|
||||
''' any user/contributor extension wanting to fit into the framework
|
||||
'''
|
||||
''' The main methods in this module allow the current library to cling to ScriptForge
|
||||
''' - RegisterScriptServices
|
||||
''' Register the list of services implemented by the current library
|
||||
''' - _NewMenu
|
||||
''' Create a new menu service instance.
|
||||
''' Called from SFDocuments services with CreateMenu()
|
||||
''' - _NewPopupMenu
|
||||
''' Create a new popup menu service instance.
|
||||
''' Called from CreateScriptService()
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
REM ================================================================== EXCEPTIONS
|
||||
|
||||
REM ================================================================= DEFINITIONS
|
||||
|
||||
REM ============================================================== PUBLIC METHODS
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Sub RegisterScriptServices() As Variant
|
||||
''' Register into ScriptForge the list of the services implemented by the current library
|
||||
''' Each library pertaining to the framework must implement its own version of this method
|
||||
'''
|
||||
''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods
|
||||
''' with 2 arguments:
|
||||
''' ServiceName: the name of the service as a case-insensitive string
|
||||
''' ServiceReference: the reference as an object
|
||||
''' If the reference refers to a module, then return the module as an object:
|
||||
''' GlobalScope.Library.Module
|
||||
''' If the reference is a class instance, then return a string referring to the method
|
||||
''' containing the New statement creating the instance
|
||||
''' "libraryname.modulename.function"
|
||||
|
||||
With GlobalScope.ScriptForge.SF_Services
|
||||
.RegisterService("Menu", "SFWidgets.SF_Register._NewMenu") ' Reference to the function initializing the service
|
||||
.RegisterService("PopupMenu", "SFWidgets.SF_Register._NewPopupMenu") ' id.
|
||||
End With
|
||||
|
||||
End Sub ' SFWidgets.SF_Register.RegisterScriptServices
|
||||
|
||||
REM =========================================================== PRIVATE FUNCTIONS
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _NewMenu(Optional ByVal pvArgs As Variant) As Object
|
||||
''' Create a new instance of the SF_Menu class
|
||||
''' [called internally from SFDocuments.Document.CreateMenu() ONLY]
|
||||
''' Args:
|
||||
''' Component: the com.sun.star.lang.XComponent where to find the menubar to plug the new menu in
|
||||
''' Header: the name/header of the menu
|
||||
''' Before: the place where to put the new menu on the menubar (string or number >= 1)
|
||||
''' When not found => last position
|
||||
''' SubmenuChar: the delimiter used in menu trees. Default = ">"
|
||||
''' Returns: the instance or Nothing
|
||||
|
||||
Dim oMenu As Object ' Return value
|
||||
Dim oComponent As Object ' The document or formdocument's component - com.sun.star.lang.XComponent
|
||||
Dim sHeader As String ' Menu header
|
||||
Dim sBefore As String ' Position of menu as a string
|
||||
Dim iBefore As Integer ' as a number
|
||||
Dim sSubmenuChar As String ' Delimiter in menu trees
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
Set oMenu = Nothing
|
||||
|
||||
Check:
|
||||
' Types and number of arguments are not checked because internal call only
|
||||
Set oComponent = pvArgs(0)
|
||||
sHeader = pvArgs(1)
|
||||
Select Case VarType(pvArgs(2))
|
||||
Case V_STRING : sBefore = pvArgs(2)
|
||||
iBefore = 0
|
||||
Case Else : sBefore = ""
|
||||
iBefore = pvArgs(2)
|
||||
End Select
|
||||
sSubmenuChar = pvArgs(3)
|
||||
|
||||
Try:
|
||||
If Not IsNull(oComponent) Then
|
||||
Set oMenu = New SF_Menu
|
||||
With oMenu
|
||||
Set .[Me] = oMenu
|
||||
._Initialize(oComponent, sHeader, sBefore, iBefore, sSubmenuChar)
|
||||
End With
|
||||
End If
|
||||
|
||||
Finally:
|
||||
Set _NewMenu = oMenu
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFWidgets.SF_Register._NewMenu
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _NewPopupMenu(Optional ByVal pvArgs As Variant) As Object
|
||||
''' Create a new instance of the SF_PopupMenu class
|
||||
''' Args:
|
||||
''' Event: a mouse event
|
||||
''' If the event has no source or is not a mouse event, the menu is displayed above the actual window
|
||||
''' X, Y: forced coordinates
|
||||
''' SubmenuChar: Delimiter used in menu trees
|
||||
''' Returns: the instance or Nothing
|
||||
|
||||
Dim oMenu As Object ' Return value
|
||||
Dim Event As Variant ' Mouse event
|
||||
Dim X As Long ' Mouse click coordinates
|
||||
Dim Y As Long
|
||||
Dim SubmenuChar As String ' Delimiter in menu trees
|
||||
Dim vUno As Variant ' UNO type split into an array
|
||||
Dim sEventType As String ' Event type, must be "MouseEvent"
|
||||
Dim oControl As Object ' The dialog or form control view which triggered the event
|
||||
Dim oWindow As Object ' ui.Window type
|
||||
Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session")
|
||||
Dim oUi As Object : Set oUi = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI")
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
|
||||
Check:
|
||||
' Check and get arguments, their number may vary
|
||||
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
|
||||
If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs)
|
||||
If UBound(pvArgs) >= 0 Then Event = pvArgs(0) Else Event = Nothing
|
||||
If IsEmpty(Event) Then Event = Nothing
|
||||
If UBound(pvArgs) >= 1 Then X = pvArgs(1) Else X = 0
|
||||
If UBound(pvArgs) >= 2 Then Y = pvArgs(2) Else Y = 0
|
||||
If UBound(pvArgs) >= 3 Then SubmenuChar = pvArgs(3) Else SubmenuChar = ""
|
||||
If Not ScriptForge.SF_Utils._Validate(Event, "Event", ScriptForge.V_OBJECT) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(X, "X", ScriptForge.V_NUMERIC) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(Y, "Y", ScriptForge.V_NUMERIC) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally
|
||||
Set oMenu = Nothing
|
||||
|
||||
Try:
|
||||
' Find and identify the control that triggered the popup menu
|
||||
Set oControl = Nothing
|
||||
If Not IsNull(Event) Then
|
||||
' Determine the X, Y coordinates
|
||||
vUno = Split(oSession.UnoObjectType(Event), ".")
|
||||
sEventType = vUno(UBound(vUno))
|
||||
If UCase(sEventType) = "MOUSEEVENT" Then
|
||||
X = Event.X
|
||||
Y = Event.Y
|
||||
' Determine the window peer target
|
||||
If oSession.HasUnoProperty(Event, "Source") Then Set oControl = Event.Source.Peer
|
||||
End If
|
||||
End If
|
||||
' If not a mouse event, if no control, find what can be decent alternatives: (a menu header in) the actual window
|
||||
If IsNull(oControl) Then
|
||||
Set oWindow = oUi._IdentifyWindow(StarDesktop.getCurrentComponent()) ' A menu has been clicked necessarily in the current window
|
||||
With oWindow
|
||||
If Not IsNull(.Frame) Then Set oControl = .Frame.getContainerWindow()
|
||||
End With
|
||||
End If
|
||||
|
||||
If Not IsNull(oControl) Then
|
||||
Set oMenu = New SF_PopupMenu
|
||||
With oMenu
|
||||
Set .[Me] = oMenu
|
||||
._Initialize(oControl, X, Y, SubmenuChar)
|
||||
End With
|
||||
Else
|
||||
Set oMenu = Nothing
|
||||
End If
|
||||
|
||||
Finally:
|
||||
Set _NewPopupMenu = oMenu
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFWidgets.SF_Register._NewPopupMenu
|
||||
|
||||
REM ============================================== END OF SFWidgets.SF_REGISTER
|
||||
</script:module>
|
||||
@@ -0,0 +1,26 @@
|
||||
<?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="__License" script:language="StarBasic" script:moduleType="normal">
|
||||
''' Copyright 2019-2022 Jean-Pierre LEDURE, Rafael LIMA, Alain ROMEDENNE
|
||||
|
||||
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 =======================================================================================================================
|
||||
|
||||
''' ScriptForge is distributed in the hope that it will be useful,
|
||||
''' but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
''' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
''' ScriptForge is free software; you can redistribute it and/or modify it under the terms of either (at your option):
|
||||
|
||||
''' 1) The Mozilla Public License, v. 2.0. If a copy of the MPL was not
|
||||
''' distributed with this file, you can obtain one at http://mozilla.org/MPL/2.0/ .
|
||||
|
||||
''' 2) The GNU Lesser General Public License as published by
|
||||
''' the Free Software Foundation, either version 3 of the License, or
|
||||
''' (at your option) any later version. If a copy of the LGPL was not
|
||||
''' distributed with this file, see http://www.gnu.org/licenses/ .
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,3 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="SFWidgets" library:readonly="false" library:passwordprotected="false"/>
|
||||
@@ -0,0 +1,9 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="SFWidgets" library:readonly="false" library:passwordprotected="false">
|
||||
<library:element library:name="__License"/>
|
||||
<library:element library:name="SF_Register"/>
|
||||
<library:element library:name="SF_PopupMenu"/>
|
||||
<library:element library:name="SF_Menu"/>
|
||||
<library:element library:name="SF_MenuListener"/>
|
||||
</library:library>
|
||||
Reference in New Issue
Block a user