| blob | f08a6ad7b45d46a72e63a9d8fe444e60670ca0b8 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Dialog" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === The SFDialogs library is one of the associated libraries. ===
6 REM === Full documentation is available on https://help.libreoffice.org/ ===
7 REM =======================================================================================================================
9 Option Compatible
10 Option ClassModule
12 Option Explicit
14 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
15 ''' SF_Dialog
16 ''' =========
17 ''' Management of dialogs. They may be defined with the Basic IDE or built from scratch
18 ''' Each instance of the current class represents a single dialog box displayed to the user
19 '''
20 ''' A dialog box can be displayed in modal or in non-modal modes
21 '''
22 ''' In modal mode, the box is displayed and the execution of the macro process is suspended
23 ''' until one of the OK or Cancel buttons is pressed. In the meantime, other user actions
24 ''' executed on the box can trigger specific actions.
25 '''
26 ''' In non-modal mode, the dialog box is "floating" on the user desktop and the execution
27 ''' of the macro process continues normally
28 ''' A dialog box disappears from memory after its explicit termination.
29 '''
30 ''' Service invocation and usage:
31 '''
32 ''' 1) when the dialog exists in some dialog libraries (= pre-defined with the Basic IDE):
33 ''' Dim myDialog As Object, lButton As Long
34 ''' Set myDialog = CreateScriptService("SFDialogs.Dialog", Container, Library, DialogName)
35 ''' ' Args:
37 ''' ' A window name (see its definition in the ScriptForge.UI service)
38 ''' ' "" (default) = the current document
39 ''' ' Library: The (case-sensitive) name of a library contained in the container
41 ''' ' DialogName: a case-sensitive string designating the dialog where it is about
42 ''' ' ... Initialize controls ...
44 ''' If lButton = myDialog.OKBUTTON Then
45 ''' ' ... Process controls and do what is needed
46 ''' End If
47 ''' myDialog.Terminate()
48 '''
50 ''' Dim myDialog As Object, oButton As Object lExec As Long
51 ''' Set myDialog = CreateScriptService("SFDialogs.NewDialog", DialogName, Place)
52 ''' ' Args:
53 ''' ' DialogName: a case-sensitive string designating the dialog
54 ''' Place: either
56 ''' - a com.sun.star.awt.Rectangle [X, Y, Width, Height]
58 ''' ' ... Create controls with the CreateXXX(...) methods ..., e.g.
59 ''' Set oButton = myDialog.CreateButton("OKButton", Place := Array(100, 100, 20, 10), Push := "OK")
61 ''' If lExec = myDialog.OKBUTTON Then
62 ''' ' ... Process controls and do what is needed
63 ''' End If
64 ''' myDialog.Terminate()
65 '''
66 '''
67 ''' Detailed user documentation:
68 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_dialog.html?DbPAR=BASIC
69 '''
70 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
72 REM ================================================================== EXCEPTIONS
78 REM ============================================================= PRIVATE MEMBERS
80 Private [Me] As Object
81 Private [_Parent] As Object
82 Private ObjectType As String ' Must be DIALOG
83 Private ServiceName As String
85 ' Dialog location
86 Private _Container As String
87 Private _Library As String
88 Private _BuiltFromScratch As Boolean ' When True, dialog is not stored in a library
89 Private _BuiltInPython As Boolean ' Used only when _BuiltFromScratch = True
90 Private _Name As String
91 Private _CacheIndex As Long ' Index in cache storage
93 ' Dialog UNO references
94 Private _DialogProvider As Object ' com.sun.star.io.XInputStreamProvider
95 Private _DialogControl As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
96 Private _DialogModel As Object ' com.sun.star.awt.XControlModel - stardiv.Toolkit.UnoControlDialogModel
98 ' Dialog attributes
99 Private _Displayed As Boolean ' True after Execute()
100 Private _Modal As Boolean ' Set by Execute()
102 ' Dialog initial position and dimensions in APPFONT units
103 Private _Left As Long
104 Private _Top As Long
105 Private _Width As Long
106 Private _Height As Long
108 ' Page management
109 Type _PageManager
110 ControlName As String ' Case-sensitive name of control involved in page management
111 PageMgtType As Integer ' One of the PILOTCONTROL, TABCONTROL, NEXTCONTROL, BACKCONTROL constants
113 ListenerType As Integer ' One of the ITEMSTATECHANGED, ACTIONPERFORMED constants
114 End Type
116 Private _PageManagement As Variant ' Array of _PageManager objects, one entry by involved control
117 Private _ItemListener As Object ' com.sun.star.awt.XItemListener
118 Private _ActionListener As Object ' com.sun.star.awt.XActionListener
121 ' Updatable events
122 ' Next identifiers MUST be identical in both SF_Dialog and SF_DialogControl class modules
123 Private _FocusListener As Object ' com.sun.star.awt.XFocusListener
124 Private _OnFocusGained As String ' Script to invoke when dialog gets focus
125 Private _OnFocusLost As String ' Script to invoke when dialog loses focus
126 Private _FocusCounter As Integer ' Counts the number of events set on the listener
127 ' ---
128 Private _KeyListener As Object ' com.sun.star.awt.XKeyListener
129 Private _OnKeyPressed As String ' Script to invoke when Key clicked in dialog
130 Private _OnKeyReleased As String ' Script to invoke when Key released in dialog
131 Private _KeyCounter As Integer ' Counts the number of events set on the listener
132 ' ---
133 Private _MouseListener As Object ' com.sun.star.awt.XMouseListener
134 Private _OnMouseEntered As String ' Script to invoke when mouse enters dialog
135 Private _OnMouseExited As String ' Script to invoke when mouse leaves dialog
136 Private _OnMousePressed As String ' Script to invoke when mouse clicked in dialog
137 Private _OnMouseReleased As String ' Script to invoke when mouse released in dialog
138 Private _MouseCounter As Integer ' Counts the number of events set on the listener
139 ' ---
140 Private _MouseMotionListener As Object ' com.sun.star.awt.XMouseMotionListener
141 Private _OnMouseDragged As String ' Script to invoke when mouse is dragged from the dialog
142 Private _OnMouseMoved As String ' Script to invoke when mouse is moved across the dialog
143 Private _MouseMotionCounter As Integer ' Counts the number of events set on the listener
145 ' Persistent storage for controls
146 Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of the Dialog model
148 REM ============================================================ MODULE CONSTANTS
150 ' Dialog usual buttons
151 Private Const cstOKBUTTON = 1
152 Private Const cstCANCELBUTTON = 0
154 ' Page management
155 Private Const PILOTCONTROL = 1
156 Private Const TABCONTROL = 2
157 Private Const BACKCONTROL = 3
158 Private Const NEXTCONTROL = 4
159 Private Const ITEMSTATECHANGED = 1
160 Private Const ACTIONPERFORMED = 2
162 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
164 REM -----------------------------------------------------------------------------
165 Private Sub Class_Initialize()
166 Set [Me] = Nothing
167 Set [_Parent] = Nothing
170 _Container = ""
171 _Library = ""
172 _BuiltFromScratch = False
173 _BuiltInPython = False
174 _Name = ""
175 _CacheIndex = -1
176 Set _DialogProvider = Nothing
177 Set _DialogControl = Nothing
178 Set _DialogModel = Nothing
179 _Displayed = False
180 _Modal = True
182 _Left = SF_DialogUtils.MINPOSITION
183 _Top = SF_DialogUtils.MINPOSITION
184 _Width = -1
185 _Height = -1
187 _PageManagement = Array()
188 Set _ItemListener = Nothing
189 Set _ActionListener = Nothing
190 _LastPage = 0
192 Set _FocusListener = Nothing
193 _OnFocusGained = ""
194 _OnFocusLost = ""
195 _FocusCounter = 0
196 Set _KeyListener = Nothing
197 _OnKeyPressed = ""
198 _OnKeyReleased = ""
199 _KeyCounter = 0
200 Set _MouseListener = Nothing
201 _OnMouseEntered = ""
202 _OnMouseExited = ""
203 _OnMousePressed = ""
204 _OnMouseReleased = ""
205 _MouseCounter = 0
206 Set _MouseMotionListener = Nothing
207 _OnMouseDragged = ""
208 _OnMouseMoved = ""
209 _MouseMotionCounter = 0
210 _ControlCache = Array()
211 End Sub ' SFDialogs.SF_Dialog Constructor
213 REM -----------------------------------------------------------------------------
214 Private Sub Class_Terminate()
215 Call Class_Initialize()
216 End Sub ' SFDialogs.SF_Dialog Destructor
218 REM -----------------------------------------------------------------------------
219 Public Function Dispose() As Variant
221 Call Class_Terminate()
222 Set Dispose = Nothing
223 End Function ' SFDialogs.SF_Dialog Explicit Destructor
225 REM ================================================================== PROPERTIES
227 REM -----------------------------------------------------------------------------
228 Property Get CANCELBUTTON() As Variant
229 CANCELBUTTON = cstCANCELBUTTON
230 End Property ' SFDialogs.SF_Dialog.CANCELBUTTON (get)
232 REM -----------------------------------------------------------------------------
233 Property Get Caption() As Variant
234 ''' The Caption property refers to the title of the dialog
236 End Property ' SFDialogs.SF_Dialog.Caption (get)
238 REM -----------------------------------------------------------------------------
239 Property Let Caption(Optional ByVal pvCaption As Variant)
240 ''' Set the updatable property Caption
242 End Property ' SFDialogs.SF_Dialog.Caption (let)
244 REM -----------------------------------------------------------------------------
245 Property Get Height() As Variant
246 ''' The Height property refers to the height of the dialog box
248 End Property ' SFDialogs.SF_Dialog.Height (get)
250 REM -----------------------------------------------------------------------------
251 Property Let Height(Optional ByVal pvHeight As Variant)
252 ''' Set the updatable property Height
254 End Property ' SFDialogs.SF_Dialog.Height (let)
256 REM -----------------------------------------------------------------------------
257 Property Get Modal() As Boolean
258 ''' The Modal property specifies if the dialog box has been executed in modal mode
260 End Property ' SFDialogs.SF_Dialog.Modal (get)
262 REM -----------------------------------------------------------------------------
263 Property Get Name() As String
264 ''' Return the name of the actual dialog
266 End Property ' SFDialogs.SF_Dialog.Name
268 REM -----------------------------------------------------------------------------
269 Property Get OKBUTTON() As Variant
270 OKBUTTON = cstOKBUTTON
271 End Property ' SFDialogs.SF_Dialog.OKBUTTON (get)
273 REM -----------------------------------------------------------------------------
274 Property Get OnFocusGained() As Variant
275 ''' Get the script associated with the OnFocusGained event
277 End Property ' SFDialogs.SF_Dialog.OnFocusGained (get)
279 REM -----------------------------------------------------------------------------
280 Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant)
281 ''' Set the updatable property OnFocusGained
283 End Property ' SFDialogs.SF_Dialog.OnFocusGained (let)
285 REM -----------------------------------------------------------------------------
286 Property Get OnFocusLost() As Variant
287 ''' Get the script associated with the OnFocusLost event
289 End Property ' SFDialogs.SF_Dialog.OnFocusLost (get)
291 REM -----------------------------------------------------------------------------
292 Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant)
293 ''' Set the updatable property OnFocusLost
295 End Property ' SFDialogs.SF_Dialog.OnFocusLost (let)
297 REM -----------------------------------------------------------------------------
298 Property Get OnKeyPressed() As Variant
299 ''' Get the script associated with the OnKeyPressed event
301 End Property ' SFDialogs.SF_Dialog.OnKeyPressed (get)
303 REM -----------------------------------------------------------------------------
304 Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant)
305 ''' Set the updatable property OnKeyPressed
307 End Property ' SFDialogs.SF_Dialog.OnKeyPressed (let)
309 REM -----------------------------------------------------------------------------
310 Property Get OnKeyReleased() As Variant
311 ''' Get the script associated with the OnKeyReleased event
313 End Property ' SFDialogs.SF_Dialog.OnKeyReleased (get)
315 REM -----------------------------------------------------------------------------
316 Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant)
317 ''' Set the updatable property OnKeyReleased
319 End Property ' SFDialogs.SF_Dialog.OnKeyReleased (let)
321 REM -----------------------------------------------------------------------------
322 Property Get OnMouseDragged() As Variant
323 ''' Get the script associated with the OnMouseDragged event
325 End Property ' SFDialogs.SF_Dialog.OnMouseDragged (get)
327 REM -----------------------------------------------------------------------------
328 Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant)
329 ''' Set the updatable property OnMouseDragged
331 End Property ' SFDialogs.SF_Dialog.OnMouseDragged (let)
333 REM -----------------------------------------------------------------------------
334 Property Get OnMouseEntered() As Variant
335 ''' Get the script associated with the OnMouseEntered event
337 End Property ' SFDialogs.SF_Dialog.OnMouseEntered (get)
339 REM -----------------------------------------------------------------------------
340 Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant)
341 ''' Set the updatable property OnMouseEntered
343 End Property ' SFDialogs.SF_Dialog.OnMouseEntered (let)
345 REM -----------------------------------------------------------------------------
346 Property Get OnMouseExited() As Variant
347 ''' Get the script associated with the OnMouseExited event
349 End Property ' SFDialogs.SF_Dialog.OnMouseExited (get)
351 REM -----------------------------------------------------------------------------
352 Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant)
353 ''' Set the updatable property OnMouseExited
355 End Property ' SFDialogs.SF_Dialog.OnMouseExited (let)
357 REM -----------------------------------------------------------------------------
358 Property Get OnMouseMoved() As Variant
359 ''' Get the script associated with the OnMouseMoved event
361 End Property ' SFDialogs.SF_Dialog.OnMouseMoved (get)
363 REM -----------------------------------------------------------------------------
364 Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant)
365 ''' Set the updatable property OnMouseMoved
367 End Property ' SFDialogs.SF_Dialog.OnMouseMoved (let)
369 REM -----------------------------------------------------------------------------
370 Property Get OnMousePressed() As Variant
371 ''' Get the script associated with the OnMousePressed event
373 End Property ' SFDialogs.SF_Dialog.OnMousePressed (get)
375 REM -----------------------------------------------------------------------------
376 Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant)
377 ''' Set the updatable property OnMousePressed
379 End Property ' SFDialogs.SF_Dialog.OnMousePressed (let)
381 REM -----------------------------------------------------------------------------
382 Property Get OnMouseReleased() As Variant
383 ''' Get the script associated with the OnMouseReleased event
385 End Property ' SFDialogs.SF_Dialog.OnMouseReleased (get)
387 REM -----------------------------------------------------------------------------
388 Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant)
389 ''' Set the updatable property OnMouseReleased
391 End Property ' SFDialogs.SF_Dialog.OnMouseReleased (let)
393 REM -----------------------------------------------------------------------------
394 Property Get Page() As Variant
395 ''' A dialog may have several pages that can be traversed by the user step by step.
396 ''' The Page property of the Dialog object defines which page of the dialog is active.
397 ''' The Page property of a control defines the page of the dialog on which the control is visible.
398 ''' For example, if a control has a page value of 1, it is only visible on page 1 of the dialog.
399 ''' If the page value of the dialog is increased from 1 to 2, then all controls with a page value of 1 disappear
402 End Property ' SFDialogs.SF_Dialog.Page (get)
404 REM -----------------------------------------------------------------------------
405 Property Let Page(Optional ByVal pvPage As Variant)
406 ''' Set the updatable property Page
408 End Property ' SFDialogs.SF_Dialog.Page (let)
410 REM -----------------------------------------------------------------------------
411 Property Get Visible() As Variant
412 ''' The Visible property is False before the Execute() statement
414 End Property ' SFDialogs.SF_Dialog.Visible (get)
416 REM -----------------------------------------------------------------------------
417 Property Let Visible(Optional ByVal pvVisible As Variant)
418 ''' Set the updatable property Visible
420 End Property ' SFDialogs.SF_Dialog.Visible (let)
422 REM -----------------------------------------------------------------------------
423 Property Get Width() As Variant
424 ''' The Width property refers to the Width of the dialog box
426 End Property ' SFDialogs.SF_Dialog.Width (get)
428 REM -----------------------------------------------------------------------------
429 Property Let Width(Optional ByVal pvWidth As Variant)
430 ''' Set the updatable property Width
432 End Property ' SFDialogs.SF_Dialog.Width (let)
434 REM -----------------------------------------------------------------------------
435 Property Get XDialogModel() As Object
436 ''' The XDialogModel property returns the model UNO object of the dialog
438 End Property ' SFDialogs.SF_Dialog.XDialogModel (get)
440 REM -----------------------------------------------------------------------------
441 Property Get XDialogView() As Object
442 ''' The XDialogView property returns the view UNO object of the dialog
444 End Property ' SFDialogs.SF_Dialog.XDialogView (get)
446 REM ===================================================================== METHODS
448 REM -----------------------------------------------------------------------------
449 Public Function Activate() As Boolean
450 ''' Set the focus on the current dialog instance
451 ''' Probably called from after an event occurrence or to focus on a non-modal dialog
452 ''' Args:
453 ''' Returns:
454 ''' True if focusing is successful
455 ''' Example:
456 ''' Dim oDlg As Object
457 ''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library
458 ''' oDlg.Activate()
460 Dim bActivate As Boolean ' Return value
462 Const cstSubArgs = ""
464 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
465 bActivate = False
467 Check:
468 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
469 If Not _IsStillAlive() Then GoTo Finally
470 End If
471 Try:
472 If Not IsNull(_DialogControl) Then
473 _DialogControl.setFocus()
474 bActivate = True
475 End If
477 Finally:
478 Activate = bActivate
479 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
480 Exit Function
481 Catch:
482 GoTo Finally
483 End Function ' SFDialogs.SF_Dialog.Activate
485 REM -----------------------------------------------------------------------------
486 Public Function Center(Optional ByRef Parent As Variant) As Boolean
487 ''' Center the actual dialog instance in the middle of a parent window
488 ''' Without arguments, the method centers the dialog in the middle of the current window
489 ''' Args:
490 ''' Parent: an object, either
491 ''' - a ScriptForge dialog object
492 ''' - a ScriptForge document (Calc, Base, ...) object
493 ''' Returns:
494 ''' True when successful
495 ''' Examples:
496 ''' Sub TriggerEvent(oEvent As Object)
497 ''' Dim oDialog1 As Object, oDialog2 As Object, lExec As Long
498 ''' Set oDialog1 = CreateScriptService("DialogEvent", oEvent) ' The dialog having caused the event
499 ''' Set oDialog2 = CreateScriptService("Dialog", ...) ' Open a second dialog
500 ''' oDialog2.Center(oDialog1)
501 ''' lExec = oDialog2.Execute()
502 ''' Select Case lExec
503 ''' ...
504 ''' End Sub
506 Dim bCenter As Boolean ' Return value
507 Dim oUi As Object ' ScriptForge.SF_UI
508 Dim oObjDesc As Object ' _ObjectDescriptor type
509 Dim sObjectType As String ' Can be uno or sf object type
510 Dim oParent As Object ' UNO alias of parent
511 Dim oParentPosSize As Object ' Parent com.sun.star.awt.Rectangle
512 Dim lParentX As Long ' X position of parent dialog
513 Dim lParentY As Long ' Y position of parent dialog
514 Dim oPosSize As Object ' Dialog com.sun.star.awt.Rectangle
518 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
519 bCenter = False
521 Check:
522 If IsMissing(Parent) Or IsEmpty(Parent) Then Set Parent = Nothing
523 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
524 If Not ScriptForge.SF_Utils._Validate(Parent, "Parent", ScriptForge.V_OBJECT) Then GoTo Finally
525 End If
527 Set oParentPosSize = Nothing
529 If IsNull(Parent) Then
531 Set oParentPosSize = oUi._PosSize() ' Return the position and dimensions of the active window
532 Else
533 ' Determine the object type
534 Set oObjDesc = ScriptForge.SF_Utils._VarTypeObj(Parent)
535 If oObjDesc.iVarType = ScriptForge.V_SFOBJECT Then ' ScriptForge object
536 sObjectType = oObjDesc.sObjectType
537 ' Document or dialog ?
538 If Not ScriptForge.SF_Array.Contains(Array("BASE", "CALC", "DIALOG", "DOCUMENT", "WRITER"), sObjectType, CaseSensitive := True) Then GoTo Finally
540 Set oParent = Parent._DialogControl
541 Set oParentPosSize = oParent.getPosSize()
542 lParentX = oParentPosSize.X
543 lParentY = oParentPosSize.Y
544 Else
545 Set oParent = Parent._Component.getCurrentController().Frame.getComponentWindow()
546 Set oParentPosSize = oParent.getPosSize()
547 End If
548 Else
549 GoTo Finally ' UNO object, do nothing
550 End If
551 End If
552 If IsNull(oParentPosSize) Then GoTo Finally
554 Try:
555 Set oPosSize = _DialogControl.getPosSize()
556 With oPosSize
557 _DialogControl.setPosSize( _
558 lParentX + CLng((oParentPosSize.Width - .Width) \ 2) _
559 , lParentY + CLng((oParentPosSize.Height - .Height) \ 2) _
560 , .Width _
561 , .Height _
562 , com.sun.star.awt.PosSize.POSSIZE)
563 End With
564 bCenter = True
566 Finally:
567 Center = bCenter
568 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
569 Exit Function
570 Catch:
571 GoTo Finally
572 End Function ' SF_Documents.SF_Dialog.Center
574 REM -----------------------------------------------------------------------------
575 Public Function CloneControl(Optional ByVal SourceName As Variant _
576 , Optional ByVal ControlName As Variant _
577 , Optional ByVal Left As Variant _
578 , Optional ByVal Top As Variant _
579 ) As Object
580 ''' Duplicate an existing control of any type in the actual dialog.
581 ''' The duplicated control is left unchanged. The new control can be relocated.
582 ''' Specific args:
583 ''' SourceName: the name of the control to duplicate
584 ''' ControlName: the name of the new control. It must not exist yet
585 ''' Left, Top: the coordinates of the new control expressed in "Map AppFont" units
586 ''' Returns:
587 ''' an instance of the SF_DialogControl class or Nothing
588 ''' Example:
589 ''' Set myButton2 = dialog.CloneControl("Button1", "Button2", 30, 30)
591 Dim oControl As Object ' Return value
592 Dim oSourceModel As Object ' com.sun.star.awt.XControlModel of the source
593 Dim oControlModel As Object ' com.sun.star.awt.XControlModel of the new control
597 Check:
598 Set oControl = Nothing
600 If IsMissing(Left) Or IsEmpty(Left) Then Left = 1
601 If IsMissing(Top) Or IsEmpty(Top) Then Top = 1
603 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place := Null) Then GoTo Finally
605 If Not ScriptForge.SF_Utils._Validate(SourceName, "SourceName", V_String, _DialogModel.getElementNames()) Then GoTo Finally
606 If Not ScriptForge.SF_Utils._Validate(Left, "Left", ScriptForge.V_NUMERIC) Then GoTo Finally
607 If Not ScriptForge.SF_Utils._Validate(Top, "Top", ScriptForge.V_NUMERIC) Then GoTo Finally
609 Try:
610 ' All control types are presumes cloneable
611 Set oSourceModel = _DialogModel.getByName(SourceName)
612 Set oControlModel = oSourceModel.createClone()
613 oControlModel.Name = ControlName
615 ' Create the control
616 Set oControl = _CreateNewControl(oControlModel, ControlName, Array(Left, Top))
618 Finally:
619 Set CloneControl = oControl
620 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
621 Exit Function
622 Catch:
623 GoTo Finally
624 End Function ' SFDialogs.SF_Dialog.CloneControl
626 REM -----------------------------------------------------------------------------
627 Public Function Controls(Optional ByVal ControlName As Variant) As Variant
628 ''' Return either
629 ''' - the list of the controls contained in the dialog
630 ''' - a dialog control object based on its name
631 ''' Args:
632 ''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
633 ''' Returns:
634 ''' A zero-base array of strings if ControlName is absent
635 ''' An instance of the SF_DialogControl class if ControlName exists
636 ''' Exceptions:
637 ''' ControlName is invalid
638 ''' Example:
639 ''' Dim myDialog As Object, myList As Variant, myControl As Object
640 ''' Set myDialog = CreateScriptService("SFDialogs.Dialog", Container, Library, DialogName)
641 ''' myList = myDialog.Controls()
644 Dim oControl As Object ' The new control class instance
645 Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache
646 Dim vControl As Variant ' Alias of _ControlCache entry
650 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
652 Check:
653 If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
654 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
655 If Not _IsStillAlive() Then GoTo Finally
656 If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
657 End If
659 Try:
660 If Len(ControlName) = 0 Then
661 Controls = _DialogModel.getElementNames()
662 Else
663 If Not _DialogModel.hasByName(ControlName) Then GoTo CatchNotFound
664 lIndexOfNames = ScriptForge.IndexOf(_DialogModel.getElementNames(), ControlName, CaseSensitive := True)
665 ' Reuse cache when relevant
666 vControl = _ControlCache(lIndexOfNames)
667 If IsEmpty(vControl) Then
668 ' Create the new dialog control class instance
669 Set oControl = New SF_DialogControl
670 With oControl
671 ._Name = ControlName
672 Set .[Me] = oControl
673 Set .[_Parent] = [Me]
674 ._IndexOfNames = ScriptForge.IndexOf(_DialogModel.getElementNames(), ControlName, CaseSensitive := True)
675 ._DialogName = _Name
676 Set ._ControlModel = _DialogModel.getByName(ControlName)
677 Set ._ControlView = _DialogControl.getControl(ControlName)
678 ._ControlView.setModel(._ControlModel)
679 ._Initialize()
680 End With
681 Else
682 Set oControl = vControl
683 End If
684 Set Controls = oControl
685 End If
687 Finally:
688 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
689 Exit Function
690 Catch:
691 GoTo Finally
692 CatchNotFound:
693 ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _DialogModel.getElementNames())
694 GoTo Finally
695 End Function ' SFDialogs.SF_Dialog.Controls
697 ''' CreateXXX functions:
698 ''' -------------------
699 ''' Common arguments:
700 ''' ControlName: the name of the new control. It must not exist yet.
701 ''' Place: either
703 ''' - a com.sun.star.awt.Rectangle [X, Y, Width, Height]
706 REM -----------------------------------------------------------------------------
707 Public Function CreateButton(Optional ByVal ControlName As Variant _
708 , Optional ByRef Place As Variant _
709 , Optional ByVal Toggle As Variant _
710 , Optional ByVal Push As Variant _
711 ) As Object
712 ''' Create a new control of type Button in the actual dialog.
713 ''' Specific args:
714 ''' Toggle: when True a Toggle button is created. Default = False
716 ''' Returns:
717 ''' an instance of the SF_DialogControl class or Nothing
718 ''' Example:
719 ''' Set myButton = dialog.CreateButton("Button1", Array(20, 20, 60, 15))
721 Dim oControl As Object ' Return value
722 Dim iPush As Integer ' Alias of Push
723 Dim vPropNames As Variant ' Array of names of specific arguments
724 Dim vPropValues As Variant ' Array of values of specific arguments
726 Const cstSubArgs = "ControlName, Place, [Toggle=False], [Push=""""|""OK""|""CANCEL""]"
728 Check:
729 Set oControl = Nothing
730 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
732 If IsMissing(Toggle) Or IsEmpty(Toggle) Then Toggle = False
733 If IsMissing(Push) Or IsEmpty(Push) Then Push = ""
734 If Not ScriptForge.SF_Utils._Validate(Toggle, "Toggle", ScriptForge.V_BOOLEAN) Then GoTo Finally
735 If Not ScriptForge.SF_Utils._Validate(Push, "Push", V_STRING, Array("", "OK", "CANCEL")) Then GoTo Finally
737 Try:
738 ' Handle specific arguments
739 Select Case UCase(Push)
740 Case "" : iPush = com.sun.star.awt.PushButtonType.STANDARD
743 End Select
745 vPropValues = Array(CBool(Toggle), iPush)
747 ' Create the control
748 Set oControl = _CreateNewControl("UnoControlButtonModel", ControlName, Place, vPropNames, vPropValues)
750 Finally:
751 Set CreateButton = oControl
752 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
753 Exit Function
754 End Function ' SFDialogs.SF_Dialog.CreateButton
756 REM -----------------------------------------------------------------------------
757 Public Function CreateCheckBox(Optional ByVal ControlName As Variant _
758 , Optional ByRef Place As Variant _
759 , Optional ByVal MultiLine As Variant _
760 ) As Object
761 ''' Create a new control of type CheckBox in the actual dialog.
762 ''' Specific args:
763 ''' MultiLine: When True (default = False), the caption may be displayed on more than one line
764 ''' Returns:
765 ''' an instance of the SF_DialogControl class or Nothing
766 ''' Example:
767 ''' Set myCheckBox = dialog.CreateCheckBox("CheckBox1", Array(20, 20, 60, 15), MultiLine := True)
769 Dim oControl As Object ' Return value
770 Dim vPropNames As Variant ' Array of names of specific arguments
771 Dim vPropValues As Variant ' Array of values of specific arguments
775 Check:
776 Set oControl = Nothing
777 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
779 If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False
780 If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally
782 Try:
783 ' Manage specific properties
785 vPropValues = Array(1, CBool(MultiLine))
787 ' Create the control
788 Set oControl = _CreateNewControl("UnoControlCheckBoxModel", ControlName, Place, vPropNames, vPropValues)
790 Finally:
791 Set CreateCheckBox = oControl
792 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
793 Exit Function
794 End Function ' SFDialogs.SF_Dialog.CreateCheckBox
796 REM -----------------------------------------------------------------------------
797 Public Function CreateComboBox(Optional ByVal ControlName As Variant _
798 , Optional ByRef Place As Variant _
799 , Optional ByVal Border As Variant _
800 , Optional ByVal Dropdown As Variant _
801 , Optional ByVal LineCount As Variant _
802 ) As Object
803 ''' Create a new control of type ComboBox in the actual dialog.
804 ''' Specific args:
806 ''' Dropdown: When True (default), a drop down button is displayed
807 ''' LineCount: Specifies the maximum line count displayed in the drop down (default = 5)
808 ''' Returns:
809 ''' an instance of the SF_DialogControl class or Nothing
810 ''' Example:
811 ''' Set myComboBox = dialog.CreateComboBox("ComboBox1", Array(20, 20, 60, 15), Dropdown := True)
813 Dim oControl As Object ' Return value
814 Dim iBorder As Integer ' Alias of border
815 Dim vPropNames As Variant ' Array of names of specific arguments
816 Dim vPropValues As Variant ' Array of values of specific arguments
818 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=True], [LineCount=5]"
820 Check:
821 Set oControl = Nothing
822 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
825 If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = True
826 If IsMissing(LineCount) Or IsEmpty(LineCount) Then LineCount = 5
828 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
829 If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally
830 If Not ScriptForge.SF_Utils._Validate(LineCount, "LineCount", ScriptForge.V_NUMERIC) Then GoTo Finally
832 Try:
833 ' Manage specific properties
834 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
836 vPropValues = Array(iBorder, CBool(Dropdown), CInt(LineCount))
838 ' Create the control
839 Set oControl = _CreateNewControl("UnoControlComboBoxModel", ControlName, Place, vPropNames, vPropValues)
841 Finally:
842 Set CreateComboBox = oControl
843 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
844 Exit Function
845 End Function ' SFDialogs.SF_Dialog.CreateComboBox
847 REM -----------------------------------------------------------------------------
848 Public Function CreateCurrencyField(Optional ByVal ControlName As Variant _
849 , Optional ByRef Place As Variant _
850 , Optional ByVal Border As Variant _
851 , Optional ByVal SpinButton As Variant _
852 , Optional ByVal MinValue As Variant _
853 , Optional ByVal MaxValue As Variant _
854 , Optional ByVal Increment As Variant _
855 , Optional ByVal Accuracy As Variant _
856 ) As Object
857 ''' Create a new control of type CurrencyField in the actual dialog.
858 ''' Specific args:
860 ''' SpinButton:: when True (default = False), a spin button is present
861 ''' MinValue: the smallest value that can be entered in the control. Dafault = -1000000
862 ''' MaxValue: the largest value that can be entered in the control. Dafault = +1000000
865 ''' Returns:
866 ''' an instance of the SF_DialogControl class or Nothing
867 ''' Example:
868 ''' Set myCurrencyField = dialog.CreateCurrencyField("CurrencyField1", Array(20, 20, 60, 15), SpinButton := True)
870 Dim oControl As Object ' Return value
871 Dim iBorder As Integer ' Alias of border
872 Dim vPropNames As Variant ' Array of names of specific arguments
873 Dim vPropValues As Variant ' Array of values of specific arguments
875 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=False], [SpinButton=False]" _
878 Check:
879 Set oControl = Nothing
880 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
883 If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False
884 If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00
885 If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00
886 If IsMissing(Increment) Or IsEmpty(Increment) Then Increment = 1.00
887 If IsMissing(Accuracy) Or IsEmpty(Accuracy) Then Accuracy = 2
889 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
890 If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally
891 If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally
892 If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally
893 If Not ScriptForge.SF_Utils._Validate(Increment, "Increment", ScriptForge.V_NUMERIC) Then GoTo Finally
894 If Not ScriptForge.SF_Utils._Validate(Accuracy, "Accuracy", ScriptForge.V_NUMERIC) Then GoTo Finally
896 Try:
897 ' Manage specific properties
898 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
899 vPropNames = Array("Border", "Spin", "ValueMin", "ValueMax", "ValueStep", "DecimalAccuracy")
900 vPropValues = Array(iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue), CDbl(Increment), CInt(Accuracy))
902 ' Create the control
903 Set oControl = _CreateNewControl("UnoControlCurrencyFieldModel", ControlName, Place, vPropNames, vPropValues)
905 Finally:
906 Set CreateCurrencyField = oControl
907 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
908 Exit Function
909 End Function ' SFDialogs.SF_Dialog.CreateCurrencyField
911 REM -----------------------------------------------------------------------------
912 Public Function CreateDateField(Optional ByVal ControlName As Variant _
913 , Optional ByRef Place As Variant _
914 , Optional ByVal Border As Variant _
915 , Optional ByVal Dropdown As Variant _
916 , Optional ByVal MinDate As Variant _
917 , Optional ByVal MaxDate As Variant _
918 ) As Object
919 ''' Create a new control of type DateField in the actual dialog.
920 ''' Specific args:
922 ''' Dropdown:: when True (default = False), a dropdown button is shown
923 ''' MinDate: the smallest date that can be entered in the control. Dafault = 1900-01-01
924 ''' MaxDate: the largest Date that can be entered in the control. Dafault = 2200-12-31
925 ''' Returns:
926 ''' an instance of the SF_DialogControl class or Nothing
927 ''' Example:
928 ''' Set myDateField = dialog.CreateDateField("DateField1", Array(20, 20, 60, 15), Dropdown := True)
930 Dim oControl As Object ' Return Date
931 Dim iBorder As Integer ' Alias of border
932 Dim oMinDate As New com.sun.star.util.Date
933 Dim oMaxDate As New com.sun.star.util.Date
934 Dim vFormats As Variant ' List of available date formats
935 Dim vPropNames As Variant ' Array of names of specific arguments
936 Dim vPropValues As Variant ' Array of values of specific arguments
938 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=False]" _
941 Check:
942 Set oControl = Nothing
943 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
946 If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = False
950 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
951 If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally
952 If Not ScriptForge.SF_Utils._Validate(MinDate, "MinDate", ScriptForge.V_DATE) Then GoTo Finally
953 If Not ScriptForge.SF_Utils._Validate(MaxDate, "MaxDate", ScriptForge.V_DATE) Then GoTo Finally
956 Try:
957 ' Manage specific properties
958 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
959 With oMinDate
960 .Year = Year(MinDate) : .Month = Month(MinDate) : .Day = Day(MinDate)
961 End With
962 With oMaxDate
963 .Year = Year(MaxDate) : .Month = Month(MaxDate) : .Day = Day(MaxDate)
964 End With
965 vPropNames = Array("Border", "Dropdown", "DateMin", "DateMax", "DateFormat")
966 vPropValues = Array(iBorder, CBool(Dropdown), oMinDate, oMaxDate, CInt(ScriptForge.SF_Array.IndexOf(vFormats(), "Standard (short)")))
968 ' Create the control
969 Set oControl = _CreateNewControl("UnoControlDateFieldModel", ControlName, Place, vPropNames, vPropValues)
971 Finally:
972 Set CreateDateField = oControl
973 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
974 Exit Function
975 End Function ' SFDialogs.SF_Dialog.CreateDateField
977 REM -----------------------------------------------------------------------------
978 Public Function CreateFileControl(Optional ByVal ControlName As Variant _
979 , Optional ByRef Place As Variant _
980 , Optional ByVal Border As Variant _
981 ) As Object
982 ''' Create a new control of type FileControl in the actual dialog.
983 ''' Specific args:
985 ''' Returns:
986 ''' an instance of the SF_DialogControl class or Nothing
987 ''' Example:
988 ''' Set myFileControl = dialog.CreateFileControl("FileControl1", Array(20, 20, 60, 15))
990 Dim oControl As Object ' Return value
991 Dim iBorder As Integer ' Alias of border
992 Dim vPropNames As Variant ' Array of names of specific arguments
993 Dim vPropValues As Variant ' Array of values of specific arguments
995 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]"
997 Check:
998 Set oControl = Nothing
999 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1002 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1004 Try:
1005 ' Manage specific properties
1006 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1008 vPropValues = Array(iBorder)
1010 ' Create the control
1011 Set oControl = _CreateNewControl("UnoControlFileControlModel", ControlName, Place, vPropNames, vPropValues)
1013 Finally:
1014 Set CreateFileControl = oControl
1015 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1016 Exit Function
1017 Catch:
1018 GoTo Finally
1019 End Function ' SFDialogs.SF_Dialog.CreateFileControl
1021 REM -----------------------------------------------------------------------------
1022 Public Function CreateFixedLine(Optional ByVal ControlName As Variant _
1023 , Optional ByRef Place As Variant _
1024 , Optional ByVal Orientation As Variant _
1025 ) As Object
1026 ''' Create a new control of type FixedLine in the actual dialog.
1027 ''' Specific args:
1029 ''' Returns:
1030 ''' an instance of the SF_DialogControl class or Nothing
1031 ''' Example:
1032 ''' Set myFixedLine = dialog.CreateFixedLine("FixedLine1", Array(20, 20, 60, 15), Orientation := "vertical")
1034 Dim oControl As Object ' Return value
1035 Dim vPropNames As Variant ' Array of names of specific arguments
1036 Dim vPropValues As Variant ' Array of values of specific arguments
1038 Const cstSubArgs = "ControlName, Place, Orientation=""H""|""Horizontal""|""V""|""Vertical"""
1040 Check:
1041 Set oControl = Nothing
1042 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1044 If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, Array("H", "Horizontal", "V", "Vertical")) Then GoTo Finally
1046 Try:
1047 ' Manage specific properties
1051 ' Create the control
1052 Set oControl = _CreateNewControl("UnoControlFixedLineModel", ControlName, Place, vPropNames, vPropValues)
1054 Finally:
1055 Set CreateFixedLine = oControl
1056 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1057 Exit Function
1058 End Function ' SFDialogs.SF_Dialog.CreateFixedLine
1060 REM -----------------------------------------------------------------------------
1061 Public Function CreateFixedText(Optional ByVal ControlName As Variant _
1062 , Optional ByRef Place As Variant _
1063 , Optional ByVal Border As Variant _
1064 , Optional ByVal MultiLine As Variant _
1065 , Optional ByVal Align As Variant _
1066 , Optional ByVal VerticalAlign As Variant _
1067 ) As Object
1068 ''' Create a new control of type FixedText in the actual dialog.
1069 ''' Specific args:
1071 ''' MultiLine: When True (default = False), the caption may be displayed on more than one line
1072 ''' Align: horizontal alignment, "LEFT" (default) or "CENTER" or "RIGHT"
1073 ''' VerticalAlign: vertical alignment, "TOP" (default) or "MIDDLE" or "BOTTOM"
1074 ''' Returns:
1075 ''' an instance of the SF_DialogControl class or Nothing
1076 ''' Example:
1077 ''' Set myFixedText = dialog.CreateFixedText("FixedText1", Array(20, 20, 60, 15), MultiLine := True)
1079 Dim oControl As Object ' Return value
1080 Dim iBorder As Integer ' Alias of border
1081 Dim iAlign As Integer ' Alias of Align
1082 Dim iVerticalAlign As Integer ' Alias of VerticalAlign
1083 Dim vPropNames As Variant ' Array of names of specific arguments
1084 Dim vPropValues As Variant ' Array of values of specific arguments
1086 Const cstSubArgs = "ControlName, Place, [MultiLine=False], [Border=""NONE""|""FLAT""|""3D""]" _
1087 & ", [Align=""LEFT""|""CENTER""|""RIGHT""], [VerticalAlign=""TOP""|""MIDDLE""|""BOTTOM""]"
1089 Check:
1090 Set oControl = Nothing
1091 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1094 If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False
1098 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1099 If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally
1100 If Not ScriptForge.SF_Utils._Validate(Align, "Align", V_STRING, Array("LEFT", "CENTER", "RIGHT")) Then GoTo Finally
1101 If Not ScriptForge.SF_Utils._Validate(VerticalAlign, "VerticalAlign", V_STRING, Array("TOP", "MIDDLE", "BOTTOM")) Then GoTo Finally
1103 Try:
1104 ' Manage specific properties
1105 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1106 iAlign = ScriptForge.SF_Array.IndexOf(Array("LEFT", "CENTER", "BOTTOM"), Align)
1107 Select Case UCase(VerticalAlign)
1111 End Select
1112 vPropNames = Array("Border", "MultiLine", "Align", "VerticalAlign")
1113 vPropValues = Array(iBorder, CBool(MultiLine), iAlign, iVerticalAlign)
1115 ' Create the control
1116 Set oControl = _CreateNewControl("UnoControlFixedTextModel", ControlName, Place, vPropNames, vPropValues)
1118 Finally:
1119 Set CreateFixedText = oControl
1120 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1121 Exit Function
1122 End Function ' SFDialogs.SF_Dialog.CreateFixedText
1124 REM -----------------------------------------------------------------------------
1125 Public Function CreateFormattedField(Optional ByVal ControlName As Variant _
1126 , Optional ByRef Place As Variant _
1127 , Optional ByVal Border As Variant _
1128 , Optional ByVal SpinButton As Variant _
1129 , Optional ByVal MinValue As Variant _
1130 , Optional ByVal MaxValue As Variant _
1131 ) As Object
1132 ''' Create a new control of type FormattedField in the actual dialog.
1133 ''' Specific args:
1135 ''' SpinButton:: when True (default = False), a spin button is present
1136 ''' MinValue: the smallest value that can be entered in the control. Dafault = -1000000
1137 ''' MaxValue: the largest value that can be entered in the control. Dafault = +1000000
1138 ''' Returns:
1139 ''' an instance of the SF_DialogControl class or Nothing
1140 ''' Example:
1141 ''' Set myFormattedField = dialog.CreateFormattedField("FormattedField1", Array(20, 20, 60, 15), SpinButton := True)
1144 Dim oControl As Object ' Return value
1145 Dim iBorder As Integer ' Alias of border
1146 Dim vPropNames As Variant ' Array of names of specific arguments
1147 Dim vPropValues As Variant ' Array of values of specific arguments
1149 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [SpinButton=False]" _
1152 Check:
1153 Set oControl = Nothing
1154 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1157 If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False
1158 If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00
1159 If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00
1161 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1162 If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally
1163 If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally
1164 If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally
1166 Try:
1167 ' Manage specific properties
1168 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1169 vPropNames = Array("FormatsSupplier", "Border", "Spin", "EffectiveMin", "EffectiveMax")
1171 , iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue))
1173 ' Create the control
1174 Set oControl = _CreateNewControl("UnoControlFormattedFieldModel", ControlName, Place, vPropNames, vPropValues)
1176 Finally:
1177 Set CreateFormattedField = oControl
1178 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1179 Exit Function
1180 Catch:
1181 GoTo Finally
1182 End Function ' SFDialogs.SF_Dialog.CreateFormattedField
1184 REM -----------------------------------------------------------------------------
1185 Public Function CreateGroupBox(Optional ByVal ControlName As Variant _
1186 , Optional ByRef Place As Variant _
1187 ) As Object
1188 ''' Create a new control of type GroupBox in the actual dialog.
1189 ''' Specific args:
1191 ''' Returns:
1192 ''' an instance of the SF_DialogControl class or Nothing
1193 ''' Example:
1194 ''' Set myGroupBox = dialog.CreateGroupBox("GroupBox1", Array(20, 20, 60, 15))
1196 Dim oControl As Object ' Return value
1197 Dim vPropNames As Variant ' Array of names of specific arguments
1198 Dim vPropValues As Variant ' Array of values of specific arguments
1202 Check:
1203 Set oControl = Nothing
1204 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1206 Try:
1207 ' Manage specific properties
1208 vPropNames = Array()
1209 vPropValues = Array()
1211 ' Create the control
1212 Set oControl = _CreateNewControl("UnoControlGroupBoxModel", ControlName, Place, vPropNames, vPropValues)
1214 Finally:
1215 Set CreateGroupBox = oControl
1216 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1217 Exit Function
1218 Catch:
1219 GoTo Finally
1220 End Function ' SFDialogs.SF_Dialog.CreateGroupBox
1222 REM -----------------------------------------------------------------------------
1223 Public Function CreateHyperlink(Optional ByVal ControlName As Variant _
1224 , Optional ByRef Place As Variant _
1225 , Optional ByVal Border As Variant _
1226 , Optional ByVal MultiLine As Variant _
1227 , Optional ByVal Align As Variant _
1228 , Optional ByVal VerticalAlign As Variant _
1229 ) As Object
1230 ''' Create a new control of type Hyperlink in the actual dialog.
1231 ''' Specific args:
1233 ''' MultiLine: When True (default = False), the caption may be displayed on more than one line
1234 ''' Align: horizontal alignment, "LEFT" (default) or "CENTER" or "RIGHT"
1235 ''' VerticalAlign: vertical alignment, "TOP" (default) or "MIDDLE" or "BOTTOM"
1236 ''' Returns:
1237 ''' an instance of the SF_DialogControl class or Nothing
1238 ''' Example:
1239 ''' Set myHyperlink = dialog.CreateHyperlink("Hyperlink1", Array(20, 20, 60, 15), MultiLine := True)
1241 Dim oControl As Object ' Return value
1242 Dim iBorder As Integer ' Alias of border
1243 Dim iAlign As Integer ' Alias of Align
1244 Dim iVerticalAlign As Integer ' Alias of VerticalAlign
1245 Dim vPropNames As Variant ' Array of names of specific arguments
1246 Dim vPropValues As Variant ' Array of values of specific arguments
1248 Const cstSubArgs = "ControlName, Place, [MultiLine=False], [Border=""NONE""|""FLAT""|""3D""]" _
1249 & ", [Align=""LEFT""|""CENTER""|""RIGHT""], [VerticalAlign=""TOP""|""MIDDLE""|""BOTTOM""]"
1251 Check:
1252 Set oControl = Nothing
1253 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1256 If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False
1260 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1261 If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally
1262 If Not ScriptForge.SF_Utils._Validate(Align, "Align", V_STRING, Array("LEFT", "CENTER", "RIGHT")) Then GoTo Finally
1263 If Not ScriptForge.SF_Utils._Validate(VerticalAlign, "VerticalAlign", V_STRING, Array("TOP", "MIDDLE", "BOTTOM")) Then GoTo Finally
1265 Try:
1266 ' Manage specific properties
1267 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1268 iAlign = ScriptForge.SF_Array.IndexOf(Array("LEFT", "CENTER", "BOTTOM"), Align)
1269 Select Case UCase(VerticalAlign)
1273 End Select
1274 vPropNames = Array("Border", "MultiLine", "Align", "VerticalAlign")
1275 vPropValues = Array(iBorder, CBool(MultiLine), iAlign, iVerticalAlign)
1277 ' Create the control
1278 Set oControl = _CreateNewControl("UnoControlFixedHyperlinkModel", ControlName, Place, vPropNames, vPropValues)
1280 Finally:
1281 Set CreateHyperlink = oControl
1282 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1283 Exit Function
1284 End Function ' SFDialogs.SF_Dialog.CreateHyperlink
1286 REM -----------------------------------------------------------------------------
1287 Public Function CreateImageControl(Optional ByVal ControlName As Variant _
1288 , Optional ByRef Place As Variant _
1289 , Optional ByVal Border As Variant _
1290 , Optional ByVal Scale As Variant _
1291 ) As Object
1292 ''' Create a new control of type ImageControl in the actual dialog.
1293 ''' Specific args:
1295 ''' Scale: One of next values: "FITTOSIZE" (default), "KEEPRATIO" or "NO"
1296 ''' Returns:
1297 ''' an instance of the SF_DialogControl class or Nothing
1298 ''' Example:
1299 ''' Set myImageControl = dialog.CreateImageControl("ImageControl1", Array(20, 20, 60, 15))
1301 Dim oControl As Object ' Return value
1302 Dim iBorder As Integer ' Alias of border
1303 Dim iScale As Integer ' Alias of Scale
1304 Dim bScale As Boolean ' When False, no scaling
1305 Dim vPropNames As Variant ' Array of names of specific arguments
1306 Dim vPropValues As Variant ' Array of values of specific arguments
1308 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Scale=""FITTOSIZE""|""KEEPRATIO""|""NO""]"
1310 Check:
1311 Set oControl = Nothing
1312 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1316 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1317 If Not ScriptForge.SF_Utils._Validate(Scale, "Scale", V_STRING, Array("FITTOSIZE", "KEEPRATIO", "NO")) Then GoTo Finally
1319 Try:
1320 ' Manage specific properties
1321 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1322 Select Case UCase(Scale)
1324 Case "FITTOSIZE" : iScale = com.sun.star.awt.ImageScaleMode.ANISOTROPIC : bScale = True
1325 Case "KEEPRATIO" : iScale = com.sun.star.awt.ImageScaleMode.ISOTROPIC : bScale = True
1326 End Select
1328 vPropValues = Array(iBorder, bScale, iScale)
1330 ' Create the control
1331 Set oControl = _CreateNewControl("UnoControlImageControlModel", ControlName, Place, vPropNames, vPropValues)
1333 Finally:
1334 Set CreateImageControl = oControl
1335 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1336 Exit Function
1337 Catch:
1338 GoTo Finally
1339 End Function ' SFDialogs.SF_Dialog.CreateImageControl
1341 REM -----------------------------------------------------------------------------
1342 Public Function CreateListBox(Optional ByVal ControlName As Variant _
1343 , Optional ByRef Place As Variant _
1344 , Optional ByVal Border As Variant _
1345 , Optional ByVal Dropdown As Variant _
1346 , Optional ByVal LineCount As Variant _
1347 , Optional ByVal MultiSelect As Variant _
1348 ) As Object
1349 ''' Create a new control of type ListBox in the actual dialog.
1350 ''' Specific args:
1352 ''' Dropdown: When True (default), a drop down button is displayed
1353 ''' LineCount: Specifies the maximum line count displayed in the drop down (default = 5)
1355 ''' Returns:
1356 ''' an instance of the SF_DialogControl class or Nothing
1357 ''' Example:
1358 ''' Set myListBox = dialog.CreateListBox("ListBox1", Array(20, 20, 60, 15), Dropdown := True, MultiSelect := True)
1360 Dim oControl As Object ' Return value
1361 Dim iBorder As Integer ' Alias of border
1362 Dim vPropNames As Variant ' Array of names of specific arguments
1363 Dim vPropValues As Variant ' Array of values of specific arguments
1365 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=True], [LineCount=5], [MultiSelect=False]"
1367 Check:
1368 Set oControl = Nothing
1369 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1372 If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = True
1373 If IsMissing(LineCount) Or IsEmpty(LineCount) Then LineCount = 5
1374 If IsMissing(MultiSelect) Or IsEmpty(MultiSelect) Then MultiSelect = True
1376 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1377 If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally
1378 If Not ScriptForge.SF_Utils._Validate(LineCount, "LineCount", ScriptForge.V_NUMERIC) Then GoTo Finally
1379 If Not ScriptForge.SF_Utils._Validate(MultiSelect, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
1381 Try:
1382 ' Manage specific properties
1383 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1384 vPropNames = Array("Border", "Dropdown", "LineCount", "MultiSelection")
1385 vPropValues = Array(iBorder, CBool(Dropdown), CInt(LineCount), CBool(MultiSelect))
1387 ' Create the control
1388 Set oControl = _CreateNewControl("UnoControlListBoxModel", ControlName, Place, vPropNames, vPropValues)
1390 Finally:
1391 Set CreateListBox = oControl
1392 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1393 Exit Function
1394 End Function ' SFDialogs.SF_Dialog.CreateListBox
1396 REM -----------------------------------------------------------------------------
1397 Public Function CreateNumericField(Optional ByVal ControlName As Variant _
1398 , Optional ByRef Place As Variant _
1399 , Optional ByVal Border As Variant _
1400 , Optional ByVal SpinButton As Variant _
1401 , Optional ByVal MinValue As Variant _
1402 , Optional ByVal MaxValue As Variant _
1403 , Optional ByVal Increment As Variant _
1404 , Optional ByVal Accuracy As Variant _
1405 ) As Object
1406 ''' Create a new control of type NumericField in the actual dialog.
1407 ''' Specific args:
1409 ''' SpinButton:: when True (default = False), a spin button is present
1410 ''' MinValue: the smallest value that can be entered in the control. Dafault = -1000000
1411 ''' MaxValue: the largest value that can be entered in the control. Dafault = +1000000
1414 ''' Returns:
1415 ''' an instance of the SF_DialogControl class or Nothing
1416 ''' Example:
1417 ''' Set myNumericField = dialog.CreateNumericField("NumericField1", Array(20, 20, 60, 15), SpinButton := True)
1419 Dim oControl As Object ' Return value
1420 Dim iBorder As Integer ' Alias of border
1421 Dim vPropNames As Variant ' Array of names of specific arguments
1422 Dim vPropValues As Variant ' Array of values of specific arguments
1424 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [SpinButton=False]" _
1427 Check:
1428 Set oControl = Nothing
1429 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1432 If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False
1433 If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00
1434 If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00
1435 If IsMissing(Increment) Or IsEmpty(Increment) Then Increment = 1.00
1436 If IsMissing(Accuracy) Or IsEmpty(Accuracy) Then Accuracy = 2
1438 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1439 If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally
1440 If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally
1441 If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally
1442 If Not ScriptForge.SF_Utils._Validate(Increment, "Increment", ScriptForge.V_NUMERIC) Then GoTo Finally
1443 If Not ScriptForge.SF_Utils._Validate(Accuracy, "Accuracy", ScriptForge.V_NUMERIC) Then GoTo Finally
1445 Try:
1446 ' Manage specific properties
1447 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1448 vPropNames = Array("Border", "Spin", "ValueMin", "ValueMax", "ValueStep", "DecimalAccuracy")
1449 vPropValues = Array(iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue), CDbl(Increment), CInt(Accuracy))
1451 ' Create the control
1452 Set oControl = _CreateNewControl("UnoControlNumericFieldModel", ControlName, Place, vPropNames, vPropValues)
1454 Finally:
1455 Set CreateNumericField = oControl
1456 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1457 Exit Function
1458 End Function ' SFDialogs.SF_Dialog.CreateNumericField
1460 REM -----------------------------------------------------------------------------
1461 Public Function CreatePatternField(Optional ByVal ControlName As Variant _
1462 , Optional ByRef Place As Variant _
1463 , Optional ByVal Border As Variant _
1464 , Optional ByVal EditMask As Variant _
1465 , Optional ByVal LiteralMask As Variant _
1466 ) As Object
1467 ''' Create a new control of type PatternField in the actual dialog.
1468 ''' Specific args:
1470 ''' Editmask: a character code that determines what the user may enter
1471 ''' LiteralMask: contains the initial values that are displayed in the pattern field
1472 ''' More details on https://wiki.documentfoundation.org/Documentation/DevGuide/Graphical_User_Interfaces#Pattern_Field
1473 ''' Returns:
1474 ''' an instance of the SF_DialogControl class or Nothing
1475 ''' Example:
1476 ''' Set myPatternField = dialog.CreatePatternField("PatternField1", Array(20, 20, 60, 15), EditMask := "NNLNNLLLLL", LiteralMask := "__.__.2002")
1478 Dim oControl As Object ' Return value
1479 Dim iBorder As Integer ' Alias of border
1480 Dim vPropNames As Variant ' Array of names of specific arguments
1481 Dim vPropValues As Variant ' Array of values of specific arguments
1483 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [EditMask=""""], [LiteralMask=""""]"
1485 Check:
1486 Set oControl = Nothing
1487 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1490 If IsMissing(EditMask) Or IsEmpty(EditMask) Then EditMask = ""
1491 If IsMissing(LiteralMask) Or IsEmpty(LiteralMask) Then LiteralMask = ""
1493 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1494 If Not ScriptForge.SF_Utils._Validate(EditMask, "EditMask", V_STRING) Then GoTo Finally
1495 If Not ScriptForge.SF_Utils._Validate(LiteralMask, "LiteralMask", V_STRING) Then GoTo Finally
1497 Try:
1498 ' Manage specific properties
1499 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1501 vPropValues = Array(iBorder, EditMask, LiteralMask)
1503 ' Create the control
1504 Set oControl = _CreateNewControl("UnoControlPatternFieldModel", ControlName, Place, vPropNames, vPropValues)
1506 Finally:
1507 Set CreatePatternField = oControl
1508 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1509 Exit Function
1510 Catch:
1511 GoTo Finally
1512 End Function ' SFDialogs.SF_Dialog.CreatePatternField
1514 REM -----------------------------------------------------------------------------
1515 Public Function CreateProgressBar(Optional ByVal ControlName As Variant _
1516 , Optional ByRef Place As Variant _
1517 , Optional ByVal Border As Variant _
1518 , Optional ByVal MinValue As Variant _
1519 , Optional ByVal MaxValue As Variant _
1520 ) As Object
1521 ''' Create a new control of type ProgressBar in the actual dialog.
1522 ''' Specific args:
1524 ''' MinValue: the smallest value that can be entered in the control. Default = 0
1525 ''' MaxValue: the largest value that can be entered in the control. Default = 100
1526 ''' Returns:
1527 ''' an instance of the SF_DialogControl class or Nothing
1528 ''' Example:
1529 ''' Set myProgressBar = dialog.CreateProgressBar("ProgressBar1", Array(20, 20, 60, 15), MaxValue := 1000)
1531 Dim oControl As Object ' Return value
1532 Dim iBorder As Integer ' Alias of border
1533 Dim vPropNames As Variant ' Array of names of specific arguments
1534 Dim vPropValues As Variant ' Array of values of specific arguments
1536 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [MinValue=0], MaxValue=100]"
1538 Check:
1539 Set oControl = Nothing
1540 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1543 If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = 0
1544 If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = 100
1546 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1547 If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally
1548 If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally
1550 Try:
1551 ' Manage specific properties
1552 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1553 vPropNames = Array("Border", "ProgressValueMin", "ProgressValueMax")
1554 vPropValues = Array(iBorder, CLng(MinValue), CLng(MaxValue))
1556 ' Create the control
1557 Set oControl = _CreateNewControl("UnoControlProgressBarModel", ControlName, Place, vPropNames, vPropValues)
1559 Finally:
1560 Set CreateProgressBar = oControl
1561 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1562 Exit Function
1563 End Function ' SFDialogs.SF_Dialog.CreateProgressBar
1565 REM -----------------------------------------------------------------------------
1566 Public Function CreateRadioButton(Optional ByVal ControlName As Variant _
1567 , Optional ByRef Place As Variant _
1568 , Optional ByVal MultiLine As Variant _
1569 ) As Object
1570 ''' Create a new control of type RadioButton in the actual dialog.
1571 ''' Specific args:
1572 ''' MultiLine: When True (default = False), the caption may be displayed on more than one line
1573 ''' Returns:
1574 ''' an instance of the SF_DialogControl class or Nothing
1575 ''' Example:
1576 ''' Set myRadioButton = dialog.CreateRadioButton("RadioButton1", Array(20, 20, 60, 15), MultiLine := True)
1578 Dim oControl As Object ' Return value
1579 Dim vPropNames As Variant ' Array of names of specific arguments
1580 Dim vPropValues As Variant ' Array of values of specific arguments
1584 Check:
1585 Set oControl = Nothing
1586 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1588 If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False
1589 If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally
1591 Try:
1592 ' Manage specific properties
1594 vPropValues = Array(1, CBool(MultiLine))
1596 ' Create the control
1597 Set oControl = _CreateNewControl("UnoControlRadioButtonModel", ControlName, Place, vPropNames, vPropValues)
1599 Finally:
1600 Set CreateRadioButton = oControl
1601 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1602 Exit Function
1603 End Function ' SFDialogs.SF_Dialog.CreateRadioButton
1605 REM -----------------------------------------------------------------------------
1606 Public Function CreateScrollBar(Optional ByVal ControlName As Variant _
1607 , Optional ByRef Place As Variant _
1608 , Optional ByVal Orientation As Variant _
1609 , Optional ByVal Border As Variant _
1610 , Optional ByVal MinValue As Variant _
1611 , Optional ByVal MaxValue As Variant _
1612 ) As Object
1613 ''' Create a new control of type ScrollBar in the actual dialog.
1614 ''' Specific args:
1615 ''' Orientation: H[orizontal] or V[ertical]
1617 ''' MinValue: the smallest value that can be entered in the control. Dafault = 0
1618 ''' MaxValue: the largest value that can be entered in the control. Dafault = 100
1619 ''' Returns:
1620 ''' an instance of the SF_DialogControl class or Nothing
1621 ''' Example:
1622 ''' Set myScrollBar = dialog.CreateScrollBar("ScrollBar1", Array(20, 20, 60, 15), MaxValue := 1000)
1624 Dim oControl As Object ' Return value
1625 Dim iBorder As Integer ' Alias of border
1626 Dim vPropNames As Variant ' Array of names of specific arguments
1627 Dim vPropValues As Variant ' Array of values of specific arguments
1629 Const cstSubArgs = "ControlName, Place, Orientation=""H""|""Horizontal""|""V""|""Vertical""" _
1630 & ", [Border=""3D""|""FLAT""|""NONE""], [MinValue=0], MaxValue=100]"
1632 Check:
1633 Set oControl = Nothing
1634 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1637 If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = 0
1638 If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = 100
1640 If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, Array("H", "Horizontal", "V", "Vertical")) Then GoTo Finally
1641 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1642 If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally
1643 If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally
1645 Try:
1646 ' Manage specific properties
1647 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1648 vPropNames = Array("Border", "Orientation", "ScrollValueMin", "ScrollValueMax")
1649 vPropValues = Array(iBorder, CLng(Iif(Left(UCase(Orientation), 1) = "V", 1, 0)), CLng(MinValue), CLng(MaxValue))
1651 ' Create the control
1652 Set oControl = _CreateNewControl("UnoControlScrollBarModel", ControlName, Place, vPropNames, vPropValues)
1654 Finally:
1655 Set CreateScrollBar = oControl
1656 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1657 Exit Function
1658 End Function ' SFDialogs.SF_Dialog.CreateScrollBar
1660 REM -----------------------------------------------------------------------------
1661 Public Function CreateTableControl(Optional ByVal ControlName As Variant _
1662 , Optional ByRef Place As Variant _
1663 , Optional ByVal Border As Variant _
1664 , Optional ByVal RowHeaders As Variant _
1665 , Optional ByVal ColumnHeaders As Variant _
1666 , Optional ByVal ScrollBars As Variant _
1667 , Optional ByVal GridLines As Variant _
1668 ) As Object
1669 ''' Create a new control of type TableControl in the actual dialog.
1670 ''' To fill the table with data, use the SetTableData() method
1671 ''' Specific args:
1673 ''' RowHeaders: when True (default), the row headers are shown
1674 ''' ColumnHeaders: when True (default), the column headers are shown
1675 ''' ScrollBars: H[orizontal] or V[ertical] or B[oth] or N[one] (default)
1676 ''' Note that scrollbars always appear dynamically when they are needed
1677 ''' GridLines: when True (default = False) horizontal and vertical lines are painted between the grid cells
1678 ''' Returns:
1679 ''' an instance of the SF_DialogControl class or Nothing
1680 ''' Example:
1681 ''' Set myTableControl = dialog.CreateTableControl("TableControl1", Array(20, 20, 60, 15), ScrollBars := "B")
1683 Dim oControl As Object ' Return value
1684 Dim iBorder As Integer ' Alias of border
1685 Dim vPropNames As Variant ' Array of names of specific arguments
1686 Dim vPropValues As Variant ' Array of values of specific arguments
1688 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [RowHeaders=True], [ColumnHeaders=True]" _
1689 & ", [ScrollBars=""N""|""None""|""B""|""Both""|""H""|""Horizontal""|""V""|""Vertical"""
1691 Check:
1692 Set oControl = Nothing
1693 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1696 If IsMissing(RowHeaders) Or IsEmpty(RowHeaders) Then RowHeaders = True
1697 If IsMissing(ColumnHeaders) Or IsEmpty(ColumnHeaders) Then ColumnHeaders = True
1699 If IsMissing(GridLines) Or IsEmpty(GridLines) Then GridLines = False
1701 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1702 If Not ScriptForge.SF_Utils._Validate(RowHeaders, "RowHeaders", ScriptForge.V_BOOLEAN) Then GoTo Finally
1703 If Not ScriptForge.SF_Utils._Validate(ColumnHeaders, "ColumnHeaders", ScriptForge.V_BOOLEAN) Then GoTo Finally
1704 If Not ScriptForge.SF_Utils._Validate(ScrollBars, "ScrollBars", V_STRING, Array("N", "None", "B", "Both", "H", "Horizontal", "V", "Vertical")) Then GoTo Finally
1705 If Not ScriptForge.SF_Utils._Validate(GridLines, "GridLines", ScriptForge.V_BOOLEAN) Then GoTo Finally
1707 Try:
1708 ' Manage specific properties
1709 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1710 vPropNames = Array("Border", "ShowRowHeader", "ShowColumnHeader", "VScroll", "HScroll", "UseGridLines")
1711 vPropValues = Array(iBorder, CBool(RowHeaders), CBool(ColumnHeaders) _
1714 , CBool(GridLines) _
1715 )
1717 ' Create the control
1718 Set oControl = _CreateNewControl("grid.UnoControlGridModel", ControlName, Place, vPropNames, vPropValues)
1720 Finally:
1721 Set CreateTableControl = oControl
1722 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1723 Exit Function
1724 End Function ' SFDialogs.SF_Dialog.CreateTableControl
1726 REM -----------------------------------------------------------------------------
1727 Public Function CreateTextField(Optional ByVal ControlName As Variant _
1728 , Optional ByRef Place As Variant _
1729 , Optional ByVal Border As Variant _
1730 , Optional ByVal MultiLine As Variant _
1731 , Optional ByVal MaximumLength As Variant _
1732 , Optional ByVal PasswordCharacter As Variant _
1733 ) As Object
1734 ''' Create a new control of type TextField in the actual dialog.
1735 ''' Specific args:
1737 ''' MultiLine: When True (default = False), the caption may be displayed on more than one line
1739 ''' PasswordCharacter: a single character specifying the echo for a password text field (default = "")
1740 ''' MultiLine must be False to have PasswordCharacter being applied
1741 ''' Returns:
1742 ''' an instance of the SF_DialogControl class or Nothing
1743 ''' Example:
1744 ''' Set myTextField = dialog.CreateTextField("TextField1", Array(20, 20, 120, 50), MultiLine := True)
1746 Dim oControl As Object ' Return value
1747 Dim iBorder As Integer ' Alias of border
1748 Dim iPassword As Integer ' Integer alias of PasswordCharacter
1749 Dim vPropNames As Variant ' Array of names of specific arguments
1750 Dim vPropValues As Variant ' Array of values of specific arguments
1752 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [MultiLine=False], [MaximumLength=0, [PasswordCharacter=""""]"
1754 Check:
1755 Set oControl = Nothing
1756 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1759 If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False
1760 If IsMissing(MaximumLength) Or IsEmpty(MaximumLength) Then MaximumLength = 0
1761 If IsMissing(PasswordCharacter) Or IsEmpty(PasswordCharacter) Then PasswordCharacter = ""
1763 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1764 If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally
1765 If Not ScriptForge.SF_Utils._Validate(MaximumLength, "MaximumLength", ScriptForge.V_NUMERIC) Then GoTo Finally
1766 If Not ScriptForge.SF_Utils._Validate(PasswordCharacter, "PasswordCharacter", V_STRING) Then GoTo Finally
1768 ' MultiLine has precedence over Password
1769 If MultiLine Then PasswordCharacter = ""
1771 Try:
1772 ' Manage specific properties
1773 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1774 If Len(PasswordCharacter) > 0 Then iPassword = Asc(Left(PasswordCharacter, 1)) Else iPassword = 0
1775 vPropNames = Array("Border", "MultiLine", "MaxTextLen", "EchoChar", "AutoVScroll") ' AutoHScroll not implemented ??
1776 vPropValues = Array(iBorder, CBool(MultiLine), CInt(MaximumLength), iPassword, True)
1778 ' Create the control
1779 Set oControl = _CreateNewControl("UnoControlEditModel", ControlName, Place, vPropNames, vPropValues)
1781 Finally:
1782 Set CreateTextField = oControl
1783 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1784 Exit Function
1785 End Function ' SFDialogs.SF_Dialog.CreateTextField
1787 REM -----------------------------------------------------------------------------
1788 Public Function CreateTimeField(Optional ByVal ControlName As Variant _
1789 , Optional ByRef Place As Variant _
1790 , Optional ByVal Border As Variant _
1791 , Optional ByVal MinTime As Variant _
1792 , Optional ByVal MaxTime As Variant _
1793 ) As Object
1794 ''' Create a new control of type TimeField in the actual dialog.
1795 ''' Specific args:
1799 ''' Returns:
1800 ''' an instance of the SF_DialogControl class or Nothing
1801 ''' Example:
1802 ''' Set myTimeField = dialog.CreateTimeField("TimeField1", Array(20, 20, 60, 15))
1804 Dim oControl As Object ' Return Time
1805 Dim iBorder As Integer ' Alias of border
1806 Dim oMinTime As New com.sun.star.util.Time
1807 Dim oMaxTime As New com.sun.star.util.Time
1808 Dim vFormats As Variant ' List of available time formats
1809 Dim vPropNames As Variant ' Array of names of specific arguments
1810 Dim vPropValues As Variant ' Array of values of specific arguments
1812 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]" _
1815 Check:
1816 Set oControl = Nothing
1817 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1823 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1824 If Not ScriptForge.SF_Utils._ValiDate(MinTime, "MinTime", ScriptForge.V_DATE) Then GoTo Finally
1825 If Not ScriptForge.SF_Utils._ValiDate(MaxTime, "MaxTime", ScriptForge.V_DATE) Then GoTo Finally
1828 Try:
1829 ' Manage specific properties
1830 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1831 With oMinTime
1832 .Hours = Hour(MinTime) : .Minutes = Minute(MinTime) : .Seconds = Second(MinTime)
1833 End With
1834 With oMaxTime
1835 .Hours = Hour(MaxTime) : .Minutes = Minute(MaxTime) : .Seconds = Second(MaxTime)
1836 End With
1837 vPropNames = Array("Border", "TimeMin", "TimeMax", "TimeFormat")
1838 vPropValues = Array(iBorder, oMinTime, oMaxTime, CInt(ScriptForge.SF_Array.IndexOf(vFormats(), "24h short")))
1840 ' Create the control
1841 Set oControl = _CreateNewControl("UnoControlTimeFieldModel", ControlName, Place, vPropNames, vPropValues)
1843 Finally:
1844 Set CreateTimeField = oControl
1845 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1846 Exit Function
1847 End Function ' SFDialogs.SF_Dialog.CreateTimeField
1849 REM -----------------------------------------------------------------------------
1850 Public Function CreateTreeControl(Optional ByVal ControlName As Variant _
1851 , Optional ByRef Place As Variant _
1852 , Optional ByVal Border As Variant _
1853 ) As Object
1854 ''' Create a new control of type TreeControl in the actual dialog.
1855 ''' Specific args:
1857 ''' Returns:
1858 ''' an instance of the SF_DialogControl class or Nothing
1859 ''' Example:
1860 ''' Set myTreeControl = dialog.CreateTreeControl("TreeControl1", Array(20, 20, 60, 15))
1862 Dim oControl As Object ' Return value
1863 Dim iBorder As Integer ' Alias of border
1864 Dim vPropNames As Variant ' Array of names of specific arguments
1865 Dim vPropValues As Variant ' Array of values of specific arguments
1867 Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]"
1869 Check:
1870 Set oControl = Nothing
1871 If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally
1874 If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally
1876 Try:
1877 ' Manage specific properties
1878 iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border)
1879 vPropNames = Array("Border", "SelectionType", "Editable", "ShowsHandles", "ShowsRootHandles")
1880 vPropValues = Array(iBorder, com.sun.star.view.SelectionType.SINGLE, False, True, True)
1882 ' Create the control
1883 Set oControl = _CreateNewControl("tree.TreeControlModel", ControlName, Place, vPropNames, vPropValues)
1885 Finally:
1886 Set CreateTreeControl = oControl
1887 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1888 Exit Function
1889 Catch:
1890 GoTo Finally
1891 End Function ' SFDialogs.SF_Dialog.CreateTreeControl
1893 REM -----------------------------------------------------------------------------
1894 Public Sub EndExecute(Optional ByVal ReturnValue As Variant)
1895 ''' Ends the display of a modal dialog and gives back the argument
1896 ''' as return value for the current Execute() action
1897 ''' EndExecute is usually contained in the processing of a macro
1898 ''' triggered by a dialog or control event
1899 ''' Args:
1900 ''' ReturnValue: must be numeric. The value passed to the running Execute() method
1901 ''' Example:
1902 ''' Sub OnEvent(poEvent As Variant)
1903 ''' Dim oDlg As Object
1906 ''' End Sub
1908 Dim lExecute As Long ' Alias of ReturnValue
1912 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1914 Check:
1915 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1916 If Not _IsStillAlive() Then GoTo Finally
1917 If Not ScriptForge.SF_Utils._Validate(ReturnValue, "ReturnValue", V_NUMERIC) Then GoTo Finally
1918 End If
1920 Try:
1921 lExecute = CLng(ReturnValue)
1922 Call _DialogControl.endDialog(lExecute)
1924 Finally:
1925 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1926 Exit Sub
1927 Catch:
1928 GoTo Finally
1929 End Sub ' SFDialogs.SF_Dialog.EndExecute
1931 REM -----------------------------------------------------------------------------
1932 Public Function Execute(Optional ByVal Modal As Variant) As Long
1933 ''' Display the dialog and wait for its termination by the user
1934 ''' Args:
1935 ''' Modal: False when non-modal dialog. Default = True
1936 ''' Returns:
1939 ''' Otherwise: the dialog stopped with an EndExecute statement executed from a dialog or control event
1940 ''' Example:
1941 ''' Dim oDlg As Object, lReturn As Long
1942 ''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library
1943 ''' lReturn = oDlg.Execute()
1944 ''' Select Case lReturn
1946 Dim lExecute As Long ' Return value
1950 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1951 lExecute = -1
1953 Check:
1954 If IsMissing(Modal) Or IsEmpty(Modal) Then Modal = True
1955 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1956 If Not _IsStillAlive() Then GoTo Finally
1958 End If
1960 Try:
1961 If Modal Then
1962 _Modal = True
1963 _Displayed = True
1964 ' In dynamic dialogs, injection of sizes and positions from model to view is done with setVisible()
1965 _DialogControl.setVisible(True)
1966 lExecute = _DialogControl.execute()
1967 Select Case lExecute
1968 Case 1 : lExecute = OKBUTTON
1969 Case 0 : lExecute = CANCELBUTTON
1970 Case Else
1971 End Select
1972 _Displayed = False
1973 Else
1974 _Modal = False
1975 _Displayed = True
1976 ' To make visible an on-the-fly designed dialog when macro triggered from Python
1977 _DialogModel.DesktopAsParent = Not ( _BuiltFromScratch And _BuiltInPython )
1978 _DialogControl.setVisible(True)
1979 lExecute = 0
1980 End If
1982 Finally:
1983 Execute = lExecute
1984 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1985 Exit Function
1986 Catch:
1987 ' When an error is caused by an event error, the location is unknown
1989 GoTo Finally
1990 End Function ' SFDialogs.SF_Dialog.Execute
1992 REM -----------------------------------------------------------------------------
1993 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
1994 ''' Return the actual value of the given property
1995 ''' Args:
1996 ''' PropertyName: the name of the property as a string
1997 ''' Returns:
1998 ''' The actual value of the property
1999 ''' Exceptions:
2000 ''' ARGUMENTERROR The property does not exist
2001 ''' Examples:
2005 Const cstSubArgs = ""
2007 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2008 GetProperty = Null
2010 Check:
2011 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2012 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
2013 End If
2015 Try:
2016 GetProperty = _PropertyGet(PropertyName)
2018 Finally:
2019 SF_Utils._ExitFunction(cstThisSub)
2020 Exit Function
2021 Catch:
2022 GoTo Finally
2023 End Function ' SFDialogs.SF_Dialog.GetProperty
2025 REM -----------------------------------------------------------------------------
2026 Public Function GetTextsFromL10N(Optional ByRef L10N As Variant) As Boolean
2027 ''' Replace all fixed text strings of a dialog by their localized version
2028 ''' Replaced texts are:
2029 ''' - the title of the dialog
2030 ''' - the caption associated with next control types: Button, CheckBox, FixedLine, FixedText, GroupBox and RadioButton
2031 ''' - the content of list- and comboboxes
2032 ''' - the tip- or helptext displayed when the mouse is hovering the control
2033 ''' The current method has a twin method ScriptForge.SF_L10N.AddTextsFromDialog
2034 ''' The current method is probably run before the Execute() method
2035 ''' Args:
2036 ''' L10N : a "L10N" service instance created with CreateScriptService("L10N")
2037 ''' Returns:
2038 ''' True when successful
2039 ''' Examples:
2040 ''' Dim myPO As Object, oDlg As Object
2041 ''' Set oDlg = CreateScriptService("Dialog", "GlobalScope", "XrayTool", "DlgXray")
2042 ''' Set myPO = CreateScriptService("L10N", "C:\myPOFiles\", "fr-BE")
2043 ''' oDlg.GetTextsFromL10N(myPO)
2045 Dim bGet As Boolean ' Return value
2046 Dim vControls As Variant ' Array of control names
2047 Dim sControl As String ' A single control name
2048 Dim oControl As Object ' SFDialogs.DialogControl
2049 Dim sText As String ' The text found in the dialog
2050 Dim sTranslation As String ' The translated text got from the dictionary
2051 Dim vSource As Variant ' RowSource property of dialog control as an array
2053 Dim i As Long
2058 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2059 bGet = False
2061 Check:
2062 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2063 If Not SF_Utils._Validate(L10N, "L10N", V_OBJECT, , , "L10N") Then GoTo Finally
2064 End If
2066 Try:
2067 ' Get the dialog title
2068 sText = Caption
2070 sTranslation = L10N._(sText)
2071 If sText <> sTranslation Then Caption = sTranslation
2072 End If
2073 ' Scan all controls
2074 vControls = Controls()
2075 For Each sControl In vControls
2076 Set oControl = Controls(sControl)
2077 With oControl
2078 ' Extract fixed texts
2079 sText = .Caption
2081 sTranslation = L10N._(sText)
2082 If sText <> sTranslation Then .Caption = sTranslation
2083 End If
2084 vSource = .RowSource ' List and comboboxes only
2085 If IsArray(vSource) Then
2086 bChanged = False
2087 For i = 0 To UBound(vSource)
2089 sTranslation = L10N._(vSource(i))
2090 If sTranslation <> vSource(i) Then
2091 bChanged = True
2092 vSource(i) = sTranslation
2093 End If
2094 End If
2095 Next i
2097 If bChanged Then .RowSource = vSource
2098 End If
2099 sText = .TipText
2101 sTranslation = L10N._(sText)
2102 If sText <> sTranslation Then .TipText = sTranslation
2103 End If
2104 End With
2105 Next sControl
2107 bGet = True
2109 Finally:
2110 GetTextsFromL10N = bGet
2111 SF_Utils._ExitFunction(cstThisSub)
2112 Exit Function
2113 Catch:
2114 GoTo Finally
2115 End Function ' SFDialogs.SF_Dialog.GetTextsFromL10N
2117 REM -----------------------------------------------------------------------------
2118 Public Function Methods() As Variant
2119 ''' Return the list of public methods of the Model service as an array
2121 Methods = Array( _
2155 )
2157 End Function ' SFDialogs.SF_Dialog.Methods
2159 REM -----------------------------------------------------------------------------
2160 Public Function OrderTabs(ByRef Optional TabsList As Variant _
2161 , ByVal Optional Start As Variant _
2162 , ByVal Optional Increment As Variant _
2163 ) As Boolean
2164 ''' Set the tabulation index f a series of controls.
2165 ''' The sequence of controls are given as an array of control names from the first to the last.
2166 ''' Next controls will not be accessible (anymore ?) via the TAB key if >=1 of next conditions is met:
2167 ''' - if they are not in the given list
2168 ''' - if their type is FixedLine, GroupBox or ProgressBar
2169 ''' - if the control is disabled
2170 ''' Args:
2171 ''' TabsList: an array of valid control names in the order of tabulation
2172 ''' Start: the tab index to be assigned to the 1st control in the list. Default = 1
2174 ''' Returns:
2175 ''' True when successful
2176 ''' Example:
2177 ''' dialog.OredrTabs(Array("myListBox", "myTextField", "myNumericField"), Start := 10)
2179 Dim bOrder As Boolean ' Return value
2180 Dim vControlNames As Variant ' List of control names in the dialog
2181 Dim oControl As Object ' A SF_DialogControl instance
2182 Dim bValid As Boolean ' When True, the considered control deserves a tab stop
2183 Dim iTabIndex As Integer ' The tab index to be set
2184 Dim vWrongTypes As Variant ' List of rejected control types
2185 Dim i As Long
2190 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2191 bOrder = False
2193 Check:
2194 If IsMissing(Start) Or IsEmpty(Start) Then Start = 1
2195 If IsMissing(Increment) Or IsEmpty(Increment) Then Increment = 1
2196 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2197 If Not ScriptForge.SF_Utils._ValidateArray(TabsList, "TabsList", 1, V_STRING, True) Then GoTo Finally
2199 If Not SF_Utils._Validate(Increment, "Increment", ScriptForge.V_NUMERIC) Then GoTo Finally
2200 End If
2202 Try:
2205 ' Remove all existing tabulations
2206 vControlNames = _DialogModel.getElementNames()
2207 For i = 0 To UBound(vControlNames)
2208 Set oControl = Controls(vControlNames(i))
2209 With oControl._ControlModel
2210 If Not ScriptForge.SF_Array.Contains(vWrongTypes, oControl._ControlType) Then
2211 .TabStop = False
2212 .TabIndex = -1
2213 End If
2214 End With
2215 Next i
2217 iTabIndex = Start
2219 ' Go through the candidate controls for being tabulated and set tabs
2220 For i = LBound(TabsList) To UBound(TabsList)
2221 Set oControl = Controls(TabsList(i)) ' Error checking on input names happens here
2222 With oControl._ControlModel
2223 bValid = Not ScriptForge.SF_Array.Contains(vWrongTypes, oControl._ControlType)
2224 If bValid Then bValid = .Enabled
2225 If bValid Then
2226 .TabStop = True
2227 .TabIndex = iTabIndex
2228 iTabIndex = iTabIndex + Increment
2229 End If
2230 End With
2231 Next i
2233 bOrder = True
2235 Finally:
2236 OrderTabs = bOrder
2237 SF_Utils._ExitFunction(cstThisSub)
2238 Exit Function
2239 Catch:
2240 GoTo Finally
2241 End Function ' SFDialogs.SF_Dialog.OrderTabls
2243 REM -----------------------------------------------------------------------------
2244 Public Function Properties() As Variant
2245 ''' Return the list or properties of the Dialog class as an array
2247 Properties = Array( _
2267 )
2269 End Function ' SFDialogs.SF_Dialog.Properties
2271 REM -----------------------------------------------------------------------------
2272 Public Function Resize(Optional ByVal Left As Variant _
2273 , Optional ByVal Top As Variant _
2274 , Optional ByVal Width As Variant _
2275 , Optional ByVal Height As Variant _
2276 ) As Boolean
2277 ''' Move the top-left corner of the dialog to new coordinates and/or modify its dimensions
2278 ''' Without arguments, the method resets the initial dimensions
2279 ''' Attributes denoting the position and size of a dialog are expressed in "Map AppFont" units.
2280 ''' Map AppFont units are device and resolution independent.
2281 ''' One Map AppFont unit is equal to one eighth of the average character (Systemfont) height and one quarter of the average character width.
2282 ''' The dialog editor (= the Basic IDE) also uses Map AppFont units.
2283 ''' Args:
2284 ''' Left : the horizontal distance from the top-left corner. It may be negative.
2285 ''' Top : the vertical distance from the top-left corner. It may be negative.
2286 ''' Width : the horizontal width of the rectangle containing the Dialog. It must be positive.
2287 ''' Height : the vertical height of the rectangle containing the Dialog. It must be positive.
2288 ''' Missing arguments are left unchanged.
2289 ''' Returns:
2290 ''' True when successful
2291 ''' Examples:
2294 Try:
2295 Resize = SF_DialogUtils._Resize([Me], Left, Top, Width, Height)
2297 End Function ' SFDialogss.SF_Dialog.Resize
2299 REM -----------------------------------------------------------------------------
2300 Public Function SetPageManager(Optional ByVal PilotControls As Variant _
2301 , Optional ByVal TabControls As Variant _
2302 , Optional ByVal WizardControls As Variant _
2303 , Optional ByVal LastPage As variant _
2304 ) As Boolean
2305 ''' Define how the dialog displays pages. The page manager is an alternative to the
2306 ''' direct use of the Page property of the dialog and dialogcontrol objects.
2307 '''
2308 ''' A dialog may have several pages that can be traversed by the user step by step.
2309 ''' The Page property of the Dialog object defines which page of the dialog is active.
2310 ''' The Page property of a control defines the page of the dialog on which the control is visible.
2311 ''' For example, if a control has a page value of 1, it is only visible on page 1 of the dialog.
2312 ''' If the page value of the dialog is increased from 1 to 2, then all controls with a page value of 1 disappear
2314 '''
2315 ''' The arguments define which controls are involved in the orchestration of the displayed pages.
2316 ''' Possible options:
2317 ''' - select a value in a list- or combobox
2318 ''' - select an item in a group of radio buttons
2319 ''' - select a button linked to a page - placed side-by-side the buttons can simulate a tabbed interface
2320 ''' - press a NEXT or BACK button like in many wizards
2321 ''' Those options may be combined. The control updates will be synchronized.
2322 ''' The method will set the actual page number to 1. Afterwards the Page property may be used to display any other page
2323 '''
2324 ''' The SetPageManager() method is to be run only once and before the Execute() statement.
2325 ''' If invoked several times, subsequent calls will be ignored.
2326 ''' The method will define new listeners on the concerned controls, addressing generic routines.
2327 ''' The corresponding events will be fired during the dialog execution.
2328 ''' Preset events (in the Basic IDE) will be preserved and executed immediately AFTER the page change.
2329 ''' The listeners will be removed at dialog termination.
2330 '''
2331 ''' Args:
2332 ''' PilotControls: a comma-separated list of listbox, combobox or radiobutton controls
2333 ''' For radio buttons, provide the first in the group
2334 ''' TabControls: a comma-separated list of button controls in ascending order
2335 ''' WizardControls: a comma-separated list of 2 controls, a BACK button and a NEXT button
2336 ''' LastPage: the index of the last available page. Recommended when use of WizardControls
2337 ''' Returns:
2338 ''' True when successful
2339 ''' Examples:
2340 ''' dialog.SetPageManager(PilotControls := "aListBox,aComboBox") ' 2 controls may cause page changes
2342 Dim bManager As Boolean ' Return value
2343 Dim vControls As Variant ' Array of involved controls
2344 Dim oControl As Object ' A DialogControl object
2345 Dim i As Long
2346 Const cstPrefix = "_SFTAB_" ' Prefix of Subs to trigger when involved controls are clicked
2350 Const cstSubArgs = "[PilotControls=""""], [TabControls=""""], [WizardControls=""""]"
2352 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2353 bManager = False
2355 Check:
2356 If IsMissing(PilotControls) Or IsEmpty(PilotControls) Then PilotControls = ""
2357 If IsMissing(TabControls) Or IsEmpty(TabControls) Then TabControls = ""
2358 If IsMissing(WizardControls) Or IsEmpty(WizardControls) Then WizardControls = ""
2359 If IsMissing(LastPage) Or IsEmpty(LastPage) Then LastPage = 0
2360 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2361 If Not ScriptForge.SF_Utils._Validate(PilotControls, "PilotControls", V_STRING) Then GoTo Finally
2362 If Not ScriptForge.SF_Utils._Validate(TabControls, "TabControls", V_STRING) Then GoTo Finally
2363 If Not ScriptForge.SF_Utils._Validate(WizardControls, "WizardControls", V_STRING) Then GoTo Finally
2364 If Not ScriptForge.SF_Utils._Validate(LastPage, "LastPage", ScriptForge.V_NUMERIC) Then GoTo Finally
2365 End If
2366 ' Ignore the call if already done before
2369 Try:
2370 ' Common listeners to all involved controls
2372 Set _ActionListener = CreateUnoListener(cstPrefix, "com.sun.star.awt.XActionListener")
2374 ' Register the arguments in the _PageManagement array, control by control
2375 ' Pilot controls
2377 vControls = Split(PilotControls, cstComma)
2378 For i = 0 To UBound(vControls)
2379 If Not _RegisterPageListener(Trim(vControls(i)), "ListBox,ComboBox,RadioButton", PILOTCONTROL, 0, ITEMSTATECHANGED) Then GoTo Catch
2380 Next i
2381 End If
2382 ' Tab controls
2384 vControls = Split(TabControls, cstComma)
2385 For i = 0 To UBound(vControls)
2386 If Not _RegisterPageListener(Trim(vControls(i)), "Button", TABCONTROL, i + 1, ACTIONPERFORMED) Then GoTo Catch
2387 Next i
2388 End If
2389 ' Wizard controls
2391 vControls = Split(WizardControls, cstComma)
2392 For i = 0 To UBound(vControls)
2393 If Not _RegisterPageListener(Trim(vControls(i)), "Button", Iif(i = 0, BACKCONTROL, NEXTCONTROL), 0, ACTIONPERFORMED) Then GoTo Catch
2394 Next i
2395 End If
2398 Page = 1
2399 _LastPage = LastPage
2401 Finally:
2402 SetPageManager = bManager
2403 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2404 Exit Function
2405 Catch:
2406 ScriptForge.SF_Exception.RaiseFatal(PAGEMANAGERERROR, "PilotControls", PilotControls, "TabControls", TabControls _
2408 GoTo Finally
2409 End Function ' SFDialogs.SF_Dialog.SetPageManager
2411 REM -----------------------------------------------------------------------------
2412 Public Function SetProperty(Optional ByVal PropertyName As Variant _
2413 , Optional ByRef Value As Variant _
2414 ) As Boolean
2415 ''' Set a new value to the given property
2416 ''' Args:
2417 ''' PropertyName: the name of the property as a string
2418 ''' Value: its new value
2419 ''' Exceptions
2420 ''' ARGUMENTERROR The property does not exist
2425 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2426 SetProperty = False
2428 Check:
2429 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2430 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
2431 End If
2433 Try:
2434 SetProperty = _PropertySet(PropertyName, Value)
2436 Finally:
2437 SF_Utils._ExitFunction(cstThisSub)
2438 Exit Function
2439 Catch:
2440 GoTo Finally
2441 End Function ' SFDialogs.SF_Dialog.SetProperty
2443 REM -----------------------------------------------------------------------------
2444 Public Function Terminate() As Boolean
2445 ''' Terminate the dialog service for the current dialog instance
2446 ''' After termination any action on the current instance will be ignored
2447 ''' Args:
2448 ''' Returns:
2449 ''' True if termination is successful
2450 ''' Example:
2451 ''' Dim oDlg As Object, lReturn As Long
2452 ''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library
2453 ''' lreturn = oDlg.Execute()
2454 ''' Select Case lReturn
2455 ''' ' ...
2456 ''' End Select
2457 ''' oDlg.Terminate()
2459 Dim bTerminate As Boolean ' Return value
2461 Const cstSubArgs = ""
2463 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2464 bTerminate = False
2466 Check:
2467 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2468 If Not _IsStillAlive() Then GoTo Finally
2469 End If
2471 Try:
2472 _RemoveAllListeners()
2473 _DialogControl.dispose()
2474 Set _DialogControl = Nothing
2475 SF_Register._CleanCacheEntry(_CacheIndex)
2476 _CacheIndex = -1
2477 Dispose()
2479 bTerminate = True
2481 Finally:
2482 Terminate = bTerminate
2483 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2484 Exit Function
2485 Catch:
2486 GoTo Finally
2487 End Function ' SFDialogs.SF_Dialog.Terminate
2489 REM =========================================================== PRIVATE FUNCTIONS
2491 REM -----------------------------------------------------------------------------
2492 Private Function _CheckNewControl(cstThisSub As String, cstSubArgs As String _
2493 , Optional ByVal ControlName As Variant _
2494 , ByRef Place As Variant _
2495 ) As Boolean
2496 ''' Check the generic arguments of a CreateXXX() method for control creation.
2497 ''' Called by the CreateButton, CreateCheckBox, ... specific methods
2498 ''' Args:
2499 ''' cstThisSub, cstSubArgs: caller routine and its arguments. Used to formulate an error message, if any.
2500 ''' ControlName: the name of the new control. It must not exist yet
2501 ''' Place: the size and position expressed in APPFONT units, either
2502 ''' - an array (X, Y, Width, Height) or Array(x, Y)
2503 ''' - a com.sun.star.awt.Rectangle structure
2504 ''' Exceptions:
2505 ''' DUPLICATECONTROLERROR A control with the same name exists already
2506 ''' Returns:
2507 ''' True when arguments passed the check
2509 Dim bCheck As Boolean ' Return value
2511 bCheck = False
2513 Check:
2514 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2515 If Not _IsStillAlive() Then GoTo Finally
2516 If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
2517 If IsArray(Place) Then
2518 If Not ScriptForge.SF_Utils._ValidateArray(Place, "Place", 1, ScriptForge.V_NUMERIC, True) Then GoTo Finally
2519 ElseIf Not IsNull(Place) Then
2520 If Not ScriptForge.SF_Utils._Validate(Place, "Place", ScriptForge.V_OBJECT) Then GoTo Finally
2521 End If
2522 End If
2523 If _DialogModel.hasByName(ControlName) Then GoTo CatchDuplicate
2525 bCheck = True
2527 Finally:
2528 _CheckNewControl = bCheck
2529 ' Call to _ExitFunction is done in the caller to allow handling of specific arguments
2530 Exit Function
2531 CatchDuplicate:
2532 ScriptForge.SF_Exception.RaiseFatal(DUPLICATECONTROLERROR, "ControlName", ControlName, _Name)
2533 GoTo Finally
2534 End Function ' SFDialogs.SF_Dialog._CheckNewControl
2536 REM -----------------------------------------------------------------------------
2537 Private Function _CreateNewControl(ByVal pvModel As Variant _
2538 , ByVal ControlName As Variant _
2539 , ByRef Place As Variant _
2540 , Optional ByRef ArgNames As Variant _
2541 , Optional ByRef ArgValues As Variant _
2542 ) As Object
2543 ''' Generic creation of a new control.
2544 ''' Called by the CreateButton, CreateCheckBox, ... specific methods
2545 ''' Args:
2546 ''' pvModel: one of the UnoControlxxx control models (as a string)
2547 ''' or such a model as a UNO class instance (cloned from an existing control)
2548 ''' ControlName: the name of the new control. It must not exist yet
2549 ''' Place: the size and position expressed in APPFONT units, either
2550 ''' - an array (X, Y, Width, Height)
2551 ''' - a com.sun.star.awt.Rectangle structure
2552 ''' ArgNames: the list of the specific arguments linked to the given pvModel
2553 ''' ArgValues: their values
2554 ''' Returns:
2555 ''' A new SF_DialogControl class instance or Nothing if creation failed
2557 Dim oControl As Object ' Return value
2558 Dim oControlModel As Object ' com.sun.star.awt.XControlModel
2559 Dim vPlace As Variant ' Alias of Place when object to avoid "Object variable not set" error
2560 Dim lCache As Long ' Number of elements in the controls cache
2561 Static oSession As Object
2563 Check:
2564 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2565 Set oControl = Nothing
2567 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
2569 If IsMissing(ArgNames) Or IsEmpty(ArgNames) Then ArgNames = Array()
2570 If IsMissing(ArgValues) Or IsEmpty(ArgValues) Then ArgValues = Array()
2572 Try:
2573 ' When the model is a string, create a new (empty) model instance
2574 Select Case VarType(pvModel)
2575 Case V_STRING : Set oControlModel = _DialogModel.createInstance("com.sun.star.awt." & pvModel)
2576 Case ScriptForge.V_OBJECT : Set oControlModel = pvModel
2577 End Select
2579 oControlModel.Name = ControlName
2581 ' Set dimension and position
2582 With oControlModel
2583 If IsArray(Place) Then
2584 ' Ignore width and height when new control is cloned from an existing one
2586 .PositionX = Place(0)
2587 .PositionY = Place(1)
2588 End If
2590 .Width = Place(2)
2591 .Height = Place(3)
2592 End If
2594 Set vPlace = Place
2595 .PositionX = vPlace.X
2596 .PositionY = vPlace.Y
2597 .Width = vPlace.Width
2598 .Height = vPlace.Height
2599 Else
2600 'Leave everything to zero
2601 End If
2602 End With
2604 ' Store the specific properties in the model
2607 ' Insert the new completed control model in the dialog
2608 _DialogModel.insertByName(ControlName, oControlModel)
2610 ' Update controls cache - existing cache is presumed unchanged: new control is added at the end of Model.ElementNames
2611 lCache = UBound(_ControlCache)
2614 Else
2616 End If
2618 ' Now the UNO control exists, build the SF_DialogControl instance as usual
2619 Set oControl = Controls(ControlName)
2621 Finally:
2622 Set _CreateNewControl = oControl
2623 Exit Function
2624 Catch:
2625 GoTo Finally
2626 End Function ' SFDialogs.SF_Dialog._CreateNewControl
2628 REM -----------------------------------------------------------------------------
2629 Private Function _FindRadioSiblings(ByVal psRadioButton As String) As String
2630 ''' Given the name of the first radio button of a group, return all the names of the group
2631 ''' For dialogs, radio buttons are considered of the same group
2632 ''' when their tab indexes are contiguous.
2633 ''' Args:
2635 ''' Returns:
2637 ''' belonging to the same group in their tabindex order.
2638 ''' The input argument when not a radio button
2641 Dim sList As String ' Return value
2642 Dim oRadioControl As Object ' DialogControl instance corresponding with the argument
2643 Dim oControl As Object ' DialogControl instance
2644 Dim vRadioList As Variant ' Array of all radio buttons having a tab index > tab index of argument
2646 Dim iRadioTabIndex As Integer ' Tab index of the argument
2647 Dim iTabIndex As Integer ' Any tab index
2648 Dim vControlNames As Variant ' Array of control names
2649 Dim sControlName As String ' A single item in vControlNames()
2650 Dim i As Long
2653 Check:
2654 On Local Error GoTo Catch
2655 sList = psRadioButton
2656 vRadioList = Array()
2658 Try:
2659 Set oRadioControl = Controls(psRadioButton)
2661 iRadioTabIndex = oRadioControl._ControlModel.Tabindex
2662 vRadioList = ScriptForge.SF_Array.AppendRow(vRadioList, Array(psRadioButton, iRadioTabIndex))
2665 vControlNames = Controls()
2666 For Each sControlName In vControlNames
2667 Set oControl = Controls(sControlName)
2668 With oControl
2669 If .Name <> psRadioButton Then
2671 iTabIndex = ._ControlModel.Tabindex
2672 If iTabIndex > iRadioTabIndex Then
2673 vRadioList = ScriptForge.SF_Array.AppendRow(vRadioList, Array(.Name, iTabIndex))
2674 End If
2675 End If
2676 End If
2677 End With
2678 Next sControlName
2680 vRadioList = ScriptForge.SF_Array.SortRows(vRadioList, 1)
2681 ' Retain contiguous tab indexes
2683 If vRadioList(i, 1) = iRadioTabIndex + i Then sList = sList & cstComma & vRadioList(i, 0)
2684 Next i
2686 Finally:
2687 _FindRadioSiblings = sList
2688 Exit Function
2689 Catch:
2690 sList = psRadioButton
2691 GoTo Finally
2692 End Function ' SFDialogs.SF_Dialog._FindRadioSiblings
2694 REM -----------------------------------------------------------------------------
2695 Public Function _GetEventName(ByVal psProperty As String) As String
2696 ''' Return the LO internal event name derived from the SF property name
2697 ''' The SF property name is not case sensitive, while the LO name is case-sensitive
2698 ' Corrects the typo on ErrorOccur(r?)ed, if necessary
2700 Dim vProperties As Variant ' Array of class properties
2701 Dim sProperty As String ' Correctly cased property name
2703 vProperties = Properties()
2704 sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
2708 End Function ' SFDialogs.SF_Dialog._GetEventName
2710 REM -----------------------------------------------------------------------------
2711 Private Function _GetListener(ByVal psEventName As String) As String
2712 ''' Getting/Setting macros triggered by events requires a Listener-EventName pair
2713 ''' Return the X...Listener corresponding with the event name in argument
2715 Select Case UCase(psEventName)
2722 Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased")
2724 Case Else
2725 _GetListener = ""
2726 End Select
2728 End Function ' SFDialogs.SF_Dialog._GetListener
2730 REM -----------------------------------------------------------------------------
2731 Public Sub _Initialize()
2732 ''' Complete the object creation process:
2733 ''' - Initialization of private members
2734 ''' - Creation of the dialog graphical interface
2735 ''' - Addition of the new object in the Dialogs buffer
2736 ''' - Initialisation of persistent storage for controls
2738 Dim lControls As Long ' Number of controls at dialog creation
2739 Try:
2740 ' Keep reference to model
2741 Set _DialogModel = _DialogControl.Model
2743 ' Store initial position and dimensions
2744 With _DialogModel
2745 _Left = .PositionX
2746 _Top = .PositionY
2747 _Width = .Width
2748 _Height = .Height
2749 End With
2751 ' Add dialog reference to cache
2752 _CacheIndex = SF_Register._AddDialogToCache(_DialogControl, [Me])
2754 ' Size the persistent storage
2755 _ControlCache = Array()
2756 lControls = UBound(_DialogModel.getElementNames())
2759 Finally:
2760 Exit Sub
2761 End Sub ' SFDialogs.SF_Dialog._Initialize
2763 REM -----------------------------------------------------------------------------
2764 Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
2765 ''' Return True if the dialog service is still active
2766 ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
2767 ''' Args:
2768 ''' pbError: if True (default), raise a fatal error
2770 Dim bAlive As Boolean ' Return value
2771 Dim sDialog As String ' Alias of DialogName
2773 Check:
2774 On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
2775 If IsMissing(pbError) Then pbError = True
2777 Try:
2778 bAlive = ( Not IsNull(_DialogProvider) Or _BuiltFromScratch )
2779 If bAlive Then bAlive = Not IsNull(_DialogControl)
2780 If Not bAlive Then GoTo Catch
2782 Finally:
2783 _IsStillAlive = bAlive
2784 Exit Function
2785 Catch:
2786 bAlive = False
2787 On Error GoTo 0
2788 sDialog = _Name
2789 Dispose()
2790 If pbError Then ScriptForge.SF_Exception.RaiseFatal(DIALOGDEADERROR, sDialog)
2791 GoTo Finally
2792 End Function ' SFDialogs.SF_Dialog._IsStillAlive
2794 REM -----------------------------------------------------------------------------
2795 Private Sub _JumpToPage(ByVal plPage As Long)
2796 ''' Called when the Page property is set to a new value
2797 ''' The rules defined in the _pageManagement array are applied here
2799 Dim oPageManager As Object ' A single entry in _PageManagement of type _PageManager
2800 Dim oControl As Object ' DialogControl instance
2801 Dim lPage As Long ' A dialog page number
2803 Check:
2804 On Local Error GoTo Finally
2806 ' PageMgtType As Integer ' One of the PILOTCONTROL, TABCONTROL, BACKCONTROL, NEXTCONTROL constants
2813 Try:
2814 ' Controls listed in the array must be synchronized with the page #
2815 ' Listboxes and comboboxes must be set to the corresponding value
2816 ' The right radio button must be selected
2817 ' One corresponding button must be dimmed, other must be enabled
2818 ' The Next button must be dimmed when last page otherwise enabled
2819 For Each oPageManager In _PageManagement
2820 With oPageManager
2821 lPage = .PageNumber
2822 Set oControl = Controls(.ControlName)
2823 With oControl
2824 Select Case .ControlType
2828 .Value = ( plPage = lPage )
2830 Select Case oPageManager.PageMgtType
2831 Case TABCONTROL
2832 .Value = ( plPage = lPage )
2833 Case BACKCONTROL
2835 Case NEXTCONTROL
2837 Case Else
2838 End Select
2839 Case Else
2840 End Select
2841 End With
2842 End With
2843 Next oPageManager
2845 Finally:
2846 Exit Sub
2847 End Sub ' SFDialogs.SF_Dialog._JumpToPage
2849 REM -----------------------------------------------------------------------------
2850 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
2851 ''' Return the value of the named property
2852 ''' Args:
2853 ''' psProperty: the name of the property
2855 Static oSession As Object ' Alias of SF_Session
2856 Dim oPosSize As Object ' com.sun.star.awt.Rectangle
2857 Dim oDialogEvents As Object ' com.sun.star.container.XNameContainer
2858 Dim sEventName As String ' Internal event name
2859 Dim cstThisSub As String
2860 Const cstSubArgs = ""
2863 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2865 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
2866 If Not _IsStillAlive() Then GoTo Finally
2868 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
2869 Select Case UCase(psProperty)
2871 If oSession.HasUNOProperty(_DialogModel, "Title") Then _PropertyGet = _DialogModel.Title
2873 If _Displayed Then ' Convert PosSize view property from pixels to APPFONT units
2874 _PropertyGet = SF_DialogUtils._ConvertToAppFont(_DialogControl, False).Height
2875 Else
2876 If oSession.HasUNOProperty(_DialogModel, "Height") Then _PropertyGet = _DialogModel.Height
2877 End If
2879 _PropertyGet = _Modal
2881 _PropertyGet = _Name
2882 Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
2883 , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
2885 ' Check OnEvents set statically in Basic IDE
2886 Set oDialogEvents = _DialogModel.getEvents()
2887 sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & _GetEventName(psProperty)
2888 If oDialogEvents.hasByName(sEventName) Then
2889 _PropertyGet = oDialogEvents.getByName(sEventName).ScriptCode
2890 Else
2891 ' Check OnEvents set dynamically by code
2892 Select Case UCase(psProperty)
2903 Case Else : _PropertyGet = ""
2904 End Select
2905 End If
2907 If oSession.HasUNOProperty(_DialogModel, "Step") Then _PropertyGet = _DialogModel.Step
2909 If oSession.HasUnoMethod(_DialogControl, "isVisible") Then _PropertyGet = CBool(_DialogControl.isVisible())
2911 If _Displayed Then ' Convert PosSize view property from pixels to APPFONT units
2912 _PropertyGet = SF_DialogUtils._ConvertToAppFont(_DialogControl, False).Width
2913 Else
2914 If oSession.HasUNOProperty(_DialogModel, "Width") Then _PropertyGet = _DialogModel.Width
2915 End If
2917 Set _PropertyGet = _DialogModel
2919 Set _PropertyGet = _DialogControl
2920 Case Else
2921 _PropertyGet = Null
2922 End Select
2924 Finally:
2925 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2926 Exit Function
2927 Catch:
2928 GoTo Finally
2929 End Function ' SFDialogs.SF_Dialog._PropertyGet
2931 REM -----------------------------------------------------------------------------
2932 Private Function _PropertySet(Optional ByVal psProperty As String _
2933 , Optional ByVal pvValue As Variant _
2934 ) As Boolean
2935 ''' Set the new value of the named property
2936 ''' Args:
2937 ''' psProperty: the name of the property
2938 ''' pvValue: the new value of the given property
2939 ''' Returns:
2940 ''' True if successful
2942 Dim bSet As Boolean ' Return value
2943 Static oSession As Object ' Alias of SF_Session
2944 Dim cstThisSub As String
2947 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2948 bSet = False
2951 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
2952 If Not _IsStillAlive() Then GoTo Finally
2954 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
2955 bSet = True
2956 Select Case UCase(psProperty)
2961 If Not ScriptForge.SF_Utils._Validate(pvValue, "Height", ScriptForge.V_NUMERIC) Then GoTo Catch
2962 bSet = Resize(Height := pvValue)
2963 Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
2964 , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
2966 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Catch
2967 bSet = SF_DialogListener._SetOnProperty([Me], psProperty, pvValue)
2969 If Not ScriptForge.SF_Utils._Validate(pvValue, "Page", ScriptForge.V_NUMERIC) Then GoTo Catch
2971 _DialogModel.Step = CLng(pvValue)
2972 ' Execute the page manager instructions
2973 _JumpToPage(pvValue)
2974 End If
2976 If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Catch
2977 If oSession.HasUnoMethod(_DialogControl, "setVisible") Then _DialogControl.setVisible(pvValue)
2979 If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch
2980 bSet = Resize(Width := pvValue)
2981 Case Else
2982 bSet = False
2983 End Select
2985 Finally:
2986 _PropertySet = bSet
2987 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2988 Exit Function
2989 Catch:
2990 bSet = False
2991 GoTo Finally
2992 End Function ' SFDialogs.SF_Dialog._PropertySet
2994 REM -----------------------------------------------------------------------------
2995 Private Function _RegisterPageListener(ByVal psControlName As String _
2996 , ByVal psControlTypes As String _
2997 , ByVal piMgtType As Integer _
2998 , ByVal plPageNumber As Long _
2999 , ByVal piListener As Integer _
3000 ) As Boolean
3001 ''' Insert a new entry in the _PageManagement array when 1st argument is a listbox, a combobox or a button
3002 ''' or insert a new entry in the _PageManagement array by radio button in the same group as the 1st argument
3003 ''' Args:
3004 ''' psControlName: name of the involved control
3005 ''' psControlTypes: comma-separated list of allowed control types
3006 ''' piMgtType: one of the PILOTCONTROL, TABCONTROL, BACKCONTROL, NEXTCONTROL constants
3008 ''' piListener: one of the ACTIONPERFORMED, ITEMSTATECHANGED constants
3010 Dim bRegister As Boolean ' Return value
3011 Dim oControl As Object ' A DialogControl object
3012 Dim oControl2 As Object ' An alternative DialogControl object for radio buttons
3013 Dim vControls As Variant ' Array of involved controls - mostly 1 item, more when radio button
3014 Dim oPageManager As Object ' Type _PageManager
3015 Dim bRadio As Boolean ' True when argument is a radio button
3016 Dim sName As String ' Control name
3017 Dim i As Long
3019 Check:
3020 On Local Error GoTo Catch
3021 bRegister = False
3023 Try:
3024 Set oControl = Controls(psControlName)
3025 With oControl
3026 ' Check the type of control otherwise return False
3027 If InStr(psControlTypes, .ControlType) = 0 Then GoTo Catch
3028 ' Are there siblings ? Siblings are returned as a comma-separated list of names
3030 If bRadio Then vControls = Split(_FindRadioSiblings(.Name), ",") Else vControls = Array(.Name)
3031 ' Several loops when radio buttons
3032 For i = 0 To UBound(vControls)
3033 sName = vControls(i)
3034 ' Prepare the next entry in the _PageManagement array
3035 Set oPageManager = New _PageManager
3036 With oPageManager
3037 .ControlName = sName
3038 .PageMgtType = piMgtType
3039 .PageNumber = Iif(bRadio, i + 1, plPageNumber)
3040 .ListenerType = piListener
3041 End With
3042 _PageManagement = ScriptForge.SF_Array.Append(_PageManagement, oPageManager)
3043 ' Activate the listener
3045 If i = 0 Then Set oControl2 = oControl Else Set oControl2 = Controls(sName)
3046 With oControl2
3047 If piListener = ACTIONPERFORMED Then
3048 ._ControlView.addActionListener(_ActionListener)
3049 ElseIf piListener = ITEMSTATECHANGED Then
3050 ._ControlView.addItemListener(_ItemListener)
3051 End If
3052 End With
3053 Next i
3054 End With
3056 bRegister = True
3058 Finally:
3059 _RegisterPageListener = bRegister
3060 Exit Function
3061 Catch:
3062 GoTo Finally
3063 End Function ' SFDialogs.SF_Dialog._RegisterPageListener
3065 REM -----------------------------------------------------------------------------
3066 Private Sub _RemoveAllListeners()
3067 ''' Executed at dialog termination to drop at once all listeners set
3068 ''' either by the page manager or by an On-property setting
3070 Dim oPageManager As Object ' Item of _PageManagement array of _PageManager type
3071 Dim oControl As Object ' DialogControl instance
3072 Dim i As Long
3074 On Local Error GoTo Finally ' Never interrupt
3076 Try:
3077 ' Scan the _PageManagement array containing the actual settings of the page manager
3078 For Each oPageManager In _PageManagement
3079 With oPageManager
3081 Set oControl = Controls(.ControlName)
3082 If .ListenerType = ACTIONPERFORMED Then
3083 oControl._ControlView.removeActionListener(_ActionListener)
3084 ElseIf .ListenerType = ITEMSTATECHANGED Then
3085 oControl._ControlView.removeItemListener(_ItemListener)
3086 End If
3087 End If
3088 End With
3089 Next oPageManager
3091 Set _ActionListener = Nothing
3092 Set _ItemListener = Nothing
3094 ' Clean listeners linked to On properties
3095 With _DialogControl
3096 If Not IsNull(_FocusListener) Then .removeFocusListener(_FocusListener)
3097 If Not IsNull(_KeyListener) Then .removeKeyListener(_KeyListener)
3098 If Not IsNull(_MouseListener) Then .removeMouseListener(_MouseListener)
3099 If Not IsNull(_MouseMotionListener) Then .removeMouseMotionListener(_MouseMotionListener)
3100 End With
3102 Set _FocusListener = Nothing
3103 Set _KeyListener = Nothing
3104 Set _MouseListener = Nothing
3105 Set _MouseMotionListener = Nothing
3107 Finally:
3108 Exit Sub
3109 End Sub ' SFDialogs.SF_Dialog._RemoveAllListeners
3110 REM -----------------------------------------------------------------------------
3111 Private Function _Repr() As String
3112 ''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
3113 ''' Args:
3114 ''' Return:
3117 _Repr = "[DIALOG]: " & _Container & "." & _Library & "." & _Name
3119 End Function ' SFDialogs.SF_Dialog._Repr
3121 REM ============================================ END OF SFDIALOGS.SF_DIALOG
3122 </script:module>