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
|
<?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 ThisComponent
''' 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 oSession As Object ' ScriptForge.SF_Session
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
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Check:
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:
Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
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, ...
If IsNull(oControl) Then
If Not IsNull(ThisComponent) Then Set oControl = ThisComponent.CurrentController.Frame.getContainerWindow()
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>
|
