Quelle  SF_DialogControl.xba   Sprache: unbekannt

<?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 _TabPageContainerListener As Object ' com.sun.star.awt.XTabPageContainerListener
Private _OnTabSelected  As String  ' Script to invoke when a new tab is selected
Private _TabPageContainerCounter 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

' TabPageContainer attributes
Private _TabHeaders   As Variant  ' Array of tab page headers as strings

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 CTLTABPAGECONTAINER = "TabPageContainer"
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 _TabPageContainerListener = Nothing
 _OnTabSelected = ""
 _TabPageContainerCounter = 0
 Set _TextListener = Nothing
 _OnTextChanged = ""
 _TextCounter = 0

 _ColumnWidths = Array()
 _TabHeaders = 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 OnTabSelected() As Variant
''' Get the script associated with the OnTabSelected event
 OnTabSelected = _PropertyGet("OnTabSelected")
End Property ' SFDialogs.SF_DialogControl.OnTabSelected (get)

REM -----------------------------------------------------------------------------
Property Let OnTabSelected(Optional ByVal pvTextChanged As Variant)
''' Set the updatable property OnTabSelected
 _PropertySet("OnTabSelected", pvTextChanged)
End Property ' SFDialogs.SF_DialogControl.OnTabSelected (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" _
     , "OnTabSelected" _
     , "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("OnTabSelected")
   _GetListener = "tab.XTabPageContainerListener"
  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 "UnoControlTabPageContainerModel"
   _ControlType = CTLTABPAGECONTAINER
  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("OnTabSelected"), 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("OnTabSelected")    : _PropertyGet = _OnTabSelected
     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 CTLTABPAGECONTAINER
     If oSession.HasUnoProperty(_ControlView, "ActiveTabPageID") Then vGet = _ControlView.ActiveTabPageID Else vGet = 0
    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 or _TabHeaders
Dim vValue As Variant      ' Alias of pvValue
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("OnTabSelected"), 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("OnTabSelected")
     If _ControlType <> CTLTABPAGECONTAINER 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("SFDialogs.SF_DialogListener._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("SFDialogs.SF_DialogListener._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 CTLTABPAGECONTAINER
     If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
     If oSession.HasUNOProperty(_ControlView, "ActiveTabPageID") Then
      If VarType(pvValue) = V_STRING Then
       lIndex = ScriptForge.SF_Array.IndexOf(_TabHeaders, pvValue, CaseSensitive := True)
       vValue = lIndex - LBound(_TabHeaders) + 1
      Else
       vValue = CInt(pvValue)
      End If
      If vValue >= 1 And vValue <= _ControlModel.Count Then _ControlView.ActiveTabPageID = vValue
     End If
    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>