diff options
| author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-15 05:54:39 +0000 |
|---|---|---|
| committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-15 05:54:39 +0000 |
| commit | 267c6f2ac71f92999e969232431ba04678e7437e (patch) | |
| tree | 358c9467650e1d0a1d7227a21dac2e3d08b622b2 /wizards/source/sfdialogs | |
| parent | Initial commit. (diff) | |
| download | libreoffice-267c6f2ac71f92999e969232431ba04678e7437e.tar.xz libreoffice-267c6f2ac71f92999e969232431ba04678e7437e.zip | |
Adding upstream version 4:24.2.0.upstream/4%24.2.0
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'wizards/source/sfdialogs')
| -rw-r--r-- | wizards/source/sfdialogs/SF_Dialog.xba | 3122 | ||||
| -rw-r--r-- | wizards/source/sfdialogs/SF_DialogControl.xba | 2514 | ||||
| -rw-r--r-- | wizards/source/sfdialogs/SF_DialogListener.xba | 633 | ||||
| -rw-r--r-- | wizards/source/sfdialogs/SF_DialogUtils.xba | 332 | ||||
| -rw-r--r-- | wizards/source/sfdialogs/SF_Register.xba | 454 | ||||
| -rw-r--r-- | wizards/source/sfdialogs/__License.xba | 26 | ||||
| -rw-r--r-- | wizards/source/sfdialogs/dialog.xlb | 3 | ||||
| -rw-r--r-- | wizards/source/sfdialogs/script.xlb | 10 |
8 files changed, 7094 insertions, 0 deletions
diff --git a/wizards/source/sfdialogs/SF_Dialog.xba b/wizards/source/sfdialogs/SF_Dialog.xba new file mode 100644 index 0000000000..bbbeddd111 --- /dev/null +++ b/wizards/source/sfdialogs/SF_Dialog.xba @@ -0,0 +1,3122 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Dialog" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === The SFDialogs library is one of the associated libraries. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option ClassModule + +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Dialog +''' ========= +''' Management of dialogs. They may be defined with the Basic IDE or built from scratch +''' Each instance of the current class represents a single dialog box displayed to the user +''' +''' A dialog box can be displayed in modal or in non-modal modes +''' +''' In modal mode, the box is displayed and the execution of the macro process is suspended +''' until one of the OK or Cancel buttons is pressed. In the meantime, other user actions +''' executed on the box can trigger specific actions. +''' +''' In non-modal mode, the dialog box is "floating" on the user desktop and the execution +''' of the macro process continues normally +''' A dialog box disappears from memory after its explicit termination. +''' +''' Service invocation and usage: +''' +''' 1) when the dialog exists in some dialog libraries (= pre-defined with the Basic IDE): +''' Dim myDialog As Object, lButton As Long +''' Set myDialog = CreateScriptService("SFDialogs.Dialog", Container, Library, DialogName) +''' ' Args: +''' ' Container: "GlobalScope" for preinstalled libraries +''' ' A window name (see its definition in the ScriptForge.UI service) +''' ' "" (default) = the current document +''' ' Library: The (case-sensitive) name of a library contained in the container +''' ' Default = "Standard" +''' ' DialogName: a case-sensitive string designating the dialog where it is about +''' ' ... Initialize controls ... +''' lButton = myDialog.Execute() ' Default mode = Modal +''' If lButton = myDialog.OKBUTTON Then +''' ' ... Process controls and do what is needed +''' End If +''' myDialog.Terminate() +''' +''' 2) when the dialog is fully defined by code: +''' Dim myDialog As Object, oButton As Object lExec As Long +''' Set myDialog = CreateScriptService("SFDialogs.NewDialog", DialogName, Place) +''' ' Args: +''' ' DialogName: a case-sensitive string designating the dialog +''' Place: either +''' - an array with 4 elements: (X, Y, Width, Height) +''' - a com.sun.star.awt.Rectangle [X, Y, Width, Height] +''' (All elements are expressed in "Map AppFont" units). +''' ' ... Create controls with the CreateXXX(...) methods ..., e.g. +''' Set oButton = myDialog.CreateButton("OKButton", Place := Array(100, 100, 20, 10), Push := "OK") +''' lExec = myDialog.Execute() ' Default mode = Modal +''' If lExec = myDialog.OKBUTTON Then +''' ' ... Process controls and do what is needed +''' End If +''' myDialog.Terminate() +''' +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_dialog.html?DbPAR=BASIC +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Private Const DIALOGDEADERROR = "DIALOGDEADERROR" +Private Const PAGEMANAGERERROR = "PAGEMANAGERERROR" +Private Const DUPLICATECONTROLERROR = "DUPLICATECONTROLERROR" + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private [_Parent] As Object +Private ObjectType As String ' Must be DIALOG +Private ServiceName As String + +' Dialog location +Private _Container As String +Private _Library As String +Private _BuiltFromScratch As Boolean ' When True, dialog is not stored in a library +Private _BuiltInPython As Boolean ' Used only when _BuiltFromScratch = True +Private _Name As String +Private _CacheIndex As Long ' Index in cache storage + +' Dialog UNO references +Private _DialogProvider As Object ' com.sun.star.io.XInputStreamProvider +Private _DialogControl As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl +Private _DialogModel As Object ' com.sun.star.awt.XControlModel - stardiv.Toolkit.UnoControlDialogModel + +' Dialog attributes +Private _Displayed As Boolean ' True after Execute() +Private _Modal As Boolean ' Set by Execute() + +' Dialog initial position and dimensions in APPFONT units +Private _Left As Long +Private _Top As Long +Private _Width As Long +Private _Height As Long + +' Page management +Type _PageManager + ControlName As String ' Case-sensitive name of control involved in page management + PageMgtType As Integer ' One of the PILOTCONTROL, TABCONTROL, NEXTCONTROL, BACKCONTROL constants + PageNumber As Long ' When > 0, the page to activate for tab controls + ListenerType As Integer ' One of the ITEMSTATECHANGED, ACTIONPERFORMED constants +End Type + +Private _PageManagement As Variant ' Array of _PageManager objects, one entry by involved control +Private _ItemListener As Object ' com.sun.star.awt.XItemListener +Private _ActionListener As Object ' com.sun.star.awt.XActionListener +Private _LastPage As Long ' When > 0, the last page in a tabbed dialog + +' Updatable events +' Next identifiers MUST be identical in both SF_Dialog and SF_DialogControl class modules +Private _FocusListener As Object ' com.sun.star.awt.XFocusListener +Private _OnFocusGained As String ' Script to invoke when dialog gets focus +Private _OnFocusLost As String ' Script to invoke when dialog loses focus +Private _FocusCounter As Integer ' Counts the number of events set on the listener +' --- +Private _KeyListener As Object ' com.sun.star.awt.XKeyListener +Private _OnKeyPressed As String ' Script to invoke when Key clicked in dialog +Private _OnKeyReleased As String ' Script to invoke when Key released in dialog +Private _KeyCounter As Integer ' Counts the number of events set on the listener +' --- +Private _MouseListener As Object ' com.sun.star.awt.XMouseListener +Private _OnMouseEntered As String ' Script to invoke when mouse enters dialog +Private _OnMouseExited As String ' Script to invoke when mouse leaves dialog +Private _OnMousePressed As String ' Script to invoke when mouse clicked in dialog +Private _OnMouseReleased As String ' Script to invoke when mouse released in dialog +Private _MouseCounter As Integer ' Counts the number of events set on the listener +' --- +Private _MouseMotionListener As Object ' com.sun.star.awt.XMouseMotionListener +Private _OnMouseDragged As String ' Script to invoke when mouse is dragged from the dialog +Private _OnMouseMoved As String ' Script to invoke when mouse is moved across the dialog +Private _MouseMotionCounter As Integer ' Counts the number of events set on the listener + +' Persistent storage for controls +Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of the Dialog model + +REM ============================================================ MODULE CONSTANTS + +' Dialog usual buttons +Private Const cstOKBUTTON = 1 +Private Const cstCANCELBUTTON = 0 + +' Page management +Private Const PILOTCONTROL = 1 +Private Const TABCONTROL = 2 +Private Const BACKCONTROL = 3 +Private Const NEXTCONTROL = 4 +Private Const ITEMSTATECHANGED = 1 +Private Const ACTIONPERFORMED = 2 + +REM ====================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + ObjectType = "DIALOG" + ServiceName = "SFDialogs.Dialog" + _Container = "" + _Library = "" + _BuiltFromScratch = False + _BuiltInPython = False + _Name = "" + _CacheIndex = -1 + Set _DialogProvider = Nothing + Set _DialogControl = Nothing + Set _DialogModel = Nothing + _Displayed = False + _Modal = True + + _Left = SF_DialogUtils.MINPOSITION + _Top = SF_DialogUtils.MINPOSITION + _Width = -1 + _Height = -1 + + _PageManagement = Array() + Set _ItemListener = Nothing + Set _ActionListener = Nothing + _LastPage = 0 + + Set _FocusListener = Nothing + _OnFocusGained = "" + _OnFocusLost = "" + _FocusCounter = 0 + Set _KeyListener = Nothing + _OnKeyPressed = "" + _OnKeyReleased = "" + _KeyCounter = 0 + Set _MouseListener = Nothing + _OnMouseEntered = "" + _OnMouseExited = "" + _OnMousePressed = "" + _OnMouseReleased = "" + _MouseCounter = 0 + Set _MouseMotionListener = Nothing + _OnMouseDragged = "" + _OnMouseMoved = "" + _MouseMotionCounter = 0 + _ControlCache = Array() +End Sub ' SFDialogs.SF_Dialog Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' SFDialogs.SF_Dialog Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + If _CacheIndex >= 0 Then Terminate() + Call Class_Terminate() + Set Dispose = Nothing +End Function ' SFDialogs.SF_Dialog Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get CANCELBUTTON() As Variant + CANCELBUTTON = cstCANCELBUTTON +End Property ' SFDialogs.SF_Dialog.CANCELBUTTON (get) + +REM ----------------------------------------------------------------------------- +Property Get Caption() As Variant +''' The Caption property refers to the title of the dialog + Caption = _PropertyGet("Caption") +End Property ' SFDialogs.SF_Dialog.Caption (get) + +REM ----------------------------------------------------------------------------- +Property Let Caption(Optional ByVal pvCaption As Variant) +''' Set the updatable property Caption + _PropertySet("Caption", pvCaption) +End Property ' SFDialogs.SF_Dialog.Caption (let) + +REM ----------------------------------------------------------------------------- +Property Get Height() As Variant +''' The Height property refers to the height of the dialog box + Height = _PropertyGet("Height") +End Property ' SFDialogs.SF_Dialog.Height (get) + +REM ----------------------------------------------------------------------------- +Property Let Height(Optional ByVal pvHeight As Variant) +''' Set the updatable property Height + _PropertySet("Height", pvHeight) +End Property ' SFDialogs.SF_Dialog.Height (let) + +REM ----------------------------------------------------------------------------- +Property Get Modal() As Boolean +''' The Modal property specifies if the dialog box has been executed in modal mode + Modal = _PropertyGet("Modal") +End Property ' SFDialogs.SF_Dialog.Modal (get) + +REM ----------------------------------------------------------------------------- +Property Get Name() As String +''' Return the name of the actual dialog + Name = _PropertyGet("Name") +End Property ' SFDialogs.SF_Dialog.Name + +REM ----------------------------------------------------------------------------- +Property Get OKBUTTON() As Variant + OKBUTTON = cstOKBUTTON +End Property ' SFDialogs.SF_Dialog.OKBUTTON (get) + +REM ----------------------------------------------------------------------------- +Property Get OnFocusGained() As Variant +''' Get the script associated with the OnFocusGained event + OnFocusGained = _PropertyGet("OnFocusGained") +End Property ' SFDialogs.SF_Dialog.OnFocusGained (get) + +REM ----------------------------------------------------------------------------- +Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant) +''' Set the updatable property OnFocusGained + _PropertySet("OnFocusGained", pvOnFocusGained) +End Property ' SFDialogs.SF_Dialog.OnFocusGained (let) + +REM ----------------------------------------------------------------------------- +Property Get OnFocusLost() As Variant +''' Get the script associated with the OnFocusLost event + OnFocusLost = _PropertyGet("OnFocusLost") +End Property ' SFDialogs.SF_Dialog.OnFocusLost (get) + +REM ----------------------------------------------------------------------------- +Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant) +''' Set the updatable property OnFocusLost + _PropertySet("OnFocusLost", pvOnFocusLost) +End Property ' SFDialogs.SF_Dialog.OnFocusLost (let) + +REM ----------------------------------------------------------------------------- +Property Get OnKeyPressed() As Variant +''' Get the script associated with the OnKeyPressed event + OnKeyPressed = _PropertyGet("OnKeyPressed") +End Property ' SFDialogs.SF_Dialog.OnKeyPressed (get) + +REM ----------------------------------------------------------------------------- +Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant) +''' Set the updatable property OnKeyPressed + _PropertySet("OnKeyPressed", pvOnKeyPressed) +End Property ' SFDialogs.SF_Dialog.OnKeyPressed (let) + +REM ----------------------------------------------------------------------------- +Property Get OnKeyReleased() As Variant +''' Get the script associated with the OnKeyReleased event + OnKeyReleased = _PropertyGet("OnKeyReleased") +End Property ' SFDialogs.SF_Dialog.OnKeyReleased (get) + +REM ----------------------------------------------------------------------------- +Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant) +''' Set the updatable property OnKeyReleased + _PropertySet("OnKeyReleased", pvOnKeyReleased) +End Property ' SFDialogs.SF_Dialog.OnKeyReleased (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMouseDragged() As Variant +''' Get the script associated with the OnMouseDragged event + OnMouseDragged = _PropertyGet("OnMouseDragged") +End Property ' SFDialogs.SF_Dialog.OnMouseDragged (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant) +''' Set the updatable property OnMouseDragged + _PropertySet("OnMouseDragged", pvOnMouseDragged) +End Property ' SFDialogs.SF_Dialog.OnMouseDragged (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMouseEntered() As Variant +''' Get the script associated with the OnMouseEntered event + OnMouseEntered = _PropertyGet("OnMouseEntered") +End Property ' SFDialogs.SF_Dialog.OnMouseEntered (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant) +''' Set the updatable property OnMouseEntered + _PropertySet("OnMouseEntered", pvOnMouseEntered) +End Property ' SFDialogs.SF_Dialog.OnMouseEntered (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMouseExited() As Variant +''' Get the script associated with the OnMouseExited event + OnMouseExited = _PropertyGet("OnMouseExited") +End Property ' SFDialogs.SF_Dialog.OnMouseExited (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant) +''' Set the updatable property OnMouseExited + _PropertySet("OnMouseExited", pvOnMouseExited) +End Property ' SFDialogs.SF_Dialog.OnMouseExited (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMouseMoved() As Variant +''' Get the script associated with the OnMouseMoved event + OnMouseMoved = _PropertyGet("OnMouseMoved") +End Property ' SFDialogs.SF_Dialog.OnMouseMoved (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant) +''' Set the updatable property OnMouseMoved + _PropertySet("OnMouseMoved", pvOnMouseMoved) +End Property ' SFDialogs.SF_Dialog.OnMouseMoved (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMousePressed() As Variant +''' Get the script associated with the OnMousePressed event + OnMousePressed = _PropertyGet("OnMousePressed") +End Property ' SFDialogs.SF_Dialog.OnMousePressed (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant) +''' Set the updatable property OnMousePressed + _PropertySet("OnMousePressed", pvOnMousePressed) +End Property ' SFDialogs.SF_Dialog.OnMousePressed (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMouseReleased() As Variant +''' Get the script associated with the OnMouseReleased event + OnMouseReleased = _PropertyGet("OnMouseReleased") +End Property ' SFDialogs.SF_Dialog.OnMouseReleased (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant) +''' Set the updatable property OnMouseReleased + _PropertySet("OnMouseReleased", pvOnMouseReleased) +End Property ' SFDialogs.SF_Dialog.OnMouseReleased (let) + +REM ----------------------------------------------------------------------------- +Property Get Page() As Variant +''' A dialog may have several pages that can be traversed by the user step by step. +''' The Page property of the Dialog object defines which page of the dialog is active. +''' The Page property of a control defines the page of the dialog on which the control is visible. +''' For example, if a control has a page value of 1, it is only visible on page 1 of the dialog. +''' If the page value of the dialog is increased from 1 to 2, then all controls with a page value of 1 disappear +''' and all controls with a page value of 2 become visible. + Page = _PropertyGet("Page") +End Property ' SFDialogs.SF_Dialog.Page (get) + +REM ----------------------------------------------------------------------------- +Property Let Page(Optional ByVal pvPage As Variant) +''' Set the updatable property Page + _PropertySet("Page", pvPage) +End Property ' SFDialogs.SF_Dialog.Page (let) + +REM ----------------------------------------------------------------------------- +Property Get Visible() As Variant +''' The Visible property is False before the Execute() statement + Visible = _PropertyGet("Visible") +End Property ' SFDialogs.SF_Dialog.Visible (get) + +REM ----------------------------------------------------------------------------- +Property Let Visible(Optional ByVal pvVisible As Variant) +''' Set the updatable property Visible + _PropertySet("Visible", pvVisible) +End Property ' SFDialogs.SF_Dialog.Visible (let) + +REM ----------------------------------------------------------------------------- +Property Get Width() As Variant +''' The Width property refers to the Width of the dialog box + Width = _PropertyGet("Width") +End Property ' SFDialogs.SF_Dialog.Width (get) + +REM ----------------------------------------------------------------------------- +Property Let Width(Optional ByVal pvWidth As Variant) +''' Set the updatable property Width + _PropertySet("Width", pvWidth) +End Property ' SFDialogs.SF_Dialog.Width (let) + +REM ----------------------------------------------------------------------------- +Property Get XDialogModel() As Object +''' The XDialogModel property returns the model UNO object of the dialog + XDialogModel = _PropertyGet("XDialogModel") +End Property ' SFDialogs.SF_Dialog.XDialogModel (get) + +REM ----------------------------------------------------------------------------- +Property Get XDialogView() As Object +''' The XDialogView property returns the view UNO object of the dialog + XDialogView = _PropertyGet("XDialogView") +End Property ' SFDialogs.SF_Dialog.XDialogView (get) + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function Activate() As Boolean +''' Set the focus on the current dialog instance +''' Probably called from after an event occurrence or to focus on a non-modal dialog +''' Args: +''' Returns: +''' True if focusing is successful +''' Example: +''' Dim oDlg As Object +''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library +''' oDlg.Activate() + +Dim bActivate As Boolean ' Return value +Const cstThisSub = "SFDialogs.Dialog.Activate" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bActivate = False + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + End If +Try: + If Not IsNull(_DialogControl) Then + _DialogControl.setFocus() + bActivate = True + End If + +Finally: + Activate = bActivate + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.Activate + +REM ----------------------------------------------------------------------------- +Public Function Center(Optional ByRef Parent As Variant) As Boolean +''' Center the actual dialog instance in the middle of a parent window +''' Without arguments, the method centers the dialog in the middle of the current window +''' Args: +''' Parent: an object, either +''' - a ScriptForge dialog object +''' - a ScriptForge document (Calc, Base, ...) object +''' Returns: +''' True when successful +''' Examples: +''' Sub TriggerEvent(oEvent As Object) +''' Dim oDialog1 As Object, oDialog2 As Object, lExec As Long +''' Set oDialog1 = CreateScriptService("DialogEvent", oEvent) ' The dialog having caused the event +''' Set oDialog2 = CreateScriptService("Dialog", ...) ' Open a second dialog +''' oDialog2.Center(oDialog1) +''' lExec = oDialog2.Execute() +''' Select Case lExec +''' ... +''' End Sub + +Dim bCenter As Boolean ' Return value +Dim oUi As Object ' ScriptForge.SF_UI +Dim oObjDesc As Object ' _ObjectDescriptor type +Dim sObjectType As String ' Can be uno or sf object type +Dim oParent As Object ' UNO alias of parent +Dim oParentPosSize As Object ' Parent com.sun.star.awt.Rectangle +Dim lParentX As Long ' X position of parent dialog +Dim lParentY As Long ' Y position of parent dialog +Dim oPosSize As Object ' Dialog com.sun.star.awt.Rectangle +Const cstThisSub = "SFDialogs.Dialog.Center" +Const cstSubArgs = "[Parent]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bCenter = False + +Check: + If IsMissing(Parent) Or IsEmpty(Parent) Then Set Parent = Nothing + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(Parent, "Parent", ScriptForge.V_OBJECT) Then GoTo Finally + End If + + Set oParentPosSize = Nothing + lParentX = 0 : lParentY = 0 + If IsNull(Parent) Then + Set oUi = CreateScriptService("UI") + Set oParentPosSize = oUi._PosSize() ' Return the position and dimensions of the active window + Else + ' Determine the object type + Set oObjDesc = ScriptForge.SF_Utils._VarTypeObj(Parent) + If oObjDesc.iVarType = ScriptForge.V_SFOBJECT Then ' ScriptForge object + sObjectType = oObjDesc.sObjectType + ' Document or dialog ? + If Not ScriptForge.SF_Array.Contains(Array("BASE", "CALC", "DIALOG", "DOCUMENT", "WRITER"), sObjectType, CaseSensitive := True) Then GoTo Finally + If sObjectType = "DIALOG" Then + Set oParent = Parent._DialogControl + Set oParentPosSize = oParent.getPosSize() + lParentX = oParentPosSize.X + lParentY = oParentPosSize.Y + Else + Set oParent = Parent._Component.getCurrentController().Frame.getComponentWindow() + Set oParentPosSize = oParent.getPosSize() + End If + Else + GoTo Finally ' UNO object, do nothing + End If + End If + If IsNull(oParentPosSize) Then GoTo Finally + +Try: + Set oPosSize = _DialogControl.getPosSize() + With oPosSize + _DialogControl.setPosSize( _ + lParentX + CLng((oParentPosSize.Width - .Width) \ 2) _ + , lParentY + CLng((oParentPosSize.Height - .Height) \ 2) _ + , .Width _ + , .Height _ + , com.sun.star.awt.PosSize.POSSIZE) + End With + bCenter = True + +Finally: + Center = bCenter + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SF_Documents.SF_Dialog.Center + +REM ----------------------------------------------------------------------------- +Public Function CloneControl(Optional ByVal SourceName As Variant _ + , Optional ByVal ControlName As Variant _ + , Optional ByVal Left As Variant _ + , Optional ByVal Top As Variant _ + ) As Object +''' Duplicate an existing control of any type in the actual dialog. +''' The duplicated control is left unchanged. The new control can be relocated. +''' Specific args: +''' SourceName: the name of the control to duplicate +''' ControlName: the name of the new control. It must not exist yet +''' Left, Top: the coordinates of the new control expressed in "Map AppFont" units +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myButton2 = dialog.CloneControl("Button1", "Button2", 30, 30) + +Dim oControl As Object ' Return value +Dim oSourceModel As Object ' com.sun.star.awt.XControlModel of the source +Dim oControlModel As Object ' com.sun.star.awt.XControlModel of the new control +Const cstThisSub = "SFDialogs.Dialog.CloneControl" +Const cstSubArgs = "SourceName, ControlName, [Left=1], [Top=1]" + +Check: + Set oControl = Nothing + + If IsMissing(Left) Or IsEmpty(Left) Then Left = 1 + If IsMissing(Top) Or IsEmpty(Top) Then Top = 1 + + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place := Null) Then GoTo Finally + + If Not ScriptForge.SF_Utils._Validate(SourceName, "SourceName", V_String, _DialogModel.getElementNames()) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Left, "Left", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Top, "Top", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' All control types are presumes cloneable + Set oSourceModel = _DialogModel.getByName(SourceName) + Set oControlModel = oSourceModel.createClone() + oControlModel.Name = ControlName + + ' Create the control + Set oControl = _CreateNewControl(oControlModel, ControlName, Array(Left, Top)) + +Finally: + Set CloneControl = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CloneControl + +REM ----------------------------------------------------------------------------- +Public Function Controls(Optional ByVal ControlName As Variant) As Variant +''' Return either +''' - the list of the controls contained in the dialog +''' - a dialog control object based on its name +''' Args: +''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned +''' Returns: +''' A zero-base array of strings if ControlName is absent +''' An instance of the SF_DialogControl class if ControlName exists +''' Exceptions: +''' ControlName is invalid +''' Example: +''' Dim myDialog As Object, myList As Variant, myControl As Object +''' Set myDialog = CreateScriptService("SFDialogs.Dialog", Container, Library, DialogName) +''' myList = myDialog.Controls() +''' Set myControl = myDialog.Controls("myTextBox") + +Dim oControl As Object ' The new control class instance +Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache +Dim vControl As Variant ' Alias of _ControlCache entry +Const cstThisSub = "SFDialogs.Dialog.Controls" +Const cstSubArgs = "[ControlName]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally + End If + +Try: + If Len(ControlName) = 0 Then + Controls = _DialogModel.getElementNames() + Else + If Not _DialogModel.hasByName(ControlName) Then GoTo CatchNotFound + lIndexOfNames = ScriptForge.IndexOf(_DialogModel.getElementNames(), ControlName, CaseSensitive := True) + ' Reuse cache when relevant + vControl = _ControlCache(lIndexOfNames) + If IsEmpty(vControl) Then + ' Create the new dialog control class instance + Set oControl = New SF_DialogControl + With oControl + ._Name = ControlName + Set .[Me] = oControl + Set .[_Parent] = [Me] + ._IndexOfNames = ScriptForge.IndexOf(_DialogModel.getElementNames(), ControlName, CaseSensitive := True) + ._DialogName = _Name + Set ._ControlModel = _DialogModel.getByName(ControlName) + Set ._ControlView = _DialogControl.getControl(ControlName) + ._ControlView.setModel(._ControlModel) + ._Initialize() + End With + Else + Set oControl = vControl + End If + Set Controls = oControl + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotFound: + ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _DialogModel.getElementNames()) + GoTo Finally +End Function ' SFDialogs.SF_Dialog.Controls + +''' CreateXXX functions: +''' ------------------- +''' Common arguments: +''' ControlName: the name of the new control. It must not exist yet. +''' Place: either +''' - an array with 4 elements: (X, Y, Width, Height) +''' - a com.sun.star.awt.Rectangle [X, Y, Width, Height] +''' All elements are expressed in "Map AppFont" units. + +REM ----------------------------------------------------------------------------- +Public Function CreateButton(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Toggle As Variant _ + , Optional ByVal Push As Variant _ + ) As Object +''' Create a new control of type Button in the actual dialog. +''' Specific args: +''' Toggle: when True a Toggle button is created. Default = False +''' Push: "OK", "CANCEL" or "" (default) +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myButton = dialog.CreateButton("Button1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return value +Dim iPush As Integer ' Alias of Push +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateButton" +Const cstSubArgs = "ControlName, Place, [Toggle=False], [Push=""""|""OK""|""CANCEL""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Toggle) Or IsEmpty(Toggle) Then Toggle = False + If IsMissing(Push) Or IsEmpty(Push) Then Push = "" + If Not ScriptForge.SF_Utils._Validate(Toggle, "Toggle", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Push, "Push", V_STRING, Array("", "OK", "CANCEL")) Then GoTo Finally + +Try: + ' Handle specific arguments + Select Case UCase(Push) + Case "" : iPush = com.sun.star.awt.PushButtonType.STANDARD + Case "OK" : iPush = com.sun.star.awt.PushButtonType.OK + Case "CANCEL" : iPush = com.sun.star.awt.PushButtonType.CANCEL + End Select + vPropNames = Array("Toggle", "PushButtonType") + vPropValues = Array(CBool(Toggle), iPush) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlButtonModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateButton = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateButton + +REM ----------------------------------------------------------------------------- +Public Function CreateCheckBox(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal MultiLine As Variant _ + ) As Object +''' Create a new control of type CheckBox in the actual dialog. +''' Specific args: +''' MultiLine: When True (default = False), the caption may be displayed on more than one line +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myCheckBox = dialog.CreateCheckBox("CheckBox1", Array(20, 20, 60, 15), MultiLine := True) + +Dim oControl As Object ' Return value +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateCheckBox" +Const cstSubArgs = "ControlName, Place, [MultiLine=False]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False + If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally + +Try: + ' Manage specific properties + vPropNames = Array("VisualEffect", "MultiLine") + vPropValues = Array(1, CBool(MultiLine)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlCheckBoxModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateCheckBox = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateCheckBox + +REM ----------------------------------------------------------------------------- +Public Function CreateComboBox(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal Dropdown As Variant _ + , Optional ByVal LineCount As Variant _ + ) As Object +''' Create a new control of type ComboBox in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Dropdown: When True (default), a drop down button is displayed +''' LineCount: Specifies the maximum line count displayed in the drop down (default = 5) +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myComboBox = dialog.CreateComboBox("ComboBox1", Array(20, 20, 60, 15), Dropdown := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateComboBox" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=True], [LineCount=5]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = True + If IsMissing(LineCount) Or IsEmpty(LineCount) Then LineCount = 5 + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(LineCount, "LineCount", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "Dropdown", "LineCount") + vPropValues = Array(iBorder, CBool(Dropdown), CInt(LineCount)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlComboBoxModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateComboBox = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateComboBox + +REM ----------------------------------------------------------------------------- +Public Function CreateCurrencyField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal SpinButton As Variant _ + , Optional ByVal MinValue As Variant _ + , Optional ByVal MaxValue As Variant _ + , Optional ByVal Increment As Variant _ + , Optional ByVal Accuracy As Variant _ + ) As Object +''' Create a new control of type CurrencyField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' SpinButton:: when True (default = False), a spin button is present +''' MinValue: the smallest value that can be entered in the control. Default = -1000000 +''' MaxValue: the largest value that can be entered in the control. Default = +1000000 +''' Increment: the step when the spin button is pressed. Default = 1 +''' Accuracy: specifies the decimal accuracy. Default = 2 decimal digits +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myCurrencyField = dialog.CreateCurrencyField("CurrencyField1", Array(20, 20, 60, 15), SpinButton := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateCurrencyField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=False], [SpinButton=False]" _ + & ", [MinValue=-1000000], MaxValue=+1000000], [Increment=1], [Accuracy=2]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False + If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00 + If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00 + If IsMissing(Increment) Or IsEmpty(Increment) Then Increment = 1.00 + If IsMissing(Accuracy) Or IsEmpty(Accuracy) Then Accuracy = 2 + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Increment, "Increment", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Accuracy, "Accuracy", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "Spin", "ValueMin", "ValueMax", "ValueStep", "DecimalAccuracy") + vPropValues = Array(iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue), CDbl(Increment), CInt(Accuracy)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlCurrencyFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateCurrencyField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateCurrencyField + +REM ----------------------------------------------------------------------------- +Public Function CreateDateField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal Dropdown As Variant _ + , Optional ByVal MinDate As Variant _ + , Optional ByVal MaxDate As Variant _ + ) As Object +''' Create a new control of type DateField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Dropdown:: when True (default = False), a dropdown button is shown +''' MinDate: the smallest date that can be entered in the control. Default = 1900-01-01 +''' MaxDate: the largest Date that can be entered in the control. Default = 2200-12-31 +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myDateField = dialog.CreateDateField("DateField1", Array(20, 20, 60, 15), Dropdown := True) + +Dim oControl As Object ' Return Date +Dim iBorder As Integer ' Alias of border +Dim oMinDate As New com.sun.star.util.Date +Dim oMaxDate As New com.sun.star.util.Date +Dim vFormats As Variant ' List of available date formats +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateDateField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=False]" _ + & ", [MinDate=DateSerial(1900, 1, 1)], [MaxDate=DateSerial(2200, 12, 31)]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = False + If IsMissing(MinDate) Or IsEmpty(MinDate) Then MinDate = DateSerial(1900, 1, 1) + If IsMissing(MaxDate) Or IsEmpty(MaxDate) Then MaxDate = DateSerial(2200, 12, 31) + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinDate, "MinDate", ScriptForge.V_DATE) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxDate, "MaxDate", ScriptForge.V_DATE) Then GoTo Finally + vFormats = SF_DialogUtils._FormatsList("DateField") + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + With oMinDate + .Year = Year(MinDate) : .Month = Month(MinDate) : .Day = Day(MinDate) + End With + With oMaxDate + .Year = Year(MaxDate) : .Month = Month(MaxDate) : .Day = Day(MaxDate) + End With + vPropNames = Array("Border", "Dropdown", "DateMin", "DateMax", "DateFormat") + vPropValues = Array(iBorder, CBool(Dropdown), oMinDate, oMaxDate, CInt(ScriptForge.SF_Array.IndexOf(vFormats(), "Standard (short)"))) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlDateFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateDateField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateDateField + +REM ----------------------------------------------------------------------------- +Public Function CreateFileControl(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + ) As Object +''' Create a new control of type FileControl in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myFileControl = dialog.CreateFileControl("FileControl1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateFileControl" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border") + vPropValues = Array(iBorder) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlFileControlModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateFileControl = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreateFileControl + +REM ----------------------------------------------------------------------------- +Public Function CreateFixedLine(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Orientation As Variant _ + ) As Object +''' Create a new control of type FixedLine in the actual dialog. +''' Specific args: +''' Orientation: "H[orizontal]" or "V[ertical]". +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myFixedLine = dialog.CreateFixedLine("FixedLine1", Array(20, 20, 60, 15), Orientation := "vertical") + +Dim oControl As Object ' Return value +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateFixedLine" +Const cstSubArgs = "ControlName, Place, Orientation=""H""|""Horizontal""|""V""|""Vertical""" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, Array("H", "Horizontal", "V", "Vertical")) Then GoTo Finally + +Try: + ' Manage specific properties + vPropNames = Array("Orientation") + vPropValues = Array(CLng(Iif(Left(UCase(Orientation), 1) = "V", 1, 0))) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlFixedLineModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateFixedLine = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateFixedLine + +REM ----------------------------------------------------------------------------- +Public Function CreateFixedText(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal MultiLine As Variant _ + , Optional ByVal Align As Variant _ + , Optional ByVal VerticalAlign As Variant _ + ) As Object +''' Create a new control of type FixedText in the actual dialog. +''' Specific args: +''' Border: "NONE" (default) or "FLAT" or "3D" +''' MultiLine: When True (default = False), the caption may be displayed on more than one line +''' Align: horizontal alignment, "LEFT" (default) or "CENTER" or "RIGHT" +''' VerticalAlign: vertical alignment, "TOP" (default) or "MIDDLE" or "BOTTOM" +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myFixedText = dialog.CreateFixedText("FixedText1", Array(20, 20, 60, 15), MultiLine := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim iAlign As Integer ' Alias of Align +Dim iVerticalAlign As Integer ' Alias of VerticalAlign +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateFixedText" +Const cstSubArgs = "ControlName, Place, [MultiLine=False], [Border=""NONE""|""FLAT""|""3D""]" _ + & ", [Align=""LEFT""|""CENTER""|""RIGHT""], [VerticalAlign=""TOP""|""MIDDLE""|""BOTTOM""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "NONE" + If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False + If IsMissing(Align) Or IsEmpty(Align) Then Align = "LEFT" + If IsMissing(VerticalAlign) Or IsEmpty(VerticalAlign) Then VerticalAlign = "TOP" + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Align, "Align", V_STRING, Array("LEFT", "CENTER", "RIGHT")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(VerticalAlign, "VerticalAlign", V_STRING, Array("TOP", "MIDDLE", "BOTTOM")) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + iAlign = ScriptForge.SF_Array.IndexOf(Array("LEFT", "CENTER", "BOTTOM"), Align) + Select Case UCase(VerticalAlign) + Case "TOP" : iVerticalAlign = com.sun.star.style.VerticalAlignment.TOP + Case "MIDDLE" : iVerticalAlign = com.sun.star.style.VerticalAlignment.MIDDLE + Case "BOTTOM" : iVerticalAlign = com.sun.star.style.VerticalAlignment.BOTTOM + End Select + vPropNames = Array("Border", "MultiLine", "Align", "VerticalAlign") + vPropValues = Array(iBorder, CBool(MultiLine), iAlign, iVerticalAlign) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlFixedTextModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateFixedText = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateFixedText + +REM ----------------------------------------------------------------------------- +Public Function CreateFormattedField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal SpinButton As Variant _ + , Optional ByVal MinValue As Variant _ + , Optional ByVal MaxValue As Variant _ + ) As Object +''' Create a new control of type FormattedField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' SpinButton:: when True (default = False), a spin button is present +''' MinValue: the smallest value that can be entered in the control. Default = -1000000 +''' MaxValue: the largest value that can be entered in the control. Default = +1000000 +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myFormattedField = dialog.CreateFormattedField("FormattedField1", Array(20, 20, 60, 15), SpinButton := True) +''' myFormattedField.Format = "##0,00E+00" + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateFormattedField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [SpinButton=False]" _ + & ", [MinValue=-1000000], MaxValue=+1000000]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False + If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00 + If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00 + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("FormatsSupplier", "Border", "Spin", "EffectiveMin", "EffectiveMax") + vPropValues = Array(CreateUnoService("com.sun.star.util.NumberFormatsSupplier") _ + , iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlFormattedFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateFormattedField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreateFormattedField + +REM ----------------------------------------------------------------------------- +Public Function CreateGroupBox(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + ) As Object +''' Create a new control of type GroupBox in the actual dialog. +''' Specific args: +''' Orientation: "H[orizontal]" or "V[ertical]" +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myGroupBox = dialog.CreateGroupBox("GroupBox1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return value +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateGroupBox" +Const cstSubArgs = "ControlName, Place" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + +Try: + ' Manage specific properties + vPropNames = Array() + vPropValues = Array() + + ' Create the control + Set oControl = _CreateNewControl("UnoControlGroupBoxModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateGroupBox = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreateGroupBox + +REM ----------------------------------------------------------------------------- +Public Function CreateHyperlink(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal MultiLine As Variant _ + , Optional ByVal Align As Variant _ + , Optional ByVal VerticalAlign As Variant _ + ) As Object +''' Create a new control of type Hyperlink in the actual dialog. +''' Specific args: +''' Border: "NONE" (default) or "FLAT" or "3D" +''' MultiLine: When True (default = False), the caption may be displayed on more than one line +''' Align: horizontal alignment, "LEFT" (default) or "CENTER" or "RIGHT" +''' VerticalAlign: vertical alignment, "TOP" (default) or "MIDDLE" or "BOTTOM" +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myHyperlink = dialog.CreateHyperlink("Hyperlink1", Array(20, 20, 60, 15), MultiLine := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim iAlign As Integer ' Alias of Align +Dim iVerticalAlign As Integer ' Alias of VerticalAlign +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateHyperlink" +Const cstSubArgs = "ControlName, Place, [MultiLine=False], [Border=""NONE""|""FLAT""|""3D""]" _ + & ", [Align=""LEFT""|""CENTER""|""RIGHT""], [VerticalAlign=""TOP""|""MIDDLE""|""BOTTOM""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "NONE" + If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False + If IsMissing(Align) Or IsEmpty(Align) Then Align = "LEFT" + If IsMissing(VerticalAlign) Or IsEmpty(VerticalAlign) Then VerticalAlign = "TOP" + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Align, "Align", V_STRING, Array("LEFT", "CENTER", "RIGHT")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(VerticalAlign, "VerticalAlign", V_STRING, Array("TOP", "MIDDLE", "BOTTOM")) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + iAlign = ScriptForge.SF_Array.IndexOf(Array("LEFT", "CENTER", "BOTTOM"), Align) + Select Case UCase(VerticalAlign) + Case "TOP" : iVerticalAlign = com.sun.star.style.VerticalAlignment.TOP + Case "MIDDLE" : iVerticalAlign = com.sun.star.style.VerticalAlignment.MIDDLE + Case "BOTTOM" : iVerticalAlign = com.sun.star.style.VerticalAlignment.BOTTOM + End Select + vPropNames = Array("Border", "MultiLine", "Align", "VerticalAlign") + vPropValues = Array(iBorder, CBool(MultiLine), iAlign, iVerticalAlign) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlFixedHyperlinkModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateHyperlink = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateHyperlink + +REM ----------------------------------------------------------------------------- +Public Function CreateImageControl(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal Scale As Variant _ + ) As Object +''' Create a new control of type ImageControl in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Scale: One of next values: "FITTOSIZE" (default), "KEEPRATIO" or "NO" +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myImageControl = dialog.CreateImageControl("ImageControl1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim iScale As Integer ' Alias of Scale +Dim bScale As Boolean ' When False, no scaling +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateImageControl" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Scale=""FITTOSIZE""|""KEEPRATIO""|""NO""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(Scale) Or IsEmpty(Scale) Then Scale = "FITTOSIZE" + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Scale, "Scale", V_STRING, Array("FITTOSIZE", "KEEPRATIO", "NO")) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + Select Case UCase(Scale) + Case "NO" : iScale = com.sun.star.awt.ImageScaleMode.NONE : bScale = False + Case "FITTOSIZE" : iScale = com.sun.star.awt.ImageScaleMode.ANISOTROPIC : bScale = True + Case "KEEPRATIO" : iScale = com.sun.star.awt.ImageScaleMode.ISOTROPIC : bScale = True + End Select + vPropNames = Array("Border", "ScaleImage", "ScaleMode") + vPropValues = Array(iBorder, bScale, iScale) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlImageControlModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateImageControl = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreateImageControl + +REM ----------------------------------------------------------------------------- +Public Function CreateListBox(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal Dropdown As Variant _ + , Optional ByVal LineCount As Variant _ + , Optional ByVal MultiSelect As Variant _ + ) As Object +''' Create a new control of type ListBox in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Dropdown: When True (default), a drop down button is displayed +''' LineCount: Specifies the maximum line count displayed in the drop down (default = 5) +''' MultiSelect: When True, more than 1 entry may be selected. Default = False +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myListBox = dialog.CreateListBox("ListBox1", Array(20, 20, 60, 15), Dropdown := True, MultiSelect := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateListBox" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=True], [LineCount=5], [MultiSelect=False]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = True + If IsMissing(LineCount) Or IsEmpty(LineCount) Then LineCount = 5 + If IsMissing(MultiSelect) Or IsEmpty(MultiSelect) Then MultiSelect = True + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(LineCount, "LineCount", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MultiSelect, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "Dropdown", "LineCount", "MultiSelection") + vPropValues = Array(iBorder, CBool(Dropdown), CInt(LineCount), CBool(MultiSelect)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlListBoxModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateListBox = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateListBox + +REM ----------------------------------------------------------------------------- +Public Function CreateNumericField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal SpinButton As Variant _ + , Optional ByVal MinValue As Variant _ + , Optional ByVal MaxValue As Variant _ + , Optional ByVal Increment As Variant _ + , Optional ByVal Accuracy As Variant _ + ) As Object +''' Create a new control of type NumericField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' SpinButton:: when True (default = False), a spin button is present +''' MinValue: the smallest value that can be entered in the control. Default = -1000000 +''' MaxValue: the largest value that can be entered in the control. Default = +1000000 +''' Increment: the step when the spin button is pressed. Default = 1 +''' Accuracy: specifies the decimal accuracy. Default = 2 decimal digits +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myNumericField = dialog.CreateNumericField("NumericField1", Array(20, 20, 60, 15), SpinButton := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateNumericField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [SpinButton=False]" _ + & ", [MinValue=-1000000], MaxValue=+1000000], [Increment=1], [Accuracy=2]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False + If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00 + If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00 + If IsMissing(Increment) Or IsEmpty(Increment) Then Increment = 1.00 + If IsMissing(Accuracy) Or IsEmpty(Accuracy) Then Accuracy = 2 + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Increment, "Increment", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Accuracy, "Accuracy", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "Spin", "ValueMin", "ValueMax", "ValueStep", "DecimalAccuracy") + vPropValues = Array(iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue), CDbl(Increment), CInt(Accuracy)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlNumericFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateNumericField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateNumericField + +REM ----------------------------------------------------------------------------- +Public Function CreatePatternField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal EditMask As Variant _ + , Optional ByVal LiteralMask As Variant _ + ) As Object +''' Create a new control of type PatternField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Editmask: a character code that determines what the user may enter +''' LiteralMask: contains the initial values that are displayed in the pattern field +''' More details on https://wiki.documentfoundation.org/Documentation/DevGuide/Graphical_User_Interfaces#Pattern_Field +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myPatternField = dialog.CreatePatternField("PatternField1", Array(20, 20, 60, 15), EditMask := "NNLNNLLLLL", LiteralMask := "__.__.2002") + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreatePatternField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [EditMask=""""], [LiteralMask=""""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(EditMask) Or IsEmpty(EditMask) Then EditMask = "" + If IsMissing(LiteralMask) Or IsEmpty(LiteralMask) Then LiteralMask = "" + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(EditMask, "EditMask", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(LiteralMask, "LiteralMask", V_STRING) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "EditMask", "LiteralMask") + vPropValues = Array(iBorder, EditMask, LiteralMask) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlPatternFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreatePatternField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreatePatternField + +REM ----------------------------------------------------------------------------- +Public Function CreateProgressBar(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal MinValue As Variant _ + , Optional ByVal MaxValue As Variant _ + ) As Object +''' Create a new control of type ProgressBar in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' MinValue: the smallest value that can be entered in the control. Default = 0 +''' MaxValue: the largest value that can be entered in the control. Default = 100 +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myProgressBar = dialog.CreateProgressBar("ProgressBar1", Array(20, 20, 60, 15), MaxValue := 1000) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateProgressBar" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [MinValue=0], MaxValue=100]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = 0 + If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = 100 + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "ProgressValueMin", "ProgressValueMax") + vPropValues = Array(iBorder, CLng(MinValue), CLng(MaxValue)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlProgressBarModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateProgressBar = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateProgressBar + +REM ----------------------------------------------------------------------------- +Public Function CreateRadioButton(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal MultiLine As Variant _ + ) As Object +''' Create a new control of type RadioButton in the actual dialog. +''' Specific args: +''' MultiLine: When True (default = False), the caption may be displayed on more than one line +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myRadioButton = dialog.CreateRadioButton("RadioButton1", Array(20, 20, 60, 15), MultiLine := True) + +Dim oControl As Object ' Return value +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateRadioButton" +Const cstSubArgs = "ControlName, Place, [MultiLine=False]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False + If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally + +Try: + ' Manage specific properties + vPropNames = Array("VisualEffect", "MultiLine") + vPropValues = Array(1, CBool(MultiLine)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlRadioButtonModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateRadioButton = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateRadioButton + +REM ----------------------------------------------------------------------------- +Public Function CreateScrollBar(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Orientation As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal MinValue As Variant _ + , Optional ByVal MaxValue As Variant _ + ) As Object +''' Create a new control of type ScrollBar in the actual dialog. +''' Specific args: +''' Orientation: H[orizontal] or V[ertical] +''' Border: "3D" (default) or "FLAT" or "NONE" +''' MinValue: the smallest value that can be entered in the control. Default = 0 +''' MaxValue: the largest value that can be entered in the control. Default = 100 +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myScrollBar = dialog.CreateScrollBar("ScrollBar1", Array(20, 20, 60, 15), MaxValue := 1000) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateScrollBar" +Const cstSubArgs = "ControlName, Place, Orientation=""H""|""Horizontal""|""V""|""Vertical""" _ + & ", [Border=""3D""|""FLAT""|""NONE""], [MinValue=0], MaxValue=100]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = 0 + If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = 100 + + If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, Array("H", "Horizontal", "V", "Vertical")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "Orientation", "ScrollValueMin", "ScrollValueMax") + vPropValues = Array(iBorder, CLng(Iif(Left(UCase(Orientation), 1) = "V", 1, 0)), CLng(MinValue), CLng(MaxValue)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlScrollBarModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateScrollBar = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateScrollBar + +REM ----------------------------------------------------------------------------- +Public Function CreateTableControl(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal RowHeaders As Variant _ + , Optional ByVal ColumnHeaders As Variant _ + , Optional ByVal ScrollBars As Variant _ + , Optional ByVal GridLines As Variant _ + ) As Object +''' Create a new control of type TableControl in the actual dialog. +''' To fill the table with data, use the SetTableData() method +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' RowHeaders: when True (default), the row headers are shown +''' ColumnHeaders: when True (default), the column headers are shown +''' ScrollBars: H[orizontal] or V[ertical] or B[oth] or N[one] (default) +''' Note that scrollbars always appear dynamically when they are needed +''' GridLines: when True (default = False) horizontal and vertical lines are painted between the grid cells +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myTableControl = dialog.CreateTableControl("TableControl1", Array(20, 20, 60, 15), ScrollBars := "B") + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateTableControl" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [RowHeaders=True], [ColumnHeaders=True]" _ + & ", [ScrollBars=""N""|""None""|""B""|""Both""|""H""|""Horizontal""|""V""|""Vertical""" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(RowHeaders) Or IsEmpty(RowHeaders) Then RowHeaders = True + If IsMissing(ColumnHeaders) Or IsEmpty(ColumnHeaders) Then ColumnHeaders = True + If IsMissing(ScrollBars) Or IsEmpty(ScrollBars) Then ScrollBars = "None" + If IsMissing(GridLines) Or IsEmpty(GridLines) Then GridLines = False + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(RowHeaders, "RowHeaders", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(ColumnHeaders, "ColumnHeaders", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(ScrollBars, "ScrollBars", V_STRING, Array("N", "None", "B", "Both", "H", "Horizontal", "V", "Vertical")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(GridLines, "GridLines", ScriptForge.V_BOOLEAN) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "ShowRowHeader", "ShowColumnHeader", "VScroll", "HScroll", "UseGridLines") + vPropValues = Array(iBorder, CBool(RowHeaders), CBool(ColumnHeaders) _ + , Left(ScrollBars, 1) = "B" Or Left(ScrollBars, 1) = "V" _ + , Left(ScrollBars, 1) = "B" Or Left(ScrollBars, 1) = "H" _ + , CBool(GridLines) _ + ) + + ' Create the control + Set oControl = _CreateNewControl("grid.UnoControlGridModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateTableControl = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateTableControl + +REM ----------------------------------------------------------------------------- +Public Function CreateTextField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal MultiLine As Variant _ + , Optional ByVal MaximumLength As Variant _ + , Optional ByVal PasswordCharacter As Variant _ + ) As Object +''' Create a new control of type TextField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' MultiLine: When True (default = False), the caption may be displayed on more than one line +''' MaximumLength: the maximum character count (default = 0 meaning unlimited) +''' PasswordCharacter: a single character specifying the echo for a password text field (default = "") +''' MultiLine must be False to have PasswordCharacter being applied +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myTextField = dialog.CreateTextField("TextField1", Array(20, 20, 120, 50), MultiLine := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim iPassword As Integer ' Integer alias of PasswordCharacter +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateTextField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [MultiLine=False], [MaximumLength=0, [PasswordCharacter=""""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False + If IsMissing(MaximumLength) Or IsEmpty(MaximumLength) Then MaximumLength = 0 + If IsMissing(PasswordCharacter) Or IsEmpty(PasswordCharacter) Then PasswordCharacter = "" + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaximumLength, "MaximumLength", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(PasswordCharacter, "PasswordCharacter", V_STRING) Then GoTo Finally + + ' MultiLine has precedence over Password + If MultiLine Then PasswordCharacter = "" + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + If Len(PasswordCharacter) > 0 Then iPassword = Asc(Left(PasswordCharacter, 1)) Else iPassword = 0 + vPropNames = Array("Border", "MultiLine", "MaxTextLen", "EchoChar", "AutoVScroll") ' AutoHScroll not implemented ?? + vPropValues = Array(iBorder, CBool(MultiLine), CInt(MaximumLength), iPassword, True) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlEditModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateTextField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateTextField + +REM ----------------------------------------------------------------------------- +Public Function CreateTimeField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal MinTime As Variant _ + , Optional ByVal MaxTime As Variant _ + ) As Object +''' Create a new control of type TimeField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' MinTime: the smallest time that can be entered in the control. Default = 0 +''' MaxTime: the largest time that can be entered in the control. Default = 24h +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myTimeField = dialog.CreateTimeField("TimeField1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return Time +Dim iBorder As Integer ' Alias of border +Dim oMinTime As New com.sun.star.util.Time +Dim oMaxTime As New com.sun.star.util.Time +Dim vFormats As Variant ' List of available time formats +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateTimeField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]" _ + & ", [MinTime=TimeSerial(0, 0, 0)], [MaxTime=TimeSerial(23, 59, 59)]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(MinTime) Or IsEmpty(MinTime) Then MinTime = TimeSerial(0, 0, 0) + If IsMissing(MaxTime) Or IsEmpty(MaxTime) Then MaxTime = TimeSerial(23, 59, 59) + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._ValiDate(MinTime, "MinTime", ScriptForge.V_DATE) Then GoTo Finally + If Not ScriptForge.SF_Utils._ValiDate(MaxTime, "MaxTime", ScriptForge.V_DATE) Then GoTo Finally + vFormats = SF_DialogUtils._FormatsList("TimeField") + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + With oMinTime + .Hours = Hour(MinTime) : .Minutes = Minute(MinTime) : .Seconds = Second(MinTime) + End With + With oMaxTime + .Hours = Hour(MaxTime) : .Minutes = Minute(MaxTime) : .Seconds = Second(MaxTime) + End With + vPropNames = Array("Border", "TimeMin", "TimeMax", "TimeFormat") + vPropValues = Array(iBorder, oMinTime, oMaxTime, CInt(ScriptForge.SF_Array.IndexOf(vFormats(), "24h short"))) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlTimeFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateTimeField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateTimeField + +REM ----------------------------------------------------------------------------- +Public Function CreateTreeControl(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + ) As Object +''' Create a new control of type TreeControl in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myTreeControl = dialog.CreateTreeControl("TreeControl1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateTreeControl" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "SelectionType", "Editable", "ShowsHandles", "ShowsRootHandles") + vPropValues = Array(iBorder, com.sun.star.view.SelectionType.SINGLE, False, True, True) + + ' Create the control + Set oControl = _CreateNewControl("tree.TreeControlModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateTreeControl = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreateTreeControl + +REM ----------------------------------------------------------------------------- +Public Sub EndExecute(Optional ByVal ReturnValue As Variant) +''' Ends the display of a modal dialog and gives back the argument +''' as return value for the current Execute() action +''' EndExecute is usually contained in the processing of a macro +''' triggered by a dialog or control event +''' Args: +''' ReturnValue: must be numeric. The value passed to the running Execute() method +''' Example: +''' Sub OnEvent(poEvent As Variant) +''' Dim oDlg As Object +''' Set oDlg = CreateScriptService("SFDialogs.DialogEvent", poEvent) +''' oDlg.EndExecute(25) +''' End Sub + +Dim lExecute As Long ' Alias of ReturnValue +Const cstThisSub = "SFDialogs.Dialog.EndExecute" +Const cstSubArgs = "ReturnValue" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(ReturnValue, "ReturnValue", V_NUMERIC) Then GoTo Finally + End If + +Try: + lExecute = CLng(ReturnValue) + Call _DialogControl.endDialog(lExecute) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' SFDialogs.SF_Dialog.EndExecute + +REM ----------------------------------------------------------------------------- +Public Function Execute(Optional ByVal Modal As Variant) As Long +''' Display the dialog and wait for its termination by the user +''' Args: +''' Modal: False when non-modal dialog. Default = True +''' Returns: +''' 0 = Cancel button pressed +''' 1 = OK button pressed +''' Otherwise: the dialog stopped with an EndExecute statement executed from a dialog or control event +''' Example: +''' Dim oDlg As Object, lReturn As Long +''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library +''' lReturn = oDlg.Execute() +''' Select Case lReturn + +Dim lExecute As Long ' Return value +Const cstThisSub = "SFDialogs.Dialog.Execute" +Const cstSubArgs = "[Modal=True]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + lExecute = -1 + +Check: + If IsMissing(Modal) Or IsEmpty(Modal) Then Modal = True + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Modal, "Modal", V_BOOLEAN) Then GoTo Finally + End If + +Try: + If Modal Then + _Modal = True + _Displayed = True + ' In dynamic dialogs, injection of sizes and positions from model to view is done with setVisible() + _DialogControl.setVisible(True) + lExecute = _DialogControl.execute() + Select Case lExecute + Case 1 : lExecute = OKBUTTON + Case 0 : lExecute = CANCELBUTTON + Case Else + End Select + _Displayed = False + Else + _Modal = False + _Displayed = True + ' To make visible an on-the-fly designed dialog when macro triggered from Python + _DialogModel.DesktopAsParent = Not ( _BuiltFromScratch And _BuiltInPython ) + _DialogControl.setVisible(True) + lExecute = 0 + End If + +Finally: + Execute = lExecute + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + ' When an error is caused by an event error, the location is unknown + SF_Exception.Raise(, "?") + GoTo Finally +End Function ' SFDialogs.SF_Dialog.Execute + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' Exceptions: +''' ARGUMENTERROR The property does not exist +''' Examples: +''' oDlg.GetProperty("Caption") + +Const cstThisSub = "SFDialogs.Dialog.GetProperty" +Const cstSubArgs = "" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + GetProperty = _PropertyGet(PropertyName) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function GetTextsFromL10N(Optional ByRef L10N As Variant) As Boolean +''' Replace all fixed text strings of a dialog by their localized version +''' Replaced texts are: +''' - the title of the dialog +''' - the caption associated with next control types: Button, CheckBox, FixedLine, FixedText, GroupBox and RadioButton +''' - the content of list- and comboboxes +''' - the tip- or helptext displayed when the mouse is hovering the control +''' The current method has a twin method ScriptForge.SF_L10N.AddTextsFromDialog +''' The current method is probably run before the Execute() method +''' Args: +''' L10N : a "L10N" service instance created with CreateScriptService("L10N") +''' Returns: +''' True when successful +''' Examples: +''' Dim myPO As Object, oDlg As Object +''' Set oDlg = CreateScriptService("Dialog", "GlobalScope", "XrayTool", "DlgXray") +''' Set myPO = CreateScriptService("L10N", "C:\myPOFiles\", "fr-BE") +''' oDlg.GetTextsFromL10N(myPO) + +Dim bGet As Boolean ' Return value +Dim vControls As Variant ' Array of control names +Dim sControl As String ' A single control name +Dim oControl As Object ' SFDialogs.DialogControl +Dim sText As String ' The text found in the dialog +Dim sTranslation As String ' The translated text got from the dictionary +Dim vSource As Variant ' RowSource property of dialog control as an array +Dim bChanged As Boolean ' True when at least 1 item of a RowSource is modified +Dim i As Long + +Const cstThisSub = "SFDialogs.Dialog.GetTextsFromL10N" +Const cstSubArgs = "L10N" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bGet = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(L10N, "L10N", V_OBJECT, , , "L10N") Then GoTo Finally + End If + +Try: + ' Get the dialog title + sText = Caption + If Len(sText) > 0 Then + sTranslation = L10N._(sText) + If sText <> sTranslation Then Caption = sTranslation + End If + ' Scan all controls + vControls = Controls() + For Each sControl In vControls + Set oControl = Controls(sControl) + With oControl + ' Extract fixed texts + sText = .Caption + If Len(sText) > 0 Then + sTranslation = L10N._(sText) + If sText <> sTranslation Then .Caption = sTranslation + End If + vSource = .RowSource ' List and comboboxes only + If IsArray(vSource) Then + bChanged = False + For i = 0 To UBound(vSource) + If Len(vSource(i)) > 0 Then + sTranslation = L10N._(vSource(i)) + If sTranslation <> vSource(i) Then + bChanged = True + vSource(i) = sTranslation + End If + End If + Next i + ' Rewrite if at least 1 item has been modified by the translation process + If bChanged Then .RowSource = vSource + End If + sText = .TipText + If Len(sText) > 0 Then + sTranslation = L10N._(sText) + If sText <> sTranslation Then .TipText = sTranslation + End If + End With + Next sControl + + bGet = True + +Finally: + GetTextsFromL10N = bGet + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.GetTextsFromL10N + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Model service as an array + + Methods = Array( _ + "Activate" _ + , "Center" _ + , "CloneControl" _ + , "Controls" _ + , "CreateButton" _ + , "CreateCheckBox" _ + , "CreateComboBox" _ + , "CreateCurrencyField" _ + , "CreateDateField" _ + , "CreateFileControl" _ + , "CreateFixedLine" _ + , "CreateFixedText" _ + , "CreateFormattedField" _ + , "CreateGroupBox" _ + , "CreateHyperlink" _ + , "CreateImageControl" _ + , "CreateListBox" _ + , "CreateNumericField" _ + , "CreatePatternField" _ + , "CreateProgressBar" _ + , "CreateRadioButton" _ + , "CreateScrollBar" _ + , "CreateTableControl" _ + , "CreateTextField" _ + , "CreateTimeField" _ + , "CreateTreeControl" _ + , "EndExecute" _ + , "Execute" _ + , "GetTextsFromL10N" _ + , "OrderTabs" _ + , "Resize" _ + , "SetPageManager" _ + , "Terminate" _ + ) + +End Function ' SFDialogs.SF_Dialog.Methods + +REM ----------------------------------------------------------------------------- +Public Function OrderTabs(ByRef Optional TabsList As Variant _ + , ByVal Optional Start As Variant _ + , ByVal Optional Increment As Variant _ + ) As Boolean +''' Set the tabulation index f a series of controls. +''' The sequence of controls are given as an array of control names from the first to the last. +''' Next controls will not be accessible (anymore ?) via the TAB key if >=1 of next conditions is met: +''' - if they are not in the given list +''' - if their type is FixedLine, GroupBox or ProgressBar +''' - if the control is disabled +''' Args: +''' TabsList: an array of valid control names in the order of tabulation +''' Start: the tab index to be assigned to the 1st control in the list. Default = 1 +''' Increment: the difference between 2 successive tab indexes. Default = 1 +''' Returns: +''' True when successful +''' Example: +''' dialog.OredrTabs(Array("myListBox", "myTextField", "myNumericField"), Start := 10) + +Dim bOrder As Boolean ' Return value +Dim vControlNames As Variant ' List of control names in the dialog +Dim oControl As Object ' A SF_DialogControl instance +Dim bValid As Boolean ' When True, the considered control deserves a tab stop +Dim iTabIndex As Integer ' The tab index to be set +Dim vWrongTypes As Variant ' List of rejected control types +Dim i As Long + +Const cstThisSub = "SFDialogs.Dialog.OrderTabs" +Const cstSubArgs = "TabsList, [Start=1], Încrement=1]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bOrder = False + +Check: + If IsMissing(Start) Or IsEmpty(Start) Then Start = 1 + If IsMissing(Increment) Or IsEmpty(Increment) Then Increment = 1 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._ValidateArray(TabsList, "TabsList", 1, V_STRING, True) Then GoTo Finally + If Not SF_Utils._Validate(Start, "Start", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(Increment, "Increment", ScriptForge.V_NUMERIC) Then GoTo Finally + End If + +Try: + vWrongTypes = Array("FixedLine", "GroupBox", "ProgressBar") + + ' Remove all existing tabulations + vControlNames = _DialogModel.getElementNames() + For i = 0 To UBound(vControlNames) + Set oControl = Controls(vControlNames(i)) + With oControl._ControlModel + If Not ScriptForge.SF_Array.Contains(vWrongTypes, oControl._ControlType) Then + .TabStop = False + .TabIndex = -1 + End If + End With + Next i + + iTabIndex = Start + + ' Go through the candidate controls for being tabulated and set tabs + For i = LBound(TabsList) To UBound(TabsList) + Set oControl = Controls(TabsList(i)) ' Error checking on input names happens here + With oControl._ControlModel + bValid = Not ScriptForge.SF_Array.Contains(vWrongTypes, oControl._ControlType) + If bValid Then bValid = .Enabled + If bValid Then + .TabStop = True + .TabIndex = iTabIndex + iTabIndex = iTabIndex + Increment + End If + End With + Next i + + bOrder = True + +Finally: + OrderTabs = bOrder + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.OrderTabls + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Dialog class as an array + + Properties = Array( _ + "Caption" _ + , "Height" _ + , "Modal" _ + , "Name" _ + , "OnFocusGained" _ + , "OnFocusLost" _ + , "OnKeyPressed" _ + , "OnKeyReleased" _ + , "OnMouseDragged" _ + , "OnMouseEntered" _ + , "OnMouseExited" _ + , "OnMouseMoved" _ + , "OnMousePressed" _ + , "OnMouseReleased" _ + , "Page" _ + , "Visible" _ + , "Width" _ + , "XDialogModel" _ + , "XDialogView" _ + ) + +End Function ' SFDialogs.SF_Dialog.Properties + +REM ----------------------------------------------------------------------------- +Public Function Resize(Optional ByVal Left As Variant _ + , Optional ByVal Top As Variant _ + , Optional ByVal Width As Variant _ + , Optional ByVal Height As Variant _ + ) As Boolean +''' Move the top-left corner of the dialog to new coordinates and/or modify its dimensions +''' Without arguments, the method resets the initial dimensions +''' Attributes denoting the position and size of a dialog are expressed in "Map AppFont" units. +''' Map AppFont units are device and resolution independent. +''' One Map AppFont unit is equal to one eighth of the average character (Systemfont) height and one quarter of the average character width. +''' The dialog editor (= the Basic IDE) also uses Map AppFont units. +''' Args: +''' Left : the horizontal distance from the top-left corner. It may be negative. +''' Top : the vertical distance from the top-left corner. It may be negative. +''' Width : the horizontal width of the rectangle containing the Dialog. It must be positive. +''' Height : the vertical height of the rectangle containing the Dialog. It must be positive. +''' Missing arguments are left unchanged. +''' Returns: +''' True when successful +''' Examples: +''' oDialog.Resize(100, 200, Height := 600) ' Width is not changed + +Try: + Resize = SF_DialogUtils._Resize([Me], Left, Top, Width, Height) + +End Function ' SFDialogss.SF_Dialog.Resize + +REM ----------------------------------------------------------------------------- +Public Function SetPageManager(Optional ByVal PilotControls As Variant _ + , Optional ByVal TabControls As Variant _ + , Optional ByVal WizardControls As Variant _ + , Optional ByVal LastPage As variant _ + ) As Boolean +''' Define how the dialog displays pages. The page manager is an alternative to the +''' direct use of the Page property of the dialog and dialogcontrol objects. +''' +''' A dialog may have several pages that can be traversed by the user step by step. +''' The Page property of the Dialog object defines which page of the dialog is active. +''' The Page property of a control defines the page of the dialog on which the control is visible. +''' For example, if a control has a page value of 1, it is only visible on page 1 of the dialog. +''' If the page value of the dialog is increased from 1 to 2, then all controls with a page value of 1 disappear +''' and all controls with a page value of 2 become visible. +''' +''' The arguments define which controls are involved in the orchestration of the displayed pages. +''' Possible options: +''' - select a value in a list- or combobox +''' - select an item in a group of radio buttons +''' - select a button linked to a page - placed side-by-side the buttons can simulate a tabbed interface +''' - press a NEXT or BACK button like in many wizards +''' Those options may be combined. The control updates will be synchronized. +''' The method will set the actual page number to 1. Afterwards the Page property may be used to display any other page +''' +''' The SetPageManager() method is to be run only once and before the Execute() statement. +''' If invoked several times, subsequent calls will be ignored. +''' The method will define new listeners on the concerned controls, addressing generic routines. +''' The corresponding events will be fired during the dialog execution. +''' Preset events (in the Basic IDE) will be preserved and executed immediately AFTER the page change. +''' The listeners will be removed at dialog termination. +''' +''' Args: +''' PilotControls: a comma-separated list of listbox, combobox or radiobutton controls +''' For radio buttons, provide the first in the group +''' TabControls: a comma-separated list of button controls in ascending order +''' WizardControls: a comma-separated list of 2 controls, a BACK button and a NEXT button +''' LastPage: the index of the last available page. Recommended when use of WizardControls +''' Returns: +''' True when successful +''' Examples: +''' dialog.SetPageManager(PilotControls := "aListBox,aComboBox") ' 2 controls may cause page changes + +Dim bManager As Boolean ' Return value +Dim vControls As Variant ' Array of involved controls +Dim oControl As Object ' A DialogControl object +Dim i As Long +Const cstPrefix = "_SFTAB_" ' Prefix of Subs to trigger when involved controls are clicked +Const cstComma = "," + +Const cstThisSub = "SFDialogs.Dialog.SetPageManager" +Const cstSubArgs = "[PilotControls=""""], [TabControls=""""], [WizardControls=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bManager = False + +Check: + If IsMissing(PilotControls) Or IsEmpty(PilotControls) Then PilotControls = "" + If IsMissing(TabControls) Or IsEmpty(TabControls) Then TabControls = "" + If IsMissing(WizardControls) Or IsEmpty(WizardControls) Then WizardControls = "" + If IsMissing(LastPage) Or IsEmpty(LastPage) Then LastPage = 0 + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(PilotControls, "PilotControls", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(TabControls, "TabControls", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(WizardControls, "WizardControls", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(LastPage, "LastPage", ScriptForge.V_NUMERIC) Then GoTo Finally + End If + ' Ignore the call if already done before + If UBound(_PageManagement) >= 0 Then GoTo Finally + +Try: + ' Common listeners to all involved controls + Set _ItemListener = CreateUnoListener(cstPrefix, "com.sun.star.awt.XItemListener") + Set _ActionListener = CreateUnoListener(cstPrefix, "com.sun.star.awt.XActionListener") + + ' Register the arguments in the _PageManagement array, control by control + ' Pilot controls + If Len(PilotControls) > 0 Then + vControls = Split(PilotControls, cstComma) + For i = 0 To UBound(vControls) + If Not _RegisterPageListener(Trim(vControls(i)), "ListBox,ComboBox,RadioButton", PILOTCONTROL, 0, ITEMSTATECHANGED) Then GoTo Catch + Next i + End If + ' Tab controls + If Len(TabControls) > 0 Then + vControls = Split(TabControls, cstComma) + For i = 0 To UBound(vControls) + If Not _RegisterPageListener(Trim(vControls(i)), "Button", TABCONTROL, i + 1, ACTIONPERFORMED) Then GoTo Catch + Next i + End If + ' Wizard controls + If Len(WizardControls) > 0 Then + vControls = Split(WizardControls, cstComma) + For i = 0 To UBound(vControls) + If Not _RegisterPageListener(Trim(vControls(i)), "Button", Iif(i = 0, BACKCONTROL, NEXTCONTROL), 0, ACTIONPERFORMED) Then GoTo Catch + Next i + End If + + ' Set the initial page to 1 + Page = 1 + _LastPage = LastPage + +Finally: + SetPageManager = bManager + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + ScriptForge.SF_Exception.RaiseFatal(PAGEMANAGERERROR, "PilotControls", PilotControls, "TabControls", TabControls _ + , "WizardControls", WizardControls) + GoTo Finally +End Function ' SFDialogs.SF_Dialog.SetPageManager + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "SFDialogs.Dialog.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + SetProperty = _PropertySet(PropertyName, Value) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.SetProperty + +REM ----------------------------------------------------------------------------- +Public Function Terminate() As Boolean +''' Terminate the dialog service for the current dialog instance +''' After termination any action on the current instance will be ignored +''' Args: +''' Returns: +''' True if termination is successful +''' Example: +''' Dim oDlg As Object, lReturn As Long +''' Set oDlg = CreateScriptService(,, "myDialog") ' Dialog stored in current document's standard library +''' lreturn = oDlg.Execute() +''' Select Case lReturn +''' ' ... +''' End Select +''' oDlg.Terminate() + +Dim bTerminate As Boolean ' Return value +Const cstThisSub = "SFDialogs.Dialog.Terminate" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bTerminate = False + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + End If + +Try: + _RemoveAllListeners() + _DialogControl.dispose() + Set _DialogControl = Nothing + SF_Register._CleanCacheEntry(_CacheIndex) + _CacheIndex = -1 + Dispose() + + bTerminate = True + +Finally: + Terminate = bTerminate + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.Terminate + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _CheckNewControl(cstThisSub As String, cstSubArgs As String _ + , Optional ByVal ControlName As Variant _ + , ByRef Place As Variant _ + ) As Boolean +''' Check the generic arguments of a CreateXXX() method for control creation. +''' Called by the CreateButton, CreateCheckBox, ... specific methods +''' Args: +''' cstThisSub, cstSubArgs: caller routine and its arguments. Used to formulate an error message, if any. +''' ControlName: the name of the new control. It must not exist yet +''' Place: the size and position expressed in APPFONT units, either +''' - an array (X, Y, Width, Height) or Array(x, Y) +''' - a com.sun.star.awt.Rectangle structure +''' Exceptions: +''' DUPLICATECONTROLERROR A control with the same name exists already +''' Returns: +''' True when arguments passed the check + +Dim bCheck As Boolean ' Return value + + bCheck = False + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally + If IsArray(Place) Then + If Not ScriptForge.SF_Utils._ValidateArray(Place, "Place", 1, ScriptForge.V_NUMERIC, True) Then GoTo Finally + ElseIf Not IsNull(Place) Then + If Not ScriptForge.SF_Utils._Validate(Place, "Place", ScriptForge.V_OBJECT) Then GoTo Finally + End If + End If + If _DialogModel.hasByName(ControlName) Then GoTo CatchDuplicate + + bCheck = True + +Finally: + _CheckNewControl = bCheck + ' Call to _ExitFunction is done in the caller to allow handling of specific arguments + Exit Function +CatchDuplicate: + ScriptForge.SF_Exception.RaiseFatal(DUPLICATECONTROLERROR, "ControlName", ControlName, _Name) + GoTo Finally +End Function ' SFDialogs.SF_Dialog._CheckNewControl + +REM ----------------------------------------------------------------------------- +Private Function _CreateNewControl(ByVal pvModel As Variant _ + , ByVal ControlName As Variant _ + , ByRef Place As Variant _ + , Optional ByRef ArgNames As Variant _ + , Optional ByRef ArgValues As Variant _ + ) As Object +''' Generic creation of a new control. +''' Called by the CreateButton, CreateCheckBox, ... specific methods +''' Args: +''' pvModel: one of the UnoControlxxx control models (as a string) +''' or such a model as a UNO class instance (cloned from an existing control) +''' ControlName: the name of the new control. It must not exist yet +''' Place: the size and position expressed in APPFONT units, either +''' - an array (X, Y, Width, Height) +''' - a com.sun.star.awt.Rectangle structure +''' ArgNames: the list of the specific arguments linked to the given pvModel +''' ArgValues: their values +''' Returns: +''' A new SF_DialogControl class instance or Nothing if creation failed + +Dim oControl As Object ' Return value +Dim oControlModel As Object ' com.sun.star.awt.XControlModel +Dim vPlace As Variant ' Alias of Place when object to avoid "Object variable not set" error +Dim lCache As Long ' Number of elements in the controls cache +Static oSession As Object + +Check: + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oControl = Nothing + + If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") + + If IsMissing(ArgNames) Or IsEmpty(ArgNames) Then ArgNames = Array() + If IsMissing(ArgValues) Or IsEmpty(ArgValues) Then ArgValues = Array() + +Try: + ' When the model is a string, create a new (empty) model instance + Select Case VarType(pvModel) + Case V_STRING : Set oControlModel = _DialogModel.createInstance("com.sun.star.awt." & pvModel) + Case ScriptForge.V_OBJECT : Set oControlModel = pvModel + End Select + + oControlModel.Name = ControlName + + ' Set dimension and position + With oControlModel + If IsArray(Place) Then + ' Ignore width and height when new control is cloned from an existing one + If UBound(Place) >= 1 Then + .PositionX = Place(0) + .PositionY = Place(1) + End If + If UBound(Place) >= 3 Then + .Width = Place(2) + .Height = Place(3) + End If + ElseIf oSession.UnoObjectType(Place) = "com.sun.star.awt.Rectangle" Then + Set vPlace = Place + .PositionX = vPlace.X + .PositionY = vPlace.Y + .Width = vPlace.Width + .Height = vPlace.Height + Else + 'Leave everything to zero + End If + End With + + ' Store the specific properties in the model + If UBound(ArgNames) >= 0 Then oControlModel.setPropertyValues(ArgNames, ArgValues) + + ' Insert the new completed control model in the dialog + _DialogModel.insertByName(ControlName, oControlModel) + + ' Update controls cache - existing cache is presumed unchanged: new control is added at the end of Model.ElementNames + lCache = UBound(_ControlCache) + If lCache < 0 Then + ReDim _ControlCache(0 To 0) + Else + ReDim Preserve _ControlCache(0 To lCache + 1) + End If + + ' Now the UNO control exists, build the SF_DialogControl instance as usual + Set oControl = Controls(ControlName) + +Finally: + Set _CreateNewControl = oControl + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog._CreateNewControl + +REM ----------------------------------------------------------------------------- +Private Function _FindRadioSiblings(ByVal psRadioButton As String) As String +''' Given the name of the first radio button of a group, return all the names of the group +''' For dialogs, radio buttons are considered of the same group +''' when their tab indexes are contiguous. +''' Args: +''' psRadioButton: the exact name of the 1st radio button of the group +''' Returns: +''' A comma-separated list of the names of the 1st and the next radio buttons +''' belonging to the same group in their tabindex order. +''' The input argument when not a radio button + + +Dim sList As String ' Return value +Dim oRadioControl As Object ' DialogControl instance corresponding with the argument +Dim oControl As Object ' DialogControl instance +Dim vRadioList As Variant ' Array of all radio buttons having a tab index > tab index of argument + ' 1st column = name of radio button, 2nd = its tab index +Dim iRadioTabIndex As Integer ' Tab index of the argument +Dim iTabIndex As Integer ' Any tab index +Dim vControlNames As Variant ' Array of control names +Dim sControlName As String ' A single item in vControlNames() +Dim i As Long +Const cstComma = "," + +Check: + On Local Error GoTo Catch + sList = psRadioButton + vRadioList = Array() + +Try: + Set oRadioControl = Controls(psRadioButton) + If oRadioControl.ControlType <> "RadioButton" Then GoTo Finally + iRadioTabIndex = oRadioControl._ControlModel.Tabindex + vRadioList = ScriptForge.SF_Array.AppendRow(vRadioList, Array(psRadioButton, iRadioTabIndex)) + + ' Scan all controls. Store radio buttons having tab index > 1st radio button + vControlNames = Controls() + For Each sControlName In vControlNames + Set oControl = Controls(sControlName) + With oControl + If .Name <> psRadioButton Then + If .ControlType = "RadioButton" Then + iTabIndex = ._ControlModel.Tabindex + If iTabIndex > iRadioTabIndex Then + vRadioList = ScriptForge.SF_Array.AppendRow(vRadioList, Array(.Name, iTabIndex)) + End If + End If + End If + End With + Next sControlName + + vRadioList = ScriptForge.SF_Array.SortRows(vRadioList, 1) + ' Retain contiguous tab indexes + For i = 1 To UBound(vRadioList, 1) ' First row = argument + If vRadioList(i, 1) = iRadioTabIndex + i Then sList = sList & cstComma & vRadioList(i, 0) + Next i + +Finally: + _FindRadioSiblings = sList + Exit Function +Catch: + sList = psRadioButton + GoTo Finally +End Function ' SFDialogs.SF_Dialog._FindRadioSiblings + +REM ----------------------------------------------------------------------------- +Public Function _GetEventName(ByVal psProperty As String) As String +''' Return the LO internal event name derived from the SF property name +''' The SF property name is not case sensitive, while the LO name is case-sensitive +' Corrects the typo on ErrorOccur(r?)ed, if necessary + +Dim vProperties As Variant ' Array of class properties +Dim sProperty As String ' Correctly cased property name + + vProperties = Properties() + sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC")) + + _GetEventName = LCase(Mid(sProperty, 3, 1)) & Right(sProperty, Len(sProperty) - 3) + +End Function ' SFDialogs.SF_Dialog._GetEventName + +REM ----------------------------------------------------------------------------- +Private Function _GetListener(ByVal psEventName As String) As String +''' Getting/Setting macros triggered by events requires a Listener-EventName pair +''' Return the X...Listener corresponding with the event name in argument + + Select Case UCase(psEventName) + Case UCase("OnFocusGained"), UCase("OnFocusLost") + _GetListener = "XFocusListener" + Case UCase("OnKeyPressed"), UCase("OnKeyReleased") + _GetListener = "XKeyListener" + Case UCase("OnMouseDragged"), UCase("OnMouseMoved") + _GetListener = "XMouseMotionListener" + Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased") + _GetListener = "XMouseListener" + Case Else + _GetListener = "" + End Select + +End Function ' SFDialogs.SF_Dialog._GetListener + +REM ----------------------------------------------------------------------------- +Public Sub _Initialize() +''' Complete the object creation process: +''' - Initialization of private members +''' - Creation of the dialog graphical interface +''' - Addition of the new object in the Dialogs buffer +''' - Initialisation of persistent storage for controls + +Dim lControls As Long ' Number of controls at dialog creation +Try: + ' Keep reference to model + Set _DialogModel = _DialogControl.Model + + ' Store initial position and dimensions + With _DialogModel + _Left = .PositionX + _Top = .PositionY + _Width = .Width + _Height = .Height + End With + + ' Add dialog reference to cache + _CacheIndex = SF_Register._AddDialogToCache(_DialogControl, [Me]) + + ' Size the persistent storage + _ControlCache = Array() + lControls = UBound(_DialogModel.getElementNames()) + If lControls >= 0 Then ReDim _ControlCache(0 To lControls) + +Finally: + Exit Sub +End Sub ' SFDialogs.SF_Dialog._Initialize + +REM ----------------------------------------------------------------------------- +Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean +''' Return True if the dialog service is still active +''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default) +''' Args: +''' pbError: if True (default), raise a fatal error + +Dim bAlive As Boolean ' Return value +Dim sDialog As String ' Alias of DialogName + +Check: + On Local Error GoTo Catch ' Anticipate DisposedException errors or alike + If IsMissing(pbError) Then pbError = True + +Try: + bAlive = ( Not IsNull(_DialogProvider) Or _BuiltFromScratch ) + If bAlive Then bAlive = Not IsNull(_DialogControl) + If Not bAlive Then GoTo Catch + +Finally: + _IsStillAlive = bAlive + Exit Function +Catch: + bAlive = False + On Error GoTo 0 + sDialog = _Name + Dispose() + If pbError Then ScriptForge.SF_Exception.RaiseFatal(DIALOGDEADERROR, sDialog) + GoTo Finally +End Function ' SFDialogs.SF_Dialog._IsStillAlive + +REM ----------------------------------------------------------------------------- +Private Sub _JumpToPage(ByVal plPage As Long) +''' Called when the Page property is set to a new value +''' The rules defined in the _pageManagement array are applied here + +Dim oPageManager As Object ' A single entry in _PageManagement of type _PageManager +Dim oControl As Object ' DialogControl instance +Dim lPage As Long ' A dialog page number + +Check: + On Local Error GoTo Finally +' ControlName As String ' Case-sensitive name of control involved in page management +' PageMgtType As Integer ' One of the PILOTCONTROL, TABCONTROL, BACKCONTROL, NEXTCONTROL constants +' PageNumber As Long ' When > 0, the page to activate for tab controls +' ListenerType As Integer ' One of the ITEMSTATECHANGED, ACTIONPERFORMED constants + + If plPage <= 0 Or (_LastPage > 0 And plPage > _LastPage) Then Exit Sub + If UBound(_PageManagement) < 0 Then Exit Sub + +Try: + ' Controls listed in the array must be synchronized with the page # + ' Listboxes and comboboxes must be set to the corresponding value + ' The right radio button must be selected + ' One corresponding button must be dimmed, other must be enabled + ' The Next button must be dimmed when last page otherwise enabled + For Each oPageManager In _PageManagement + With oPageManager + lPage = .PageNumber + Set oControl = Controls(.ControlName) + With oControl + Select Case .ControlType + Case "ListBox", "ComboBox" + If plPage <= .ListCount Then .ListIndex = plPage - 1 ' ListIndex is zero-based + Case "RadioButton" + .Value = ( plPage = lPage ) + Case "Button" + Select Case oPageManager.PageMgtType + Case TABCONTROL + .Value = ( plPage = lPage ) + Case BACKCONTROL + .Enabled = ( plPage <> 1 ) + Case NEXTCONTROL + .Enabled = ( _LastPage = 0 Or plPage < _LastPage ) + Case Else + End Select + Case Else + End Select + End With + End With + Next oPageManager + +Finally: + Exit Sub +End Sub ' SFDialogs.SF_Dialog._JumpToPage + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property + +Static oSession As Object ' Alias of SF_Session +Dim oPosSize As Object ' com.sun.star.awt.Rectangle +Dim oDialogEvents As Object ' com.sun.star.container.XNameContainer +Dim sEventName As String ' Internal event name +Dim cstThisSub As String +Const cstSubArgs = "" + + cstThisSub = "SFDialogs.Dialog.get" & psProperty + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not _IsStillAlive() Then GoTo Finally + + If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") + Select Case UCase(psProperty) + Case UCase("Caption") + If oSession.HasUNOProperty(_DialogModel, "Title") Then _PropertyGet = _DialogModel.Title + Case UCase("Height") + If _Displayed Then ' Convert PosSize view property from pixels to APPFONT units + _PropertyGet = SF_DialogUtils._ConvertToAppFont(_DialogControl, False).Height + Else + If oSession.HasUNOProperty(_DialogModel, "Height") Then _PropertyGet = _DialogModel.Height + End If + Case UCase("Modal") + _PropertyGet = _Modal + Case UCase("Name") + _PropertyGet = _Name + Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _ + , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _ + , UCase("OnMousePressed"), UCase("OnMouseReleased") + ' Check OnEvents set statically in Basic IDE + Set oDialogEvents = _DialogModel.getEvents() + sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & _GetEventName(psProperty) + If oDialogEvents.hasByName(sEventName) Then + _PropertyGet = oDialogEvents.getByName(sEventName).ScriptCode + Else + ' Check OnEvents set dynamically by code + Select Case UCase(psProperty) + Case UCase("OnFocusGained") : _PropertyGet = _OnFocusGained + Case UCase("OnFocusLost") : _PropertyGet = _OnFocusLost + Case UCase("OnKeyPressed") : _PropertyGet = _OnKeyPressed + Case UCase("OnKeyReleased") : _PropertyGet = _OnKeyReleased + Case UCase("OnMouseDragged") : _PropertyGet = _OnMouseDragged + Case UCase("OnMouseEntered") : _PropertyGet = _OnMouseEntered + Case UCase("OnMouseExited") : _PropertyGet = _OnMouseExited + Case UCase("OnMouseMoved") : _PropertyGet = _OnMouseMoved + Case UCase("OnMousePressed") : _PropertyGet = _OnMousePressed + Case UCase("OnMouseReleased") : _PropertyGet = _OnMouseReleased + Case Else : _PropertyGet = "" + End Select + End If + Case UCase("Page") + If oSession.HasUNOProperty(_DialogModel, "Step") Then _PropertyGet = _DialogModel.Step + Case UCase("Visible") + If oSession.HasUnoMethod(_DialogControl, "isVisible") Then _PropertyGet = CBool(_DialogControl.isVisible()) + Case UCase("Width") + If _Displayed Then ' Convert PosSize view property from pixels to APPFONT units + _PropertyGet = SF_DialogUtils._ConvertToAppFont(_DialogControl, False).Width + Else + If oSession.HasUNOProperty(_DialogModel, "Width") Then _PropertyGet = _DialogModel.Width + End If + Case UCase("XDialogModel") + Set _PropertyGet = _DialogModel + Case UCase("XDialogView") + Set _PropertyGet = _DialogControl + Case Else + _PropertyGet = Null + End Select + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _PropertySet(Optional ByVal psProperty As String _ + , Optional ByVal pvValue As Variant _ + ) As Boolean +''' Set the new value of the named property +''' Args: +''' psProperty: the name of the property +''' pvValue: the new value of the given property +''' Returns: +''' True if successful + +Dim bSet As Boolean ' Return value +Static oSession As Object ' Alias of SF_Session +Dim cstThisSub As String +Const cstSubArgs = "Value" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bSet = False + + cstThisSub = "SFDialogs.Dialog.set" & psProperty + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not _IsStillAlive() Then GoTo Finally + + If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") + bSet = True + Select Case UCase(psProperty) + Case UCase("Caption") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Caption", V_STRING) Then GoTo Catch + If oSession.HasUNOProperty(_DialogModel, "Title") Then _DialogModel.Title = pvValue + Case UCase("Height") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Height", ScriptForge.V_NUMERIC) Then GoTo Catch + bSet = Resize(Height := pvValue) + Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _ + , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _ + , UCase("OnMousePressed"), UCase("OnMouseReleased") + If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Catch + bSet = SF_DialogListener._SetOnProperty([Me], psProperty, pvValue) + Case UCase("Page") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Page", ScriptForge.V_NUMERIC) Then GoTo Catch + If oSession.HasUNOProperty(_DialogModel, "Step") Then + _DialogModel.Step = CLng(pvValue) + ' Execute the page manager instructions + _JumpToPage(pvValue) + End If + Case UCase("Visible") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Catch + If oSession.HasUnoMethod(_DialogControl, "setVisible") Then _DialogControl.setVisible(pvValue) + Case UCase("Width") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch + bSet = Resize(Width := pvValue) + Case Else + bSet = False + End Select + +Finally: + _PropertySet = bSet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + bSet = False + GoTo Finally +End Function ' SFDialogs.SF_Dialog._PropertySet + +REM ----------------------------------------------------------------------------- +Private Function _RegisterPageListener(ByVal psControlName As String _ + , ByVal psControlTypes As String _ + , ByVal piMgtType As Integer _ + , ByVal plPageNumber As Long _ + , ByVal piListener As Integer _ + ) As Boolean +''' Insert a new entry in the _PageManagement array when 1st argument is a listbox, a combobox or a button +''' or insert a new entry in the _PageManagement array by radio button in the same group as the 1st argument +''' Args: +''' psControlName: name of the involved control +''' psControlTypes: comma-separated list of allowed control types +''' piMgtType: one of the PILOTCONTROL, TABCONTROL, BACKCONTROL, NEXTCONTROL constants +''' plPageNumber: when > 0 the page to jump to when control is clicked +''' piListener: one of the ACTIONPERFORMED, ITEMSTATECHANGED constants + +Dim bRegister As Boolean ' Return value +Dim oControl As Object ' A DialogControl object +Dim oControl2 As Object ' An alternative DialogControl object for radio buttons +Dim vControls As Variant ' Array of involved controls - mostly 1 item, more when radio button +Dim oPageManager As Object ' Type _PageManager +Dim bRadio As Boolean ' True when argument is a radio button +Dim sName As String ' Control name +Dim i As Long + +Check: + On Local Error GoTo Catch + bRegister = False + +Try: + Set oControl = Controls(psControlName) + With oControl + ' Check the type of control otherwise return False + If InStr(psControlTypes, .ControlType) = 0 Then GoTo Catch + ' Are there siblings ? Siblings are returned as a comma-separated list of names + bRadio = ( .ControlType = "RadioButton") + If bRadio Then vControls = Split(_FindRadioSiblings(.Name), ",") Else vControls = Array(.Name) + ' Several loops when radio buttons + For i = 0 To UBound(vControls) + sName = vControls(i) + ' Prepare the next entry in the _PageManagement array + Set oPageManager = New _PageManager + With oPageManager + .ControlName = sName + .PageMgtType = piMgtType + .PageNumber = Iif(bRadio, i + 1, plPageNumber) + .ListenerType = piListener + End With + _PageManagement = ScriptForge.SF_Array.Append(_PageManagement, oPageManager) + ' Activate the listener + ' Use alternative control for radio buttons > first + If i = 0 Then Set oControl2 = oControl Else Set oControl2 = Controls(sName) + With oControl2 + If piListener = ACTIONPERFORMED Then + ._ControlView.addActionListener(_ActionListener) + ElseIf piListener = ITEMSTATECHANGED Then + ._ControlView.addItemListener(_ItemListener) + End If + End With + Next i + End With + + bRegister = True + +Finally: + _RegisterPageListener = bRegister + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog._RegisterPageListener + +REM ----------------------------------------------------------------------------- +Private Sub _RemoveAllListeners() +''' Executed at dialog termination to drop at once all listeners set +''' either by the page manager or by an On-property setting + +Dim oPageManager As Object ' Item of _PageManagement array of _PageManager type +Dim oControl As Object ' DialogControl instance +Dim i As Long + + On Local Error GoTo Finally ' Never interrupt + +Try: + ' Scan the _PageManagement array containing the actual settings of the page manager + For Each oPageManager In _PageManagement + With oPageManager + If .ListenerType > 0 Then + Set oControl = Controls(.ControlName) + If .ListenerType = ACTIONPERFORMED Then + oControl._ControlView.removeActionListener(_ActionListener) + ElseIf .ListenerType = ITEMSTATECHANGED Then + oControl._ControlView.removeItemListener(_ItemListener) + End If + End If + End With + Next oPageManager + + Set _ActionListener = Nothing + Set _ItemListener = Nothing + + ' Clean listeners linked to On properties + With _DialogControl + If Not IsNull(_FocusListener) Then .removeFocusListener(_FocusListener) + If Not IsNull(_KeyListener) Then .removeKeyListener(_KeyListener) + If Not IsNull(_MouseListener) Then .removeMouseListener(_MouseListener) + If Not IsNull(_MouseMotionListener) Then .removeMouseMotionListener(_MouseMotionListener) + End With + + Set _FocusListener = Nothing + Set _KeyListener = Nothing + Set _MouseListener = Nothing + Set _MouseMotionListener = Nothing + +Finally: + Exit Sub +End Sub ' SFDialogs.SF_Dialog._RemoveAllListeners +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[DIALOG]: Container.Library.Name" + + _Repr = "[DIALOG]: " & _Container & "." & _Library & "." & _Name + +End Function ' SFDialogs.SF_Dialog._Repr + +REM ============================================ END OF SFDIALOGS.SF_DIALOG +</script:module> diff --git a/wizards/source/sfdialogs/SF_DialogControl.xba b/wizards/source/sfdialogs/SF_DialogControl.xba new file mode 100644 index 0000000000..a82a18e2e1 --- /dev/null +++ b/wizards/source/sfdialogs/SF_DialogControl.xba @@ -0,0 +1,2514 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_DialogControl" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === The SFDialogs library is one of the associated libraries. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option ClassModule + +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_DialogControl +''' ================ +''' Manage the controls belonging to a dialog defined with the Basic IDE +''' Each instance of the current class represents a single control within a dialog box +''' +''' The focus is clearly set on getting and setting the values displayed by the controls of the dialog box, +''' not on their formatting. The latter is easily accessible via the XControlModel and XControlView +''' UNO objects. +''' Essentially a single property "Value" maps many alternative UNO properties depending each on +''' the control type. +''' +''' A special attention is given to controls with types TreeControl and TableControl +''' It is easy with the API proposed in the current class to populate a tree, either +''' - branch by branch (CreateRoot and AddSubNode), or +''' - with a set of branches at once (AddSubtree) +''' Additionally populating a TreeControl can be done statically or dynamically +''' +''' With the method SetTableData(), feed a tablecontrol with a sortable and selectable +''' array of data. Columns and rows may receive a header. Column widths are adjusted manually by the user or +''' with the same method. Alignments can be set as well by script. +''' +''' Service invocation: +''' Dim myDialog As Object, myControl As Object +''' Set myDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", myLibrary, DialogName) +''' Set myControl = myDialog.Controls("myTextBox") +''' myControl.Value = "Dialog started at " & Now() +''' myDialog.Execute() +''' ' ... process the controls actual values +''' myDialog.Terminate() +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_dialogcontrol.html?DbPAR=BASIC +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Private Const CONTROLTYPEERROR = "CONTROLTYPEERROR" +Private Const TEXTFIELDERROR = "TEXTFIELDERROR" + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private [_Parent] As Object +Private ObjectType As String ' Must be DIALOGCONTROL +Private ServiceName As String + +' Control naming +Private _Name As String +Private _IndexOfNames As Long ' Index in ElementNames array. Used to access SF_Dialog._ControlCache +Private _DialogName As String ' Parent dialog name + +' Control UNO references +Private _ControlModel As Object ' com.sun.star.awt.XControlModel +Private _ControlView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl +Private _TreeDataModel As Object ' com.sun.star.awt.tree.MutableTreeDataModel +Private _GridColumnModel As Object ' com.sun.star.awt.grid.XGridColumnModel +Private _GridDataModel As Object ' com.sun.star.awt.grid.XGridDataModel + +' Control attributes +Private _ImplementationName As String +Private _ControlType As String ' One of the CTLxxx constants + +' Control initial position and dimensions in APPFONT units +Private _Left As Long +Private _Top As Long +Private _Width As Long +Private _Height As Long + +' Tree control on-select and on-expand attributes +' Tree controls may be associated with events not defined in the Basic IDE +Private _OnNodeSelected As String ' Script to invoke when a node is selected +Private _OnNodeExpanded As String ' Script to invoke when a node is expanded +Private _SelectListener As Object ' com.sun.star.view.XSelectionChangeListener +Private _ExpandListener As Object ' com.sun.star.awt.tree.XTreeExpansionListener + +' Updatable events +Private _ActionListener As Object ' com.sun.star.awt.XActionListener +Private _OnActionPerformed As String ' Script to invoke when action triggered +Private _ActionCounter As Integer ' Counts the number of events set on the listener +' --- +Private _AdjustmentListener As Object ' com.sun.star.awt.XAdjustmentListener +Private _OnAdjustmentValueChanged As String ' Script to invoke when scrollbar value has changed +Private _AdjustmentCounter As Integer ' Counts the number of events set on the listener +' --- +Private _FocusListener As Object ' com.sun.star.awt.XFocusListener +Private _OnFocusGained As String ' Script to invoke when control gets focus +Private _OnFocusLost As String ' Script to invoke when control loses focus +Private _FocusCounter As Integer ' Counts the number of events set on the listener +' --- +Private _ItemListener As Object ' com.sun.star.awt.XItemListener +Private _OnItemStateChanged As String ' Script to invoke when status of item changes +Private _ItemCounter As Integer ' Counts the number of events set on the listener +' --- +Private _KeyListener As Object ' com.sun.star.awt.XKeyListener +Private _OnKeyPressed As String ' Script to invoke when Key clicked in control +Private _OnKeyReleased As String ' Script to invoke when Key released in control +Private _KeyCounter As Integer ' Counts the number of events set on the listener +' --- +Private _MouseListener As Object ' com.sun.star.awt.XMouseListener +Private _OnMouseEntered As String ' Script to invoke when mouse enters control +Private _OnMouseExited As String ' Script to invoke when mouse leaves control +Private _OnMousePressed As String ' Script to invoke when mouse clicked in control +Private _OnMouseReleased As String ' Script to invoke when mouse released in control +Private _MouseCounter As Integer ' Counts the number of events set on the listener +' --- +Private _MouseMotionListener As Object ' com.sun.star.awt.XMouseMotionListener +Private _OnMouseDragged As String ' Script to invoke when mouse is dragged from the control +Private _OnMouseMoved As String ' Script to invoke when mouse is moved across the control +Private _MouseMotionCounter As Integer ' Counts the number of events set on the listener +' --- +Private _TextListener As Object ' com.sun.star.awt.XTextListener +Private _OnTextChanged As String ' Script to invoke when textual content has changed +Private _TextCounter As Integer ' Counts the number of events set on the listener + +' Table control attributes +Private _ColumnWidths As Variant ' Array of column widths + +REM ============================================================ MODULE CONSTANTS + +Private Const CTLBUTTON = "Button" +Private Const CTLCHECKBOX = "CheckBox" +Private Const CTLCOMBOBOX = "ComboBox" +Private Const CTLCURRENCYFIELD = "CurrencyField" +Private Const CTLDATEFIELD = "DateField" +Private Const CTLFILECONTROL = "FileControl" +Private Const CTLFIXEDLINE = "FixedLine" +Private Const CTLFIXEDTEXT = "FixedText" +Private Const CTLFORMATTEDFIELD = "FormattedField" +Private Const CTLGROUPBOX = "GroupBox" +Private Const CTLHYPERLINK = "Hyperlink" +Private Const CTLIMAGECONTROL = "ImageControl" +Private Const CTLLISTBOX = "ListBox" +Private Const CTLNUMERICFIELD = "NumericField" +Private Const CTLPATTERNFIELD = "PatternField" +Private Const CTLPROGRESSBAR = "ProgressBar" +Private Const CTLRADIOBUTTON = "RadioButton" +Private Const CTLSCROLLBAR = "ScrollBar" +Private Const CTLTABLECONTROL = "TableControl" +Private Const CTLTEXTFIELD = "TextField" +Private Const CTLTIMEFIELD = "TimeField" +Private Const CTLTREECONTROL = "TreeControl" + +REM ====================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + ObjectType = "DIALOGCONTROL" + ServiceName = "SFDialogs.DialogControl" + _Name = "" + _IndexOfNames = -1 + _DialogName = "" + Set _ControlModel = Nothing + Set _ControlView = Nothing + Set _TreeDataModel = Nothing + Set _GridColumnModel = Nothing + Set _GridDataModel = Nothing + _ImplementationName = "" + _ControlType = "" + + _Left = SF_DialogUtils.MINPOSITION + _Top = SF_DialogUtils.MINPOSITION + _Width = -1 + _Height = -1 + + _OnNodeSelected = "" + _OnNodeExpanded = "" + Set _SelectListener = Nothing + Set _ExpandListener = Nothing + + Set _ActionListener = Nothing + _OnActionPerformed = "" + _ActionCounter = 0 + Set _AdjustmentListener = Nothing + _OnAdjustmentValueChanged = "" + _AdjustmentCounter = 0 + Set _FocusListener = Nothing + _OnFocusGained = "" + _OnFocusLost = "" + _FocusCounter = 0 + Set _KeyListener = Nothing + _OnKeyPressed = "" + _OnKeyReleased = "" + _KeyCounter = 0 + Set _MouseListener = Nothing + _OnMouseEntered = "" + _OnMouseExited = "" + _OnMousePressed = "" + _OnMouseReleased = "" + _MouseCounter = 0 + Set _MouseMotionListener = Nothing + _OnMouseDragged = "" + _OnMouseMoved = "" + _MouseMotionCounter = 0 + Set _ItemListener = Nothing + _OnItemStateChanged = "" + _ItemCounter = 0 + Set _TextListener = Nothing + _OnTextChanged = "" + _TextCounter = 0 + + _ColumnWidths = Array() +End Sub ' SFDialogs.SF_DialogControl Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' SFDialogs.SF_DialogControl Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Call Class_Terminate() + Set Dispose = Nothing +End Function ' SFDialogs.SF_DialogControl Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get Border() As Variant +''' The Border property refers to the surrounding of the control: 3D, FLAT or NONE + Border = _PropertyGet("Border", "") +End Property ' SFDialogs.SF_DialogControl.Border (get) + +REM ----------------------------------------------------------------------------- +Property Let Border(Optional ByVal pvBorder As Variant) +''' Set the updatable property Border + _PropertySet("Border", pvBorder) +End Property ' SFDialogs.SF_DialogControl.Border (let) + +REM ----------------------------------------------------------------------------- +Property Get Cancel() As Variant +''' The Cancel property specifies if a command button has or not the behaviour of a Cancel button. + Cancel = _PropertyGet("Cancel", False) +End Property ' SFDialogs.SF_DialogControl.Cancel (get) + +REM ----------------------------------------------------------------------------- +Property Let Cancel(Optional ByVal pvCancel As Variant) +''' Set the updatable property Cancel + _PropertySet("Cancel", pvCancel) +End Property ' SFDialogs.SF_DialogControl.Cancel (let) + +REM ----------------------------------------------------------------------------- +Property Get Caption() As Variant +''' The Caption property refers to the text associated with the control + Caption = _PropertyGet("Caption", "") +End Property ' SFDialogs.SF_DialogControl.Caption (get) + +REM ----------------------------------------------------------------------------- +Property Let Caption(Optional ByVal pvCaption As Variant) +''' Set the updatable property Caption + _PropertySet("Caption", pvCaption) +End Property ' SFDialogs.SF_DialogControl.Caption (let) + +REM ----------------------------------------------------------------------------- +Property Get ControlType() As String +''' Return the type of the actual control: "CheckBox", "TextField", "DateField", ... + ControlType = _PropertyGet("ControlType") +End Property ' SFDialogs.SF_DialogControl.ControlType + +REM ----------------------------------------------------------------------------- +Property Get CurrentNode() As Variant +''' The CurrentNode property returns the currently selected node +''' It returns Empty when there is no node selected +''' When there are several selections, it returns the topmost node among the selected ones + CurrentNode = _PropertyGet("CurrentNode", "") +End Property ' SFDialogs.SF_DialogControl.CurrentNode (get) + +REM ----------------------------------------------------------------------------- +Property Let CurrentNode(Optional ByVal pvCurrentNode As Variant) +''' Set a single selection in a tree control + _PropertySet("CurrentNode", pvCurrentNode) +End Property ' SFDialogs.SF_DialogControl.CurrentNode (let) + +REM ----------------------------------------------------------------------------- +Property Get Default() As Variant +''' The Default property specifies whether a command button is the default (OK) button. + Default = _PropertyGet("Default", False) +End Property ' SFDialogs.SF_DialogControl.Default (get) + +REM ----------------------------------------------------------------------------- +Property Let Default(Optional ByVal pvDefault As Variant) +''' Set the updatable property Default + _PropertySet("Default", pvDefault) +End Property ' SFDialogs.SF_DialogControl.Default (let) + +REM ----------------------------------------------------------------------------- +Property Get Enabled() As Variant +''' The Enabled property specifies if the control is accessible with the cursor. + Enabled = _PropertyGet("Enabled") +End Property ' SFDialogs.SF_DialogControl.Enabled (get) + +REM ----------------------------------------------------------------------------- +Property Let Enabled(Optional ByVal pvEnabled As Variant) +''' Set the updatable property Enabled + _PropertySet("Enabled", pvEnabled) +End Property ' SFDialogs.SF_DialogControl.Enabled (let) + +REM ----------------------------------------------------------------------------- +Property Get Format() As Variant +''' The Format property specifies the format in which to display dates and times. + Format = _PropertyGet("Format", "") +End Property ' SFDialogs.SF_DialogControl.Format (get) + +REM ----------------------------------------------------------------------------- +Property Let Format(Optional ByVal pvFormat As Variant) +''' Set the updatable property Format + _PropertySet("Format", pvFormat) +End Property ' SFDialogs.SF_DialogControl.Format (let) + +REM ----------------------------------------------------------------------------- +Property Get Height() As Variant +''' The Height property refers to the height of the control + Height = _PropertyGet("Height") +End Property ' SFDialogs.SF_DialogControl.Height (get) + +REM ----------------------------------------------------------------------------- +Property Let Height(Optional ByVal pvHeight As Variant) +''' Set the updatable property Height + _PropertySet("Height", pvHeight) +End Property ' SFDialogs.SF_DialogControl.Height (let) + +REM ----------------------------------------------------------------------------- +Property Get ListCount() As Long +''' The ListCount property specifies the number of rows in a list box or a combo box + ListCount = _PropertyGet("ListCount", 0) +End Property ' SFDialogs.SF_DialogControl.ListCount (get) + +REM ----------------------------------------------------------------------------- +Property Get ListIndex() As Variant +''' The ListIndex property specifies which item is selected in a list box or combo box. +''' In case of multiple selection, the index of the first one is returned or only one is set + ListIndex = _PropertyGet("ListIndex", -1) +End Property ' SFDialogs.SF_DialogControl.ListIndex (get) + +REM ----------------------------------------------------------------------------- +Property Let ListIndex(Optional ByVal pvListIndex As Variant) +''' Set the updatable property ListIndex + _PropertySet("ListIndex", pvListIndex) +End Property ' SFDialogs.SF_DialogControl.ListIndex (let) + +REM ----------------------------------------------------------------------------- +Property Get Locked() As Variant +''' The Locked property specifies if a control is read-only + Locked = _PropertyGet("Locked", False) +End Property ' SFDialogs.SF_DialogControl.Locked (get) + +REM ----------------------------------------------------------------------------- +Property Let Locked(Optional ByVal pvLocked As Variant) +''' Set the updatable property Locked + _PropertySet("Locked", pvLocked) +End Property ' SFDialogs.SF_DialogControl.Locked (let) + +REM ----------------------------------------------------------------------------- +Property Get MultiSelect() As Variant +''' The MultiSelect property specifies whether a user can make multiple selections in a listbox + MultiSelect = _PropertyGet("MultiSelect", False) +End Property ' SFDialogs.SF_DialogControl.MultiSelect (get) + +REM ----------------------------------------------------------------------------- +Property Let MultiSelect(Optional ByVal pvMultiSelect As Variant) +''' Set the updatable property MultiSelect + _PropertySet("MultiSelect", pvMultiSelect) +End Property ' SFDialogs.SF_DialogControl.MultiSelect (let) + +REM ----------------------------------------------------------------------------- +Property Get Name() As String +''' Return the name of the actual control + Name = _PropertyGet("Name") +End Property ' SFDialogs.SF_DialogControl.Name + +REM ----------------------------------------------------------------------------- +Property Get OnActionPerformed() As Variant +''' Get the script associated with the OnActionPerformed event + OnActionPerformed = _PropertyGet("OnActionPerformed") +End Property ' SFDialogs.SF_DialogControl.OnActionPerformed (get) + +REM ----------------------------------------------------------------------------- +Property Let OnActionPerformed(Optional ByVal pvActionPerformed As Variant) +''' Set the updatable property OnActionPerformed + _PropertySet("OnActionPerformed", pvActionPerformed) +End Property ' SFDialogs.SF_DialogControl.OnActionPerformed (let) + +REM ----------------------------------------------------------------------------- +Property Get OnAdjustmentValueChanged() As Variant +''' Get the script associated with the OnAdjustmentValueChanged event + OnAdjustmentValueChanged = _PropertyGet("OnAdjustmentValueChanged") +End Property ' SFDialogs.SF_DialogControl.OnAdjustmentValueChanged (get) + +REM ----------------------------------------------------------------------------- +Property Let OnAdjustmentValueChanged(Optional ByVal pvAdjustmentValueChanged As Variant) +''' Set the updatable property OnAdjustmentValueChanged + _PropertySet("OnAdjustmentValueChanged", pvAdjustmentValueChanged) +End Property ' SFDialogs.SF_DialogControl.OnAdjustmentValueChanged (let) + +REM ----------------------------------------------------------------------------- +Property Get OnFocusGained() As Variant +''' Get the script associated with the OnFocusGained event + OnFocusGained = _PropertyGet("OnFocusGained") +End Property ' SFDialogs.SF_DialogControl.OnFocusGained (get) + +REM ----------------------------------------------------------------------------- +Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant) +''' Set the updatable property OnFocusGained + _PropertySet("OnFocusGained", pvOnFocusGained) +End Property ' SFDialogs.SF_DialogControl.OnFocusGained (let) + +REM ----------------------------------------------------------------------------- +Property Get OnFocusLost() As Variant +''' Get the script associated with the OnFocusLost event + OnFocusLost = _PropertyGet("OnFocusLost") +End Property ' SFDialogs.SF_DialogControl.OnFocusLost (get) + +REM ----------------------------------------------------------------------------- +Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant) +''' Set the updatable property OnFocusLost + _PropertySet("OnFocusLost", pvOnFocusLost) +End Property ' SFDialogs.SF_DialogControl.OnFocusLost (let) + +REM ----------------------------------------------------------------------------- +Property Get OnItemStateChanged() As Variant +''' Get the script associated with the OnItemStateChanged event + OnItemStateChanged = _PropertyGet("OnItemStateChanged") +End Property ' SFDialogs.SF_DialogControl.OnItemStateChanged (get) + +REM ----------------------------------------------------------------------------- +Property Let OnItemStateChanged(Optional ByVal pvItemStateChanged As Variant) +''' Set the updatable property OnItemStateChanged + _PropertySet("OnItemStateChanged", pvItemStateChanged) +End Property ' SFDialogs.SF_DialogControl.OnItemStateChanged (let) + +REM ----------------------------------------------------------------------------- +Property Get OnKeyPressed() As Variant +''' Get the script associated with the OnKeyPressed event + OnKeyPressed = _PropertyGet("OnKeyPressed") +End Property ' SFDialogs.SF_DialogControl.OnKeyPressed (get) + +REM ----------------------------------------------------------------------------- +Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant) +''' Set the updatable property OnKeyPressed + _PropertySet("OnKeyPressed", pvOnKeyPressed) +End Property ' SFDialogs.SF_DialogControl.OnKeyPressed (let) + +REM ----------------------------------------------------------------------------- +Property Get OnKeyReleased() As Variant +''' Get the script associated with the OnKeyReleased event + OnKeyReleased = _PropertyGet("OnKeyReleased") +End Property ' SFDialogs.SF_DialogControl.OnKeyReleased (get) + +REM ----------------------------------------------------------------------------- +Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant) +''' Set the updatable property OnKeyReleased + _PropertySet("OnKeyReleased", pvOnKeyReleased) +End Property ' SFDialogs.SF_DialogControl.OnKeyReleased (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMouseDragged() As Variant +''' Get the script associated with the OnMouseDragged event + OnMouseDragged = _PropertyGet("OnMouseDragged") +End Property ' SFDialogs.SF_DialogControl.OnMouseDragged (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant) +''' Set the updatable property OnMouseDragged + _PropertySet("OnMouseDragged", pvOnMouseDragged) +End Property ' SFDialogs.SF_DialogControl.OnMouseDragged (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMouseEntered() As Variant +''' Get the script associated with the OnMouseEntered event + OnMouseEntered = _PropertyGet("OnMouseEntered") +End Property ' SFDialogs.SF_DialogControl.OnMouseEntered (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant) +''' Set the updatable property OnMouseEntered + _PropertySet("OnMouseEntered", pvOnMouseEntered) +End Property ' SFDialogs.SF_DialogControl.OnMouseEntered (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMouseExited() As Variant +''' Get the script associated with the OnMouseExited event + OnMouseExited = _PropertyGet("OnMouseExited") +End Property ' SFDialogs.SF_DialogControl.OnMouseExited (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant) +''' Set the updatable property OnMouseExited + _PropertySet("OnMouseExited", pvOnMouseExited) +End Property ' SFDialogs.SF_DialogControl.OnMouseExited (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMouseMoved() As Variant +''' Get the script associated with the OnMouseMoved event + OnMouseMoved = _PropertyGet("OnMouseMoved") +End Property ' SFDialogs.SF_DialogControl.OnMouseMoved (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant) +''' Set the updatable property OnMouseMoved + _PropertySet("OnMouseMoved", pvOnMouseMoved) +End Property ' SFDialogs.SF_DialogControl.OnMouseMoved (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMousePressed() As Variant +''' Get the script associated with the OnMousePressed event + OnMousePressed = _PropertyGet("OnMousePressed") +End Property ' SFDialogs.SF_DialogControl.OnMousePressed (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant) +''' Set the updatable property OnMousePressed + _PropertySet("OnMousePressed", pvOnMousePressed) +End Property ' SFDialogs.SF_DialogControl.OnMousePressed (let) + +REM ----------------------------------------------------------------------------- +Property Get OnMouseReleased() As Variant +''' Get the script associated with the OnMouseReleased event + OnMouseReleased = _PropertyGet("OnMouseReleased") +End Property ' SFDialogs.SF_DialogControl.OnMouseReleased (get) + +REM ----------------------------------------------------------------------------- +Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant) +''' Set the updatable property OnMouseReleased + _PropertySet("OnMouseReleased", pvOnMouseReleased) +End Property ' SFDialogs.SF_DialogControl.OnMouseReleased (let) + +REM ----------------------------------------------------------------------------- +Property Get OnNodeExpanded() As Variant +''' Get the script associated with the OnNodeExpanded event + OnNodeExpanded = _PropertyGet("OnNodeExpanded") +End Property ' SFDialogs.SF_DialogControl.OnNodeExpanded (get) + +REM ----------------------------------------------------------------------------- +Property Let OnNodeExpanded(Optional ByVal pvOnNodeExpanded As Variant) +''' Set the updatable property OnNodeExpanded + _PropertySet("OnNodeExpanded", pvOnNodeExpanded) +End Property ' SFDialogs.SF_DialogControl.OnNodeExpanded (let) + +REM ----------------------------------------------------------------------------- +Property Get OnNodeSelected() As Variant +''' Get the script associated with the OnNodeSelected event + OnNodeSelected = _PropertyGet("OnNodeSelected") +End Property ' SFDialogs.SF_DialogControl.OnNodeSelected (get) + +REM ----------------------------------------------------------------------------- +Property Let OnNodeSelected(Optional ByVal pvOnNodeSelected As Variant) +''' Set the updatable property OnNodeSelected + _PropertySet("OnNodeSelected", pvOnNodeSelected) +End Property ' SFDialogs.SF_DialogControl.OnNodeSelected (let) + +REM ----------------------------------------------------------------------------- +Property Get OnTextChanged() As Variant +''' Get the script associated with the OnTextChanged event + OnTextChanged = _PropertyGet("OnTextChanged") +End Property ' SFDialogs.SF_DialogControl.OnTextChanged (get) + +REM ----------------------------------------------------------------------------- +Property Let OnTextChanged(Optional ByVal pvTextChanged As Variant) +''' Set the updatable property OnTextChanged + _PropertySet("OnTextChanged", pvTextChanged) +End Property ' SFDialogs.SF_DialogControl.OnTextChanged (let) + +REM ----------------------------------------------------------------------------- +Property Get Page() As Variant +''' A dialog may have several pages that can be traversed by the user step by step. The Page property of the Dialog object defines which page of the dialog is active. +''' The Page property of a control defines the page of the dialog on which the control is visible. +''' For example, if a control has a page value of 1, it is only visible on page 1 of the dialog. +''' If the page value of the dialog is increased from 1 to 2, then all controls with a page value of 1 disappear and all controls with a page value of 2 become visible. + Page = _PropertyGet("Page") +End Property ' SFDialogs.SF_DialogControl.Page (get) + +REM ----------------------------------------------------------------------------- +Property Let Page(Optional ByVal pvPage As Variant) +''' Set the updatable property Page + _PropertySet("Page", pvPage) +End Property ' SFDialogs.SF_DialogControl.Page (let) + +REM ----------------------------------------------------------------------------- +Property Get Parent() As Object +''' Return the Parent dialog object of the actual control + Parent = _PropertyGet("Parent", Nothing) +End Property ' SFDialogs.SF_DialogControl.Parent + +REM ----------------------------------------------------------------------------- +Property Get Picture() As Variant +''' The Picture property specifies a bitmap or other type of graphic to be displayed on the specified control + Picture = _PropertyGet("Picture", "") +End Property ' SFDialogs.SF_DialogControl.Picture (get) + +REM ----------------------------------------------------------------------------- +Property Let Picture(Optional ByVal pvPicture As Variant) +''' Set the updatable property Picture + _PropertySet("Picture", pvPicture) +End Property ' SFDialogs.SF_DialogControl.Picture (let) + +REM ----------------------------------------------------------------------------- +Property Get RootNode() As Variant +''' The RootNode property returns the last root node of a tree control + RootNode = _PropertyGet("RootNode", "") +End Property ' SFDialogs.SF_DialogControl.RootNode (get) + +REM ----------------------------------------------------------------------------- +Property Get RowSource() As Variant +''' The RowSource property specifies the data contained in a combobox or a listbox +''' as a zero-based array of string values + RowSource = _PropertyGet("RowSource", "") +End Property ' SFDialogs.SF_DialogControl.RowSource (get) + +REM ----------------------------------------------------------------------------- +Property Let RowSource(Optional ByVal pvRowSource As Variant) +''' Set the updatable property RowSource + _PropertySet("RowSource", pvRowSource) +End Property ' SFDialogs.SF_DialogControl.RowSource (let) + +REM ----------------------------------------------------------------------------- +Property Get TabIndex() As Variant +''' The TabIndex property specifies a control's place in the tab order in the dialog +''' Zero or negative means no tab set in the control + TabIndex = _PropertyGet("TabIndex", -1) +End Property ' SFDialogs.SF_DialogControl.TabIndex (get) + +REM ----------------------------------------------------------------------------- +Property Let TabIndex(Optional ByVal pvTabIndex As Variant) +''' Set the updatable property TabIndex + _PropertySet("TabIndex", pvTabIndex) +End Property ' SFDialogs.SF_DialogControl.TabIndex (let) + +REM ----------------------------------------------------------------------------- +Property Get Text() As Variant +''' The Text property specifies the actual content of the control like it is displayed on the screen + Text = _PropertyGet("Text", "") +End Property ' SFDialogs.SF_DialogControl.Text (get) + +REM ----------------------------------------------------------------------------- +Property Get TipText() As Variant +''' The TipText property specifies the text that appears in a screentip when you hold the mouse pointer over a control + TipText = _PropertyGet("TipText", "") +End Property ' SFDialogs.SF_DialogControl.TipText (get) + +REM ----------------------------------------------------------------------------- +Property Let TipText(Optional ByVal pvTipText As Variant) +''' Set the updatable property TipText + _PropertySet("TipText", pvTipText) +End Property ' SFDialogs.SF_DialogControl.TipText (let) + +REM ----------------------------------------------------------------------------- +Property Get TripleState() As Variant +''' The TripleState property specifies how a check box will display Null values +''' When True, the control will cycle through states for Yes, No, and Null values. The control appears dimmed (grayed) when its Value property is set to Null. +''' When False, the control will cycle through states for Yes and No values. Null values display as if they were No values. + TripleState = _PropertyGet("TripleState", False) +End Property ' SFDialogs.SF_DialogControl.TripleState (get) + +REM ----------------------------------------------------------------------------- +Property Let TripleState(Optional ByVal pvTripleState As Variant) +''' Set the updatable property TripleState + _PropertySet("TripleState", pvTripleState) +End Property ' SFDialogs.SF_DialogControl.TripleState (let) + +REM ----------------------------------------------------------------------------- +Property Get URL() As Variant +''' The URL property refers to the URL to open when the control is clicked + URL = _PropertyGet("URL", "") +End Property ' SFDialogs.SF_DialogControl.URL (get) + +REM ----------------------------------------------------------------------------- +Property Let URL(Optional ByVal pvURL As Variant) +''' Set the updatable property URL + _PropertySet("URL", pvURL) +End Property ' SFDialogs.SF_DialogControl.URL (let) + +REM ----------------------------------------------------------------------------- +Property Get Value() As Variant +''' The Value property specifies the data contained in the control + Value = _PropertyGet("Value", Empty) +End Property ' SFDialogs.SF_DialogControl.Value (get) + +REM ----------------------------------------------------------------------------- +Property Let Value(Optional ByVal pvValue As Variant) +''' Set the updatable property Value + _PropertySet("Value", pvValue) +End Property ' SFDialogs.SF_DialogControl.Value (let) + +REM ----------------------------------------------------------------------------- +Property Get Visible() As Variant +''' The Visible property specifies if the control is accessible with the cursor. + Visible = _PropertyGet("Visible", True) +End Property ' SFDialogs.SF_DialogControl.Visible (get) + +REM ----------------------------------------------------------------------------- +Property Let Visible(Optional ByVal pvVisible As Variant) +''' Set the updatable property Visible + _PropertySet("Visible", pvVisible) +End Property ' SFDialogs.SF_DialogControl.Visible (let) + +REM ----------------------------------------------------------------------------- +Property Get Width() As Variant +''' The Width property refers to the Width of the control + Width = _PropertyGet("Width") +End Property ' SFDialogs.SF_DialogControl.Width (get) + +REM ----------------------------------------------------------------------------- +Property Let Width(Optional ByVal pvWidth As Variant) +''' Set the updatable property Width + _PropertySet("Width", pvWidth) +End Property ' SFDialogs.SF_DialogControl.Width (let) + +REM ----------------------------------------------------------------------------- +Property Get X() As Variant +''' The X property refers to the X coordinate of the top-left corner of the control + X = _PropertyGet("X") +End Property ' SFDialogs.SF_DialogControl.X (get) + +REM ----------------------------------------------------------------------------- +Property Let X(Optional ByVal pvX As Variant) +''' Set the updatable property X + _PropertySet("X", pvX) +End Property ' SFDialogs.SF_DialogControl.X (let) + +REM ----------------------------------------------------------------------------- +Property Get Y() As Variant +''' The Y property refers to the Y coordinate of the top-left corner of the control + Y = _PropertyGet("Y") +End Property ' SFDialogs.SF_DialogControl.Y (get) + +REM ----------------------------------------------------------------------------- +Property Let Y(Optional ByVal pvY As Variant) +''' Set the updatable property Y + _PropertySet("Y", pvY) +End Property ' SFDialogs.SF_DialogControl.Y (let) + +REM ----------------------------------------------------------------------------- +Property Get XControlModel() As Object +''' The XControlModel property returns the model UNO object of the control + XControlModel = _PropertyGet("XControlModel", Nothing) +End Property ' SFDialogs.SF_DialogControl.XControlModel (get) + +REM ----------------------------------------------------------------------------- +Property Get XControlView() As Object +''' The XControlView property returns the view UNO object of the control + XControlView = _PropertyGet("XControlView", Nothing) +End Property ' SFDialogs.SF_DialogControl.XControlView (get) + +REM ----------------------------------------------------------------------------- +Property Get XGridColumnModel() As Object +''' The XGridColumnModel property returns the mutable data model UNO object of the tree control + XGridColumnModel = _PropertyGet("XGridColumnModel", Nothing) +End Property ' SFDialogs.SF_DialogControl.XGridColumnModel (get) + +REM ----------------------------------------------------------------------------- +Property Get XGridDataModel() As Object +''' The XGridDataModel property returns the mutable data model UNO object of the tree control + XGridDataModel = _PropertyGet("XGridDataModel", Nothing) +End Property ' SFDialogs.SF_DialogControl.XGridDataModel (get) + +REM ----------------------------------------------------------------------------- +Property Get XTreeDataModel() As Object +''' The XTreeDataModel property returns the mutable data model UNO object of the tree control + XTreeDataModel = _PropertyGet("XTreeDataModel", Nothing) +End Property ' SFDialogs.SF_DialogControl.XTreeDataModel (get) + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function AddSubNode(Optional ByRef ParentNode As Variant _ + , Optional ByVal DisplayValue As Variant _ + , Optional ByRef DataValue As Variant _ + ) As Variant +''' Return a new node of the tree control subordinate to a parent node +''' Args: +''' ParentNode: A node UNO object, of type com.sun.star.awt.tree.XMutableTreeNode +''' DisplayValue: the text appearing in the control box +''' DataValue: any value associated with the new node. Default = Empty +''' Returns: +''' The new node UNO object: com.sun.star.awt.tree.XMutableTreeNode +''' Examples: +''' Dim myTree As Object, myNode As Object, theRoot As Object +''' Set myTree = myDialog.Controls("myTreeControl") +''' Set theRoot = myTree.CreateRoot("Tree top") +''' Set myNode = myTree.AddSubNode(theRoot, "A branch ...") + +Dim oNode As Object ' Return value +Const cstThisSub = "SFDialogs.DialogControl.AddSubNode" +Const cstSubArgs = "ParentNode, DisplayValue, [DataValue=Empty]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oNode = Nothing + +Check: + If IsMissing(DataValue) Then DataValue = Empty + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If _ControlType <> CTLTREECONTROL Then GoTo CatchType + If Not ScriptForge.SF_Utils._Validate(ParentNode, "ParentNode", V_OBJECT) Then GoTo Catch + If ScriptForge.SF_Session.UnoObjectType(ParentNode) <> "toolkit.MutableTreeNode" Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch + End If + +Try: + With _TreeDataModel + Set oNode = .createNode(DisplayValue, True) + oNode.DataValue = DataValue + ParentNode.appendChild(oNode) + End With + +Finally: + Set AddSubNode = oNode + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchType: + ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "AddSubNode") + GoTo Finally +End Function ' SFDialogs.SF_DialogControl.AddSubNode + +REM ----------------------------------------------------------------------------- +Public Function AddSubTree(Optional ByRef ParentNode As Variant _ + , Optional ByRef FlatTree As Variant _ + , Optional ByVal WithDataValue As Variant _ + ) As Boolean +''' Return True when a subtree, subordinate to a parent node, could be inserted successfully in a tree control +''' If the parent node had already child nodes before calling this method, the child nodes are erased +''' Args: +''' ParentNode: A node UNO object, of type com.sun.star.awt.tree.XMutableTreeNode +''' FlatTree: a 2D array sorted on the columns containing the DisplayValues +''' Flat tree >>>> Resulting subtree +''' A1 B1 C1 |__ A1 +''' A1 B1 C2 |__ B1 +''' A1 B2 C3 |__ C1 +''' A2 B3 C4 |__ C2 +''' A2 B3 C5 |__ B2 +''' A3 B4 C6 |__ C3 +''' |__ A2 +''' |__ B3 +''' |__ C4 +''' |__ C5 +''' |__ A3 +''' |__ B4 +''' |__ C6 +''' Typically, such an array can be issued by the GetRows method applied on the SFDatabases.Database service +''' when an array item containing the text to be displayed is = "" or is empty/null, +''' no new subnode is created and the remainder of the row is skipped +''' When AddSubTree() is called from a Python script, FlatTree may be an array of arrays +''' WithDataValue: +''' When False (default), every column of FlatTree contains the text to be displayed in the tree control +''' When True, the texts to be displayed (DisplayValue) are in columns 0, 2, 4, ... +''' while the DataValues are in columns 1, 3, 5, ... +''' Returns: +''' True when successful +''' Examples: +''' Dim myTree As Object, theRoot As Object, oDb As Object, vData As Variant +''' Set myTree = myDialog.Controls("myTreeControl") +''' Set theRoot = myTree.CreateRoot("By product category") +''' Set oDb = CreateScriptService("SFDatabases.Database", "/home/.../mydatabase.odb") +''' vData = oDb.GetRows("SELECT [Category].[Name], [Category].[ID], [Product].[Name], [Product].[ID] " _ +''' & "FROM [Category], [Product] WHERE [Product].[CategoryID] = [Category].[ID] " _ +''' & "ORDER BY [Category].[Name], [Product].[Name]") +''' myTree.AddSubTree(theRoot, vData, WithDataValue := True) + +Dim bSubTree As Boolean ' Return value +Dim oNode As Object ' com.sun.star.awt.tree.XMutableTreeNode +Dim oNewNode As Object ' com.sun.star.awt.tree.XMutableTreeNode +Dim lChildCount As Long ' Number of children nodes of a parent node +Dim iStep As Integer ' 1 when WithDataValue = False, 2 otherwise +Dim iDims As Integer ' Number of dimensions of FlatTree +Dim lMin1 As Long ' Lower bound (rows) +Dim lMin2 As Long ' Lower bounds (cols) +Dim lMax1 As Long ' Upper bound (rows) +Dim lMax2 As Long ' Upper bounds (cols) +Dim vFlatItem As Variant ' A single FlatTree item: FlatTree(i, j) +Dim vFlatItem2 As Variant ' A single FlatTree item +Dim bChange As Boolean ' When True, the item in FlatTree is different from the item above +Dim sValue As String ' Alias for display values +Dim i As Long, j As Long +Const cstThisSub = "SFDialogs.DialogControl.AddSubTree" +Const cstSubArgs = "ParentNode, FlatTree, [WithDataValue=False]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bSubTree = False + +Check: + If IsMissing(WithDataValue) Or IsEmpty(WithDataValue) Then WithDataValue = False + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If _ControlType <> CTLTREECONTROL Then GoTo CatchType + If Not ScriptForge.SF_Utils._Validate(ParentNode, "ParentNode", V_OBJECT) Then GoTo Catch + If ScriptForge.SF_Session.UnoObjectType(ParentNode) <> "toolkit.MutableTreeNode" Then GoTo Catch + If Not ScriptForge.SF_Utils._ValidateArray(FlatTree, "FlatTree") Then GoTo Catch ' Dimensions checked below + If Not ScriptForge.SF_Utils._Validate(WithDataValue, "WithDataValue", V_BOOLEAN) Then GoTo Catch + End If + +Try: + With _TreeDataModel + ' Clean subtree + lChildCount = ParentNode.getChildCount() + For i = 1 To lChildCount + ParentNode.removeChildByIndex(0) ' This cleans all subtrees too + Next i + + ' Determine bounds + iDims = ScriptForge.SF_Array.CountDims(FlatTree) + Select Case iDims + Case -1, 0 : GoTo Catch + Case 1 ' Called probably from Python + lMin1 = LBound(FlatTree, 1) : lMax1 = UBound(FlatTree, 1) + If Not IsArray(FlatTree(0)) Then GoTo Catch + If UBound(FlatTree(0)) < LBound(FlatTree(0)) Then GoTo Catch ' No columns + lMin2 = LBound(FlatTree(0)) : lMax2 = UBound(FlatTree(0)) + Case 2 + lMin1 = LBound(FlatTree, 1) : lMax1 = UBound(FlatTree, 1) + lMin2 = LBound(FlatTree, 2) : lMax2 = UBound(FlatTree, 2) + Case Else : GoTo Catch + End Select + + ' Build a new subtree + iStep = Iif(WithDataValue, 2, 1) + For i = lMin1 To lMax1 + bChange = ( i = 0 ) + ' Restart from the parent node at each i-iteration + Set oNode = ParentNode + For j = lMin2 To lMax2 Step iStep ' Array columns + If iDims = 1 Then vFlatItem = FlatTree(i)(j) Else vFlatItem = FlatTree(i, j) + If vFlatItem = "" Or IsNull(vFlatItem) Or IsEmpty(vFlatItem) Then + Set oNode = Nothing + Exit For ' Exit j-loop + End If + If Not bChange Then + If iDims = 1 Then vFlatItem2 = FlatTree(i - 1)(j) Else vFlatItem2 = FlatTree(i - 1, j) + bChange = ( vFlatItem <> vFlatItem2 ) + End If + If bChange Then ' Create new subnode at tree depth = j + If VarType(vFlatItem) = V_STRING Then sValue = vFlatItem Else sValue = ScriptForge.SF_String.Represent(vFlatItem) + Set oNewNode = .createNode(sValue, True) + If WithDataValue Then + If iDims = 1 Then vFlatItem2 = FlatTree(i)(j + 1) Else vFlatItem2 = FlatTree(i, j + 1) + oNewNode.DataValue = vFlatItem2 + End If + oNode.appendChild(oNewNode) + Set oNode = oNewNode + Else + ' Position next current node on last child of actual current node + lChildCount = oNode.getChildCount() + If lChildCount > 0 Then Set oNode = oNode.getChildAt(lChildCount - 1) Else Set oNode = Nothing + End If + Next j + Next i + bSubTree = True + End With + +Finally: + AddSubTree = bSubTree + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchType: + ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "AddSubTree") + GoTo Finally +End Function ' SFDialogs.SF_DialogControl.AddSubTree + +REM ----------------------------------------------------------------------------- +Public Function CreateRoot(Optional ByVal DisplayValue As Variant _ + , Optional ByRef DataValue As Variant _ + ) As Variant +''' Return a new root node of the tree control. The new tree root is inserted below pre-existing root nodes +''' Args: +''' DisplayValue: the text appearing in the control box +''' DataValue: any value associated with the root node. Default = Empty +''' Returns: +''' The new root node as a UNO object of type com.sun.star.awt.tree.XMutableTreeNode +''' Examples: +''' Dim myTree As Object, myNode As Object +''' Set myTree = myDialog.Controls("myTreeControl") +''' Set myNode = myTree.CreateRoot("Tree starts here ...") + +Dim oRoot As Object ' Return value +Const cstThisSub = "SFDialogs.DialogControl.CreateRoot" +Const cstSubArgs = "DisplayValue, [DataValue=Empty]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oRoot = Nothing + +Check: + If IsMissing(DataValue) Then DataValue = Empty + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If _ControlType <> CTLTREECONTROL Then GoTo CatchType + If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch + End If + +Try: + With _TreeDataModel + Set oRoot = .createNode(DisplayValue, True) + oRoot.DataValue = DataValue + .setRoot(oRoot) + ' To be visible, a root must have contained at least 1 child. Create a fictive one and erase it. + ' This behaviour does not seem related to the RootDisplayed property ?? + oRoot.appendChild(.createNode("Something", False)) + oRoot.removeChildByIndex(0) + End With + +Finally: + Set CreateRoot = oRoot + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchType: + ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "CreateRoot") + GoTo Finally +End Function ' SFDialogs.SF_DialogControl.CreateRoot + +REM ----------------------------------------------------------------------------- +Public Function FindNode(Optional ByVal DisplayValue As String _ + , Optional ByRef DataValue As Variant _ + , Optional ByVal CaseSensitive As Boolean _ + ) As Object +''' Traverses the tree and find recursively, starting from the root, a node meeting some criteria +''' Either (1 match is enough): +''' having its DisplayValue like DisplayValue +''' having its DataValue = DataValue +''' Comparisons may be or not case-sensitive +''' The first matching occurrence is returned +''' Args: +''' DisplayValue: the pattern to be matched +''' DataValue: a string, a numeric value or a date or Empty (if not applicable) +''' CaseSensitive: applicable on both criteria. Default = False +''' Returns: +''' The found node of type com.sun.star.awt.tree.XMutableTreeNode or Nothing if not found +''' Examples: +''' Dim myTree As Object, myNode As Object +''' Set myTree = myDialog.Controls("myTreeControl") +''' Set myNode = myTree.FindNode("*Sophie*", CaseSensitive := True) + + +Dim oNode As Object ' Return value +Const cstThisSub = "SFDialogs.DialogControl.FindNode" +Const cstSubArgs = "[DisplayValue=""""], [DataValue=Empty], [CaseSensitive=False]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oNode = Nothing + +Check: + If IsMissing(DisplayValue) Or IsEmpty(DisplayValue) Then DisplayValue = "" + If IsMissing(DataValue) Then DataValue = Empty + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If _ControlType <> CTLTREECONTROL Then GoTo CatchType + If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", ScriptForge.V_BOOLEAN) Then GoTo Catch + End If + +Try: + Set oNode = _FindNode(_TreeDataModel.getRoot(), DisplayValue, DataValue, CaseSensitive) + +Finally: + Set FindNode = oNode + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchType: + ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "FindNode") + GoTo Finally +End Function ' SFDialogs.SF_DialogControl.FindNode + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Returns: +''' The actual value of the property +''' If the property does not exist, returns Null +''' Exceptions: +''' see the exceptions of the individual properties +''' Examples: +''' myModel.GetProperty("MyProperty") + +Const cstThisSub = "SFDialogs.DialogControl.GetProperty" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + GetProperty = _PropertyGet(PropertyName) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_DialogControl.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Model service as an array + + Methods = Array( _ + "AddSubNode" _ + , "AddSubTree" _ + , "CreateRoot" _ + , "FindNode" _ + , "SetFocus" _ + , "WriteLine" _ + ) + +End Function ' SFDialogs.SF_DialogControl.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Timer class as an array + + Properties = Array( _ + "Border" _ + , "Cancel" _ + , "Caption" _ + , "ControlType" _ + , "CurrentNode" _ + , "Default" _ + , "Enabled" _ + , "Format" _ + , "Height" _ + , "ListCount" _ + , "ListIndex" _ + , "Locked" _ + , "MultiSelect" _ + , "Name" _ + , "OnActionPerformed" _ + , "OnAdjustmentValueChanged" _ + , "OnFocusGained" _ + , "OnFocusLost" _ + , "OnItemStateChanged" _ + , "OnKeyPressed" _ + , "OnKeyReleased" _ + , "OnMouseDragged" _ + , "OnMouseEntered" _ + , "OnMouseExited" _ + , "OnMouseMoved" _ + , "OnMousePressed" _ + , "OnMouseReleased" _ + , "OnNodeExpanded" _ + , "OnNodeSelected" _ + , "OnTextChanged" _ + , "Page" _ + , "Parent" _ + , "Picture" _ + , "RootNode" _ + , "RowSource" _ + , "TabIndex" _ + , "Text" _ + , "TipText" _ + , "TripleState" _ + , "URL" _ + , "Value" _ + , "Visible" _ + , "Width" _ + , "X" _ + , "XControlModel" _ + , "XControlView" _ + , "XGridColumnModel" _ + , "XGridDataModel" _ + , "XTreeDataModel" _ + , "Y" _ + ) + +End Function ' SFDialogs.SF_DialogControl.Properties + +REM ----------------------------------------------------------------------------- +Public Function Resize(Optional ByVal Left As Variant _ + , Optional ByVal Top As Variant _ + , Optional ByVal Width As Variant _ + , Optional ByVal Height As Variant _ + ) As Boolean +''' Move the top-left corner of the control to new coordinates and/or modify its dimensions +''' Without arguments, the method resets the initial dimensions and position +''' Attributes denoting the position and size of a control are expressed in "Map AppFont" units. +''' Map AppFont units are device and resolution independent. +''' One Map AppFont unit is equal to one eighth of the average character (Systemfont) height and one quarter of the average character width. +''' The dialog editor (= the Basic IDE) also uses Map AppFont units. +''' Args: +''' Left : the horizontal distance from the top-left corner. It may be negative. +''' Top : the vertical distance from the top-left corner. It may be negative. +''' Width : the horizontal width of the rectangle containing the Dialog. It must be positive. +''' Height : the vertical height of the rectangle containing the Dialog. It must be positive. +''' Missing arguments are left unchanged. +''' Returns: +''' True when successful +''' Examples: +''' myControl.Resize(100, 200, Height := 600) ' Width is not changed + +Try: + Resize = SF_DialogUtils._Resize([Me], Left, Top, Width, Height) + +End Function ' SFDialogss.SF_Dialog.Resize + +REM ----------------------------------------------------------------------------- +Public Function SetFocus() As Boolean +''' Set the focus on the current Control instance +''' Probably called from after an event occurrence +''' Args: +''' Returns: +''' True if focusing is successful +''' Example: +''' Dim oDlg As Object, oControl As Object +''' Set oDlg = CreateScriptService(,, "myControl") ' Control stored in current document's standard library +''' Set oControl = oDlg.Controls("thisControl") +''' oControl.SetFocus() + +Dim bSetFocus As Boolean ' Return value +Const cstThisSub = "SFDialogs.DialogControl.SetFocus" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bSetFocus = False + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Parent]._IsStillAlive() Then GoTo Finally + End If + +Try: + If Not IsNull(_ControlView) Then + _ControlView.setFocus() + bSetFocus = True + End If + +Finally: + SetFocus = bSetFocus + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFControls.SF_DialogControl.SetFocus + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "SFDialogs.DialogControl.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + SetProperty = _PropertySet(PropertyName, Value) + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_DialogControl.SetProperty + +REM ----------------------------------------------------------------------------- +Public Function SetTableData(Optional ByRef DataArray As Variant _ + , Optional ByRef Widths As Variant _ + , Optional ByRef Alignments As Variant _ + , Optional ByVal RowHeaderWidth As Variant _ + ) As Boolean +''' Fill a table control with the given data. Preexisting data is erased +''' The Basic IDE allows to define if the control has a row and/or a column header +''' When it is the case, the array in argument should contain those headers resp. in the first +''' column and/or in the first row +''' A column in the control shall be sortable when the data (headers excluded) in that column +''' is homogeneously filled either with numbers or with strings +''' Columns containing strings will be left-aligned, those with numbers will be right-aligned +''' Args: +''' DataArray: the set of data to display in the table control, including optional column/row headers +''' Is a 2D array in Basic, is a tuple of tuples when called from Python +''' Widths: the column's relative widths as a 1D array, each element corresponding with one data column +''' If the array is shorter than the number of columns, the last value is kept for the next columns. +''' Example: +''' Widths := Array(1, 2) +''' means that the first column is half as wide as all the other columns +''' When the argument is absent, the columns are evenly spread over the available space in the control +''' Alignments: the column's horizontal alignment as a string with length = number of columns. +''' Possible characters are: +''' L(EFT), C(ENTER), R(IGHT) or space (default behaviour) +''' RowGeaderWidth: width of the row header column expressed in AppFont units. Default = 10. +''' The argument is ignored when the TableControl has no row header. +''' Returns: +''' True when successful +''' Examples: +''' Dim myTable As Object, bSet As Boolean, vData As Variant +''' Set myTable = myDialog.Controls("myTableControl") ' This control has only column headers +''' vData = Array("Col1", "Col2", "Col3") +''' vData = SF_Array.AppendRow(vData, Array(1, 2, 3)) +''' vData = SF_Array.AppendRow(vData, Array(4, 5, 6)) +''' vData = SF_Array.AppendRow(vData, Array(7, 8, 9)) +''' bSet = myTable.SetTableData(vData, Alignments := " C ") + +Dim bData As Boolean ' Return value +Dim iDims As Integer ' Number of dimensions of DataArray +Dim lMin1 As Long ' LBound1 of input array +Dim lMax1 As Long ' UBound1 of input array +Dim lMin2 As Long ' LBound2 of input array +Dim lMax2 As Long ' UBound2 of input array +Dim lControlWidth As Long ' Width of the table control +Dim lMinW As Long ' lBound of Widths +Dim lMaxW As Long ' UBound of vWidths +Dim lMinRow As Long ' Row index of effective data subarray +Dim lMinCol As Long ' Column index of effective data subarray +Dim vRowHeaders As Variant ' Array of row headers +Dim sRowHeader As String ' A single row header +Dim vColHeaders As Variant ' Array of column headers +Dim oColumn As Object ' com.sun.star.awt.grid.XGridColumn +Dim dWidth As Double ' A single item of Widths +Dim dRelativeWidth As Double ' Sum of Widths up to the number of columns +Dim dWidthFactor As Double ' Factor to apply to relative widths to get absolute column widths +Dim lHeaderWidth As Long ' Row header width when row header present, otherwise = 0 +Dim lAverageWidth As Long ' Width to apply when columns spread evenly across table +Dim vDataRow As Variant ' A single row content in the tablecontrol +Dim vDataItem As Variant ' A single DataArray item +Dim sAlign As String ' Column's horizontal alignments (single chars: L, C, R, space) +Dim lAlign As Long ' com.sun.star.style.HorizontalAlignment.XXX +Dim i As Long, j As Long, k As Long + +Const cstThisSub = "SFDialogs.DialogControl.SetTableData" +Const cstSubArgs = "DataArray, [Widths=Array(1)], [Alignments=""""], [RowHeaderWidth=10]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bData = False + +Check: + If IsMissing(Widths) Or IsEmpty(Widths) Then Widths = Array() + If IsMissing(Alignments) Or IsEmpty(Alignments) Then Alignments = "" + If IsMissing(RowHeaderWidth) Or IsEmpty(RowHeaderWidth) Then RowHeaderWidth = 10 + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If _ControlType <> CTLTABLECONTROL Then GoTo CatchType + If Not ScriptForge.SF_Utils._ValidateArray(DataArray, "DataArray") Then GoTo Catch ' Dimensions are checked below + If Not ScriptForge.SF_Utils._ValidateArray(Widths, "Widths", 1, ScriptForge.V_NUMERIC, True) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Alignments, "Alignments", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(RowHeaderWidth, "RowHeaderWidth", ScriptForge.V_NUMERIC) Then GoTo Catch + End If + +Try: + ' Erase any pre-existing data and columns + _GridDataModel.removeAllRows() + For i = _GridColumnModel.ColumnCount - 1 To 0 Step -1 + _GridColumnModel.removeColumn(i) + Next i + + ' LBounds, UBounds - Basic or Python + iDims = ScriptForge.SF_Array.CountDims(DataArray) + Select Case iDims + Case -1, 0 : GoTo Catch + Case 1 ' Called probably from Python + lMin1 = LBound(DataArray, 1) : lMax1 = UBound(DataArray, 1) + If Not IsArray(DataArray(0)) Then GoTo Catch + If UBound(DataArray(0)) < LBound(DataArray(0)) Then GoTo Catch ' No columns + lMin2 = LBound(DataArray(0)) : lMax2 = UBound(DataArray(0)) + Case 2 + lMin1 = LBound(DataArray, 1) : lMax1 = UBound(DataArray, 1) + lMin2 = LBound(DataArray, 2) : lMax2 = UBound(DataArray, 2) + Case Else : GoTo Catch + End Select + + ' Extract headers from data array + lMinW = LBound(Widths) : lMaxW = UBound(Widths) + With _ControlModel + If .ShowColumnHeader Then + lMinRow = lMin1 + 1 + If iDims = 1 Then + vColHeaders = DataArray(lMin1) + Else + vColHeaders = ScriptForge.SF_Array.ExtractRow(DataArray, lMin1) + End If + Else + lMinRow = lMin1 + vColHeaders = Array() + End If + If .ShowRowHeader Then + lMinCol = lMin2 + 1 + If iDims = 1 Then + vRowHeaders = Array() + ReDim vRowHeaders(lMin1 To lMax1) + For i = lMin1 To lMax1 + vRowHeaders(i) = DataArray(i)(lMin2) + Next i + Else + vRowHeaders = ScriptForge.SF_Array.ExtractColumn(DataArray, lMin2) + End If + Else + lMinCol = lMin2 + vRowHeaders = Array() + End If + End With + + ' Create the columns + For j = lMinCol To lMax2 + Set oColumn = _GridColumnModel.createColumn() + If _ControlModel.ShowColumnHeader Then oColumn.Title = vColHeaders(j) + _GridColumnModel.addColumn(oColumn) + Next j + + ' Manage row headers width + If _ControlModel.ShowRowHeader Then + lHeaderWidth = RowHeaderWidth + _ControlModel.RowHeaderWidth = lHeaderWidth + Else + lHeaderWidth = 0 + End If + + ' Size the columns. Column sizing cannot be done before all the columns are added + If lMaxW >= lMinW Then ' There must be at least 1 width given as argument + ' Size the columns proportionally with their relative widths + dRelativeWidth = 0.0 + i = lMinW - 1 + ' Compute the sum of the relative widths + For j = 0 To lMax2 - lMinCol + i = i + 1 + If i >= lMinW And i <= lMaxW Then dRelativeWidth = dRelativeWidth + Widths(i) Else dRelativeWidth = dRelativeWidth + Widths(lMaxW) + Next j + + ' Set absolute column widths + If dRelativeWidth > 0.0 Then dWidthFactor = CDbl(_ControlModel.Width - lHeaderWidth) / dRelativeWidth Else dWidthFactor = 1.0 + i = lMinW - 1 + For j = 0 To lMax2 - lMinCol + i = i + 1 + If i >= lMinW And i <= lMaxW Then dWidth = CDbl(Widths(i)) Else dWidth = CDbl(Widths(lMaxW)) + _GridColumnModel.Columns(j).ColumnWidth = CLng(dWidthFactor * dWidth) + Next j + Else + ' Size header and columns evenly + lAverageWidth = (_ControlModel.Width - lHeaderWidth) / (lMax2 - lMin2 + 1) + For j = 0 To lMax2 - lMinCol + _GridColumnModel.Columns(j).ColumnWidth = lAverageWidth + Next j + End If + + ' Initialize the column alignment + If Len(Alignments) >= lMax2 - lMinCol + 1 Then sAlign = Alignments Else sAlign = Alignments & Space(lMax2 - lMinCol + 1 - Len(Alignments)) + + ' Feed the table with data and define/confirm the column alignment + vDataRow = Array() + For i = lMinRow To lMax1 + ReDim vDataRow(0 To lMax2 - lMinCol) + For j = lMinCol To lMax2 + If iDims = 1 Then vDataItem = DataArray(i)(j) Else vDataItem = DataArray(i, j) + If VarType(vDataItem) = V_STRING Then + ElseIf ScriptForge.SF_Utils._VarTypeExt(vDataItem) = ScriptForge.V_NUMERIC Then + Else + vDataItem = ScriptForge.SF_String.Represent(vDataItem) + End If + vDataRow(j - lMinCol) = vDataItem + ' Store alignment while processing the first row of the array + If i = lMinRow Then + k = j - lMinCol + 1 + If Mid(sAlign, k, 1) = " " Then Mid(sAlign, k, 1) = Iif(VarType(vDataItem) = V_STRING, "L", "R") + End If + Next j + If _ControlModel.ShowRowHeader Then sRowHeader = vRowHeaders(i) Else sRowHeader = "" + _GridDataModel.addRow(sRowHeader, vDataRow) + Next i + + ' Determine alignments of each column + For j = 0 To lMax2 - lMinCol + Select Case Mid(sAlign, j + 1, 1) + Case "L", " " : lAlign = com.sun.star.style.HorizontalAlignment.LEFT + Case "R" : lAlign = com.sun.star.style.HorizontalAlignment.RIGHT + Case "C" : lAlign = com.sun.star.style.HorizontalAlignment.CENTER + Case Else + End Select + _GridColumnModel.Columns(j).HorizontalAlign = lAlign + Next j + + bData = True + +Finally: + SetTableData = bData + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchType: + ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "SetTableData") + GoTo Finally +End Function ' SFDialogs.SF_DialogControl.SetTableData + +REM ----------------------------------------------------------------------------- +Public Function WriteLine(Optional ByVal Line As Variant) As Boolean +''' Add a new line to a multiline TextField control +''' Args: +''' Line: (default = "") the line to insert at the end of the text box +''' a newline character will be inserted before the line, if relevant +''' Returns: +''' True if insertion is successful +''' Exceptions +''' TEXTFIELDERROR Method applicable on multiline text fields only +''' Example: +''' Dim oDlg As Object, oControl As Object +''' Set oDlg = CreateScriptService(,, "myControl") ' Control stored in current document's standard library +''' Set oControl = oDlg.Controls("thisControl") +''' oControl.WriteLine("a new line") + +Dim bWriteLine As Boolean ' Return value +Dim lTextLength As Long ' Actual length of text in box +Dim oSelection As New com.sun.star.awt.Selection +Dim sNewLine As String ' Newline character(s) +Const cstThisSub = "SFDialogs.DialogControl.WriteLine" +Const cstSubArgs = "[Line=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bWriteLine = False + +Check: + If IsMissing(Line) Or IsEmpty(Line) Then Line = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Parent]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Line, "Line", V_STRING) Then GoTo Finally + End If + If ControlType <> CTLTEXTFIELD Then GoTo CatchField + If _ControlModel.MultiLine = False Then GoTo CatchField + +Try: + _ControlModel.HardLineBreaks = True + sNewLine = ScriptForge.SF_String.sfNEWLINE + With _ControlView + lTextLength = Len(.getText()) + If lTextLength = 0 Then ' Text field is still empty + oSelection.Min = 0 : oSelection.Max = 0 + .setText(Line) + Else ' Put cursor at the end of the actual text + oSelection.Min = lTextLength : oSelection.Max = lTextLength + .insertText(oSelection, sNewLine & Line) + End If + ' Put the cursor at the end of the inserted text + oSelection.Max = oSelection.Max + Len(sNewLine) + Len(Line) + oSelection.Min = oSelection.Max + .setSelection(oSelection) + End With + bWriteLine = True + +Finally: + WriteLine = bWriteLine + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchField: + ScriptForge.SF_Exception.RaiseFatal(TEXTFIELDERROR, _Name, _DialogName) + GoTo Finally +End Function ' SFControls.SF_DialogControl.WriteLine + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _FindNode(ByRef poNode As Object _ + , ByVal psDisplayValue As String _ + , ByRef pvDataValue As Variant _ + , ByVal pbCaseSensitive As Boolean _ + ) As Object +''' Traverses the tree and find recursively, starting from the root, a node meeting some criteria +''' Either (1 match is enough): +''' having its DisplayValue like psDisplayValue +''' having its DataValue = pvDataValue +''' Comparisons may be or not case-sensitive +''' The first matching occurrence is returned +''' Args: +''' poNode: the current node, the root at 1st call +''' psDisplayValue: the pattern to be matched +''' pvDataValue: a string, a numeric value or a date or Empty (if not applicable) +''' pbCaseSensitive: applicable on both criteria +''' Returns: +''' The found node of type com.sun.star.awt.tree.XMutableTreeNode + +Dim oChild As Object ' Child node com.sun.star.awt.tree.XMutableTreeNode +Dim oFind As Object ' Found node com.sun.star.awt.tree.XMutableTreeNode +Dim lChildCount As Long ' Number of children of a node +Dim bFound As Boolean ' True when node found +Dim i As Long + + Set _FindNode = Nothing + On Local Error GoTo Finally ' Better not found than raise an error + +Check: + ' Does the actual node match the criteria ? + bFound = False + If Len(psDisplayValue) > 0 Then + bFound = ScriptForge.SF_String.IsLike(poNode.DisplayValue, psDisplayValue, pbCaseSensitive) + End If + If Not bFound And Not IsEmpty(poNode.DataValue) Then + If Not IsEmpty(pvdataValue) Then bFound = ( ScriptForge.SF_Array._ValCompare(poNode.DataValue, pvDataB-Value, pbCaseSensitive) = 0 ) + End If + If bFound Then + Set _FindNode = poNode + Exit Function + End If + +Try: + ' Explore sub-branches + lChildCount = poNode.getChildCount + If lChildCount > 0 Then + For i = 0 To lChildCount - 1 + Set oChild = poNode.getChildAt(i) + Set oFind = _FindNode(oChild, psDisplayValue, pvDataValue, pbCaseSensitive) ' Recursive call + If Not IsNull(oFind) Then + Set _FindNode = oFind + Exit For + End If + Next i + End If + +Finally: + Exit Function +End Function ' SFDialogs.SF_DialogControl._FindNode + +REM ----------------------------------------------------------------------------- +Public Function _GetEventName(ByVal psProperty As String) As String +''' Return the LO internal event name derived from the SF property name +''' The SF property name is not case sensitive, while the LO name is case-sensitive +' Corrects the typo on ErrorOccur(r?)ed, if necessary + +Dim vProperties As Variant ' Array of class properties +Dim sProperty As String ' Correctly cased property name + + vProperties = Properties() + sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC")) + + _GetEventName = LCase(Mid(sProperty, 3, 1)) & Right(sProperty, Len(sProperty) - 3) + +End Function ' SFDialogs.SF_DialogControl._GetEventName + +REM ----------------------------------------------------------------------------- +Private Function _GetListener(ByVal psEventName As String) As String +''' Getting/Setting macros triggered by events requires a Listener-EventName pair +''' Return the X...Listener corresponding with the event name in argument + + Select Case UCase(psEventName) + Case UCase("OnActionPerformed") + _GetListener = "XActionListener" + Case UCase("OnAdjustmentValueChanged") + _GetListener = "XAdjustmentListener" + Case UCase("OnFocusGained"), UCase("OnFocusLost") + _GetListener = "XFocusListener" + Case UCase("OnItemStateChanged") + _GetListener = "XItemListener" + Case UCase("OnKeyPressed"), UCase("OnKeyReleased") + _GetListener = "XKeyListener" + Case UCase("OnMouseDragged"), UCase("OnMouseMoved") + _GetListener = "XMouseMotionListener" + Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased") + _GetListener = "XMouseListener" + Case UCase("OnTextChanged") + _GetListener = "XTextListener" + Case Else + _GetListener = "" + End Select + +End Function ' SFDialogs.SF_DialogControl._GetListener + +REM ----------------------------------------------------------------------------- +Public Sub _Initialize() +''' Complete the object creation process: +''' - Initialization of private members +''' - Collection of specific attributes +''' - synchronization with parent dialog instance + +Dim vServiceName As Variant ' Split service name +Dim sType As String ' Last component of service name + +Try: + _ImplementationName = _ControlModel.getImplementationName() + + ' Identify the control type + vServiceName = Split(_ControlModel.getServiceName(), ".") + sType = vServiceName(UBound(vServiceName)) + Select Case sType + Case "UnoControlSpinButtonModel" + _ControlType = "" ' Not supported + Case "Edit" : _ControlType = CTLTEXTFIELD + Case "UnoControlFixedHyperlinkModel" + _ControlType = CTLHYPERLINK + Case "TreeControlModel" + ' Initialize the data model + _ControlType = CTLTREECONTROL + Set _ControlModel.DataModel = CreateUnoService("com.sun.star.awt.tree.MutableTreeDataModel") + Set _TreeDataModel = _ControlModel.DataModel + Case "UnoControlGridModel" + _ControlType = CTLTABLECONTROL + Set _GridColumnModel = _ControlModel.ColumnModel + Set _GridDataModel = _ControlModel.GridDataModel + Case Else : _ControlType = sType + End Select + + ' Store initial position and dimensions + With _ControlModel + _Left = .PositionX + _Top = .PositionY + _Width = .Width + _Height = .Height + End With + + ' Store the SF_DialogControl object in the parent cache + Set _Parent._ControlCache(_IndexOfNames) = [Me] + +Finally: + Exit Sub +End Sub ' SFDialogs.SF_DialogControl._Initialize + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String _ + , Optional ByVal pvDefault As Variant _ + ) As Variant +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property +''' pvDefault: the value returned when the property is not applicable on the control's type +''' Getting a non-existing property for a specific control type should +''' not generate an error to not disrupt the Basic IDE debugger + +Dim vGet As Variant ' Return value +Static oSession As Object ' Alias of SF_Session +Dim vSelection As Variant ' Alias of Model.SelectedItems or Model.Selection +Dim vList As Variant ' Alias of Model.StringItemList +Dim lIndex As Long ' Index in StringItemList +Dim sItem As String ' A single item +Dim vDate As Variant ' com.sun.star.util.Date or com.sun.star.util.Time +Dim vValues As Variant ' Array of listbox values +Dim oPosSize As Object ' com.sun.star.awt.Rectangle +Dim oControlEvents As Object ' com.sun.star.container.XNameContainer +Dim sEventName As String ' Internal event name +Dim i As Long +Dim cstThisSub As String +Const cstSubArgs = "" + + cstThisSub = "SFDialogs.DialogControl.get" & psProperty + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not [_Parent]._IsStillAlive() Then GoTo Finally + + If IsMissing(pvDefault) Then pvDefault = Null + _PropertyGet = pvDefault + + If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") + Select Case UCase(psProperty) + Case UCase("Border") + Select Case _ControlType + Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT, CTLFORMATTEDFIELD _ + , CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLPROGRESSBAR _ + , CTLSCROLLBAR , CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL + If oSession.HasUNOProperty(_ControlModel, "Border") Then _PropertyGet = Array("NONE", "3D", "FLAT")(_ControlModel.Border) + Case CTLCHECKBOX, CTLRADIOBUTTON + If oSession.HasUNOProperty(_ControlModel, "VisualEffect") Then _PropertyGet = Array("NONE", "3D", "FLAT")(_ControlModel.VisualEffect) + Case Else : GoTo CatchType + End Select + Case UCase("Cancel") + Select Case _ControlType + Case CTLBUTTON + If oSession.HasUNOProperty(_ControlModel, "PushButtonType") Then _PropertyGet = ( _ControlModel.PushButtonType = com.sun.star.awt.PushButtonType.CANCEL ) + Case Else : GoTo CatchType + End Select + Case UCase("Caption") + Select Case _ControlType + Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDLINE, CTLFIXEDTEXT, CTLGROUPBOX, CTLHYPERLINK, CTLRADIOBUTTON + If oSession.HasUNOProperty(_ControlModel, "Label") Then _PropertyGet = _ControlModel.Label + Case Else : GoTo CatchType + End Select + Case UCase("ControlType") + _PropertyGet = _ControlType + Case UCase("CurrentNode") + Select Case _ControlType + Case CTLTREECONTROL + If oSession.HasUNOMethod(_ControlView, "getSelection") Then + _PropertyGet = Empty + If _ControlModel.SelectionType <> com.sun.star.view.SelectionType.NONE Then + vSelection = _ControlView.getSelection() + If IsArray(vSelection) Then + If UBound(vSelection) >= 0 Then Set _PropertyGet = vSelection(0) + Else + Set _PropertyGet = vSelection + End If + End If + End If + Case Else : GoTo CatchType + End Select + Case UCase("Default") + Select Case _ControlType + Case CTLBUTTON + If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _PropertyGet = _ControlModel.DefaultButton + Case Else : GoTo CatchType + End Select + Case UCase("Enabled") + If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _PropertyGet = _ControlModel.Enabled + Case UCase("Format") + Select Case _ControlType + Case CTLDATEFIELD + If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = SF_DialogUtils._FormatsList(_ControlType)(_ControlModel.DateFormat) + Case CTLTIMEFIELD + If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = SF_DialogUtils._FormatsList(_ControlType)(_ControlModel.TimeFormat) + Case CTLFORMATTEDFIELD + If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") And oSession.HasUNOProperty(_ControlModel, "FormatKey") Then + _PropertyGet = _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString + End If + Case Else : GoTo CatchType + End Select + Case UCase("Height") + If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units + _PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, False).Height + Else + If oSession.HasUNOProperty(_ControlModel, "Height") Then _PropertyGet = _ControlModel.Height + End If + Case UCase("ListCount") + Select Case _ControlType + Case CTLCOMBOBOX, CTLLISTBOX + If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1 + Case CTLTABLECONTROL ' Returns zero when no table data yet + If oSession.HasUNOProperty(_GridDataModel, "RowCount") Then _PropertyGet = _GridDataModel.RowCount + Case Else : GoTo CatchType + End Select + Case UCase("ListIndex") + Select Case _ControlType + Case CTLCOMBOBOX + _PropertyGet = -1 ' Not found, multiselection + If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then + _PropertyGet = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, _ControlModel.Text, CaseSensitive := True) + End If + Case CTLLISTBOX + _PropertyGet = -1 ' Not found, multiselection + If oSession.HasUNOProperty(_ControlModel, "SelectedItems") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then + vSelection = _ControlModel.SelectedItems + If UBound(vSelection) >= 0 Then _PropertyGet = vSelection(0) + End If + Case CTLTABLECONTROL + _PropertyGet = -1 ' No row selected, no data, multiselection + If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _ + And oSession.HasUNOProperty(_ControlView, "CurrentRow") Then + ' Other selection types (multi, range) not supported + If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE Then + lIndex = _ControlView.CurrentRow + If lIndex < 0 And oSession.HasUNOProperty(_ControlView, "SelectedRows") Then + If UBound(_ControlView.SelectedRows) >= 0 Then lIndex = _ControlView.SelectedRows(0) + End If + _PropertyGet = lIndex + End If + End If + Case Else : GoTo CatchType + End Select + Case UCase("Locked") + Select Case _ControlType + Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLLISTBOX _ + , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD + If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _PropertyGet = _ControlModel.ReadOnly + Case Else : GoTo CatchType + End Select + Case UCase("MultiSelect") + Select Case _ControlType + Case CTLLISTBOX + If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then + _PropertyGet = _ControlModel.MultiSelection + ElseIf oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then ' Not documented: gridcontrols only TBC ?? + _PropertyGet = _ControlModel.MultiSelectionSimpleMode + End If + Case Else : GoTo CatchType + End Select + Case UCase("Name") + _PropertyGet = _Name + Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnFocusGained"), UCase("OnFocusLost") _ + , UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _ + , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _ + , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnTextChanged") + Set oControlEvents = _ControlModel.getEvents() + sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & _GetEventName(psProperty) + If oControlEvents.hasByName(sEventName) Then + _PropertyGet = oControlEvents.getByName(sEventName).ScriptCode + Else + ' Check OnEvents set dynamically by code + Select Case UCase(psProperty) + Case UCase("OnActionPerformed") : _PropertyGet = _OnActionPerformed + Case UCase("OnAdjustmentValueChanged") : _PropertyGet = _OnAdjustmentValueChanged + Case UCase("OnFocusGained") : _PropertyGet = _OnFocusGained + Case UCase("OnFocusLost") : _PropertyGet = _OnFocusLost + Case UCase("OnItemStateChanged") : _PropertyGet = _OnItemStateChanged + Case UCase("OnKeyPressed") : _PropertyGet = _OnKeyPressed + Case UCase("OnKeyReleased") : _PropertyGet = _OnKeyReleased + Case UCase("OnMouseDragged") : _PropertyGet = _OnMouseDragged + Case UCase("OnMouseEntered") : _PropertyGet = _OnMouseEntered + Case UCase("OnMouseExited") : _PropertyGet = _OnMouseExited + Case UCase("OnMouseMoved") : _PropertyGet = _OnMouseMoved + Case UCase("OnMousePressed") : _PropertyGet = _OnMousePressed + Case UCase("OnMouseReleased") : _PropertyGet = _OnMouseReleased + Case UCase("OnTextChanged") : _PropertyGet = _OnTextChanged + Case Else : _PropertyGet = "" + End Select + End If + Case UCase("OnNodeExpanded") + Select Case _ControlType + Case CTLTREECONTROL + _PropertyGet = _OnNodeExpanded + Case Else : GoTo CatchType + End Select + Case UCase("OnNodeSelected") + Select Case _ControlType + Case CTLTREECONTROL + _PropertyGet = _OnNodeSelected + Case Else : GoTo CatchType + End Select + Case UCase("Page") + If oSession.HasUnoProperty(_ControlModel, "Step") Then _PropertyGet = _ControlModel.Step + Case UCase("Parent") + Set _PropertyGet = [_Parent] + Case UCase("Picture") + Select Case _ControlType + Case CTLBUTTON, CTLIMAGECONTROL + If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_ControlModel.ImageURL) + Case Else : GoTo CatchType + End Select + Case UCase("RootNode") + Select Case _ControlType + Case CTLTREECONTROL + _PropertyGet = _TreeDataModel.getRoot() + Case Else : GoTo CatchType + End Select + Case UCase("RowSource") + Select Case _ControlType + Case CTLCOMBOBOX, CTLLISTBOX + If oSession.HasUnoProperty(_ControlModel, "StringItemList") Then + If IsArray(_ControlModel.StringItemList) Then _PropertyGet = _ControlModel.StringItemList Else _PropertyGet = Array(_ControlModel.StringItemList) + End If + Case Else : GoTo CatchType + End Select + Case UCase("TabIndex") + Select Case _ControlType + Case CTLBUTTON, CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT _ + , CTLFORMATTEDFIELD, CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD _ + , CTLRADIOBUTTON, CTLSCROLLBAR, CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL + If oSession.HasUnoProperty(_ControlModel, "TabIndex") Then + If CBool(_ControlModel.TabStop) Or IsEmpty(_ControlModel.TabStop) Then _PropertyGet = _ControlModel.TabIndex Else _PropertyGet = -1 + End If + Case Else : GoTo CatchType + End Select + Case UCase("Text") + Select Case _ControlType + Case CTLCOMBOBOX, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLPATTERNFIELD, CTLTEXTFIELD + If oSession.HasUnoProperty(_ControlModel, "Text") Then _PropertyGet = _ControlModel.Text + Case Else : GoTo CatchType + End Select + Case UCase("TipText") + If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _PropertyGet = _ControlModel.HelpText + Case UCase("TripleState") + Select Case _ControlType + Case CTLCHECKBOX + If oSession.HasUnoProperty(_ControlModel, "TriState") Then _PropertyGet = _ControlModel.TriState + Case Else : GoTo CatchType + End Select + Case "URL" + Select Case _ControlType + Case CTLHYPERLINK + If oSession.HasUnoProperty(_ControlModel, "URL") Then _PropertyGet = _ControlModel.URL + Case Else : GoTo CatchType + End Select + Case UCase("Value") ' Default values are set here by control type, not in the 2nd argument + vGet = pvDefault + Select Case _ControlType + Case CTLBUTTON 'Boolean, toggle buttons only + vGet = False + If oSession.HasUnoProperty(_ControlModel, "Toggle") Then + If oSession.HasUnoProperty(_ControlModel, "State") And _ControlMOdel.Toggle Then vGet = ( _ControlModel.State = 1 ) + End If + Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know + If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = _ControlModel.State Else vGet = 2 + Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String + If oSession.HasUnoProperty(_ControlModel, "Text") Then vGet = _ControlModel.Text Else vGet = "" + Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric + If oSession.HasUnoProperty(_ControlModel, "Value") Then vGet = _ControlModel.Value Else vGet = 0 + Case CTLDATEFIELD 'Date + vGet = CDate(1) + If oSession.HasUnoProperty(_ControlModel, "Date") Then + If VarType(_ControlModel.Date) = ScriptForge.V_OBJECT Then ' com.sun.star.util.Date + Set vDate = _ControlModel.Date + vGet = DateSerial(vDate.Year, vDate.Month, vDate.Day) + End If + End If + Case CTLFORMATTEDFIELD 'String or numeric + If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then vGet = _ControlModel.EffectiveValue Else vGet = "" + Case CTLLISTBOX 'String or array of strings depending on MultiSelection + ' StringItemList is the list of the items displayed in the box + ' SelectedItems is the list of the indexes in StringItemList of the selected items + ' It can go beyond the limits of StringItemList + ' It can contain multiple values even if the listbox is not multiselect + If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _ + And oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then + vSelection = _ControlModel.SelectedItems + vList = _ControlModel.StringItemList + If _ControlModel.MultiSelection Then vValues = Array() + For i = 0 To UBound(vSelection) + lIndex = vSelection(i) + If lIndex >= 0 And lIndex <= UBound(vList) Then + If Not _ControlModel.MultiSelection Then + vValues = vList(lIndex) + Exit For + End If + vValues = ScriptForge.SF_Array.Append(vValues, vList(lIndex)) + End If + Next i + vGet = vValues + Else + vGet = "" + End If + Case CTLPROGRESSBAR 'Numeric + If oSession.HasUnoProperty(_ControlModel, "ProgressValue") Then vGet = _ControlModel.ProgressValue Else vGet = 0 + Case CTLRADIOBUTTON 'Boolean + If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 ) Else vGet = False + Case CTLSCROLLBAR 'Numeric + If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then vGet = _ControlModel.ScrollValue Else vGet = 0 + Case CTLTABLECONTROL + vGet = Array() ' Default value when no row selected, no data, multiselection + If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _ + And oSession.HasUNOProperty(_ControlView, "CurrentRow") Then + ' Other selection types (multi, range) not supported + If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE Then + lIndex = _ControlView.CurrentRow + If lIndex < 0 And oSession.HasUNOProperty(_ControlView, "SelectedRows") Then + If UBound(_ControlView.SelectedRows) >= 0 Then lIndex = _ControlView.SelectedRows(0) + End If + If lIndex >= 0 Then vGet = _GridDataModel.getRowData(lIndex) + End If + End If + Case CTLTIMEFIELD + vGet = CDate(0) + If oSession.HasUnoProperty(_ControlModel, "Time") Then + If VarType(_ControlModel.Time) = ScriptForge.V_OBJECT Then ' com.sun.star.Util.Time + Set vDate = _ControlModel.Time + vGet = TimeSerial(vDate.Hours, vDate.Minutes, vDate.Seconds) + End If + End If + Case Else : GoTo CatchType + End Select + _PropertyGet = vGet + Case UCase("Visible") + If oSession.HasUnoMethod(_ControlView, "isVisible") Then _PropertyGet = CBool(_ControlView.isVisible()) + Case UCase("Width") + If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units + _PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, False).Width + Else + If oSession.HasUNOProperty(_ControlModel, "Width") Then _PropertyGet = _ControlModel.Width + End If + Case UCase("X") + If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units + _PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, True).X + Else + If oSession.HasUNOProperty(_ControlModel, "PositionX") Then _PropertyGet = _ControlModel.PositionX + End If + Case UCase("Y") + If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units + _PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, True).Y + Else + If oSession.HasUNOProperty(_ControlModel, "PositionY") Then _PropertyGet = _ControlModel.PositionY + End If + Case UCase("XControlModel") + Set _PropertyGet = _ControlModel + Case UCase("XControlView") + Set _PropertyGet = _ControlView + Case UCase("XGridColumnModel") + Set _PropertyGet = _GridColumnModel + Case UCase("XGridDataModel") + Set _PropertyGet = _GridDataModel + Case UCase("XTreeDataModel") + Set _PropertyGet = _TreeDataModel + Case Else + _PropertyGet = Null + End Select + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchType: + GoTo Finally +End Function ' SFDialogs.SF_DialogControl._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _PropertySet(Optional ByVal psProperty As String _ + , Optional ByVal pvValue As Variant _ + ) As Boolean +''' Set the new value of the named property +''' Args: +''' psProperty: the name of the property +''' pvValue: the new value of the given property + +Dim bSet As Boolean ' Return value +Static oSession As Object ' Alias of SF_Session +Dim vSet As Variant ' Value to set in UNO model or view property +Dim vBorders As Variant ' Array of allowed Border values +Dim vFormats As Variant ' Format property: output of _FormatsList() +Dim iFormat As Integer ' Format property: index in vFormats +Dim oNumberFormats As Object ' com.sun.star.util.XNumberFormats +Dim lFormatKey As Long ' Format index for formatted fields +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim vSelection As Variant ' Alias of Model.SelectedItems +Dim vList As Variant ' Alias of Model.StringItemList +Dim lIndex As Long ' Index in StringItemList +Dim sItem As String ' A single item +Dim vCtlTypes As Variant ' Array of allowed control types +Dim i As Long +Dim cstThisSub As String +Const cstSubArgs = "Value" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bSet = False + + cstThisSub = "SFDialogs.DialogControl.set" & psProperty + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not [_Parent]._IsStillAlive() Then GoTo Finally + + If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") + bSet = True + Select Case UCase(psProperty) + Case UCase("Border") + Select Case _ControlType + Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT, CTLFORMATTEDFIELD _ + , CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLPROGRESSBAR _ + , CTLRADIOBUTTON, CTLSCROLLBAR , CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL + vBorders = Array("NONE", "3D", "FLAT") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Border", V_STRING, vBorders) Then GoTo Finally + vSet = ScriptForge.SF_Array.IndexOf(vBorders, pvValue) + If oSession.HasUNOProperty(_ControlModel, "Border") Then + _ControlModel.Border = vSet + ElseIf oSession.HasUNOProperty(_ControlModel, "VisualEffect") Then ' Checkbox case + _ControlModel.VisualEffect = vSet + End If + Case Else : GoTo CatchType + End Select + Case UCase("Cancel") + Select Case _ControlType + Case CTLBUTTON + If Not ScriptForge.SF_Utils._Validate(pvValue, "Cancel", ScriptForge.V_BOOLEAN) Then GoTo Finally + If oSession.HasUNOProperty(_ControlModel, "PushButtonType") Then + If pvValue Then vSet = com.sun.star.awt.PushButtonType.CANCEL Else vSet = com.sun.star.awt.PushButtonType.STANDARD + _ControlModel.PushButtonType = vSet + End If + Case Else : GoTo CatchType + End Select + Case UCase("Caption") + Select Case _ControlType + Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDLINE, CTLFIXEDTEXT, CTLGROUPBOX, CTLHYPERLINK, CTLRADIOBUTTON + If Not ScriptForge.SF_Utils._Validate(pvValue, "Caption", V_STRING) Then GoTo Finally + If oSession.HasUNOProperty(_ControlModel, "Label") Then _ControlModel.Label = pvValue + Case Else : GoTo CatchType + End Select + Case UCase("CurrentNode") + Select Case _ControlType + Case CTLTREECONTROL + If Not ScriptForge.SF_Utils._Validate(pvValue, "Selection", ScriptForge.V_OBJECT) Then GoTo Finally + If oSession.UnoObjectType(pvValue) <> "toolkit.MutableTreeNode" Then GoTo CatchType + With _ControlView + .clearSelection() + If Not IsNull(pvValue) Then + .addSelection(pvValue) + ' Suspending temporarily the expansion listener avoids conflicts + If Len(_OnNodeExpanded) > 0 Then _ControlView.removeTreeExpansionListener(_ExpandListener) + .makeNodeVisible(pvValue) ' Expand parent nodes and put node in the display area + If Len(_OnNodeExpanded) > 0 Then _ControlView.addTreeExpansionListener(_ExpandListener) + End If + End With + Case Else : GoTo CatchType + End Select + Case UCase("Default") + Select Case _ControlType + Case CTLBUTTON + If Not ScriptForge.SF_Utils._Validate(pvValue, "Default", ScriptForge.V_BOOLEAN) Then GoTo Finally + If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _ControlModel.DefaultButton = pvValue + Case Else : GoTo CatchType + End Select + Case UCase("Enabled") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Enabled", ScriptForge.V_BOOLEAN) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _ControlModel.Enabled = pvValue + Case UCase("Format") + Select Case _ControlType + Case CTLDATEFIELD, CTLTIMEFIELD + vFormats = SF_DialogUtils._FormatsList(_ControlType) + If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING, vFormats) Then GoTo Finally + iFormat = ScriptForge.SF_Array.IndexOf(vFormats, pvValue, CaseSensitive := False) + If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then + _ControlModel.DateFormat = iFormat + ElseIf oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then + _ControlModel.TimeFormat = iFormat + End If + Case CTLFORMATTEDFIELD ' The format may exist already or not yet + If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING) Then GoTo Finally + If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") Then + If Not IsNull(_ControlModel.FormatsSupplier) Then + Set oLocale = ScriptForge.SF_Utils._GetUnoService("FormatLocale") + Set oNumberFormats = _ControlModel.FormatsSupplier.getNumberFormats() + lFormatKey = oNumberFormats.queryKey(pvValue, oLocale, True) + If lFormatKey < 0 Then ' Format not found + _ControlModel.FormatKey = oNumberFormats.addNew(pvValue, oLocale) + Else + _ControlModel.FormatKey = lFormatKey + End If + End If + End If + Case Else : GoTo CatchType + End Select + Case UCase("Height") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Height", ScriptForge.V_NUMERIC) Then GoTo Catch + bSet = Resize(Height := pvValue) + Case UCase("ListIndex") + If Not ScriptForge.SF_Utils._Validate(pvValue, "ListIndex", ScriptForge.V_NUMERIC) Then GoTo Finally + Select Case _ControlType + Case CTLCOMBOBOX + If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then + _ControlModel.Text = _ControlModel.StringItemList(CInt(pvValue)) + End If + Case CTLLISTBOX + If oSession.HasUNOProperty(_ControlModel, "SelectedItems") Then _ControlModel.SelectedItems = Array(CInt(pvValue)) + Case CTLTABLECONTROL + If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _ + And oSession.HasUNOMethod(_ControlView, "selectRow") Then + ' Other selection types (multi, range) not supported + If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE _ + And pvValue >= 0 And pvValue <= _GridDataModel.RowCount - 1 Then + _ControlView.selectRow(pvValue) + End If + End If + Case Else : GoTo CatchType + End Select + Case UCase("Locked") + Select Case _ControlType + Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLLISTBOX _ + , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD + If Not ScriptForge.SF_Utils._Validate(pvValue, "Locked", ScriptForge.V_BOOLEAN) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _ControlModel.ReadOnly = pvValue + Case Else : GoTo CatchType + End Select + Case UCase("MultiSelect") + Select Case _ControlType + Case CTLLISTBOX + If Not ScriptForge.SF_Utils._Validate(pvValue, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then _ControlModel.MultiSelection = pvValue + If oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then _ControlModel.MultiSelectionSimpleMode = pvValue + If oSession.HasUnoProperty(_ControlModel, "SelectedItems") Then + If Not pvValue And UBound(_ControlModel.SelectedItems) > 0 Then ' Cancel selections when MultiSelect becomes False + lIndex = _ControlModel.SelectedItems(0) + _ControlModel.SelectedItems = Array(lIndex) + End If + End If + Case Else : GoTo CatchType + End Select + Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnFocusGained"), UCase("OnFocusLost") _ + , UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _ + , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _ + , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnTextChanged") + If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Catch + ' Check control type for not universal event types + Select Case UCase(psProperty) + Case UCase("OnActionPerformed"), UCase("OnItemStateChanged") + Select Case _ControlType + Case CTLBUTTON, CTLCHECKBOX, CTLCOMBOBOX, CTLHYPERLINK, CTLLISTBOX, CTLRADIOBUTTON + Case Else : GoTo CatchType + End Select + Case UCase("OnAdjustmentValueChanged") + If _ControlType <> CTLSCROLLBAR Then GoTo CatchType + Case UCase("OnTextChanged") + Select Case _ControlType + Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD _ + , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL + Case Else : GoTo CatchType + End Select + Case Else + End Select + bSet = SF_DialogListener._SetOnProperty([Me], psProperty, pvValue) + Case UCase("OnNodeExpanded") + Select Case _ControlType + Case CTLTREECONTROL + If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Finally + ' If the listener was already set, then stop it + If Len(_OnNodeExpanded) > 0 Then + _ControlView.removeTreeExpansionListener(_ExpandListener) + Set _ExpandListener = Nothing + _OnNodeExpanded = "" + End If + ' Setup a new fresh listener + If Len(pvValue) > 0 Then + Set _ExpandListener = CreateUnoListener("_SFEXP_", "com.sun.star.awt.tree.XTreeExpansionListener") + _ControlView.addTreeExpansionListener(_ExpandListener) + _OnNodeExpanded = pvValue + End If + Case Else : GoTo CatchType + End Select + Case UCase("OnNodeSelected") + Select Case _ControlType + Case CTLTREECONTROL + If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Finally + ' If the listener was already set, then stop it + If Len(_OnNodeSelected) > 0 Then + _ControlView.removeSelectionChangeListener(_SelectListener) + Set _SelectListener = Nothing + _OnNodeSelected = "" + End If + ' Setup a new fresh listener + If Len(pvValue) > 0 Then + Set _SelectListener = CreateUnoListener("_SFSEL_", "com.sun.star.view.XSelectionChangeListener") + _ControlView.addSelectionChangeListener(_SelectListener) + _OnNodeSelected = pvValue + End If + Case Else : GoTo CatchType + End Select + Case UCase("Page") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Page", ScriptForge.V_NUMERIC) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "Step") Then _ControlModel.Step = CLng(pvValue) + Case UCase("Picture") + Select Case _ControlType + Case CTLBUTTON, CTLIMAGECONTROL + If Not ScriptForge.SF_Utils._ValidateFile(pvValue, "Picture") Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _ControlModel.ImageURL = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue) + Case Else : GoTo CatchType + End Select + Case UCase("RowSource") + Select Case _ControlType + Case CTLCOMBOBOX, CTLLISTBOX + If Not IsArray(pvValue) Then + If Not ScriptForge.SF_Utils._Validate(pvValue, "RowSource", V_STRING) Then GoTo Finally + pvArray = Array(pvArray) + ElseIf Not ScriptForge.SF_Utils._ValidateArray(pvValue, "RowSource", 1, V_STRING, True) Then + GoTo Finally + End If + If oSession.HasUnoProperty(_ControlModel, "StringItemList") Then _ControlModel.StringItemList = pvValue + Case Else : GoTo CatchType + End Select + Case UCase("TabIndex") + Select Case _ControlType + Case CTLBUTTON, CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT _ + , CTLFORMATTEDFIELD, CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD _ + , CTLRADIOBUTTON, CTLSCROLLBAR, CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL + If Not ScriptForge.SF_Utils._Validate(pvValue, "TabIndex", ScriptForge.V_NUMERIC) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "TabIndex") Then + _ControlModel.TabStop = ( pvValue > 0 ) + _ControlModel.TabIndex = Iif(pvValue > 0, pvValue, -1) + End If + Case Else : GoTo CatchType + End Select + Case UCase("TipText") + If Not ScriptForge.SF_Utils._Validate(pvValue, "TipText", V_STRING) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _ControlModel.HelpText = pvValue + Case UCase("TripleState") + Select Case _ControlType + Case CTLCHECKBOX + If Not ScriptForge.SF_Utils._Validate(pvValue, "TripleState", ScriptForge.V_BOOLEAN) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "TriState") Then _ControlModel.TriState = pvValue + Case Else : GoTo CatchType + End Select + Case "URL" + Select Case _ControlType + Case CTLHYPERLINK + If Not ScriptForge.SF_Utils._Validate(pvValue, "URL", V_STRING) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "URL") Then _ControlModel.URL = pvValue + Case Else : GoTo CatchType + End Select + Case UCase("Value") + Select Case _ControlType + Case CTLBUTTON 'Boolean, toggle buttons only + If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "Toggle") And oSession.HasUnoProperty(_ControlModel, "State") Then + If _ControlModel.Toggle Then _ControlModel.State = Iif(pvValue, 1, 0) Else _ControlModel.State = 2 + End If + Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know + If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(ScriptForge.V_BOOLEAN, ScriptForge.V_NUMERIC), Array(0, 1, 2, True, False)) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "State") Then + If VarType(pvValue) = ScriptForge.V_BOOLEAN Then pvValue = Iif(pvValue, 1, 0) + _ControlModel.State = pvValue + End If + Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String + If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "Text") Then _ControlModel.Text = pvValue + Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric + If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "Value") Then _ControlModel.Value = pvValue + Case CTLDATEFIELD 'Date + If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_DATE) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "Date") Then + Set vSet = New com.sun.star.util.Date + vSet.Year = Year(pvValue) + vSet.Month = Month(pvValue) + vSet.Day = Day(pvValue) + _ControlModel.Date = vSet + End If + Case CTLFORMATTEDFIELD 'String or numeric + If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then _ControlModel.EffectiveValue = pvValue + Case CTLLISTBOX 'String or array of strings depending on MultiSelection + ' StringItemList is the list of the items displayed in the box + ' SelectedItems is the list of the indexes in StringItemList of the selected items + ' It can go beyond the limits of StringItemList + ' It can contain multiple values even if the listbox is not multiselect + If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _ + And oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then + vSelection = Array() + If _ControlModel.MultiSelection Then + If Not ScriptForge.SF_Utils._ValidateArray(pvValue, "Value", 1, V_STRING, True) Then GoTo Finally + vList = _ControlModel.StringItemList + For i = LBound(pvValue) To UBound(pvValue) + sItem = pvValue(i) + lIndex = ScriptForge.SF_Array.IndexOf(vList, sItem) + If lIndex >= 0 Then vSelection = ScriptForge.SF_Array.Append(vSelection, lIndex) + Next i + Else + If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally + lIndex = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, pvValue) + If lIndex >= 0 Then vSelection = Array(lIndex) + End If + _ControlModel.SelectedItems = vSelection + End If + Case CTLPROGRESSBAR 'Numeric + If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "ProgressValueMin") Then + If pvValue < _ControlModel.ProgressValueMin Then pvValue = _ControlModel.ProgressValueMin + End If + If oSession.HasUnoProperty(_ControlModel, "ProgressValueMax") Then + If pvValue > _ControlModel.ProgressValueMax Then pvValue = _ControlModel.ProgressValueMax + End If + If oSession.HasUnoProperty(_ControlModel, "ProgressValue") Then _ControlModel.ProgressValue = pvValue + Case CTLRADIOBUTTON 'Boolean + If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "State") Then _ControlModel.State = Iif(pvValue, 1, 0) + Case CTLSCROLLBAR 'Numeric + If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "ScrollValueMin") Then + If pvValue < _ControlModel.ScrollValueMin Then pvValue = _ControlModel.ScrollValueMin + End If + If oSession.HasUnoProperty(_ControlModel, "ScrollValueMax") Then + If pvValue > _ControlModel.ScrollValueMax Then pvValue = _ControlModel.ScrollValueMax + End If + If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then _ControlModel.ScrollValue = pvValue + Case CTLTIMEFIELD + If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_DATE) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "Time") Then + Set vSet = New com.sun.star.util.Time + vSet.Hours = Hour(pvValue) + vSet.Minutes = Minute(pvValue) + vSet.Seconds = Second(pvValue) + _ControlModel.Time = vSet + End If + Case Else : GoTo CatchType + End Select + Case UCase("Visible") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Finally + If oSession.HasUnoMethod(_ControlView, "setVisible") Then + If pvValue Then + If oSession.HasUnoProperty(_ControlModel, "EnableVisible") Then _ControlModel.EnableVisible = True + End If + _ControlView.setVisible(pvValue) + End If + Case UCase("Width") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch + bSet = Resize(Width := pvValue) + Case "X" + If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch + bSet = Resize(Left := pvValue) + Case "Y" + If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch + bSet = Resize(Top := pvValue) + Case Else + bSet = False + End Select +Finally: + _PropertySet = bSet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchType: + ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, psProperty) + GoTo Finally +End Function ' SFDialogs.SF_DialogControl._PropertySet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[DIALOGCONTROL]: Name, Type (dialogname) + _Repr = "[DIALOGCONTROL]: " & _Name & ", " & _ControlType & " (" & _DialogName & ")" + +End Function ' SFDialogs.SF_DialogControl._Repr + +REM ============================================ END OF SFDIALOGS.SF_DIALOGCONTROL +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdialogs/SF_DialogListener.xba b/wizards/source/sfdialogs/SF_DialogListener.xba new file mode 100644 index 0000000000..54dc875452 --- /dev/null +++ b/wizards/source/sfdialogs/SF_DialogListener.xba @@ -0,0 +1,633 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_DialogListener" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === The SFDialogs library is one of the associated libraries. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Listener +''' =========== +''' The current module is dedicated to the management of dialog control events, triggered by user actions, +''' which are not defined with the Basic IDE +''' +''' Concerned events: +''' TreeControl control type, prefix = _SFEXP_ +''' ----------- +''' The OnNodeSelected event, triggered when a user selects a node +''' A typical action is to display additional info about the selected item elsewhere in the dialog +''' The OnNodeExpanded event, triggered when a user clicks on the expansion symbol +''' A typical action is to create dynamically a subnode or a subtree below the expanded item +''' +''' PageManager facility, prefix = _SFTAB_ +''' ----------- +''' Depending on the piloting control(s), next event types are implemented +''' XActionListener: for buttons +''' XItemListener: for listboxes, comboboxes and radio buttons +''' +''' The described events are processed thru UNO listeners +''' +''' "On" events defined by code, prefix = _SFFOCUS_, _SFKEY_, _SFMOUSE_, _SFMOVE_, _SFITEM_, _SFADJUST_, _SFTEXT_ +''' ----------- +''' All event types applicable on dialogs and control types <> TreeControl +''' The events MUST NOT be preset in the Basic IDE +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================= DEFINITIONS + +REM ================================================================== EXCEPTIONS + +REM ================================================ PUBLIC METHODS (TREECONTROL) + +REM ----------------------------------------------------------------------------- +Public Sub _SFEXP_requestChildNodes(Optional ByRef poEvent As Object) +''' Triggered by the OnNodeExpanded event of a tree control +''' The event is triggered thru a com.sun.star.view.XTreeExpansionListener +''' The argument is passed to a user routine stored in the SF_DialogControl instance +''' as a scripting framework URI + +Dim oControl As Object ' The SF_DialogControl object having triggered the event + + On Local Error GoTo Catch ' Avoid stopping event scripts + +Check: + ' Ensure there is a node + If IsNull(poEvent) Or IsMissing(poEvent) Then Exit Sub + If IsNull(poEvent.Node) Then Exit Sub + +Try: + Set oControl = ScriptForge.SF_Services.CreateScriptService("SFDialogs.DialogEvent", poEvent) + ScriptForge.SF_Session._ExecuteScript(oControl.OnNodeExpanded, poEvent) + +Finally: + Exit Sub +Catch: + GoTo Finally +End Sub ' SFDialogs.SF_Dialoglistener._SFEXP_requestChildNodes + +Sub _SFEXP_disposing(ByRef poEvent As Object) +End Sub + +Sub _SFEXP_treeExpanding(Optional ByRef poEvent As Object) +End Sub + +Sub _SFEXP_treeCollapsing(ByRef poEvent As Object) +End Sub + +Sub _SFEXP_treeExpanded(ByRef poEvent As Object) +End Sub + +Sub _SFEXP_treeCollapsed(ByRef poEvent As Object) +End Sub + +REM ----------------------------------------------------------------------------- +Public Sub _SFSEL_selectionChanged(Optional ByRef poEvent As Object) +''' Triggered by the OnNodeSelected event of a tree control +''' The event is triggered thru a com.sun.star.view.XSelectionChangeListener +''' The argument is passed to a user routine stored in the SF_DialogControl instance +''' as a scripting framework URI +''' +''' Nothing happens if there are several selected nodes or none + +Dim vSelection As Variant ' Variant, not object !! +Dim oControl As Object ' The SF_DialogControl object having triggered the event + + On Local Error GoTo Catch ' Avoid stopping event scripts + +Check: + ' Ensure there is a selection + If IsNull(poEvent) Or IsMissing(poEvent) Then Exit Sub + vSelection = poEvent.Source.getSelection() + If IsEmpty(vSelection) Or IsArray(vSelection) Then Exit Sub + +Try: + Set oControl = ScriptForge.SF_Services.CreateScriptService("SFDialogs.DialogEvent", poEvent) + ScriptForge.SF_Session._ExecuteScript(oControl.OnNodeSelected, poEvent) + +Finally: + Exit Sub +Catch: + GoTo Finally +End Sub ' SFDialogs.SF_Dialoglistener._SFSEL_selectionChanged + +Sub _SFSEL_disposing(ByRef poEvent As Object) +End Sub + +REM ============================================ PUBLIC METHODS (PAGE MANAGEMENT) + +REM ----------------------------------------------------------------------------- +Public Sub _SFTAB_actionPerformed(Optional ByRef poEvent As Object) +''' Event triggered by a button configured through the dialog page manager +''' Buttons may be of type TABCONTROL, BACKCONTROL or NEXTCONTROL + +Dim oControl As Object ' The DialogControl instance having caused the event +Dim sName As String ' Control name +Dim oDialog As Object ' The parent Dialog instance +Dim oPageManager As Object ' An entry in dialog._PageManagement +Const TABCONTROL = 2 +Const BACKCONTROL = 3 +Const NEXTCONTROL = 4 + +Check: + On Local Error GoTo Finally ' Never interrupt !! + Set oControl = CreateScriptService("DialogEvent", poEvent) + If IsNull(oControl) Then GoTo Finally + +Try: + Set oDialog = oControl.Parent + With oDialog + sName = oControl.Name + ' Find entry in page manager settings + For Each oPageManager In ._PageManagement + If oPageManager.ControlName = sName Then + Select Case oPageManager.PageMgtType + Case TABCONTROL : .Page = oPageManager.PageNumber + Case BACKCONTROL : .Page = .Page - 1 + Case NEXTCONTROL : .Page = .Page + 1 + Case Else + End Select + Exit For + End If + Next oPageManager + End With + +Finally: + Exit Sub +End Sub ' SFDialogs.SF_Dialoglistener._SFTAB_actionPerformed + +REM ----------------------------------------------------------------------------- +Public Sub _SFTAB_itemStateChanged(Optional ByRef poEvent As Object) +''' Event triggered by a listbox, combobox or radiobutton configured through the dialog page manager +''' Buttons are of type PILOTCONTROL + +Dim oControl As Object ' The DialogControl instance having caused the event +Dim sName As String ' Control name +Dim oDialog As Object ' The parent Dialog instance +Dim oPageManager As Object ' An entry in dialog._PageManagement +Dim lPage As Long ' Actual page number + +Check: + On Local Error GoTo Finally ' Never interrupt !! + Set oControl = CreateScriptService("DialogEvent", poEvent) + If IsNull(oControl) Then GoTo Finally + +Try: + Set oDialog = oControl.Parent + With oDialog + sName = oControl.Name + ' Find entry in page manager settings + For Each oPageManager In ._PageManagement + If oPageManager.ControlName = sName Then + lPage = oPageManager.PageNumber + If lPage = 0 Then .Page = oControl.ListIndex + 1 Else .Page = lPage + Exit For + End If + Next oPageManager + End With + +Finally: + Exit Sub +End Sub ' SFDialogs.SF_Dialoglistener._SFTAB_itemStateChanged + +REM ----------------------------------------------------------------------------- +Public Sub _SFTAB_disposing(Optional ByRef poEvent As Object) +End Sub + +REM ========================== PUBLIC METHODS (GENERIC DIALOG AND CONTROL EVENTS) + +''' Next methods SIMULATE the behaviour of events set on dialogs and dialog controls +''' in the Events tab of a dialog editing page in the Basic IDE. +''' They are not triggered by events preset in the Basic IDE. +''' They are triggered ONLY when the event has been set by code with one of the OnXxxYyyy properties, +''' like in: +''' dialog.OnActionPerformed = "vnd...." ' URI notation + +REM ----------------------------------------------------------------------------- +Public Sub _SFACTION_actionPerformed(Optional ByRef poEvent As Object) +''' Triggered by the OnActionPerformed event in a dialog control +''' The event is triggered thru a com.sun.star.awt.XActionListener +''' The argument is passed to a user routine stored in the SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("actionPerformed", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener. _SFACTION_actionPerformed + +REM ----------------------------------------------------------------------------- +Public Sub _SFACTION_disposing() +End Sub + +REM ----------------------------------------------------------------------------- +Public Sub _SFADJUST_adjustmentValueChanged(Optional ByRef poEvent As Object) +''' Triggered by the OnAdjustmentValueChanged event in a scrollbar +''' The event is triggered thru a com.sun.star.awt.XAdjustmentListener +''' The argument is passed to a user routine stored in the SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("adjustmentValueChanged", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener. _SFADJUST_adjustmentValueChanged + +REM ----------------------------------------------------------------------------- +Public Sub _SFADJUST_disposing() +End Sub + +REM ----------------------------------------------------------------------------- +Public Sub _SFFOCUS_focusGained(Optional ByRef poEvent As Object) +''' Triggered by the OnFocusGained event in a dialog or dialog control +''' The event is triggered thru a com.sun.star.awt.XFocusListener +''' The argument is passed to a user routine stored in the SF_Dialog or SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("focusGained", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener._SFFOCUS_focusGained + +REM ----------------------------------------------------------------------------- +Public Sub _SFFOCUS_focusLost(Optional ByRef poEvent As Object) +''' Triggered by the OnFocusLost event in a dialog or dialog control +''' The event is triggered thru a com.sun.star.awt.XFocusListener +''' The argument is passed to a user routine stored in the SF_Dialog or SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("focusLost", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener._SFFOCUS_focusLost + +REM ----------------------------------------------------------------------------- +Public Sub _SFFOCUS_disposing() +End Sub + +REM ----------------------------------------------------------------------------- +Public Sub _SFITEM_itemStateChanged(Optional ByRef poEvent As Object) +''' Triggered by the OnItemStateChanged event in a dialog control +''' The event is triggered thru a com.sun.star.awt.XItemListener +''' The argument is passed to a user routine stored in the SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("itemStateChanged", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener. _SFACTION_actionPerformed + +REM ----------------------------------------------------------------------------- +Public Sub _SFITEM_disposing() +End Sub + +REM ----------------------------------------------------------------------------- +Public Sub _SFKEY_keyPressed(Optional ByRef poEvent As Object) +''' Triggered by the OnKeyPressed event in a dialog or dialog control +''' The event is triggered thru a com.sun.star.awt.XKeyListener +''' The argument is passed to a user routine stored in the SF_Dialog or SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("keyPressed", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener._SFKEY_keyPressed + +REM ----------------------------------------------------------------------------- +Public Sub _SFKEY_keyReleased(Optional ByRef poEvent As Object) +''' Triggered by the OnKeyReleased event in a dialog or dialog control +''' The event is triggered thru a com.sun.star.awt.XKeyListener +''' The argument is passed to a user routine stored in the SF_Dialog or SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("keyReleased", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener._SFKEY_keyReleased + +REM ----------------------------------------------------------------------------- +Public Sub _SFKEY_disposing() +End Sub + +REM ----------------------------------------------------------------------------- +Public Sub _SFMOUSE_mouseEntered(Optional ByRef poEvent As Object) +''' Triggered by the OnMouseEntered event in a dialog or dialog control +''' The event is triggered thru a com.sun.star.awt.XMouseListener +''' The argument is passed to a user routine stored in the SF_Dialog or SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("mouseEntered", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener._SFMOUSE_mouseEntered + +REM ----------------------------------------------------------------------------- +Public Sub _SFMOUSE_mouseExited(Optional ByRef poEvent As Object) +''' Triggered by the OnMouseExited event in a dialog or dialog control +''' The event is triggered thru a com.sun.star.awt.XMouseListener +''' The argument is passed to a user routine stored in the SF_Dialog or SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("mouseExited", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener._SFMOUSE_mouseExited + +REM ----------------------------------------------------------------------------- +Public Sub _SFMOUSE_mousePressed(Optional ByRef poEvent As Object) +''' Triggered by the OnMousePressed event in a dialog or dialog control +''' The event is triggered thru a com.sun.star.awt.XMouseListener +''' The argument is passed to a user routine stored in the SF_Dialog or SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("mousePressed", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener._SFMOUSE_mousePressed + +REM ----------------------------------------------------------------------------- +Public Sub _SFMOUSE_mouseReleased(Optional ByRef poEvent As Object) +''' Triggered by the OnMouseReleased event in a dialog or dialog control +''' The event is triggered thru a com.sun.star.awt.XMouseListener +''' The argument is passed to a user routine stored in the SF_Dialog or SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("mouseReleased", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener._SFMOUSE_mouseReleased + +REM ----------------------------------------------------------------------------- +Public Sub _SFMOUSE_disposing() +End Sub + +REM ----------------------------------------------------------------------------- +Public Sub _SFMOVE_mouseDragged(Optional ByRef poEvent As Object) +''' Triggered by the OnMouseDragged event in a dialog or dialog control +''' The event is triggered thru a com.sun.star.awt.XMouseMotionListener +''' The argument is passed to a user routine stored in the SF_Dialog or SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("mouseDragged", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener._SFMOUSE_mouseDragged + +REM ----------------------------------------------------------------------------- +Public Sub _SFMOVE_mouseMoved(Optional ByRef poEvent As Object) +''' Triggered by the OnMouseMoved event in a dialog or dialog control +''' The event is triggered thru a com.sun.star.awt.XMouseMotionListener +''' The argument is passed to a user routine stored in the SF_Dialog or SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("mouseMoved", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener._SFMOUSE_mouseMoved + +REM ----------------------------------------------------------------------------- +Public Sub _SFMOVE_disposing() +End Sub + +REM ----------------------------------------------------------------------------- +Public Sub _SFTEXT_textChanged(Optional ByRef poEvent As Object) +''' Triggered by the OnTextChanged event in a dialog control +''' The event is triggered thru a com.sun.star.awt.XTextListener +''' The argument is passed to a user routine stored in the SF_DialogControl instance +''' as a scripting framework URI + + _TriggerEvent("textChanged", poEvent) + +End Sub ' SFDialogs.SF_Dialoglistener. _SFTEXT_textChanged + +REM ----------------------------------------------------------------------------- +Public Sub _SFTEXT_disposing() +End Sub + +REM ============================================================= PRIVATE METHODS + +REM ----------------------------------------------------------------------------- +Public Function _SetOnProperty(ByRef poInstance As Object _ + , ByVal psProperty As String _ + , ByVal psScript As String _ + ) As Boolean +''' Set one of the On properties related to either a SF_Dialog or SF_DialogControl instance +''' Such a property is typically set by next pseudo-code: +''' poInstance.psProperty = psScript +''' It requires a strictly identical nomenclature of internal variables in both classes. +''' Args: +''' poInstance: a SF_Dialog or a SF_DialogControl instance +''' psProperty: one of the applicable On properties ("OnFocusGained", "OnMouseMoved", ...) +''' psScript: the script to run when the event is triggered +''' When the zero-length string, the trigger is deactivated + +Dim bSet As Boolean ' Return value +Dim oModel As Object ' com.sun.star.awt.XControlModel +Dim oView As Object ' com.sun.star.awt.XControl +Dim oDialogEvents As Object ' com.sun.star.container.XNameContainer +Dim sListener As String ' Applicable listener, depending on property, f.i. "XMouseListener" +Dim sEventName As String ' Internal event name +Dim iCounterIncrement As Integer ' Increment to be applied on listener counter +Dim sPrevious As String ' Actual value of script before the change + +Const cstPrefix = "com.sun.star.awt." + + bSet = True + +Check: + If IsNull(poInstance) Or Len(psProperty) = 0 Then GoTo Catch + With poInstance + + ' Initialize local variables depending on instance type + If .ObjectType = "DIALOG" Then + Set oModel = ._DialogModel + Set oView = ._DialogControl + Else ' DIALOGCONTROL + Set oModel = ._ControlModel + Set oView = ._ControlView + End If + If IsNull(oModel) Or IsNull(oView) Then GoTo Catch + + ' Ignore request if an event has been statically preset (in the Basic IDE) with the same name + Set oDialogEvents = oModel.getEvents() + sListener = ._GetListener(psProperty) + sEventName = cstPrefix & sListener & "::" & ._GetEventName(psProperty) + If oDialogEvents.hasByName(sEventName) Then GoTo Catch + +Try: + ' Note the target scripts. Compare previous and new values. Fix the increment to be applied on counter + Select Case UCase(psProperty) + Case UCase("OnActionPerformed") + sPrevious = ._OnActionPerformed + ._OnActionPerformed = psScript + Case UCase("OnAdjustmentValueChanged") + sPrevious = ._OnAdjustmentValueChanged + ._OnAdjustmentValueChanged = psScript + Case UCase("OnFocusGained") + sPrevious = ._OnfocusGained + ._OnFocusGained = psScript + Case UCase("OnFocusLost") + sPrevious = ._OnFocusLost + ._OnFocusLost = psScript + Case UCase("OnItemStateChanged") + sPrevious = ._OnItemStateChanged + ._OnItemStateChanged = psScript + Case UCase("OnKeyPressed") + sPrevious = ._OnKeyPressed + ._OnKeyPressed = psScript + Case UCase("OnKeyReleased") + sPrevious = ._OnKeyReleased + ._OnKeyReleased = psScript + Case UCase("OnMouseDragged") + sPrevious = ._OnMouseDragged + ._OnMouseDragged = psScript + Case UCase("OnMouseEntered") + sPrevious = ._OnMouseEntered + ._OnMouseEntered = psScript + Case UCase("OnMouseExited") + sPrevious = ._OnMouseExited + ._OnMouseExited = psScript + Case UCase("OnMouseMoved") + sPrevious = ._OnMouseMoved + ._OnMouseMoved = psScript + Case UCase("OnMousePressed") + sPrevious = ._OnMousePressed + ._OnMousePressed = psScript + Case UCase("OnMouseReleased") + sPrevious = ._OnMouseReleased + ._OnMouseReleased = psScript + Case UCase("OnTextChanged") + sPrevious = ._OnTextChanged + ._OnTextChanged = psScript + End Select + ' Compare previous and new event to know what to do next with the listener + If sPrevious = psScript Then GoTo Finally ' No change + If Len(sPrevious) = 0 Then ' New event + iCounterIncrement = +1 + ElseIf Len(psScript) = 0 Then ' Cancel event + iCounterIncrement = -1 + Else ' Event replacement + iCounterIncrement = 0 + End If + + ' Setup a new fresh listener, only once by listener during dialog or control life time, + ' (re)add it to the instance view or remove the existing one if not needed anymore + Select Case sListener + Case "XActionListener" + ._ActionCounter = ._ActionCounter + iCounterIncrement + If ._ActionCounter = 1 Then + If IsNull(._ActionListener) Then Set ._ActionListener = CreateUnoListener("_SFACTION_", cstPrefix & sListener) + If iCounterIncrement = 1 Then oView.addActionListener(._ActionListener) + ElseIf ._ActionCounter <= 0 Then + If Not IsNull(._ActionListener) Then oView.removeActionListener(._ActionListener) + ._ActionCounter = 0 ' Prevent negative values + End If + Case "XAdjustmentListener" + ._AdjustmentCounter = ._AdjustmentCounter + iCounterIncrement + If ._AdjustmentCounter = 1 Then + If IsNull(._AdjustmentListener) Then Set ._AdjustmentListener = CreateUnoListener("_SFADJUST_", cstPrefix & sListener) + If iCounterIncrement = 1 Then oView.addAdjustmentListener(._AdjustmentListener) + ElseIf ._AdjustmentCounter <= 0 Then + If Not IsNull(._AdjustmentListener) Then oView.removeAdjustmentListener(._AdjustmentListener) + ._AdjustmentCounter = 0 ' Prevent negative values + End If + Case "XFocusListener" + ._FocusCounter = ._FocusCounter + iCounterIncrement + If ._FocusCounter = 1 Then + If IsNull(._FocusListener) Then Set ._FocusListener = CreateUnoListener("_SFFOCUS_", cstPrefix & sListener) + If iCounterIncrement = 1 Then oView.addFocusListener(._FocusListener) + ElseIf ._FocusCounter <= 0 Then + If Not IsNull(._FocusListener) Then oView.removeFocusListener(._FocusListener) + ._FocusCounter = 0 ' Prevent negative values + End If + Case "XItemListener" + ._ItemCounter = ._ItemCounter + iCounterIncrement + If ._ItemCounter = 1 Then + If IsNull(._ItemListener) Then Set ._ItemListener = CreateUnoListener("_SFITEM_", cstPrefix & sListener) + If iCounterIncrement = 1 Then oView.addItemListener(._ItemListener) + ElseIf ._ItemCounter <= 0 Then + If Not IsNull(._ItemListener) Then oView.removeItemListener(._ItemListener) + ._ItemCounter = 0 ' Prevent negative values + End If + Case "XKeyListener" + ._KeyCounter = ._KeyCounter + iCounterIncrement + If ._KeyCounter= 1 Then + If IsNull(._KeyListener) Then Set ._KeyListener = CreateUnoListener("_SFKEY_", cstPrefix & sListener) + If iCounterIncrement = 1 Then oView.addKeyListener(._KeyListener) + ElseIf ._KeyCounter <= 0 Then + If Not IsNull(._KeyListener) Then oView.removeKeyListener(._KeyListener) + ._KeyCounter = 0 ' Prevent negative values + End If + Case "XMouseListener" + ._MouseCounter = ._MouseCounter + iCounterIncrement + If ._MouseCounter= 1 Then + If IsNull(._MouseListener) Then Set ._MouseListener = CreateUnoListener("_SFMOUSE_", cstPrefix & sListener) + If iCounterIncrement = 1 Then oView.addMouseListener(._MouseListener) + ElseIf ._MouseCounter <= 0 Then + If Not IsNull(._MouseListener) Then oView.removeMouseListener(._MouseListener) + ._MouseCounter = 0 ' Prevent negative values + End If + Case "XMouseMotionListener" + ._MouseMotionCounter = ._MouseMotionCounter + iCounterIncrement + If ._MouseMotionCounter = 1 Then + If IsNull(._MouseMotionListener) Then Set ._MouseMotionListener = CreateUnoListener("_SFMOVE_", cstPrefix & sListener) + If iCounterIncrement = 1 Then oView.addMouseMotionListener(._MouseMotionListener) + ElseIf ._MouseMotionCounter <= 0 Then + If Not IsNull(._MouseMotionListener) Then oView.removeMouseMotionListener(._MouseMotionListener) + ._MouseMotionCounter = 0 ' Prevent negative values + End If + Case "XTextListener" + ._TextCounter = ._TextCounter + iCounterIncrement + If ._TextCounter = 1 Then + If IsNull(._TextListener) Then Set ._TextListener = CreateUnoListener("_SFTEXT_", cstPrefix & sListener) + If iCounterIncrement = 1 Then oView.addTextListener(._TextListener) + ElseIf ._TextCounter <= 0 Then + If Not IsNull(._TextListener) Then oView.removeTextListener(._TextListener) + ._TextCounter = 0 ' Prevent negative values + End If + End Select + + End With + +Finally: + _SetOnProperty = bSet + Exit Function +Catch: + bSet = False + GoTo Finally +End Function ' SFDialogs.SF_Dialoglistener._SetOnProperty + +REM ----------------------------------------------------------------------------- +Public Sub _TriggerEvent(ByVal EventType, Optional ByRef poEvent As Object) +''' Triggered by the EventType event in a dialog or dialog control +''' The argument is passed to a user routine stored in the SF_Dialog or SF_DialogControl instance +''' as a scripting framework URI + +Dim oDialog As Object ' The SF_Dialog or SF_DialogControl object having triggered the event +Dim sScript As String ' Script to be invoked + + On Local Error GoTo Catch ' Avoid stopping event scripts + +Check: + If IsNull(poEvent) Or IsMissing(poEvent) Then Exit Sub + +Try: + Set oDialog = ScriptForge.SF_Services.CreateScriptService("SFDialogs.DialogEvent", poEvent) + If IsNull(oDialog) Then Exit Sub + With oDialog + Select Case EventType + Case "actionPerformed" : sScript = .OnActionPerformed + Case "adjustmentValueChanged" : sScript = .OnAdjustmentValueChanged + Case "focusGained" : sScript = .OnFocusGained + Case "focusLost" : sScript = .OnFocusLost + Case "itemStateChanged" : sScript = .OnItemStateChanged + Case "mouseDragged" : sScript = .OnMouseDragged + Case "mouseEntered" : sScript = .OnMouseEntered + Case "mouseExited" : sScript = .OnMouseExited + Case "mouseMoved" : sScript = .OnMouseMoved + Case "mousePressed" : sScript = .OnMousePressed + Case "mouseReleased" : sScript = .OnMouseReleased + Case "textChanged" : sScript = .OnTextChanged + Case Else : sScript = "" ' Should not happen + End Select + If Len(sScript) = 0 Then Exit Sub + ScriptForge.SF_Session._ExecuteScript(sScript, poEvent) + End With + +Finally: + Exit Sub +Catch: + GoTo Finally +End Sub ' SFDialogs.SF_Dialoglistener._TriggerEvent + +REM ============================================ END OF SFDIALOGS.SF_DIALOGLISTENER +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdialogs/SF_DialogUtils.xba b/wizards/source/sfdialogs/SF_DialogUtils.xba new file mode 100644 index 0000000000..e364acac46 --- /dev/null +++ b/wizards/source/sfdialogs/SF_DialogUtils.xba @@ -0,0 +1,332 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_DialogUtils" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === The SFDialogs library is one of the associated libraries. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Explicit +Option Private Module + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_DialogUtils +''' ======== +''' FOR INTERNAL USE ONLY +''' Groups private functions that are common to the SF_Dialog and SF_DialogControl class modules +''' +''' Topics where SF_DialogUtils matters: +''' - resizing dialog and dialog controls +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +REM ============================================================ MODULE CONSTANTS + +Public Const MINPOSITION = -99999 ' Conventionally indicates "do not change position" + +REM =========================================pvA================= PRIVATE METHODS + +REM ----------------------------------------------------------------------------- +Public Function _ConvertPointToAppFont(ByRef poView As Object _ + , ByVal plX As Long _ + , ByVal plY As Long _ + ) As Object +''' Convert the X, Y position expressed in pixels to a Point expressed in "Map APPFONT" +''' Args: +''' poView: a com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl +''' plX, plY : the horizontal and vertical coordinates of the top-left corner of the control +''' Returns: +''' a com.sun.star.awt.Point object + +Dim oPoint As New com.sun.star.awt.Point ' The input Point +Dim oReturn As Object ' Return value + +Try: + oPoint.X = plX + oPoint.Y = plY + Set oReturn = poView.convertPointToLogic(oPoint, com.sun.star.util.MeasureUnit.APPFONT) + +Finally: + Set _ConvertPointToAppFont = oReturn + Exit Function +End Function ' SFDialogs.SF_DialogUtils._ConvertPointToAppFont + +REM ----------------------------------------------------------------------------- +Public Function _ConvertPointToPixel(ByRef poView As Object _ + , ByVal plX As Long _ + , ByVal plY As Long _ + ) As Object +''' Convert the X, Y coordinates expressed in "Map APPFONT" units to a point expressed in pixels +''' Args: +''' poView: a com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl +''' plX, plY : the horizontal and vertical coordinates of the top-left corner of the control +''' Returns: +''' a com.sun.star.awt.Point object + +Dim oPoint As New com.sun.star.awt.Point ' The input point +Dim oReturn As Object ' Return value + +Try: + oPoint.X = plX + oPoint.Y = plY + Set oReturn = poView.convertPointToPixel(oPoint, com.sun.star.util.MeasureUnit.APPFONT) + +Finally: + Set _ConvertPointToPixel = oReturn + Exit Function +End Function ' SFDialogs.SF_DialogUtils._ConvertPointToPixel + +REM ----------------------------------------------------------------------------- +Public Function _ConvertSizeToAppFont(ByRef poView As Object _ + , ByVal plWidth As Long _ + , ByVal plHeight As Long _ + ) As Object +''' Convert the Width, Height dimensions expressed in pixels to a Size expressed in "Map APPFONT" +''' Args: +''' poView: a com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl +''' plWidth, plHeight : the horizontal and vertical dimensions of the control +''' Returns: +''' a com.sun.star.awt.Size object + +Dim oSize As New com.sun.star.awt.Size ' The input size +Dim oReturn As Object ' Return value + +Try: + oSize.Width = plWidth + oSize.Height = plHeight + Set oReturn = poView.convertSizeToLogic(oSize, com.sun.star.util.MeasureUnit.APPFONT) + +Finally: + Set _ConvertSizeToAppFont = oReturn + Exit Function +End Function ' SFDialogs.SF_DialogUtils._ConvertSizeToAppFont + +REM ----------------------------------------------------------------------------- +Public Function _ConvertSizeToPixel(ByRef poView As Object _ + , ByVal plWidth As Long _ + , ByVal plHeight As Long _ + ) As Object +''' Convert the Width, Height dimensions expressed in "Map APPFONT" units to a Size expressed in pixels +''' Args: +''' poView: a com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl +''' plWidth, plHeight : the horizontal and vertical dimensions of the control +''' Returns: +''' a com.sun.star.awt.Size object + +Dim oSize As New com.sun.star.awt.Size ' The input size +Dim oReturn As Object ' Return value + +Try: + oSize.Width = plWidth + oSize.Height = plHeight + Set oReturn = poView.convertSizeToPixel(oSize, com.sun.star.util.MeasureUnit.APPFONT) + +Finally: + Set _ConvertSizeToPixel = oReturn + Exit Function +End Function ' SFDialogs.SF_DialogUtils._ConvertSizeToPixel + +REM ----------------------------------------------------------------------------- +Public Function _ConvertToAppFont(ByRef poView As Object _ + , ByVal pbPoint As Boolean _ + ) As Object +''' Switch between the _ConvertPointToAppFont and the _ConvertSizeToAppFont routines +''' Args: +''' poView: a com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl +''' pbPoint: when True return a Point, otherwise return a Size +''' Returns: +''' a com.sun.star.awt.Point or a com.sun.star.awt.Size object + +Static oSession As Object ' Alias of SF_Session +Dim oPosSize As Object ' com.sun.star.awt.Rectangle + +Try: + If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") + If oSession.HasUNOMethod(poView, "getPosSize") Then + Set oPosSize =poView.getPosSize() + Else ' Should not happen + Set oPosSize = New com.sun.star.awt.Rectangle + End If + + If pbPoint Then + _ConvertToAppFont = _ConvertPointToAppFont(poView, oPosSize.X, oPosSize.Y) ' com.sun.star.awt.Point + Else + _ConvertToAppFont = _ConvertSizeToAppFont(poView, oPosSize.Width, oPosSize.Height) ' com.sun.star.awt.Size + End If + +End Function ' SFDialogs.SF_DialogUtils._ConvertToAppFont + +REM ----------------------------------------------------------------------------- +Private Function _FormatsList(psControlType) As Variant +''' Return the list of the allowed formats for Date and Time control types +''' Args: +''' DateField or TimeField control +''' Returns: +''' The allowed format entries as a zero-based array + +Dim vFormats() As Variant ' Return value +Const CTLDATEFIELD = "DateField" +Const CTLTIMEFIELD = "TimeField" + + Select Case psControlType + Case CTLDATEFIELD + vFormats = Array( _ + "Standard (short)" _ + , "Standard (short YY)" _ + , "Standard (short YYYY)" _ + , "Standard (long)" _ + , "DD/MM/YY" _ + , "MM/DD/YY" _ + , "YY/MM/DD" _ + , "DD/MM/YYYY" _ + , "MM/DD/YYYY" _ + , "YYYY/MM/DD" _ + , "YY-MM-DD" _ + , "YYYY-MM-DD" _ + ) + Case CTLTIMEFIELD + vFormats = Array( _ + "24h short" _ + , "24h long" _ + , "12h short" _ + , "12h long" _ + ) + Case Else + vFormats = Array() + End Select + + _FormatsList = vFormats + +End Function ' SFDialogs.SF_DialogUtils._FormatsList + +REM ----------------------------------------------------------------------------- +Public Function _Resize(ByRef Control As Object _ + , Optional ByVal Left As Variant _ + , Optional ByVal Top As Variant _ + , Optional ByVal Width As Variant _ + , Optional ByVal Height As Variant _ + ) As Boolean +''' Move the top-left corner of a dialog or a dialog control to new coordinates and/or modify its dimensions +''' Without arguments, the method either: +''' leaves the position unchanged and computes best fit dimensions +''' resets the initial position and dimensions (Scrollbar, ProgressBar, FixedLine, GroupBox, TreeControl", TableControl) +''' Attributes denoting the position and size of a dialog are expressed in "Map AppFont" units. +''' Map AppFont units are device and resolution independent. +''' One Map AppFont unit is equal to one eighth of the average character (Systemfont) height and one quarter of the average character width. +''' The dialog editor (= the Basic IDE) also uses Map AppFont units. +''' Args: +''' Control: a SF_Dialog or SF_DialogControl class instance +''' Left : the horizontal distance from the top-left corner +''' Top : the vertical distance from the top-left corner +''' Width : the horizontal width of the rectangle containing the Dialog[Control] +''' Height : the vertical height of the rectangle containing the Dialog[Control] +''' Negative or missing arguments are left unchanged. +''' Returns: +''' True when successful + +Dim bResize As Boolean ' Return value +Dim oModel As Object ' Model of Control object +Dim oView As Object ' View of Control object +Dim Displayed As Boolean ' When Trs, the dialog is currently active +Dim oSize As Object ' com.sun.star.awt.Size +Dim oPoint As Object ' com.sun.star.awt.Point +Dim oPreferredSize As Object ' com.sun.star.awt.Size +Dim iFlags As Integer ' com.sun.star.awt.PosSize constants +Static oSession As Object ' SF_Session alias +Dim cstThisSub As String +Const cstSubArgs = "[Left], [Top], [Width], [Height]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bResize = False + +Check: + If IsNull(Control) Then GoTo Finally + If IsMissing(Left) Or IsEmpty(Left) Then Left = MINPOSITION + If IsMissing(Top) Or IsEmpty(Top) Then Top = MINPOSITION + If IsMissing(Height) Or IsEmpty(Height) Then Height = -1 + If IsMissing(Width) Or IsEmpty(Width) Then Width = -1 + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(Left, "Left", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Top, "Top", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Width, "Width", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Height, "Height", ScriptForge.V_NUMERIC) Then GoTo Finally + End If + +Try: + With Control + ' Initialize local variables depending on caller + Select Case .ObjectType + Case "DIALOG" + cstThisSub = "SFDialogs.Dialog.Resize" + Set oModel = ._DialogModel + Set oView = ._DialogControl + Displayed = ._Displayed + Case "DIALOGCONTROL" + cstThisSub = "SFDialogs.DialogControl.Resize" + Set oModel = ._ControlModel + Set oView = ._ControlView + Displayed = .[Parent]._Displayed + Case Else + End Select + ' Manage absence of arguments: best fit or reset + If Left = MINPOSITION And Top = MINPOSITION And Width = -1 And Height = -1 Then + If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session") + If oSession.HasUnoMethod(oView, "getPreferredSize") Then + ' Compute a best fit size when relevant + Set oPreferredSize = oView.getPreferredSize() + Set oSize = SF_DialogUtils._ConvertSizeToAppFont(oView, oPreferredSize.Width, oPreferredSize.Height) + Width = oSize.Width + Height = oSize.Height + Else + ' Reset factory settings otherwise + Left = ._Left + Top = ._Top + Width = ._Width + Height = ._Height + End If + End If + End With + + ' Model sizes are in APPFONTs, View sizes are in pixels. Use view.convertSizeToPixel() to convert + ' For dynamic dialogs: convertSizeToPixel() is available only as from the dialog is made visible + ' => When the dialog is visible, positions and sizes are updated in view + ' When the dialog is not visible, positions and sizes adapted on model + If Displayed Then + With oView + ' Trace the elements to change + iFlags = 0 + With com.sun.star.awt.PosSize + If Left > MINPOSITION Then iFlags = iFlags + .X Else Left = 0 + If Top > MINPOSITION Then iFlags = iFlags + .Y Else Top = 0 + If Width > 0 Then iFlags = iFlags + .WIDTH Else Width = 0 + If Height > 0 Then iFlags = iFlags + .HEIGHT Else Height = 0 + End With + ' Convert APPFONT units to pixels + Set oPoint = SF_DialogUtils._ConvertPointToPixel(oView, CLng(Left), CLng(Top)) + Set oSize = SF_DialogUtils._ConvertSizeToPixel(oView, CLng(Width), CLng(Height)) + ' Rewrite + If iFlags > 0 Then .setPosSize(oPoint.X, oPoint.Y, oSize.Width, oSize.Height, iFlags) + End With + Else + With oModel + ' Store position and dimensions in APPFONT units + If Left > MINPOSITION Then .PositionX = CLng(Left) + If Top > MINPOSITION Then .PositionY = CLng(Top) + If Width > 0 Then .Width = CLng(Width) + If Height > 0 Then .Height = CLng(Height) + End With + End If + bResize = True + +Finally: + _Resize = bResize + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogss.SF_DialogUtils._Resize + +REM ============================================= END OF SFDIALOGS.SF_DIALOGUTILS + +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdialogs/SF_Register.xba b/wizards/source/sfdialogs/SF_Register.xba new file mode 100644 index 0000000000..4639739089 --- /dev/null +++ b/wizards/source/sfdialogs/SF_Register.xba @@ -0,0 +1,454 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Register" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === The SFDialogs library is one of the associated libraries. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Register +''' =========== +''' The ScriptForge framework includes +''' the master ScriptForge library +''' a number of "associated" libraries SF* +''' any user/contributor extension wanting to fit into the framework +''' +''' The main methods in this module allow the current library to cling to ScriptForge +''' - RegisterScriptServices +''' Register the list of services implemented by the current library +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================= DEFINITIONS + +''' Event management of dialogs requires to being able to rebuild a Dialog object +''' from its com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl UNO instance +''' For that purpose, the started dialogs are buffered in a global array of _DialogCache types + +Type _DialogCache + Terminated As Boolean + XUnoDialog As Object + BasicDialog As Object +End Type + +REM ================================================================== EXCEPTIONS + +Private Const DIALOGNOTFOUNDERROR = "DIALOGNOTFOUNDERROR" + +REM ============================================================== PUBLIC METHODS + +REM ----------------------------------------------------------------------------- +Public Sub RegisterScriptServices() As Variant +''' Register into ScriptForge the list of the services implemented by the current library +''' Each library pertaining to the framework must implement its own version of this method +''' +''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods +''' with 2 arguments: +''' ServiceName: the name of the service as a case-insensitive string +''' ServiceReference: the reference as an object +''' If the reference refers to a module, then return the module as an object: +''' GlobalScope.Library.Module +''' If the reference is a class instance, then return a string referring to the method +''' containing the New statement creating the instance +''' "libraryname.modulename.function" + + With GlobalScope.ScriptForge.SF_Services + .RegisterService("Dialog", "SFDialogs.SF_Register._NewDialog") ' Reference to the function initializing the service + .RegisterEventManager("DialogEvent", "SFDialogs.SF_Register._EventManager") ' Reference to the events manager + .RegisterEventManager("NewDialog", "SFDialogs.SF_Register._NewDialogFromScratch") ' Reference to the function initializing the service + End With + +End Sub ' SFDialogs.SF_Register.RegisterScriptServices + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _AddDialogToCache(ByRef pvUnoDialog As Object _ + , ByRef pvBasicDialog As Object _ + ) As Long +''' Add a new entry in the cache array with the references of the actual dialog +''' If relevant, the last entry of the cache is reused. +''' The cache is located in the global _SF_ variable +''' Args: +''' pvUnoDialog: the com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl of the dialog box +''' pvBasicDialog: its corresponding Basic object +''' Returns: +''' The index of the new or modified entry + +Dim vCache As New _DialogCache ' Entry to be added +Dim lIndex As Long ' UBound of _SF_.SFDialogs +Dim vCacheArray As Variant ' Alias of _SF_.SFDialogs + +Try: + vCacheArray = _SF_.SFDialogs + + If IsEmpty(vCacheArray) Then vCacheArray = Array() + lIndex = UBound(vCacheArray) + If lIndex < LBound(vCacheArray) Then + ReDim vCacheArray(0 To 0) + lIndex = 0 + ElseIf Not vCacheArray(lIndex).Terminated Then ' Often last entry can be reused + lIndex = lIndex + 1 + ReDim Preserve vCacheArray(0 To lIndex) + End If + + With vCache + .Terminated = False + Set .XUnoDialog = pvUnoDialog + Set .BasicDialog = pvBasicDialog + End With + vCacheArray(lIndex) = vCache + + _SF_.SFDialogs = vCacheArray + +Finally: + _AddDialogToCache = lIndex + Exit Function +End Function ' SFDialogs.SF_Register._AddDialogToCache + +REM ----------------------------------------------------------------------------- +Private Sub _CleanCacheEntry(ByVal plIndex As Long) +''' Clean the plIndex-th entry in the dialogs cache +''' Args: +''' plIndex: must fit within the actual boundaries of the cache, otherwise the request is ignored + +Dim vCache As New _DialogCache ' Cleaned entry + + With _SF_ + If Not IsArray(.SFDialogs) Then Exit Sub + If plIndex < LBound(.SFDialogs) Or plIndex > UBound(.SFDialogs) Then Exit Sub + + With vCache + .Terminated = True + Set .XUnoDialog = Nothing + Set .BasicDialog = Nothing + End With + .SFDialogs(plIndex) = vCache + End With + +Finally: + Exit Sub +End Sub ' SFDialogs.SF_Register._CleanCacheEntry + +REM ----------------------------------------------------------------------------- +Public Function _EventManager(Optional ByRef pvArgs As Variant) As Object +''' Returns a Dialog or DialogControl object corresponding with the Basic dialog +''' which triggered the event in argument +''' This method should be triggered only thru the invocation of CreateScriptService +''' Args: +''' pvEvent: com.sun.star.xxx +''' Returns: +''' the output of a Dialog or DialogControl service or Nothing +''' Example: +''' Sub TriggeredByEvent(ByRef poEvent As Object) +''' Dim oDlg As Object +''' Set oDlg = CreateScriptService("SFDialogs.DialogEvent", poEvent) +''' If Not IsNull(oDlg) Then +''' ' ... (a valid dialog or one of its controls has been identified) +''' End Sub + +Dim oSource As Object ' Return value +Dim oEventSource As Object ' Event UNO source +Dim vEvent As Variant ' Alias of pvArgs(0) +Dim sSourceType As String ' Implementation name of event source +Dim oDialog As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl +Dim bControl As Boolean ' True when control event + + ' Never abort while an event is processed + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally + Set oSource = Nothing + +Check: + If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() + If UBound(pvArgs) >= 0 Then vEvent = pvArgs(0) Else vEvent = Empty + If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally + If Not ScriptForge.SF_Session.HasUnoProperty(vEvent, "Source") Then GoTo Finally + +Try: + Set oEventSource = vEvent.Source + sSourceType = ScriptForge.SF_Session.UnoObjectType(oEventSource) + + Set oDialog = Nothing + Select Case True + Case sSourceType = "stardiv.Toolkit.UnoDialogControl" ' A dialog + ' Search the dialog in the cache + Set oDialog = _FindDialogInCache(oEventSource) + bControl = False + Case Left(sSourceType, 16) = "stardiv.Toolkit." ' A dialog control + Set oDialog = _FindDialogInCache(oEventSource.Context) + bControl = True + Case Else + End Select + + If Not IsNull(oDialog) Then + If bControl Then Set oSource = oDialog.Controls(oEventSource.Model.Name) Else Set oSource = oDialog + End If + +Finally: + Set _EventManager = oSource + Exit Function +End Function ' SFDialogs.SF_Register._EventManager + +REM ----------------------------------------------------------------------------- +Private Function _FindDialogInCache(ByRef poDialog As Object) As Object +''' Find the dialog based on its XUnoDialog +''' The dialog must not be terminated +''' Returns: +''' The corresponding Basic dialog part or Nothing + +Dim oBasicDialog As Object ' Return value +Dim oCache As _DialogCache ' Entry in the cache + + Set oBasicDialog = Nothing + +Try: + For Each oCache In _SF_.SFDialogs + If EqualUnoObjects(poDialog, oCache.XUnoDialog) And Not oCache.Terminated Then + Set oBasicDialog = oCache.BasicDialog + Exit For + End If + Next oCache + +Finally: + Set _FindDialogInCache = oBasicDialog + Exit Function +End Function ' SFDialogs.SF_Register._FindDialogInCache + +REM ----------------------------------------------------------------------------- +Public Function _NewDialog(Optional ByVal pvArgs As Variant) As Object +''' Create a new instance of the SF_Dialog class +''' Args: +''' Container: either "GlobalScope" or a WindowName. Default = the active window +''' see the definition of WindowName in the description of the UI service +''' Library: the name of the library hosting the dialog. Default = "Standard" +''' DialogName: The name of the dialog +''' Library and dialog names are case-sensitive +''' Context: When called from Python, the context must be provided : XSCRIPTCONTEXT +''' Returns: the instance or Nothing + +Dim oDialog As Object ' Return value +Dim vContainer As Variant ' Alias of pvArgs(0) +Dim vLibrary As Variant ' Alias of pvArgs(1) +Dim vDialogName As Variant ' Alias of pvArgs(2) +Dim oLibraries As Object ' com.sun.star.comp.sfx2.DialogLibraryContainer +Dim vContext As Variant ' com.sun.star.uno.XComponentContext +Dim oDialogProvider As Object ' com.sun.star.io.XInputStreamProvider +Dim oEnum As Object ' com.sun.star.container.XEnumeration +Dim oComp As Object ' com.sun.star.lang.XComponent +Dim oDialogControl As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl +Dim vWindow As Window ' A single component +Dim sScope As String ' "application" or "document" +Dim sURI As String ' URI of the targeted dialog +Dim oUi As Object ' "UI" service +Dim bFound As Boolean ' True if WindowName is found on the desktop +Const cstService = "SFDialogs.Dialog" +Const cstGlobal = "GlobalScope" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() + If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) + If UBound(pvArgs) >= 0 Then vContainer = pvArgs(0) Else vContainer = "" + If UBound(pvArgs) >= 1 Then vLibrary = pvArgs(1) + If IsEmpty(vLibrary) Then vLibrary = "Standard" + If UBound(pvArgs) >= 2 Then vDialogName = pvArgs(2) Else vDialogName = Empty ' Use Empty to force mandatory status + + If Not ScriptForge.SF_Utils._Validate(vContainer, "Container", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(vLibrary, "Library", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(vDialogName, "DialogName", V_STRING) Then GoTo Finally + If UBound(pvArgs) >= 3 Then vContext = pvArgs(3) Else Set vContext = Nothing + If Not ScriptForge.SF_Utils._Validate(vContext, "Context", ScriptForge.V_OBJECT) Then GoTo Finally + + Set oDialog = Nothing + +Try: + ' Determine the library container hosting the dialog + Set oUi = ScriptForge.SF_Register.CreateScriptService("UI") + Set oComp = Nothing + If VarType(vContainer) = V_STRING Then + bFound = ( UCase(vContainer) = UCase(cstGlobal) ) + End If + If Not bFound Then + Select Case VarType(vContainer) + Case V_STRING + If Len(vContainer) > 0 Then + bFound = False + Set oEnum = StarDesktop.Components().createEnumeration + Do While oEnum.hasMoreElements + Set oComp = oEnum.nextElement + vWindow = oUi._IdentifyWindow(oComp) + With vWindow + ' Does the current window match the argument ? + If (Len(.WindowFileName) > 0 And .WindowFileName = ScriptForge.SF_FileSystem._ConvertToUrl(vContainer)) _ + Or (Len(.WindowName) > 0 And .WindowName = vContainer) _ + Or (Len(.WindowTitle) > 0 And .WindowTitle = vContainer) Then + bFound = True + Exit Do + End If + End With + Loop + Else + bFound = True + Set oComp = StarDesktop.CurrentComponent + vWindow = oUi._IdentifyWindow(oComp) + End If + Case V_OBJECT ' com.sun.star.lang.XComponent + bFound = True + vWindow = oUi._IdentifyWindow(vContainer) + Set oComp = vContainer + End Select + If Not bFound Then GoTo CatchNotFound + If Len(vWindow.DocumentType) = 0 Then GoTo CatchNotFound + End If + + ' Determine the dialog provider + Select Case True + Case IsNull(vContext) And IsNull(oComp) ' Basic and GlobalScope + Set oDialogProvider = GetProcessServiceManager.createInstance("com.sun.star.awt.DialogProvider") + Case IsNull(vContext) And Not IsNull(oComp) ' Basic and Document + Set oDialogProvider = GetProcessServiceManager.createInstanceWithArguments("com.sun.star.awt.DialogProvider", Array(oComp)) + Case Not IsNull(vContext) And IsNull(oComp) ' Python and GlobalScope + Set oDialogProvider = vContext.getServiceManager().createInstanceWithContext("com.sun.star.awt.DialogProvider", vContext) + Case Not IsNull(vContext) And Not IsNull(oComp) ' Python and Document + Set oDialogProvider = vContext.getServiceManager().createInstanceWithArguments("com.sun.star.awt.DialogProvider", Array(oComp)) + End Select + + ' Create the graphical interface + sScope = Iif(IsNull(oComp), "application", "document") + sURI = "vnd.sun.star.script:" & vLibrary & "." & vDialogName & "?location=" & sScope + On Local Error GoTo CatchNotFound + Set oDialogControl = oDialogProvider.createDialog(sURI) + + ' Initialize the basic SF_Dialog instance to return to the user script + Set oDialog = New SF_Dialog + With oDialog + Set .[Me] = oDialog + If VarType(vContainer) = V_STRING Then ._Container = vContainer Else ._Container = vWindow.WindowName + ._Library = vLibrary + ._Name = vDialogName + Set ._DialogProvider = oDialogProvider + Set ._DialogControl = oDialogControl + ._Initialize() + End With + +Finally: + Set _NewDialog = oDialog + Exit Function +Catch: + GoTo Finally +CatchNotFound: + ScriptForge.SF_Exception.RaiseFatal(DIALOGNOTFOUNDERROR, "Service", cstService _ + , "Container", vContainer, "Library", vLibrary, "DialogName", vDialogName) + GoTo Finally +End Function ' SFDialogs.SF_Register._NewDialog + +REM ----------------------------------------------------------------------------- +Private Function _NewDialogFromScratch(Optional ByVal pvArgs As Variant) As Object +''' Create a new instance of the SF_Dialog class describing a dynamically defined dialog box +''' Args: +''' DialogName: a symbolic name of the dialog to create, for information only. Not checked for unicity. +''' Place: either +''' - an array with 4 elements: (X, Y, Width, Height) +''' - a com.sun.star.awt.Rectangle [X, Y, Width, Height] +''' All elements are expressed in "Map AppFont" units. +''' Context: When called from Python, the context must be provided : XSCRIPTCONTEXT +''' Returns: the instance or Nothing + +Dim oDialog As Object ' Return value +Dim vDialogName As Variant ' The name is for information only +Dim vPlace As variant ' com.sun.star.awt.rectangle or array(X, Y, Width, Height) +Dim oPlace As Object ' com.sun.star.awt.rectangle +Dim oProcessManager As Object ' com.sun.star.lang.XMultiServiceFactory +Dim bBuiltInPython As Boolean ' True when context is present +Dim oModel As Object ' com.sun.star.awt.UnoControlDialogModel +Dim oView As Object ' com.sun.star.awt.UnoControlDialog +Dim vContext As Variant ' com.sun.star.uno.XComponentContext + +Const cstDialogModel = "com.sun.star.awt.UnoControlDialogModel" +Const cstDialogView = "com.sun.star.awt.UnoControlDialog" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() + If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) + If UBound(pvArgs) >= 0 Then vDialogName = pvArgs(0) Else vDialogName = Empty + If UBound(pvArgs) >= 1 Then vPlace = pvArgs(1) Else vPlace = Empty ' Use Empty to force the mandatory status + If IsMissing(vDialogName) Or IsEmpty(vDialogName) Then vDialogName = "DYNDIALOG" + If UBound(pvArgs) >= 2 Then vContext = pvArgs(2) Else Set vContext = Nothing + + If Not ScriptForge.SF_Utils._Validate(vDialogName, "DialogName", V_STRING) Then GoTo Finally + If IsArray(vPlace) Then + If Not ScriptForge.SF_Utils._ValidateArray(vPlace, "Place", 1, ScriptForge.V_NUMERIC, True) Then GoTo Finally + Else + If Not ScriptForge.SF_Utils._Validate(vPlace, "Place", ScriptForge.V_OBJECT) Then GoTo Finally + End If + If Not ScriptForge.SF_Utils._Validate(vContext, "Context", ScriptForge.V_OBJECT) Then GoTo Finally + + Set oDialog = Nothing + +Try: + ' Determine the process service manager and create the dialog model + If IsNull(vContext) Then ' Basic + Set oprocessManager = GetProcessServiceManager() + Set oModel = oProcessManager.createInstance(cstDialogModel) + bBuiltInPython = False + Else ' Python + Set oprocessManager = vContext.getServiceManager() + Set oModel = oProcessManager.createInstanceWithContext(cstDialogModel, vContext) + bBuiltInPython = True + End If + + oModel.Name = vDialogName + + ' Set dimension and position + With oModel + If IsArray(vPlace) Then + If UBound(vPlace) = 3 Then + .PositionX = vPlace(0) + .PositionY = vPlace(1) + .Width = vPlace(2) + .Height = vPlace(3) + End If + ElseIf ScriptForge.SF_Session.UnoObjectType(vPlace) = "com.sun.star.awt.Rectangle" Then + Set oPlace = vPlace + .PositionX = oPlace.X + .PositionY = oPlace.Y + .Width = oPlace.Width + .Height = oPlace.Height + Else + 'Leave everything to zero + End If + End With + + ' Create the view and associate model and view + Set oView = oProcessManager.createInstance(cstDialogView) + oView.setModel(oModel) + + ' Initialize the basic SF_Dialog instance to return to the user script + Set oDialog = New SF_Dialog + With oDialog + Set .[Me] = oDialog + ._Container = "" + ._Library = "" + ._BuiltFromScratch = True + ._BuiltInPython = bBuiltInPython + ._Name = vDialogName + Set ._DialogProvider = Nothing + Set ._DialogControl = oView + ._Initialize() + End With + +Finally: + Set _NewDialogFromScratch = oDialog + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Register._NewDialogFromScratch + +REM ============================================== END OF SFDIALOGS.SF_REGISTER +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdialogs/__License.xba b/wizards/source/sfdialogs/__License.xba new file mode 100644 index 0000000000..e98be710ea --- /dev/null +++ b/wizards/source/sfdialogs/__License.xba @@ -0,0 +1,26 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="__License" script:language="StarBasic" script:moduleType="normal"> +''' Copyright 2019-2022 Jean-Pierre LEDURE, Rafael LIMA, Alain ROMEDENNE + +REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === The SFDialogs library is one of the associated libraries. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +''' ScriptForge is distributed in the hope that it will be useful, +''' but WITHOUT ANY WARRANTY; without even the implied warranty of +''' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +''' ScriptForge is free software; you can redistribute it and/or modify it under the terms of either (at your option): + +''' 1) The Mozilla Public License, v. 2.0. If a copy of the MPL was not +''' distributed with this file, you can obtain one at http://mozilla.org/MPL/2.0/ . + +''' 2) The GNU Lesser General Public License as published by +''' the Free Software Foundation, either version 3 of the License, or +''' (at your option) any later version. If a copy of the LGPL was not +''' distributed with this file, see http://www.gnu.org/licenses/ . + +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdialogs/dialog.xlb b/wizards/source/sfdialogs/dialog.xlb new file mode 100644 index 0000000000..be8e58d45a --- /dev/null +++ b/wizards/source/sfdialogs/dialog.xlb @@ -0,0 +1,3 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd"> +<library:library xmlns:library="http://openoffice.org/2000/library" library:name="SFDialogs" library:readonly="false" library:passwordprotected="false"/>
\ No newline at end of file diff --git a/wizards/source/sfdialogs/script.xlb b/wizards/source/sfdialogs/script.xlb new file mode 100644 index 0000000000..59263472b3 --- /dev/null +++ b/wizards/source/sfdialogs/script.xlb @@ -0,0 +1,10 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd"> +<library:library xmlns:library="http://openoffice.org/2000/library" library:name="SFDialogs" library:readonly="false" library:passwordprotected="false"> + <library:element library:name="__License"/> + <library:element library:name="SF_Register"/> + <library:element library:name="SF_Dialog"/> + <library:element library:name="SF_DialogControl"/> + <library:element library:name="SF_DialogListener"/> + <library:element library:name="SF_DialogUtils"/> +</library:library>
\ No newline at end of file |