2514 lines
No EOL
124 KiB
XML
2514 lines
No EOL
124 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_DialogControl" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
|
|
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
|
REM === The SFDialogs library is one of the associated libraries. ===
|
|
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
|
REM =======================================================================================================================
|
|
|
|
Option Compatible
|
|
Option ClassModule
|
|
|
|
Option Explicit
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''' SF_DialogControl
|
|
''' ================
|
|
''' Manage the controls belonging to a dialog defined with the Basic IDE
|
|
''' Each instance of the current class represents a single control within a dialog box
|
|
'''
|
|
''' The focus is clearly set on getting and setting the values displayed by the controls of the dialog box,
|
|
''' not on their formatting. The latter is easily accessible via the XControlModel and XControlView
|
|
''' UNO objects.
|
|
''' Essentially a single property "Value" maps many alternative UNO properties depending each on
|
|
''' the control type.
|
|
'''
|
|
''' A special attention is given to controls with types TreeControl and TableControl
|
|
''' It is easy with the API proposed in the current class to populate a tree, either
|
|
''' - branch by branch (CreateRoot and AddSubNode), or
|
|
''' - with a set of branches at once (AddSubtree)
|
|
''' Additionally populating a TreeControl can be done statically or dynamically
|
|
'''
|
|
''' With the method SetTableData(), feed a tablecontrol with a sortable and selectable
|
|
''' array of data. Columns and rows may receive a header. Column widths are adjusted manually by the user or
|
|
''' with the same method. Alignments can be set as well by script.
|
|
'''
|
|
''' Service invocation:
|
|
''' Dim myDialog As Object, myControl As Object
|
|
''' Set myDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", myLibrary, DialogName)
|
|
''' Set myControl = myDialog.Controls("myTextBox")
|
|
''' myControl.Value = "Dialog started at " & Now()
|
|
''' myDialog.Execute()
|
|
''' ' ... process the controls actual values
|
|
''' myDialog.Terminate()
|
|
'''
|
|
''' Detailed user documentation:
|
|
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_dialogcontrol.html?DbPAR=BASIC
|
|
'''
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
Private Const CONTROLTYPEERROR = "CONTROLTYPEERROR"
|
|
Private Const TEXTFIELDERROR = "TEXTFIELDERROR"
|
|
|
|
REM ============================================================= PRIVATE MEMBERS
|
|
|
|
Private [Me] As Object
|
|
Private [_Parent] As Object
|
|
Private ObjectType As String ' Must be DIALOGCONTROL
|
|
Private ServiceName As String
|
|
|
|
' Control naming
|
|
Private _Name As String
|
|
Private _IndexOfNames As Long ' Index in ElementNames array. Used to access SF_Dialog._ControlCache
|
|
Private _DialogName As String ' Parent dialog name
|
|
|
|
' Control UNO references
|
|
Private _ControlModel As Object ' com.sun.star.awt.XControlModel
|
|
Private _ControlView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
|
|
Private _TreeDataModel As Object ' com.sun.star.awt.tree.MutableTreeDataModel
|
|
Private _GridColumnModel As Object ' com.sun.star.awt.grid.XGridColumnModel
|
|
Private _GridDataModel As Object ' com.sun.star.awt.grid.XGridDataModel
|
|
|
|
' Control attributes
|
|
Private _ImplementationName As String
|
|
Private _ControlType As String ' One of the CTLxxx constants
|
|
|
|
' Control initial position and dimensions in APPFONT units
|
|
Private _Left As Long
|
|
Private _Top As Long
|
|
Private _Width As Long
|
|
Private _Height As Long
|
|
|
|
' Tree control on-select and on-expand attributes
|
|
' Tree controls may be associated with events not defined in the Basic IDE
|
|
Private _OnNodeSelected As String ' Script to invoke when a node is selected
|
|
Private _OnNodeExpanded As String ' Script to invoke when a node is expanded
|
|
Private _SelectListener As Object ' com.sun.star.view.XSelectionChangeListener
|
|
Private _ExpandListener As Object ' com.sun.star.awt.tree.XTreeExpansionListener
|
|
|
|
' Updatable events
|
|
Private _ActionListener As Object ' com.sun.star.awt.XActionListener
|
|
Private _OnActionPerformed As String ' Script to invoke when action triggered
|
|
Private _ActionCounter As Integer ' Counts the number of events set on the listener
|
|
' ---
|
|
Private _AdjustmentListener As Object ' com.sun.star.awt.XAdjustmentListener
|
|
Private _OnAdjustmentValueChanged As String ' Script to invoke when scrollbar value has changed
|
|
Private _AdjustmentCounter As Integer ' Counts the number of events set on the listener
|
|
' ---
|
|
Private _FocusListener As Object ' com.sun.star.awt.XFocusListener
|
|
Private _OnFocusGained As String ' Script to invoke when control gets focus
|
|
Private _OnFocusLost As String ' Script to invoke when control loses focus
|
|
Private _FocusCounter As Integer ' Counts the number of events set on the listener
|
|
' ---
|
|
Private _ItemListener As Object ' com.sun.star.awt.XItemListener
|
|
Private _OnItemStateChanged As String ' Script to invoke when status of item changes
|
|
Private _ItemCounter As Integer ' Counts the number of events set on the listener
|
|
' ---
|
|
Private _KeyListener As Object ' com.sun.star.awt.XKeyListener
|
|
Private _OnKeyPressed As String ' Script to invoke when Key clicked in control
|
|
Private _OnKeyReleased As String ' Script to invoke when Key released in control
|
|
Private _KeyCounter As Integer ' Counts the number of events set on the listener
|
|
' ---
|
|
Private _MouseListener As Object ' com.sun.star.awt.XMouseListener
|
|
Private _OnMouseEntered As String ' Script to invoke when mouse enters control
|
|
Private _OnMouseExited As String ' Script to invoke when mouse leaves control
|
|
Private _OnMousePressed As String ' Script to invoke when mouse clicked in control
|
|
Private _OnMouseReleased As String ' Script to invoke when mouse released in control
|
|
Private _MouseCounter As Integer ' Counts the number of events set on the listener
|
|
' ---
|
|
Private _MouseMotionListener As Object ' com.sun.star.awt.XMouseMotionListener
|
|
Private _OnMouseDragged As String ' Script to invoke when mouse is dragged from the control
|
|
Private _OnMouseMoved As String ' Script to invoke when mouse is moved across the control
|
|
Private _MouseMotionCounter As Integer ' Counts the number of events set on the listener
|
|
' ---
|
|
Private _TextListener As Object ' com.sun.star.awt.XTextListener
|
|
Private _OnTextChanged As String ' Script to invoke when textual content has changed
|
|
Private _TextCounter As Integer ' Counts the number of events set on the listener
|
|
|
|
' Table control attributes
|
|
Private _ColumnWidths As Variant ' Array of column widths
|
|
|
|
REM ============================================================ MODULE CONSTANTS
|
|
|
|
Private Const CTLBUTTON = "Button"
|
|
Private Const CTLCHECKBOX = "CheckBox"
|
|
Private Const CTLCOMBOBOX = "ComboBox"
|
|
Private Const CTLCURRENCYFIELD = "CurrencyField"
|
|
Private Const CTLDATEFIELD = "DateField"
|
|
Private Const CTLFILECONTROL = "FileControl"
|
|
Private Const CTLFIXEDLINE = "FixedLine"
|
|
Private Const CTLFIXEDTEXT = "FixedText"
|
|
Private Const CTLFORMATTEDFIELD = "FormattedField"
|
|
Private Const CTLGROUPBOX = "GroupBox"
|
|
Private Const CTLHYPERLINK = "Hyperlink"
|
|
Private Const CTLIMAGECONTROL = "ImageControl"
|
|
Private Const CTLLISTBOX = "ListBox"
|
|
Private Const CTLNUMERICFIELD = "NumericField"
|
|
Private Const CTLPATTERNFIELD = "PatternField"
|
|
Private Const CTLPROGRESSBAR = "ProgressBar"
|
|
Private Const CTLRADIOBUTTON = "RadioButton"
|
|
Private Const CTLSCROLLBAR = "ScrollBar"
|
|
Private Const CTLTABLECONTROL = "TableControl"
|
|
Private Const CTLTEXTFIELD = "TextField"
|
|
Private Const CTLTIMEFIELD = "TimeField"
|
|
Private Const CTLTREECONTROL = "TreeControl"
|
|
|
|
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Initialize()
|
|
Set [Me] = Nothing
|
|
Set [_Parent] = Nothing
|
|
ObjectType = "DIALOGCONTROL"
|
|
ServiceName = "SFDialogs.DialogControl"
|
|
_Name = ""
|
|
_IndexOfNames = -1
|
|
_DialogName = ""
|
|
Set _ControlModel = Nothing
|
|
Set _ControlView = Nothing
|
|
Set _TreeDataModel = Nothing
|
|
Set _GridColumnModel = Nothing
|
|
Set _GridDataModel = Nothing
|
|
_ImplementationName = ""
|
|
_ControlType = ""
|
|
|
|
_Left = SF_DialogUtils.MINPOSITION
|
|
_Top = SF_DialogUtils.MINPOSITION
|
|
_Width = -1
|
|
_Height = -1
|
|
|
|
_OnNodeSelected = ""
|
|
_OnNodeExpanded = ""
|
|
Set _SelectListener = Nothing
|
|
Set _ExpandListener = Nothing
|
|
|
|
Set _ActionListener = Nothing
|
|
_OnActionPerformed = ""
|
|
_ActionCounter = 0
|
|
Set _AdjustmentListener = Nothing
|
|
_OnAdjustmentValueChanged = ""
|
|
_AdjustmentCounter = 0
|
|
Set _FocusListener = Nothing
|
|
_OnFocusGained = ""
|
|
_OnFocusLost = ""
|
|
_FocusCounter = 0
|
|
Set _KeyListener = Nothing
|
|
_OnKeyPressed = ""
|
|
_OnKeyReleased = ""
|
|
_KeyCounter = 0
|
|
Set _MouseListener = Nothing
|
|
_OnMouseEntered = ""
|
|
_OnMouseExited = ""
|
|
_OnMousePressed = ""
|
|
_OnMouseReleased = ""
|
|
_MouseCounter = 0
|
|
Set _MouseMotionListener = Nothing
|
|
_OnMouseDragged = ""
|
|
_OnMouseMoved = ""
|
|
_MouseMotionCounter = 0
|
|
Set _ItemListener = Nothing
|
|
_OnItemStateChanged = ""
|
|
_ItemCounter = 0
|
|
Set _TextListener = Nothing
|
|
_OnTextChanged = ""
|
|
_TextCounter = 0
|
|
|
|
_ColumnWidths = Array()
|
|
End Sub ' SFDialogs.SF_DialogControl Constructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Terminate()
|
|
Call Class_Initialize()
|
|
End Sub ' SFDialogs.SF_DialogControl Destructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Dispose() As Variant
|
|
Call Class_Terminate()
|
|
Set Dispose = Nothing
|
|
End Function ' SFDialogs.SF_DialogControl Explicit Destructor
|
|
|
|
REM ================================================================== PROPERTIES
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Border() As Variant
|
|
''' The Border property refers to the surrounding of the control: 3D, FLAT or NONE
|
|
Border = _PropertyGet("Border", "")
|
|
End Property ' SFDialogs.SF_DialogControl.Border (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Border(Optional ByVal pvBorder As Variant)
|
|
''' Set the updatable property Border
|
|
_PropertySet("Border", pvBorder)
|
|
End Property ' SFDialogs.SF_DialogControl.Border (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Cancel() As Variant
|
|
''' The Cancel property specifies if a command button has or not the behaviour of a Cancel button.
|
|
Cancel = _PropertyGet("Cancel", False)
|
|
End Property ' SFDialogs.SF_DialogControl.Cancel (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Cancel(Optional ByVal pvCancel As Variant)
|
|
''' Set the updatable property Cancel
|
|
_PropertySet("Cancel", pvCancel)
|
|
End Property ' SFDialogs.SF_DialogControl.Cancel (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Caption() As Variant
|
|
''' The Caption property refers to the text associated with the control
|
|
Caption = _PropertyGet("Caption", "")
|
|
End Property ' SFDialogs.SF_DialogControl.Caption (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Caption(Optional ByVal pvCaption As Variant)
|
|
''' Set the updatable property Caption
|
|
_PropertySet("Caption", pvCaption)
|
|
End Property ' SFDialogs.SF_DialogControl.Caption (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ControlType() As String
|
|
''' Return the type of the actual control: "CheckBox", "TextField", "DateField", ...
|
|
ControlType = _PropertyGet("ControlType")
|
|
End Property ' SFDialogs.SF_DialogControl.ControlType
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get CurrentNode() As Variant
|
|
''' The CurrentNode property returns the currently selected node
|
|
''' It returns Empty when there is no node selected
|
|
''' When there are several selections, it returns the topmost node among the selected ones
|
|
CurrentNode = _PropertyGet("CurrentNode", "")
|
|
End Property ' SFDialogs.SF_DialogControl.CurrentNode (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let CurrentNode(Optional ByVal pvCurrentNode As Variant)
|
|
''' Set a single selection in a tree control
|
|
_PropertySet("CurrentNode", pvCurrentNode)
|
|
End Property ' SFDialogs.SF_DialogControl.CurrentNode (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Default() As Variant
|
|
''' The Default property specifies whether a command button is the default (OK) button.
|
|
Default = _PropertyGet("Default", False)
|
|
End Property ' SFDialogs.SF_DialogControl.Default (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Default(Optional ByVal pvDefault As Variant)
|
|
''' Set the updatable property Default
|
|
_PropertySet("Default", pvDefault)
|
|
End Property ' SFDialogs.SF_DialogControl.Default (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Enabled() As Variant
|
|
''' The Enabled property specifies if the control is accessible with the cursor.
|
|
Enabled = _PropertyGet("Enabled")
|
|
End Property ' SFDialogs.SF_DialogControl.Enabled (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Enabled(Optional ByVal pvEnabled As Variant)
|
|
''' Set the updatable property Enabled
|
|
_PropertySet("Enabled", pvEnabled)
|
|
End Property ' SFDialogs.SF_DialogControl.Enabled (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Format() As Variant
|
|
''' The Format property specifies the format in which to display dates and times.
|
|
Format = _PropertyGet("Format", "")
|
|
End Property ' SFDialogs.SF_DialogControl.Format (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Format(Optional ByVal pvFormat As Variant)
|
|
''' Set the updatable property Format
|
|
_PropertySet("Format", pvFormat)
|
|
End Property ' SFDialogs.SF_DialogControl.Format (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Height() As Variant
|
|
''' The Height property refers to the height of the control
|
|
Height = _PropertyGet("Height")
|
|
End Property ' SFDialogs.SF_DialogControl.Height (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Height(Optional ByVal pvHeight As Variant)
|
|
''' Set the updatable property Height
|
|
_PropertySet("Height", pvHeight)
|
|
End Property ' SFDialogs.SF_DialogControl.Height (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ListCount() As Long
|
|
''' The ListCount property specifies the number of rows in a list box or a combo box
|
|
ListCount = _PropertyGet("ListCount", 0)
|
|
End Property ' SFDialogs.SF_DialogControl.ListCount (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ListIndex() As Variant
|
|
''' The ListIndex property specifies which item is selected in a list box or combo box.
|
|
''' In case of multiple selection, the index of the first one is returned or only one is set
|
|
ListIndex = _PropertyGet("ListIndex", -1)
|
|
End Property ' SFDialogs.SF_DialogControl.ListIndex (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let ListIndex(Optional ByVal pvListIndex As Variant)
|
|
''' Set the updatable property ListIndex
|
|
_PropertySet("ListIndex", pvListIndex)
|
|
End Property ' SFDialogs.SF_DialogControl.ListIndex (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Locked() As Variant
|
|
''' The Locked property specifies if a control is read-only
|
|
Locked = _PropertyGet("Locked", False)
|
|
End Property ' SFDialogs.SF_DialogControl.Locked (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Locked(Optional ByVal pvLocked As Variant)
|
|
''' Set the updatable property Locked
|
|
_PropertySet("Locked", pvLocked)
|
|
End Property ' SFDialogs.SF_DialogControl.Locked (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get MultiSelect() As Variant
|
|
''' The MultiSelect property specifies whether a user can make multiple selections in a listbox
|
|
MultiSelect = _PropertyGet("MultiSelect", False)
|
|
End Property ' SFDialogs.SF_DialogControl.MultiSelect (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let MultiSelect(Optional ByVal pvMultiSelect As Variant)
|
|
''' Set the updatable property MultiSelect
|
|
_PropertySet("MultiSelect", pvMultiSelect)
|
|
End Property ' SFDialogs.SF_DialogControl.MultiSelect (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Name() As String
|
|
''' Return the name of the actual control
|
|
Name = _PropertyGet("Name")
|
|
End Property ' SFDialogs.SF_DialogControl.Name
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnActionPerformed() As Variant
|
|
''' Get the script associated with the OnActionPerformed event
|
|
OnActionPerformed = _PropertyGet("OnActionPerformed")
|
|
End Property ' SFDialogs.SF_DialogControl.OnActionPerformed (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnActionPerformed(Optional ByVal pvActionPerformed As Variant)
|
|
''' Set the updatable property OnActionPerformed
|
|
_PropertySet("OnActionPerformed", pvActionPerformed)
|
|
End Property ' SFDialogs.SF_DialogControl.OnActionPerformed (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnAdjustmentValueChanged() As Variant
|
|
''' Get the script associated with the OnAdjustmentValueChanged event
|
|
OnAdjustmentValueChanged = _PropertyGet("OnAdjustmentValueChanged")
|
|
End Property ' SFDialogs.SF_DialogControl.OnAdjustmentValueChanged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnAdjustmentValueChanged(Optional ByVal pvAdjustmentValueChanged As Variant)
|
|
''' Set the updatable property OnAdjustmentValueChanged
|
|
_PropertySet("OnAdjustmentValueChanged", pvAdjustmentValueChanged)
|
|
End Property ' SFDialogs.SF_DialogControl.OnAdjustmentValueChanged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnFocusGained() As Variant
|
|
''' Get the script associated with the OnFocusGained event
|
|
OnFocusGained = _PropertyGet("OnFocusGained")
|
|
End Property ' SFDialogs.SF_DialogControl.OnFocusGained (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant)
|
|
''' Set the updatable property OnFocusGained
|
|
_PropertySet("OnFocusGained", pvOnFocusGained)
|
|
End Property ' SFDialogs.SF_DialogControl.OnFocusGained (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnFocusLost() As Variant
|
|
''' Get the script associated with the OnFocusLost event
|
|
OnFocusLost = _PropertyGet("OnFocusLost")
|
|
End Property ' SFDialogs.SF_DialogControl.OnFocusLost (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant)
|
|
''' Set the updatable property OnFocusLost
|
|
_PropertySet("OnFocusLost", pvOnFocusLost)
|
|
End Property ' SFDialogs.SF_DialogControl.OnFocusLost (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnItemStateChanged() As Variant
|
|
''' Get the script associated with the OnItemStateChanged event
|
|
OnItemStateChanged = _PropertyGet("OnItemStateChanged")
|
|
End Property ' SFDialogs.SF_DialogControl.OnItemStateChanged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnItemStateChanged(Optional ByVal pvItemStateChanged As Variant)
|
|
''' Set the updatable property OnItemStateChanged
|
|
_PropertySet("OnItemStateChanged", pvItemStateChanged)
|
|
End Property ' SFDialogs.SF_DialogControl.OnItemStateChanged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnKeyPressed() As Variant
|
|
''' Get the script associated with the OnKeyPressed event
|
|
OnKeyPressed = _PropertyGet("OnKeyPressed")
|
|
End Property ' SFDialogs.SF_DialogControl.OnKeyPressed (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant)
|
|
''' Set the updatable property OnKeyPressed
|
|
_PropertySet("OnKeyPressed", pvOnKeyPressed)
|
|
End Property ' SFDialogs.SF_DialogControl.OnKeyPressed (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnKeyReleased() As Variant
|
|
''' Get the script associated with the OnKeyReleased event
|
|
OnKeyReleased = _PropertyGet("OnKeyReleased")
|
|
End Property ' SFDialogs.SF_DialogControl.OnKeyReleased (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant)
|
|
''' Set the updatable property OnKeyReleased
|
|
_PropertySet("OnKeyReleased", pvOnKeyReleased)
|
|
End Property ' SFDialogs.SF_DialogControl.OnKeyReleased (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseDragged() As Variant
|
|
''' Get the script associated with the OnMouseDragged event
|
|
OnMouseDragged = _PropertyGet("OnMouseDragged")
|
|
End Property ' SFDialogs.SF_DialogControl.OnMouseDragged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant)
|
|
''' Set the updatable property OnMouseDragged
|
|
_PropertySet("OnMouseDragged", pvOnMouseDragged)
|
|
End Property ' SFDialogs.SF_DialogControl.OnMouseDragged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseEntered() As Variant
|
|
''' Get the script associated with the OnMouseEntered event
|
|
OnMouseEntered = _PropertyGet("OnMouseEntered")
|
|
End Property ' SFDialogs.SF_DialogControl.OnMouseEntered (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant)
|
|
''' Set the updatable property OnMouseEntered
|
|
_PropertySet("OnMouseEntered", pvOnMouseEntered)
|
|
End Property ' SFDialogs.SF_DialogControl.OnMouseEntered (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseExited() As Variant
|
|
''' Get the script associated with the OnMouseExited event
|
|
OnMouseExited = _PropertyGet("OnMouseExited")
|
|
End Property ' SFDialogs.SF_DialogControl.OnMouseExited (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant)
|
|
''' Set the updatable property OnMouseExited
|
|
_PropertySet("OnMouseExited", pvOnMouseExited)
|
|
End Property ' SFDialogs.SF_DialogControl.OnMouseExited (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseMoved() As Variant
|
|
''' Get the script associated with the OnMouseMoved event
|
|
OnMouseMoved = _PropertyGet("OnMouseMoved")
|
|
End Property ' SFDialogs.SF_DialogControl.OnMouseMoved (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant)
|
|
''' Set the updatable property OnMouseMoved
|
|
_PropertySet("OnMouseMoved", pvOnMouseMoved)
|
|
End Property ' SFDialogs.SF_DialogControl.OnMouseMoved (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMousePressed() As Variant
|
|
''' Get the script associated with the OnMousePressed event
|
|
OnMousePressed = _PropertyGet("OnMousePressed")
|
|
End Property ' SFDialogs.SF_DialogControl.OnMousePressed (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant)
|
|
''' Set the updatable property OnMousePressed
|
|
_PropertySet("OnMousePressed", pvOnMousePressed)
|
|
End Property ' SFDialogs.SF_DialogControl.OnMousePressed (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseReleased() As Variant
|
|
''' Get the script associated with the OnMouseReleased event
|
|
OnMouseReleased = _PropertyGet("OnMouseReleased")
|
|
End Property ' SFDialogs.SF_DialogControl.OnMouseReleased (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant)
|
|
''' Set the updatable property OnMouseReleased
|
|
_PropertySet("OnMouseReleased", pvOnMouseReleased)
|
|
End Property ' SFDialogs.SF_DialogControl.OnMouseReleased (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnNodeExpanded() As Variant
|
|
''' Get the script associated with the OnNodeExpanded event
|
|
OnNodeExpanded = _PropertyGet("OnNodeExpanded")
|
|
End Property ' SFDialogs.SF_DialogControl.OnNodeExpanded (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnNodeExpanded(Optional ByVal pvOnNodeExpanded As Variant)
|
|
''' Set the updatable property OnNodeExpanded
|
|
_PropertySet("OnNodeExpanded", pvOnNodeExpanded)
|
|
End Property ' SFDialogs.SF_DialogControl.OnNodeExpanded (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnNodeSelected() As Variant
|
|
''' Get the script associated with the OnNodeSelected event
|
|
OnNodeSelected = _PropertyGet("OnNodeSelected")
|
|
End Property ' SFDialogs.SF_DialogControl.OnNodeSelected (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnNodeSelected(Optional ByVal pvOnNodeSelected As Variant)
|
|
''' Set the updatable property OnNodeSelected
|
|
_PropertySet("OnNodeSelected", pvOnNodeSelected)
|
|
End Property ' SFDialogs.SF_DialogControl.OnNodeSelected (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnTextChanged() As Variant
|
|
''' Get the script associated with the OnTextChanged event
|
|
OnTextChanged = _PropertyGet("OnTextChanged")
|
|
End Property ' SFDialogs.SF_DialogControl.OnTextChanged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnTextChanged(Optional ByVal pvTextChanged As Variant)
|
|
''' Set the updatable property OnTextChanged
|
|
_PropertySet("OnTextChanged", pvTextChanged)
|
|
End Property ' SFDialogs.SF_DialogControl.OnTextChanged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Page() As Variant
|
|
''' A dialog may have several pages that can be traversed by the user step by step. The Page property of the Dialog object defines which page of the dialog is active.
|
|
''' The Page property of a control defines the page of the dialog on which the control is visible.
|
|
''' For example, if a control has a page value of 1, it is only visible on page 1 of the dialog.
|
|
''' If the page value of the dialog is increased from 1 to 2, then all controls with a page value of 1 disappear and all controls with a page value of 2 become visible.
|
|
Page = _PropertyGet("Page")
|
|
End Property ' SFDialogs.SF_DialogControl.Page (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Page(Optional ByVal pvPage As Variant)
|
|
''' Set the updatable property Page
|
|
_PropertySet("Page", pvPage)
|
|
End Property ' SFDialogs.SF_DialogControl.Page (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Parent() As Object
|
|
''' Return the Parent dialog object of the actual control
|
|
Parent = _PropertyGet("Parent", Nothing)
|
|
End Property ' SFDialogs.SF_DialogControl.Parent
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Picture() As Variant
|
|
''' The Picture property specifies a bitmap or other type of graphic to be displayed on the specified control
|
|
Picture = _PropertyGet("Picture", "")
|
|
End Property ' SFDialogs.SF_DialogControl.Picture (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Picture(Optional ByVal pvPicture As Variant)
|
|
''' Set the updatable property Picture
|
|
_PropertySet("Picture", pvPicture)
|
|
End Property ' SFDialogs.SF_DialogControl.Picture (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get RootNode() As Variant
|
|
''' The RootNode property returns the last root node of a tree control
|
|
RootNode = _PropertyGet("RootNode", "")
|
|
End Property ' SFDialogs.SF_DialogControl.RootNode (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get RowSource() As Variant
|
|
''' The RowSource property specifies the data contained in a combobox or a listbox
|
|
''' as a zero-based array of string values
|
|
RowSource = _PropertyGet("RowSource", "")
|
|
End Property ' SFDialogs.SF_DialogControl.RowSource (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let RowSource(Optional ByVal pvRowSource As Variant)
|
|
''' Set the updatable property RowSource
|
|
_PropertySet("RowSource", pvRowSource)
|
|
End Property ' SFDialogs.SF_DialogControl.RowSource (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get TabIndex() As Variant
|
|
''' The TabIndex property specifies a control's place in the tab order in the dialog
|
|
''' Zero or negative means no tab set in the control
|
|
TabIndex = _PropertyGet("TabIndex", -1)
|
|
End Property ' SFDialogs.SF_DialogControl.TabIndex (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let TabIndex(Optional ByVal pvTabIndex As Variant)
|
|
''' Set the updatable property TabIndex
|
|
_PropertySet("TabIndex", pvTabIndex)
|
|
End Property ' SFDialogs.SF_DialogControl.TabIndex (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Text() As Variant
|
|
''' The Text property specifies the actual content of the control like it is displayed on the screen
|
|
Text = _PropertyGet("Text", "")
|
|
End Property ' SFDialogs.SF_DialogControl.Text (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get TipText() As Variant
|
|
''' The TipText property specifies the text that appears in a screentip when you hold the mouse pointer over a control
|
|
TipText = _PropertyGet("TipText", "")
|
|
End Property ' SFDialogs.SF_DialogControl.TipText (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let TipText(Optional ByVal pvTipText As Variant)
|
|
''' Set the updatable property TipText
|
|
_PropertySet("TipText", pvTipText)
|
|
End Property ' SFDialogs.SF_DialogControl.TipText (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get TripleState() As Variant
|
|
''' The TripleState property specifies how a check box will display Null values
|
|
''' When True, the control will cycle through states for Yes, No, and Null values. The control appears dimmed (grayed) when its Value property is set to Null.
|
|
''' When False, the control will cycle through states for Yes and No values. Null values display as if they were No values.
|
|
TripleState = _PropertyGet("TripleState", False)
|
|
End Property ' SFDialogs.SF_DialogControl.TripleState (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let TripleState(Optional ByVal pvTripleState As Variant)
|
|
''' Set the updatable property TripleState
|
|
_PropertySet("TripleState", pvTripleState)
|
|
End Property ' SFDialogs.SF_DialogControl.TripleState (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get URL() As Variant
|
|
''' The URL property refers to the URL to open when the control is clicked
|
|
URL = _PropertyGet("URL", "")
|
|
End Property ' SFDialogs.SF_DialogControl.URL (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let URL(Optional ByVal pvURL As Variant)
|
|
''' Set the updatable property URL
|
|
_PropertySet("URL", pvURL)
|
|
End Property ' SFDialogs.SF_DialogControl.URL (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Value() As Variant
|
|
''' The Value property specifies the data contained in the control
|
|
Value = _PropertyGet("Value", Empty)
|
|
End Property ' SFDialogs.SF_DialogControl.Value (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Value(Optional ByVal pvValue As Variant)
|
|
''' Set the updatable property Value
|
|
_PropertySet("Value", pvValue)
|
|
End Property ' SFDialogs.SF_DialogControl.Value (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Visible() As Variant
|
|
''' The Visible property specifies if the control is accessible with the cursor.
|
|
Visible = _PropertyGet("Visible", True)
|
|
End Property ' SFDialogs.SF_DialogControl.Visible (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Visible(Optional ByVal pvVisible As Variant)
|
|
''' Set the updatable property Visible
|
|
_PropertySet("Visible", pvVisible)
|
|
End Property ' SFDialogs.SF_DialogControl.Visible (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Width() As Variant
|
|
''' The Width property refers to the Width of the control
|
|
Width = _PropertyGet("Width")
|
|
End Property ' SFDialogs.SF_DialogControl.Width (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Width(Optional ByVal pvWidth As Variant)
|
|
''' Set the updatable property Width
|
|
_PropertySet("Width", pvWidth)
|
|
End Property ' SFDialogs.SF_DialogControl.Width (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get X() As Variant
|
|
''' The X property refers to the X coordinate of the top-left corner of the control
|
|
X = _PropertyGet("X")
|
|
End Property ' SFDialogs.SF_DialogControl.X (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let X(Optional ByVal pvX As Variant)
|
|
''' Set the updatable property X
|
|
_PropertySet("X", pvX)
|
|
End Property ' SFDialogs.SF_DialogControl.X (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Y() As Variant
|
|
''' The Y property refers to the Y coordinate of the top-left corner of the control
|
|
Y = _PropertyGet("Y")
|
|
End Property ' SFDialogs.SF_DialogControl.Y (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Y(Optional ByVal pvY As Variant)
|
|
''' Set the updatable property Y
|
|
_PropertySet("Y", pvY)
|
|
End Property ' SFDialogs.SF_DialogControl.Y (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XControlModel() As Object
|
|
''' The XControlModel property returns the model UNO object of the control
|
|
XControlModel = _PropertyGet("XControlModel", Nothing)
|
|
End Property ' SFDialogs.SF_DialogControl.XControlModel (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XControlView() As Object
|
|
''' The XControlView property returns the view UNO object of the control
|
|
XControlView = _PropertyGet("XControlView", Nothing)
|
|
End Property ' SFDialogs.SF_DialogControl.XControlView (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XGridColumnModel() As Object
|
|
''' The XGridColumnModel property returns the mutable data model UNO object of the tree control
|
|
XGridColumnModel = _PropertyGet("XGridColumnModel", Nothing)
|
|
End Property ' SFDialogs.SF_DialogControl.XGridColumnModel (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XGridDataModel() As Object
|
|
''' The XGridDataModel property returns the mutable data model UNO object of the tree control
|
|
XGridDataModel = _PropertyGet("XGridDataModel", Nothing)
|
|
End Property ' SFDialogs.SF_DialogControl.XGridDataModel (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XTreeDataModel() As Object
|
|
''' The XTreeDataModel property returns the mutable data model UNO object of the tree control
|
|
XTreeDataModel = _PropertyGet("XTreeDataModel", Nothing)
|
|
End Property ' SFDialogs.SF_DialogControl.XTreeDataModel (get)
|
|
|
|
REM ===================================================================== METHODS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function AddSubNode(Optional ByRef ParentNode As Variant _
|
|
, Optional ByVal DisplayValue As Variant _
|
|
, Optional ByRef DataValue As Variant _
|
|
) As Variant
|
|
''' Return a new node of the tree control subordinate to a parent node
|
|
''' Args:
|
|
''' ParentNode: A node UNO object, of type com.sun.star.awt.tree.XMutableTreeNode
|
|
''' DisplayValue: the text appearing in the control box
|
|
''' DataValue: any value associated with the new node. Default = Empty
|
|
''' Returns:
|
|
''' The new node UNO object: com.sun.star.awt.tree.XMutableTreeNode
|
|
''' Examples:
|
|
''' Dim myTree As Object, myNode As Object, theRoot As Object
|
|
''' Set myTree = myDialog.Controls("myTreeControl")
|
|
''' Set theRoot = myTree.CreateRoot("Tree top")
|
|
''' Set myNode = myTree.AddSubNode(theRoot, "A branch ...")
|
|
|
|
Dim oNode As Object ' Return value
|
|
Const cstThisSub = "SFDialogs.DialogControl.AddSubNode"
|
|
Const cstSubArgs = "ParentNode, DisplayValue, [DataValue=Empty]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oNode = Nothing
|
|
|
|
Check:
|
|
If IsMissing(DataValue) Then DataValue = Empty
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If _ControlType <> CTLTREECONTROL Then GoTo CatchType
|
|
If Not ScriptForge.SF_Utils._Validate(ParentNode, "ParentNode", V_OBJECT) Then GoTo Catch
|
|
If ScriptForge.SF_Session.UnoObjectType(ParentNode) <> "toolkit.MutableTreeNode" Then GoTo Catch
|
|
If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
With _TreeDataModel
|
|
Set oNode = .createNode(DisplayValue, True)
|
|
oNode.DataValue = DataValue
|
|
ParentNode.appendChild(oNode)
|
|
End With
|
|
|
|
Finally:
|
|
Set AddSubNode = oNode
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchType:
|
|
ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "AddSubNode")
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_DialogControl.AddSubNode
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function AddSubTree(Optional ByRef ParentNode As Variant _
|
|
, Optional ByRef FlatTree As Variant _
|
|
, Optional ByVal WithDataValue As Variant _
|
|
) As Boolean
|
|
''' Return True when a subtree, subordinate to a parent node, could be inserted successfully in a tree control
|
|
''' If the parent node had already child nodes before calling this method, the child nodes are erased
|
|
''' Args:
|
|
''' ParentNode: A node UNO object, of type com.sun.star.awt.tree.XMutableTreeNode
|
|
''' FlatTree: a 2D array sorted on the columns containing the DisplayValues
|
|
''' Flat tree >>>> Resulting subtree
|
|
''' A1 B1 C1 |__ A1
|
|
''' A1 B1 C2 |__ B1
|
|
''' A1 B2 C3 |__ C1
|
|
''' A2 B3 C4 |__ C2
|
|
''' A2 B3 C5 |__ B2
|
|
''' A3 B4 C6 |__ C3
|
|
''' |__ A2
|
|
''' |__ B3
|
|
''' |__ C4
|
|
''' |__ C5
|
|
''' |__ A3
|
|
''' |__ B4
|
|
''' |__ C6
|
|
''' Typically, such an array can be issued by the GetRows method applied on the SFDatabases.Database service
|
|
''' when an array item containing the text to be displayed is = "" or is empty/null,
|
|
''' no new subnode is created and the remainder of the row is skipped
|
|
''' When AddSubTree() is called from a Python script, FlatTree may be an array of arrays
|
|
''' WithDataValue:
|
|
''' When False (default), every column of FlatTree contains the text to be displayed in the tree control
|
|
''' When True, the texts to be displayed (DisplayValue) are in columns 0, 2, 4, ...
|
|
''' while the DataValues are in columns 1, 3, 5, ...
|
|
''' Returns:
|
|
''' True when successful
|
|
''' Examples:
|
|
''' Dim myTree As Object, theRoot As Object, oDb As Object, vData As Variant
|
|
''' Set myTree = myDialog.Controls("myTreeControl")
|
|
''' Set theRoot = myTree.CreateRoot("By product category")
|
|
''' Set oDb = CreateScriptService("SFDatabases.Database", "/home/.../mydatabase.odb")
|
|
''' vData = oDb.GetRows("SELECT [Category].[Name], [Category].[ID], [Product].[Name], [Product].[ID] " _
|
|
''' & "FROM [Category], [Product] WHERE [Product].[CategoryID] = [Category].[ID] " _
|
|
''' & "ORDER BY [Category].[Name], [Product].[Name]")
|
|
''' myTree.AddSubTree(theRoot, vData, WithDataValue := True)
|
|
|
|
Dim bSubTree As Boolean ' Return value
|
|
Dim oNode As Object ' com.sun.star.awt.tree.XMutableTreeNode
|
|
Dim oNewNode As Object ' com.sun.star.awt.tree.XMutableTreeNode
|
|
Dim lChildCount As Long ' Number of children nodes of a parent node
|
|
Dim iStep As Integer ' 1 when WithDataValue = False, 2 otherwise
|
|
Dim iDims As Integer ' Number of dimensions of FlatTree
|
|
Dim lMin1 As Long ' Lower bound (rows)
|
|
Dim lMin2 As Long ' Lower bounds (cols)
|
|
Dim lMax1 As Long ' Upper bound (rows)
|
|
Dim lMax2 As Long ' Upper bounds (cols)
|
|
Dim vFlatItem As Variant ' A single FlatTree item: FlatTree(i, j)
|
|
Dim vFlatItem2 As Variant ' A single FlatTree item
|
|
Dim bChange As Boolean ' When True, the item in FlatTree is different from the item above
|
|
Dim sValue As String ' Alias for display values
|
|
Dim i As Long, j As Long
|
|
Const cstThisSub = "SFDialogs.DialogControl.AddSubTree"
|
|
Const cstSubArgs = "ParentNode, FlatTree, [WithDataValue=False]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bSubTree = False
|
|
|
|
Check:
|
|
If IsMissing(WithDataValue) Or IsEmpty(WithDataValue) Then WithDataValue = False
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If _ControlType <> CTLTREECONTROL Then GoTo CatchType
|
|
If Not ScriptForge.SF_Utils._Validate(ParentNode, "ParentNode", V_OBJECT) Then GoTo Catch
|
|
If ScriptForge.SF_Session.UnoObjectType(ParentNode) <> "toolkit.MutableTreeNode" Then GoTo Catch
|
|
If Not ScriptForge.SF_Utils._ValidateArray(FlatTree, "FlatTree") Then GoTo Catch ' Dimensions checked below
|
|
If Not ScriptForge.SF_Utils._Validate(WithDataValue, "WithDataValue", V_BOOLEAN) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
With _TreeDataModel
|
|
' Clean subtree
|
|
lChildCount = ParentNode.getChildCount()
|
|
For i = 1 To lChildCount
|
|
ParentNode.removeChildByIndex(0) ' This cleans all subtrees too
|
|
Next i
|
|
|
|
' Determine bounds
|
|
iDims = ScriptForge.SF_Array.CountDims(FlatTree)
|
|
Select Case iDims
|
|
Case -1, 0 : GoTo Catch
|
|
Case 1 ' Called probably from Python
|
|
lMin1 = LBound(FlatTree, 1) : lMax1 = UBound(FlatTree, 1)
|
|
If Not IsArray(FlatTree(0)) Then GoTo Catch
|
|
If UBound(FlatTree(0)) < LBound(FlatTree(0)) Then GoTo Catch ' No columns
|
|
lMin2 = LBound(FlatTree(0)) : lMax2 = UBound(FlatTree(0))
|
|
Case 2
|
|
lMin1 = LBound(FlatTree, 1) : lMax1 = UBound(FlatTree, 1)
|
|
lMin2 = LBound(FlatTree, 2) : lMax2 = UBound(FlatTree, 2)
|
|
Case Else : GoTo Catch
|
|
End Select
|
|
|
|
' Build a new subtree
|
|
iStep = Iif(WithDataValue, 2, 1)
|
|
For i = lMin1 To lMax1
|
|
bChange = ( i = 0 )
|
|
' Restart from the parent node at each i-iteration
|
|
Set oNode = ParentNode
|
|
For j = lMin2 To lMax2 Step iStep ' Array columns
|
|
If iDims = 1 Then vFlatItem = FlatTree(i)(j) Else vFlatItem = FlatTree(i, j)
|
|
If vFlatItem = "" Or IsNull(vFlatItem) Or IsEmpty(vFlatItem) Then
|
|
Set oNode = Nothing
|
|
Exit For ' Exit j-loop
|
|
End If
|
|
If Not bChange Then
|
|
If iDims = 1 Then vFlatItem2 = FlatTree(i - 1)(j) Else vFlatItem2 = FlatTree(i - 1, j)
|
|
bChange = ( vFlatItem <> vFlatItem2 )
|
|
End If
|
|
If bChange Then ' Create new subnode at tree depth = j
|
|
If VarType(vFlatItem) = V_STRING Then sValue = vFlatItem Else sValue = ScriptForge.SF_String.Represent(vFlatItem)
|
|
Set oNewNode = .createNode(sValue, True)
|
|
If WithDataValue Then
|
|
If iDims = 1 Then vFlatItem2 = FlatTree(i)(j + 1) Else vFlatItem2 = FlatTree(i, j + 1)
|
|
oNewNode.DataValue = vFlatItem2
|
|
End If
|
|
oNode.appendChild(oNewNode)
|
|
Set oNode = oNewNode
|
|
Else
|
|
' Position next current node on last child of actual current node
|
|
lChildCount = oNode.getChildCount()
|
|
If lChildCount > 0 Then Set oNode = oNode.getChildAt(lChildCount - 1) Else Set oNode = Nothing
|
|
End If
|
|
Next j
|
|
Next i
|
|
bSubTree = True
|
|
End With
|
|
|
|
Finally:
|
|
AddSubTree = bSubTree
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchType:
|
|
ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "AddSubTree")
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_DialogControl.AddSubTree
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateRoot(Optional ByVal DisplayValue As Variant _
|
|
, Optional ByRef DataValue As Variant _
|
|
) As Variant
|
|
''' Return a new root node of the tree control. The new tree root is inserted below pre-existing root nodes
|
|
''' Args:
|
|
''' DisplayValue: the text appearing in the control box
|
|
''' DataValue: any value associated with the root node. Default = Empty
|
|
''' Returns:
|
|
''' The new root node as a UNO object of type com.sun.star.awt.tree.XMutableTreeNode
|
|
''' Examples:
|
|
''' Dim myTree As Object, myNode As Object
|
|
''' Set myTree = myDialog.Controls("myTreeControl")
|
|
''' Set myNode = myTree.CreateRoot("Tree starts here ...")
|
|
|
|
Dim oRoot As Object ' Return value
|
|
Const cstThisSub = "SFDialogs.DialogControl.CreateRoot"
|
|
Const cstSubArgs = "DisplayValue, [DataValue=Empty]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oRoot = Nothing
|
|
|
|
Check:
|
|
If IsMissing(DataValue) Then DataValue = Empty
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If _ControlType <> CTLTREECONTROL Then GoTo CatchType
|
|
If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
With _TreeDataModel
|
|
Set oRoot = .createNode(DisplayValue, True)
|
|
oRoot.DataValue = DataValue
|
|
.setRoot(oRoot)
|
|
' To be visible, a root must have contained at least 1 child. Create a fictive one and erase it.
|
|
' This behaviour does not seem related to the RootDisplayed property ??
|
|
oRoot.appendChild(.createNode("Something", False))
|
|
oRoot.removeChildByIndex(0)
|
|
End With
|
|
|
|
Finally:
|
|
Set CreateRoot = oRoot
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchType:
|
|
ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "CreateRoot")
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_DialogControl.CreateRoot
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function FindNode(Optional ByVal DisplayValue As String _
|
|
, Optional ByRef DataValue As Variant _
|
|
, Optional ByVal CaseSensitive As Boolean _
|
|
) As Object
|
|
''' Traverses the tree and find recursively, starting from the root, a node meeting some criteria
|
|
''' Either (1 match is enough):
|
|
''' having its DisplayValue like DisplayValue
|
|
''' having its DataValue = DataValue
|
|
''' Comparisons may be or not case-sensitive
|
|
''' The first matching occurrence is returned
|
|
''' Args:
|
|
''' DisplayValue: the pattern to be matched
|
|
''' DataValue: a string, a numeric value or a date or Empty (if not applicable)
|
|
''' CaseSensitive: applicable on both criteria. Default = False
|
|
''' Returns:
|
|
''' The found node of type com.sun.star.awt.tree.XMutableTreeNode or Nothing if not found
|
|
''' Examples:
|
|
''' Dim myTree As Object, myNode As Object
|
|
''' Set myTree = myDialog.Controls("myTreeControl")
|
|
''' Set myNode = myTree.FindNode("*Sophie*", CaseSensitive := True)
|
|
|
|
|
|
Dim oNode As Object ' Return value
|
|
Const cstThisSub = "SFDialogs.DialogControl.FindNode"
|
|
Const cstSubArgs = "[DisplayValue=""""], [DataValue=Empty], [CaseSensitive=False]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oNode = Nothing
|
|
|
|
Check:
|
|
If IsMissing(DisplayValue) Or IsEmpty(DisplayValue) Then DisplayValue = ""
|
|
If IsMissing(DataValue) Then DataValue = Empty
|
|
If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If _ControlType <> CTLTREECONTROL Then GoTo CatchType
|
|
If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch
|
|
If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", ScriptForge.V_BOOLEAN) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
Set oNode = _FindNode(_TreeDataModel.getRoot(), DisplayValue, DataValue, CaseSensitive)
|
|
|
|
Finally:
|
|
Set FindNode = oNode
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchType:
|
|
ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "FindNode")
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_DialogControl.FindNode
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
|
|
''' Return the actual value of the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Returns:
|
|
''' The actual value of the property
|
|
''' If the property does not exist, returns Null
|
|
''' Exceptions:
|
|
''' see the exceptions of the individual properties
|
|
''' Examples:
|
|
''' myModel.GetProperty("MyProperty")
|
|
|
|
Const cstThisSub = "SFDialogs.DialogControl.GetProperty"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
GetProperty = Null
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
GetProperty = _PropertyGet(PropertyName)
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_DialogControl.GetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Methods() As Variant
|
|
''' Return the list of public methods of the Model service as an array
|
|
|
|
Methods = Array( _
|
|
"AddSubNode" _
|
|
, "AddSubTree" _
|
|
, "CreateRoot" _
|
|
, "FindNode" _
|
|
, "SetFocus" _
|
|
, "WriteLine" _
|
|
)
|
|
|
|
End Function ' SFDialogs.SF_DialogControl.Methods
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Properties() As Variant
|
|
''' Return the list or properties of the Timer class as an array
|
|
|
|
Properties = Array( _
|
|
"Border" _
|
|
, "Cancel" _
|
|
, "Caption" _
|
|
, "ControlType" _
|
|
, "CurrentNode" _
|
|
, "Default" _
|
|
, "Enabled" _
|
|
, "Format" _
|
|
, "Height" _
|
|
, "ListCount" _
|
|
, "ListIndex" _
|
|
, "Locked" _
|
|
, "MultiSelect" _
|
|
, "Name" _
|
|
, "OnActionPerformed" _
|
|
, "OnAdjustmentValueChanged" _
|
|
, "OnFocusGained" _
|
|
, "OnFocusLost" _
|
|
, "OnItemStateChanged" _
|
|
, "OnKeyPressed" _
|
|
, "OnKeyReleased" _
|
|
, "OnMouseDragged" _
|
|
, "OnMouseEntered" _
|
|
, "OnMouseExited" _
|
|
, "OnMouseMoved" _
|
|
, "OnMousePressed" _
|
|
, "OnMouseReleased" _
|
|
, "OnNodeExpanded" _
|
|
, "OnNodeSelected" _
|
|
, "OnTextChanged" _
|
|
, "Page" _
|
|
, "Parent" _
|
|
, "Picture" _
|
|
, "RootNode" _
|
|
, "RowSource" _
|
|
, "TabIndex" _
|
|
, "Text" _
|
|
, "TipText" _
|
|
, "TripleState" _
|
|
, "URL" _
|
|
, "Value" _
|
|
, "Visible" _
|
|
, "Width" _
|
|
, "X" _
|
|
, "XControlModel" _
|
|
, "XControlView" _
|
|
, "XGridColumnModel" _
|
|
, "XGridDataModel" _
|
|
, "XTreeDataModel" _
|
|
, "Y" _
|
|
)
|
|
|
|
End Function ' SFDialogs.SF_DialogControl.Properties
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Resize(Optional ByVal Left As Variant _
|
|
, Optional ByVal Top As Variant _
|
|
, Optional ByVal Width As Variant _
|
|
, Optional ByVal Height As Variant _
|
|
) As Boolean
|
|
''' Move the top-left corner of the control to new coordinates and/or modify its dimensions
|
|
''' Without arguments, the method resets the initial dimensions and position
|
|
''' Attributes denoting the position and size of a control are expressed in "Map AppFont" units.
|
|
''' Map AppFont units are device and resolution independent.
|
|
''' One Map AppFont unit is equal to one eighth of the average character (Systemfont) height and one quarter of the average character width.
|
|
''' The dialog editor (= the Basic IDE) also uses Map AppFont units.
|
|
''' Args:
|
|
''' Left : the horizontal distance from the top-left corner. It may be negative.
|
|
''' Top : the vertical distance from the top-left corner. It may be negative.
|
|
''' Width : the horizontal width of the rectangle containing the Dialog. It must be positive.
|
|
''' Height : the vertical height of the rectangle containing the Dialog. It must be positive.
|
|
''' Missing arguments are left unchanged.
|
|
''' Returns:
|
|
''' True when successful
|
|
''' Examples:
|
|
''' myControl.Resize(100, 200, Height := 600) ' Width is not changed
|
|
|
|
Try:
|
|
Resize = SF_DialogUtils._Resize([Me], Left, Top, Width, Height)
|
|
|
|
End Function ' SFDialogss.SF_Dialog.Resize
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetFocus() As Boolean
|
|
''' Set the focus on the current Control instance
|
|
''' Probably called from after an event occurrence
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if focusing is successful
|
|
''' Example:
|
|
''' Dim oDlg As Object, oControl As Object
|
|
''' Set oDlg = CreateScriptService(,, "myControl") ' Control stored in current document's standard library
|
|
''' Set oControl = oDlg.Controls("thisControl")
|
|
''' oControl.SetFocus()
|
|
|
|
Dim bSetFocus As Boolean ' Return value
|
|
Const cstThisSub = "SFDialogs.DialogControl.SetFocus"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bSetFocus = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not [_Parent]._IsStillAlive() Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
If Not IsNull(_ControlView) Then
|
|
_ControlView.setFocus()
|
|
bSetFocus = True
|
|
End If
|
|
|
|
Finally:
|
|
SetFocus = bSetFocus
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFControls.SF_DialogControl.SetFocus
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetProperty(Optional ByVal PropertyName As Variant _
|
|
, Optional ByRef Value As Variant _
|
|
) As Boolean
|
|
''' Set a new value to the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Value: its new value
|
|
''' Exceptions
|
|
''' ARGUMENTERROR The property does not exist
|
|
|
|
Const cstThisSub = "SFDialogs.DialogControl.SetProperty"
|
|
Const cstSubArgs = "PropertyName, Value"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
SetProperty = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
SetProperty = _PropertySet(PropertyName, Value)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_DialogControl.SetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetTableData(Optional ByRef DataArray As Variant _
|
|
, Optional ByRef Widths As Variant _
|
|
, Optional ByRef Alignments As Variant _
|
|
, Optional ByVal RowHeaderWidth As Variant _
|
|
) As Boolean
|
|
''' Fill a table control with the given data. Preexisting data is erased
|
|
''' The Basic IDE allows to define if the control has a row and/or a column header
|
|
''' When it is the case, the array in argument should contain those headers resp. in the first
|
|
''' column and/or in the first row
|
|
''' A column in the control shall be sortable when the data (headers excluded) in that column
|
|
''' is homogeneously filled either with numbers or with strings
|
|
''' Columns containing strings will be left-aligned, those with numbers will be right-aligned
|
|
''' Args:
|
|
''' DataArray: the set of data to display in the table control, including optional column/row headers
|
|
''' Is a 2D array in Basic, is a tuple of tuples when called from Python
|
|
''' Widths: the column's relative widths as a 1D array, each element corresponding with one data column
|
|
''' If the array is shorter than the number of columns, the last value is kept for the next columns.
|
|
''' Example:
|
|
''' Widths := Array(1, 2)
|
|
''' means that the first column is half as wide as all the other columns
|
|
''' When the argument is absent, the columns are evenly spread over the available space in the control
|
|
''' Alignments: the column's horizontal alignment as a string with length = number of columns.
|
|
''' Possible characters are:
|
|
''' L(EFT), C(ENTER), R(IGHT) or space (default behaviour)
|
|
''' RowGeaderWidth: width of the row header column expressed in AppFont units. Default = 10.
|
|
''' The argument is ignored when the TableControl has no row header.
|
|
''' Returns:
|
|
''' True when successful
|
|
''' Examples:
|
|
''' Dim myTable As Object, bSet As Boolean, vData As Variant
|
|
''' Set myTable = myDialog.Controls("myTableControl") ' This control has only column headers
|
|
''' vData = Array("Col1", "Col2", "Col3")
|
|
''' vData = SF_Array.AppendRow(vData, Array(1, 2, 3))
|
|
''' vData = SF_Array.AppendRow(vData, Array(4, 5, 6))
|
|
''' vData = SF_Array.AppendRow(vData, Array(7, 8, 9))
|
|
''' bSet = myTable.SetTableData(vData, Alignments := " C ")
|
|
|
|
Dim bData As Boolean ' Return value
|
|
Dim iDims As Integer ' Number of dimensions of DataArray
|
|
Dim lMin1 As Long ' LBound1 of input array
|
|
Dim lMax1 As Long ' UBound1 of input array
|
|
Dim lMin2 As Long ' LBound2 of input array
|
|
Dim lMax2 As Long ' UBound2 of input array
|
|
Dim lControlWidth As Long ' Width of the table control
|
|
Dim lMinW As Long ' lBound of Widths
|
|
Dim lMaxW As Long ' UBound of vWidths
|
|
Dim lMinRow As Long ' Row index of effective data subarray
|
|
Dim lMinCol As Long ' Column index of effective data subarray
|
|
Dim vRowHeaders As Variant ' Array of row headers
|
|
Dim sRowHeader As String ' A single row header
|
|
Dim vColHeaders As Variant ' Array of column headers
|
|
Dim oColumn As Object ' com.sun.star.awt.grid.XGridColumn
|
|
Dim dWidth As Double ' A single item of Widths
|
|
Dim dRelativeWidth As Double ' Sum of Widths up to the number of columns
|
|
Dim dWidthFactor As Double ' Factor to apply to relative widths to get absolute column widths
|
|
Dim lHeaderWidth As Long ' Row header width when row header present, otherwise = 0
|
|
Dim lAverageWidth As Long ' Width to apply when columns spread evenly across table
|
|
Dim vDataRow As Variant ' A single row content in the tablecontrol
|
|
Dim vDataItem As Variant ' A single DataArray item
|
|
Dim sAlign As String ' Column's horizontal alignments (single chars: L, C, R, space)
|
|
Dim lAlign As Long ' com.sun.star.style.HorizontalAlignment.XXX
|
|
Dim i As Long, j As Long, k As Long
|
|
|
|
Const cstThisSub = "SFDialogs.DialogControl.SetTableData"
|
|
Const cstSubArgs = "DataArray, [Widths=Array(1)], [Alignments=""""], [RowHeaderWidth=10]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bData = False
|
|
|
|
Check:
|
|
If IsMissing(Widths) Or IsEmpty(Widths) Then Widths = Array()
|
|
If IsMissing(Alignments) Or IsEmpty(Alignments) Then Alignments = ""
|
|
If IsMissing(RowHeaderWidth) Or IsEmpty(RowHeaderWidth) Then RowHeaderWidth = 10
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If _ControlType <> CTLTABLECONTROL Then GoTo CatchType
|
|
If Not ScriptForge.SF_Utils._ValidateArray(DataArray, "DataArray") Then GoTo Catch ' Dimensions are checked below
|
|
If Not ScriptForge.SF_Utils._ValidateArray(Widths, "Widths", 1, ScriptForge.V_NUMERIC, True) Then GoTo Catch
|
|
If Not ScriptForge.SF_Utils._Validate(Alignments, "Alignments", V_STRING) Then GoTo Catch
|
|
If Not ScriptForge.SF_Utils._Validate(RowHeaderWidth, "RowHeaderWidth", ScriptForge.V_NUMERIC) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
' Erase any pre-existing data and columns
|
|
_GridDataModel.removeAllRows()
|
|
For i = _GridColumnModel.ColumnCount - 1 To 0 Step -1
|
|
_GridColumnModel.removeColumn(i)
|
|
Next i
|
|
|
|
' LBounds, UBounds - Basic or Python
|
|
iDims = ScriptForge.SF_Array.CountDims(DataArray)
|
|
Select Case iDims
|
|
Case -1, 0 : GoTo Catch
|
|
Case 1 ' Called probably from Python
|
|
lMin1 = LBound(DataArray, 1) : lMax1 = UBound(DataArray, 1)
|
|
If Not IsArray(DataArray(0)) Then GoTo Catch
|
|
If UBound(DataArray(0)) < LBound(DataArray(0)) Then GoTo Catch ' No columns
|
|
lMin2 = LBound(DataArray(0)) : lMax2 = UBound(DataArray(0))
|
|
Case 2
|
|
lMin1 = LBound(DataArray, 1) : lMax1 = UBound(DataArray, 1)
|
|
lMin2 = LBound(DataArray, 2) : lMax2 = UBound(DataArray, 2)
|
|
Case Else : GoTo Catch
|
|
End Select
|
|
|
|
' Extract headers from data array
|
|
lMinW = LBound(Widths) : lMaxW = UBound(Widths)
|
|
With _ControlModel
|
|
If .ShowColumnHeader Then
|
|
lMinRow = lMin1 + 1
|
|
If iDims = 1 Then
|
|
vColHeaders = DataArray(lMin1)
|
|
Else
|
|
vColHeaders = ScriptForge.SF_Array.ExtractRow(DataArray, lMin1)
|
|
End If
|
|
Else
|
|
lMinRow = lMin1
|
|
vColHeaders = Array()
|
|
End If
|
|
If .ShowRowHeader Then
|
|
lMinCol = lMin2 + 1
|
|
If iDims = 1 Then
|
|
vRowHeaders = Array()
|
|
ReDim vRowHeaders(lMin1 To lMax1)
|
|
For i = lMin1 To lMax1
|
|
vRowHeaders(i) = DataArray(i)(lMin2)
|
|
Next i
|
|
Else
|
|
vRowHeaders = ScriptForge.SF_Array.ExtractColumn(DataArray, lMin2)
|
|
End If
|
|
Else
|
|
lMinCol = lMin2
|
|
vRowHeaders = Array()
|
|
End If
|
|
End With
|
|
|
|
' Create the columns
|
|
For j = lMinCol To lMax2
|
|
Set oColumn = _GridColumnModel.createColumn()
|
|
If _ControlModel.ShowColumnHeader Then oColumn.Title = vColHeaders(j)
|
|
_GridColumnModel.addColumn(oColumn)
|
|
Next j
|
|
|
|
' Manage row headers width
|
|
If _ControlModel.ShowRowHeader Then
|
|
lHeaderWidth = RowHeaderWidth
|
|
_ControlModel.RowHeaderWidth = lHeaderWidth
|
|
Else
|
|
lHeaderWidth = 0
|
|
End If
|
|
|
|
' Size the columns. Column sizing cannot be done before all the columns are added
|
|
If lMaxW >= lMinW Then ' There must be at least 1 width given as argument
|
|
' Size the columns proportionally with their relative widths
|
|
dRelativeWidth = 0.0
|
|
i = lMinW - 1
|
|
' Compute the sum of the relative widths
|
|
For j = 0 To lMax2 - lMinCol
|
|
i = i + 1
|
|
If i >= lMinW And i <= lMaxW Then dRelativeWidth = dRelativeWidth + Widths(i) Else dRelativeWidth = dRelativeWidth + Widths(lMaxW)
|
|
Next j
|
|
|
|
' Set absolute column widths
|
|
If dRelativeWidth > 0.0 Then dWidthFactor = CDbl(_ControlModel.Width - lHeaderWidth) / dRelativeWidth Else dWidthFactor = 1.0
|
|
i = lMinW - 1
|
|
For j = 0 To lMax2 - lMinCol
|
|
i = i + 1
|
|
If i >= lMinW And i <= lMaxW Then dWidth = CDbl(Widths(i)) Else dWidth = CDbl(Widths(lMaxW))
|
|
_GridColumnModel.Columns(j).ColumnWidth = CLng(dWidthFactor * dWidth)
|
|
Next j
|
|
Else
|
|
' Size header and columns evenly
|
|
lAverageWidth = (_ControlModel.Width - lHeaderWidth) / (lMax2 - lMin2 + 1)
|
|
For j = 0 To lMax2 - lMinCol
|
|
_GridColumnModel.Columns(j).ColumnWidth = lAverageWidth
|
|
Next j
|
|
End If
|
|
|
|
' Initialize the column alignment
|
|
If Len(Alignments) >= lMax2 - lMinCol + 1 Then sAlign = Alignments Else sAlign = Alignments & Space(lMax2 - lMinCol + 1 - Len(Alignments))
|
|
|
|
' Feed the table with data and define/confirm the column alignment
|
|
vDataRow = Array()
|
|
For i = lMinRow To lMax1
|
|
ReDim vDataRow(0 To lMax2 - lMinCol)
|
|
For j = lMinCol To lMax2
|
|
If iDims = 1 Then vDataItem = DataArray(i)(j) Else vDataItem = DataArray(i, j)
|
|
If VarType(vDataItem) = V_STRING Then
|
|
ElseIf ScriptForge.SF_Utils._VarTypeExt(vDataItem) = ScriptForge.V_NUMERIC Then
|
|
Else
|
|
vDataItem = ScriptForge.SF_String.Represent(vDataItem)
|
|
End If
|
|
vDataRow(j - lMinCol) = vDataItem
|
|
' Store alignment while processing the first row of the array
|
|
If i = lMinRow Then
|
|
k = j - lMinCol + 1
|
|
If Mid(sAlign, k, 1) = " " Then Mid(sAlign, k, 1) = Iif(VarType(vDataItem) = V_STRING, "L", "R")
|
|
End If
|
|
Next j
|
|
If _ControlModel.ShowRowHeader Then sRowHeader = vRowHeaders(i) Else sRowHeader = ""
|
|
_GridDataModel.addRow(sRowHeader, vDataRow)
|
|
Next i
|
|
|
|
' Determine alignments of each column
|
|
For j = 0 To lMax2 - lMinCol
|
|
Select Case Mid(sAlign, j + 1, 1)
|
|
Case "L", " " : lAlign = com.sun.star.style.HorizontalAlignment.LEFT
|
|
Case "R" : lAlign = com.sun.star.style.HorizontalAlignment.RIGHT
|
|
Case "C" : lAlign = com.sun.star.style.HorizontalAlignment.CENTER
|
|
Case Else
|
|
End Select
|
|
_GridColumnModel.Columns(j).HorizontalAlign = lAlign
|
|
Next j
|
|
|
|
bData = True
|
|
|
|
Finally:
|
|
SetTableData = bData
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchType:
|
|
ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "SetTableData")
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_DialogControl.SetTableData
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function WriteLine(Optional ByVal Line As Variant) As Boolean
|
|
''' Add a new line to a multiline TextField control
|
|
''' Args:
|
|
''' Line: (default = "") the line to insert at the end of the text box
|
|
''' a newline character will be inserted before the line, if relevant
|
|
''' Returns:
|
|
''' True if insertion is successful
|
|
''' Exceptions
|
|
''' TEXTFIELDERROR Method applicable on multiline text fields only
|
|
''' Example:
|
|
''' Dim oDlg As Object, oControl As Object
|
|
''' Set oDlg = CreateScriptService(,, "myControl") ' Control stored in current document's standard library
|
|
''' Set oControl = oDlg.Controls("thisControl")
|
|
''' oControl.WriteLine("a new line")
|
|
|
|
Dim bWriteLine As Boolean ' Return value
|
|
Dim lTextLength As Long ' Actual length of text in box
|
|
Dim oSelection As New com.sun.star.awt.Selection
|
|
Dim sNewLine As String ' Newline character(s)
|
|
Const cstThisSub = "SFDialogs.DialogControl.WriteLine"
|
|
Const cstSubArgs = "[Line=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bWriteLine = False
|
|
|
|
Check:
|
|
If IsMissing(Line) Or IsEmpty(Line) Then Line = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not [_Parent]._IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Line, "Line", V_STRING) Then GoTo Finally
|
|
End If
|
|
If ControlType <> CTLTEXTFIELD Then GoTo CatchField
|
|
If _ControlModel.MultiLine = False Then GoTo CatchField
|
|
|
|
Try:
|
|
_ControlModel.HardLineBreaks = True
|
|
sNewLine = ScriptForge.SF_String.sfNEWLINE
|
|
With _ControlView
|
|
lTextLength = Len(.getText())
|
|
If lTextLength = 0 Then ' Text field is still empty
|
|
oSelection.Min = 0 : oSelection.Max = 0
|
|
.setText(Line)
|
|
Else ' Put cursor at the end of the actual text
|
|
oSelection.Min = lTextLength : oSelection.Max = lTextLength
|
|
.insertText(oSelection, sNewLine & Line)
|
|
End If
|
|
' Put the cursor at the end of the inserted text
|
|
oSelection.Max = oSelection.Max + Len(sNewLine) + Len(Line)
|
|
oSelection.Min = oSelection.Max
|
|
.setSelection(oSelection)
|
|
End With
|
|
bWriteLine = True
|
|
|
|
Finally:
|
|
WriteLine = bWriteLine
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchField:
|
|
ScriptForge.SF_Exception.RaiseFatal(TEXTFIELDERROR, _Name, _DialogName)
|
|
GoTo Finally
|
|
End Function ' SFControls.SF_DialogControl.WriteLine
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _FindNode(ByRef poNode As Object _
|
|
, ByVal psDisplayValue As String _
|
|
, ByRef pvDataValue As Variant _
|
|
, ByVal pbCaseSensitive As Boolean _
|
|
) As Object
|
|
''' Traverses the tree and find recursively, starting from the root, a node meeting some criteria
|
|
''' Either (1 match is enough):
|
|
''' having its DisplayValue like psDisplayValue
|
|
''' having its DataValue = pvDataValue
|
|
''' Comparisons may be or not case-sensitive
|
|
''' The first matching occurrence is returned
|
|
''' Args:
|
|
''' poNode: the current node, the root at 1st call
|
|
''' psDisplayValue: the pattern to be matched
|
|
''' pvDataValue: a string, a numeric value or a date or Empty (if not applicable)
|
|
''' pbCaseSensitive: applicable on both criteria
|
|
''' Returns:
|
|
''' The found node of type com.sun.star.awt.tree.XMutableTreeNode
|
|
|
|
Dim oChild As Object ' Child node com.sun.star.awt.tree.XMutableTreeNode
|
|
Dim oFind As Object ' Found node com.sun.star.awt.tree.XMutableTreeNode
|
|
Dim lChildCount As Long ' Number of children of a node
|
|
Dim bFound As Boolean ' True when node found
|
|
Dim i As Long
|
|
|
|
Set _FindNode = Nothing
|
|
On Local Error GoTo Finally ' Better not found than raise an error
|
|
|
|
Check:
|
|
' Does the actual node match the criteria ?
|
|
bFound = False
|
|
If Len(psDisplayValue) > 0 Then
|
|
bFound = ScriptForge.SF_String.IsLike(poNode.DisplayValue, psDisplayValue, pbCaseSensitive)
|
|
End If
|
|
If Not bFound And Not IsEmpty(poNode.DataValue) Then
|
|
If Not IsEmpty(pvdataValue) Then bFound = ( ScriptForge.SF_Array._ValCompare(poNode.DataValue, pvDataB-Value, pbCaseSensitive) = 0 )
|
|
End If
|
|
If bFound Then
|
|
Set _FindNode = poNode
|
|
Exit Function
|
|
End If
|
|
|
|
Try:
|
|
' Explore sub-branches
|
|
lChildCount = poNode.getChildCount
|
|
If lChildCount > 0 Then
|
|
For i = 0 To lChildCount - 1
|
|
Set oChild = poNode.getChildAt(i)
|
|
Set oFind = _FindNode(oChild, psDisplayValue, pvDataValue, pbCaseSensitive) ' Recursive call
|
|
If Not IsNull(oFind) Then
|
|
Set _FindNode = oFind
|
|
Exit For
|
|
End If
|
|
Next i
|
|
End If
|
|
|
|
Finally:
|
|
Exit Function
|
|
End Function ' SFDialogs.SF_DialogControl._FindNode
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _GetEventName(ByVal psProperty As String) As String
|
|
''' Return the LO internal event name derived from the SF property name
|
|
''' The SF property name is not case sensitive, while the LO name is case-sensitive
|
|
' Corrects the typo on ErrorOccur(r?)ed, if necessary
|
|
|
|
Dim vProperties As Variant ' Array of class properties
|
|
Dim sProperty As String ' Correctly cased property name
|
|
|
|
vProperties = Properties()
|
|
sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
|
|
|
|
_GetEventName = LCase(Mid(sProperty, 3, 1)) & Right(sProperty, Len(sProperty) - 3)
|
|
|
|
End Function ' SFDialogs.SF_DialogControl._GetEventName
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _GetListener(ByVal psEventName As String) As String
|
|
''' Getting/Setting macros triggered by events requires a Listener-EventName pair
|
|
''' Return the X...Listener corresponding with the event name in argument
|
|
|
|
Select Case UCase(psEventName)
|
|
Case UCase("OnActionPerformed")
|
|
_GetListener = "XActionListener"
|
|
Case UCase("OnAdjustmentValueChanged")
|
|
_GetListener = "XAdjustmentListener"
|
|
Case UCase("OnFocusGained"), UCase("OnFocusLost")
|
|
_GetListener = "XFocusListener"
|
|
Case UCase("OnItemStateChanged")
|
|
_GetListener = "XItemListener"
|
|
Case UCase("OnKeyPressed"), UCase("OnKeyReleased")
|
|
_GetListener = "XKeyListener"
|
|
Case UCase("OnMouseDragged"), UCase("OnMouseMoved")
|
|
_GetListener = "XMouseMotionListener"
|
|
Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased")
|
|
_GetListener = "XMouseListener"
|
|
Case UCase("OnTextChanged")
|
|
_GetListener = "XTextListener"
|
|
Case Else
|
|
_GetListener = ""
|
|
End Select
|
|
|
|
End Function ' SFDialogs.SF_DialogControl._GetListener
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub _Initialize()
|
|
''' Complete the object creation process:
|
|
''' - Initialization of private members
|
|
''' - Collection of specific attributes
|
|
''' - synchronization with parent dialog instance
|
|
|
|
Dim vServiceName As Variant ' Split service name
|
|
Dim sType As String ' Last component of service name
|
|
|
|
Try:
|
|
_ImplementationName = _ControlModel.getImplementationName()
|
|
|
|
' Identify the control type
|
|
vServiceName = Split(_ControlModel.getServiceName(), ".")
|
|
sType = vServiceName(UBound(vServiceName))
|
|
Select Case sType
|
|
Case "UnoControlSpinButtonModel"
|
|
_ControlType = "" ' Not supported
|
|
Case "Edit" : _ControlType = CTLTEXTFIELD
|
|
Case "UnoControlFixedHyperlinkModel"
|
|
_ControlType = CTLHYPERLINK
|
|
Case "TreeControlModel"
|
|
' Initialize the data model
|
|
_ControlType = CTLTREECONTROL
|
|
Set _ControlModel.DataModel = CreateUnoService("com.sun.star.awt.tree.MutableTreeDataModel")
|
|
Set _TreeDataModel = _ControlModel.DataModel
|
|
Case "UnoControlGridModel"
|
|
_ControlType = CTLTABLECONTROL
|
|
Set _GridColumnModel = _ControlModel.ColumnModel
|
|
Set _GridDataModel = _ControlModel.GridDataModel
|
|
Case Else : _ControlType = sType
|
|
End Select
|
|
|
|
' Store initial position and dimensions
|
|
With _ControlModel
|
|
_Left = .PositionX
|
|
_Top = .PositionY
|
|
_Width = .Width
|
|
_Height = .Height
|
|
End With
|
|
|
|
' Store the SF_DialogControl object in the parent cache
|
|
Set _Parent._ControlCache(_IndexOfNames) = [Me]
|
|
|
|
Finally:
|
|
Exit Sub
|
|
End Sub ' SFDialogs.SF_DialogControl._Initialize
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertyGet(Optional ByVal psProperty As String _
|
|
, Optional ByVal pvDefault As Variant _
|
|
) As Variant
|
|
''' Return the value of the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
''' pvDefault: the value returned when the property is not applicable on the control's type
|
|
''' Getting a non-existing property for a specific control type should
|
|
''' not generate an error to not disrupt the Basic IDE debugger
|
|
|
|
Dim vGet As Variant ' Return value
|
|
Static oSession As Object ' Alias of SF_Session
|
|
Dim vSelection As Variant ' Alias of Model.SelectedItems or Model.Selection
|
|
Dim vList As Variant ' Alias of Model.StringItemList
|
|
Dim lIndex As Long ' Index in StringItemList
|
|
Dim sItem As String ' A single item
|
|
Dim vDate As Variant ' com.sun.star.util.Date or com.sun.star.util.Time
|
|
Dim vValues As Variant ' Array of listbox values
|
|
Dim oPosSize As Object ' com.sun.star.awt.Rectangle
|
|
Dim oControlEvents As Object ' com.sun.star.container.XNameContainer
|
|
Dim sEventName As String ' Internal event name
|
|
Dim i As Long
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = ""
|
|
|
|
cstThisSub = "SFDialogs.DialogControl.get" & psProperty
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
If Not [_Parent]._IsStillAlive() Then GoTo Finally
|
|
|
|
If IsMissing(pvDefault) Then pvDefault = Null
|
|
_PropertyGet = pvDefault
|
|
|
|
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
Select Case UCase(psProperty)
|
|
Case UCase("Border")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT, CTLFORMATTEDFIELD _
|
|
, CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLPROGRESSBAR _
|
|
, CTLSCROLLBAR , CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL
|
|
If oSession.HasUNOProperty(_ControlModel, "Border") Then _PropertyGet = Array("NONE", "3D", "FLAT")(_ControlModel.Border)
|
|
Case CTLCHECKBOX, CTLRADIOBUTTON
|
|
If oSession.HasUNOProperty(_ControlModel, "VisualEffect") Then _PropertyGet = Array("NONE", "3D", "FLAT")(_ControlModel.VisualEffect)
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Cancel")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON
|
|
If oSession.HasUNOProperty(_ControlModel, "PushButtonType") Then _PropertyGet = ( _ControlModel.PushButtonType = com.sun.star.awt.PushButtonType.CANCEL )
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Caption")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDLINE, CTLFIXEDTEXT, CTLGROUPBOX, CTLHYPERLINK, CTLRADIOBUTTON
|
|
If oSession.HasUNOProperty(_ControlModel, "Label") Then _PropertyGet = _ControlModel.Label
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("ControlType")
|
|
_PropertyGet = _ControlType
|
|
Case UCase("CurrentNode")
|
|
Select Case _ControlType
|
|
Case CTLTREECONTROL
|
|
If oSession.HasUNOMethod(_ControlView, "getSelection") Then
|
|
_PropertyGet = Empty
|
|
If _ControlModel.SelectionType <> com.sun.star.view.SelectionType.NONE Then
|
|
vSelection = _ControlView.getSelection()
|
|
If IsArray(vSelection) Then
|
|
If UBound(vSelection) >= 0 Then Set _PropertyGet = vSelection(0)
|
|
Else
|
|
Set _PropertyGet = vSelection
|
|
End If
|
|
End If
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Default")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON
|
|
If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _PropertyGet = _ControlModel.DefaultButton
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Enabled")
|
|
If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _PropertyGet = _ControlModel.Enabled
|
|
Case UCase("Format")
|
|
Select Case _ControlType
|
|
Case CTLDATEFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = SF_DialogUtils._FormatsList(_ControlType)(_ControlModel.DateFormat)
|
|
Case CTLTIMEFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = SF_DialogUtils._FormatsList(_ControlType)(_ControlModel.TimeFormat)
|
|
Case CTLFORMATTEDFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") And oSession.HasUNOProperty(_ControlModel, "FormatKey") Then
|
|
_PropertyGet = _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Height")
|
|
If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units
|
|
_PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, False).Height
|
|
Else
|
|
If oSession.HasUNOProperty(_ControlModel, "Height") Then _PropertyGet = _ControlModel.Height
|
|
End If
|
|
Case UCase("ListCount")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLLISTBOX
|
|
If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1
|
|
Case CTLTABLECONTROL ' Returns zero when no table data yet
|
|
If oSession.HasUNOProperty(_GridDataModel, "RowCount") Then _PropertyGet = _GridDataModel.RowCount
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("ListIndex")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX
|
|
_PropertyGet = -1 ' Not found, multiselection
|
|
If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
|
|
_PropertyGet = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, _ControlModel.Text, CaseSensitive := True)
|
|
End If
|
|
Case CTLLISTBOX
|
|
_PropertyGet = -1 ' Not found, multiselection
|
|
If oSession.HasUNOProperty(_ControlModel, "SelectedItems") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
|
|
vSelection = _ControlModel.SelectedItems
|
|
If UBound(vSelection) >= 0 Then _PropertyGet = vSelection(0)
|
|
End If
|
|
Case CTLTABLECONTROL
|
|
_PropertyGet = -1 ' No row selected, no data, multiselection
|
|
If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _
|
|
And oSession.HasUNOProperty(_ControlView, "CurrentRow") Then
|
|
' Other selection types (multi, range) not supported
|
|
If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE Then
|
|
lIndex = _ControlView.CurrentRow
|
|
If lIndex < 0 And oSession.HasUNOProperty(_ControlView, "SelectedRows") Then
|
|
If UBound(_ControlView.SelectedRows) >= 0 Then lIndex = _ControlView.SelectedRows(0)
|
|
End If
|
|
_PropertyGet = lIndex
|
|
End If
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Locked")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLLISTBOX _
|
|
, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
|
|
If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _PropertyGet = _ControlModel.ReadOnly
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("MultiSelect")
|
|
Select Case _ControlType
|
|
Case CTLLISTBOX
|
|
If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
|
|
_PropertyGet = _ControlModel.MultiSelection
|
|
ElseIf oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then ' Not documented: gridcontrols only TBC ??
|
|
_PropertyGet = _ControlModel.MultiSelectionSimpleMode
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Name")
|
|
_PropertyGet = _Name
|
|
Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnFocusGained"), UCase("OnFocusLost") _
|
|
, UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
|
|
, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
|
|
, UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnTextChanged")
|
|
Set oControlEvents = _ControlModel.getEvents()
|
|
sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & _GetEventName(psProperty)
|
|
If oControlEvents.hasByName(sEventName) Then
|
|
_PropertyGet = oControlEvents.getByName(sEventName).ScriptCode
|
|
Else
|
|
' Check OnEvents set dynamically by code
|
|
Select Case UCase(psProperty)
|
|
Case UCase("OnActionPerformed") : _PropertyGet = _OnActionPerformed
|
|
Case UCase("OnAdjustmentValueChanged") : _PropertyGet = _OnAdjustmentValueChanged
|
|
Case UCase("OnFocusGained") : _PropertyGet = _OnFocusGained
|
|
Case UCase("OnFocusLost") : _PropertyGet = _OnFocusLost
|
|
Case UCase("OnItemStateChanged") : _PropertyGet = _OnItemStateChanged
|
|
Case UCase("OnKeyPressed") : _PropertyGet = _OnKeyPressed
|
|
Case UCase("OnKeyReleased") : _PropertyGet = _OnKeyReleased
|
|
Case UCase("OnMouseDragged") : _PropertyGet = _OnMouseDragged
|
|
Case UCase("OnMouseEntered") : _PropertyGet = _OnMouseEntered
|
|
Case UCase("OnMouseExited") : _PropertyGet = _OnMouseExited
|
|
Case UCase("OnMouseMoved") : _PropertyGet = _OnMouseMoved
|
|
Case UCase("OnMousePressed") : _PropertyGet = _OnMousePressed
|
|
Case UCase("OnMouseReleased") : _PropertyGet = _OnMouseReleased
|
|
Case UCase("OnTextChanged") : _PropertyGet = _OnTextChanged
|
|
Case Else : _PropertyGet = ""
|
|
End Select
|
|
End If
|
|
Case UCase("OnNodeExpanded")
|
|
Select Case _ControlType
|
|
Case CTLTREECONTROL
|
|
_PropertyGet = _OnNodeExpanded
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("OnNodeSelected")
|
|
Select Case _ControlType
|
|
Case CTLTREECONTROL
|
|
_PropertyGet = _OnNodeSelected
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Page")
|
|
If oSession.HasUnoProperty(_ControlModel, "Step") Then _PropertyGet = _ControlModel.Step
|
|
Case UCase("Parent")
|
|
Set _PropertyGet = [_Parent]
|
|
Case UCase("Picture")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON, CTLIMAGECONTROL
|
|
If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_ControlModel.ImageURL)
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("RootNode")
|
|
Select Case _ControlType
|
|
Case CTLTREECONTROL
|
|
_PropertyGet = _TreeDataModel.getRoot()
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("RowSource")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLLISTBOX
|
|
If oSession.HasUnoProperty(_ControlModel, "StringItemList") Then
|
|
If IsArray(_ControlModel.StringItemList) Then _PropertyGet = _ControlModel.StringItemList Else _PropertyGet = Array(_ControlModel.StringItemList)
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("TabIndex")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON, CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT _
|
|
, CTLFORMATTEDFIELD, CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD _
|
|
, CTLRADIOBUTTON, CTLSCROLLBAR, CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL
|
|
If oSession.HasUnoProperty(_ControlModel, "TabIndex") Then
|
|
If CBool(_ControlModel.TabStop) Or IsEmpty(_ControlModel.TabStop) Then _PropertyGet = _ControlModel.TabIndex Else _PropertyGet = -1
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Text")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLPATTERNFIELD, CTLTEXTFIELD
|
|
If oSession.HasUnoProperty(_ControlModel, "Text") Then _PropertyGet = _ControlModel.Text
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("TipText")
|
|
If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _PropertyGet = _ControlModel.HelpText
|
|
Case UCase("TripleState")
|
|
Select Case _ControlType
|
|
Case CTLCHECKBOX
|
|
If oSession.HasUnoProperty(_ControlModel, "TriState") Then _PropertyGet = _ControlModel.TriState
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case "URL"
|
|
Select Case _ControlType
|
|
Case CTLHYPERLINK
|
|
If oSession.HasUnoProperty(_ControlModel, "URL") Then _PropertyGet = _ControlModel.URL
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Value") ' Default values are set here by control type, not in the 2nd argument
|
|
vGet = pvDefault
|
|
Select Case _ControlType
|
|
Case CTLBUTTON 'Boolean, toggle buttons only
|
|
vGet = False
|
|
If oSession.HasUnoProperty(_ControlModel, "Toggle") Then
|
|
If oSession.HasUnoProperty(_ControlModel, "State") And _ControlMOdel.Toggle Then vGet = ( _ControlModel.State = 1 )
|
|
End If
|
|
Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know
|
|
If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = _ControlModel.State Else vGet = 2
|
|
Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String
|
|
If oSession.HasUnoProperty(_ControlModel, "Text") Then vGet = _ControlModel.Text Else vGet = ""
|
|
Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
|
|
If oSession.HasUnoProperty(_ControlModel, "Value") Then vGet = _ControlModel.Value Else vGet = 0
|
|
Case CTLDATEFIELD 'Date
|
|
vGet = CDate(1)
|
|
If oSession.HasUnoProperty(_ControlModel, "Date") Then
|
|
If VarType(_ControlModel.Date) = ScriptForge.V_OBJECT Then ' com.sun.star.util.Date
|
|
Set vDate = _ControlModel.Date
|
|
vGet = DateSerial(vDate.Year, vDate.Month, vDate.Day)
|
|
End If
|
|
End If
|
|
Case CTLFORMATTEDFIELD 'String or numeric
|
|
If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then vGet = _ControlModel.EffectiveValue Else vGet = ""
|
|
Case CTLLISTBOX 'String or array of strings depending on MultiSelection
|
|
' StringItemList is the list of the items displayed in the box
|
|
' SelectedItems is the list of the indexes in StringItemList of the selected items
|
|
' It can go beyond the limits of StringItemList
|
|
' It can contain multiple values even if the listbox is not multiselect
|
|
If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _
|
|
And oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
|
|
vSelection = _ControlModel.SelectedItems
|
|
vList = _ControlModel.StringItemList
|
|
If _ControlModel.MultiSelection Then vValues = Array()
|
|
For i = 0 To UBound(vSelection)
|
|
lIndex = vSelection(i)
|
|
If lIndex >= 0 And lIndex <= UBound(vList) Then
|
|
If Not _ControlModel.MultiSelection Then
|
|
vValues = vList(lIndex)
|
|
Exit For
|
|
End If
|
|
vValues = ScriptForge.SF_Array.Append(vValues, vList(lIndex))
|
|
End If
|
|
Next i
|
|
vGet = vValues
|
|
Else
|
|
vGet = ""
|
|
End If
|
|
Case CTLPROGRESSBAR 'Numeric
|
|
If oSession.HasUnoProperty(_ControlModel, "ProgressValue") Then vGet = _ControlModel.ProgressValue Else vGet = 0
|
|
Case CTLRADIOBUTTON 'Boolean
|
|
If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 ) Else vGet = False
|
|
Case CTLSCROLLBAR 'Numeric
|
|
If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then vGet = _ControlModel.ScrollValue Else vGet = 0
|
|
Case CTLTABLECONTROL
|
|
vGet = Array() ' Default value when no row selected, no data, multiselection
|
|
If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _
|
|
And oSession.HasUNOProperty(_ControlView, "CurrentRow") Then
|
|
' Other selection types (multi, range) not supported
|
|
If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE Then
|
|
lIndex = _ControlView.CurrentRow
|
|
If lIndex < 0 And oSession.HasUNOProperty(_ControlView, "SelectedRows") Then
|
|
If UBound(_ControlView.SelectedRows) >= 0 Then lIndex = _ControlView.SelectedRows(0)
|
|
End If
|
|
If lIndex >= 0 Then vGet = _GridDataModel.getRowData(lIndex)
|
|
End If
|
|
End If
|
|
Case CTLTIMEFIELD
|
|
vGet = CDate(0)
|
|
If oSession.HasUnoProperty(_ControlModel, "Time") Then
|
|
If VarType(_ControlModel.Time) = ScriptForge.V_OBJECT Then ' com.sun.star.Util.Time
|
|
Set vDate = _ControlModel.Time
|
|
vGet = TimeSerial(vDate.Hours, vDate.Minutes, vDate.Seconds)
|
|
End If
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
_PropertyGet = vGet
|
|
Case UCase("Visible")
|
|
If oSession.HasUnoMethod(_ControlView, "isVisible") Then _PropertyGet = CBool(_ControlView.isVisible())
|
|
Case UCase("Width")
|
|
If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units
|
|
_PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, False).Width
|
|
Else
|
|
If oSession.HasUNOProperty(_ControlModel, "Width") Then _PropertyGet = _ControlModel.Width
|
|
End If
|
|
Case UCase("X")
|
|
If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units
|
|
_PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, True).X
|
|
Else
|
|
If oSession.HasUNOProperty(_ControlModel, "PositionX") Then _PropertyGet = _ControlModel.PositionX
|
|
End If
|
|
Case UCase("Y")
|
|
If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units
|
|
_PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, True).Y
|
|
Else
|
|
If oSession.HasUNOProperty(_ControlModel, "PositionY") Then _PropertyGet = _ControlModel.PositionY
|
|
End If
|
|
Case UCase("XControlModel")
|
|
Set _PropertyGet = _ControlModel
|
|
Case UCase("XControlView")
|
|
Set _PropertyGet = _ControlView
|
|
Case UCase("XGridColumnModel")
|
|
Set _PropertyGet = _GridColumnModel
|
|
Case UCase("XGridDataModel")
|
|
Set _PropertyGet = _GridDataModel
|
|
Case UCase("XTreeDataModel")
|
|
Set _PropertyGet = _TreeDataModel
|
|
Case Else
|
|
_PropertyGet = Null
|
|
End Select
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchType:
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_DialogControl._PropertyGet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertySet(Optional ByVal psProperty As String _
|
|
, Optional ByVal pvValue As Variant _
|
|
) As Boolean
|
|
''' Set the new value of the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
''' pvValue: the new value of the given property
|
|
|
|
Dim bSet As Boolean ' Return value
|
|
Static oSession As Object ' Alias of SF_Session
|
|
Dim vSet As Variant ' Value to set in UNO model or view property
|
|
Dim vBorders As Variant ' Array of allowed Border values
|
|
Dim vFormats As Variant ' Format property: output of _FormatsList()
|
|
Dim iFormat As Integer ' Format property: index in vFormats
|
|
Dim oNumberFormats As Object ' com.sun.star.util.XNumberFormats
|
|
Dim lFormatKey As Long ' Format index for formatted fields
|
|
Dim oLocale As Object ' com.sun.star.lang.Locale
|
|
Dim vSelection As Variant ' Alias of Model.SelectedItems
|
|
Dim vList As Variant ' Alias of Model.StringItemList
|
|
Dim lIndex As Long ' Index in StringItemList
|
|
Dim sItem As String ' A single item
|
|
Dim vCtlTypes As Variant ' Array of allowed control types
|
|
Dim i As Long
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = "Value"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bSet = False
|
|
|
|
cstThisSub = "SFDialogs.DialogControl.set" & psProperty
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
If Not [_Parent]._IsStillAlive() Then GoTo Finally
|
|
|
|
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
bSet = True
|
|
Select Case UCase(psProperty)
|
|
Case UCase("Border")
|
|
Select Case _ControlType
|
|
Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT, CTLFORMATTEDFIELD _
|
|
, CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLPROGRESSBAR _
|
|
, CTLRADIOBUTTON, CTLSCROLLBAR , CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL
|
|
vBorders = Array("NONE", "3D", "FLAT")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Border", V_STRING, vBorders) Then GoTo Finally
|
|
vSet = ScriptForge.SF_Array.IndexOf(vBorders, pvValue)
|
|
If oSession.HasUNOProperty(_ControlModel, "Border") Then
|
|
_ControlModel.Border = vSet
|
|
ElseIf oSession.HasUNOProperty(_ControlModel, "VisualEffect") Then ' Checkbox case
|
|
_ControlModel.VisualEffect = vSet
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Cancel")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Cancel", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUNOProperty(_ControlModel, "PushButtonType") Then
|
|
If pvValue Then vSet = com.sun.star.awt.PushButtonType.CANCEL Else vSet = com.sun.star.awt.PushButtonType.STANDARD
|
|
_ControlModel.PushButtonType = vSet
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Caption")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDLINE, CTLFIXEDTEXT, CTLGROUPBOX, CTLHYPERLINK, CTLRADIOBUTTON
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Caption", V_STRING) Then GoTo Finally
|
|
If oSession.HasUNOProperty(_ControlModel, "Label") Then _ControlModel.Label = pvValue
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("CurrentNode")
|
|
Select Case _ControlType
|
|
Case CTLTREECONTROL
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Selection", ScriptForge.V_OBJECT) Then GoTo Finally
|
|
If oSession.UnoObjectType(pvValue) <> "toolkit.MutableTreeNode" Then GoTo CatchType
|
|
With _ControlView
|
|
.clearSelection()
|
|
If Not IsNull(pvValue) Then
|
|
.addSelection(pvValue)
|
|
' Suspending temporarily the expansion listener avoids conflicts
|
|
If Len(_OnNodeExpanded) > 0 Then _ControlView.removeTreeExpansionListener(_ExpandListener)
|
|
.makeNodeVisible(pvValue) ' Expand parent nodes and put node in the display area
|
|
If Len(_OnNodeExpanded) > 0 Then _ControlView.addTreeExpansionListener(_ExpandListener)
|
|
End If
|
|
End With
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Default")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Default", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _ControlModel.DefaultButton = pvValue
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Enabled")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Enabled", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _ControlModel.Enabled = pvValue
|
|
Case UCase("Format")
|
|
Select Case _ControlType
|
|
Case CTLDATEFIELD, CTLTIMEFIELD
|
|
vFormats = SF_DialogUtils._FormatsList(_ControlType)
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING, vFormats) Then GoTo Finally
|
|
iFormat = ScriptForge.SF_Array.IndexOf(vFormats, pvValue, CaseSensitive := False)
|
|
If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then
|
|
_ControlModel.DateFormat = iFormat
|
|
ElseIf oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then
|
|
_ControlModel.TimeFormat = iFormat
|
|
End If
|
|
Case CTLFORMATTEDFIELD ' The format may exist already or not yet
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING) Then GoTo Finally
|
|
If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") Then
|
|
If Not IsNull(_ControlModel.FormatsSupplier) Then
|
|
Set oLocale = ScriptForge.SF_Utils._GetUnoService("FormatLocale")
|
|
Set oNumberFormats = _ControlModel.FormatsSupplier.getNumberFormats()
|
|
lFormatKey = oNumberFormats.queryKey(pvValue, oLocale, True)
|
|
If lFormatKey < 0 Then ' Format not found
|
|
_ControlModel.FormatKey = oNumberFormats.addNew(pvValue, oLocale)
|
|
Else
|
|
_ControlModel.FormatKey = lFormatKey
|
|
End If
|
|
End If
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Height")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Height", ScriptForge.V_NUMERIC) Then GoTo Catch
|
|
bSet = Resize(Height := pvValue)
|
|
Case UCase("ListIndex")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "ListIndex", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX
|
|
If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
|
|
_ControlModel.Text = _ControlModel.StringItemList(CInt(pvValue))
|
|
End If
|
|
Case CTLLISTBOX
|
|
If oSession.HasUNOProperty(_ControlModel, "SelectedItems") Then _ControlModel.SelectedItems = Array(CInt(pvValue))
|
|
Case CTLTABLECONTROL
|
|
If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _
|
|
And oSession.HasUNOMethod(_ControlView, "selectRow") Then
|
|
' Other selection types (multi, range) not supported
|
|
If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE _
|
|
And pvValue >= 0 And pvValue <= _GridDataModel.RowCount - 1 Then
|
|
_ControlView.selectRow(pvValue)
|
|
End If
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Locked")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLLISTBOX _
|
|
, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Locked", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _ControlModel.ReadOnly = pvValue
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("MultiSelect")
|
|
Select Case _ControlType
|
|
Case CTLLISTBOX
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then _ControlModel.MultiSelection = pvValue
|
|
If oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then _ControlModel.MultiSelectionSimpleMode = pvValue
|
|
If oSession.HasUnoProperty(_ControlModel, "SelectedItems") Then
|
|
If Not pvValue And UBound(_ControlModel.SelectedItems) > 0 Then ' Cancel selections when MultiSelect becomes False
|
|
lIndex = _ControlModel.SelectedItems(0)
|
|
_ControlModel.SelectedItems = Array(lIndex)
|
|
End If
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnFocusGained"), UCase("OnFocusLost") _
|
|
, UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
|
|
, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
|
|
, UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnTextChanged")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Catch
|
|
' Check control type for not universal event types
|
|
Select Case UCase(psProperty)
|
|
Case UCase("OnActionPerformed"), UCase("OnItemStateChanged")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON, CTLCHECKBOX, CTLCOMBOBOX, CTLHYPERLINK, CTLLISTBOX, CTLRADIOBUTTON
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("OnAdjustmentValueChanged")
|
|
If _ControlType <> CTLSCROLLBAR Then GoTo CatchType
|
|
Case UCase("OnTextChanged")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD _
|
|
, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case Else
|
|
End Select
|
|
bSet = SF_DialogListener._SetOnProperty([Me], psProperty, pvValue)
|
|
Case UCase("OnNodeExpanded")
|
|
Select Case _ControlType
|
|
Case CTLTREECONTROL
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Finally
|
|
' If the listener was already set, then stop it
|
|
If Len(_OnNodeExpanded) > 0 Then
|
|
_ControlView.removeTreeExpansionListener(_ExpandListener)
|
|
Set _ExpandListener = Nothing
|
|
_OnNodeExpanded = ""
|
|
End If
|
|
' Setup a new fresh listener
|
|
If Len(pvValue) > 0 Then
|
|
Set _ExpandListener = CreateUnoListener("_SFEXP_", "com.sun.star.awt.tree.XTreeExpansionListener")
|
|
_ControlView.addTreeExpansionListener(_ExpandListener)
|
|
_OnNodeExpanded = pvValue
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("OnNodeSelected")
|
|
Select Case _ControlType
|
|
Case CTLTREECONTROL
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Finally
|
|
' If the listener was already set, then stop it
|
|
If Len(_OnNodeSelected) > 0 Then
|
|
_ControlView.removeSelectionChangeListener(_SelectListener)
|
|
Set _SelectListener = Nothing
|
|
_OnNodeSelected = ""
|
|
End If
|
|
' Setup a new fresh listener
|
|
If Len(pvValue) > 0 Then
|
|
Set _SelectListener = CreateUnoListener("_SFSEL_", "com.sun.star.view.XSelectionChangeListener")
|
|
_ControlView.addSelectionChangeListener(_SelectListener)
|
|
_OnNodeSelected = pvValue
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Page")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Page", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Step") Then _ControlModel.Step = CLng(pvValue)
|
|
Case UCase("Picture")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON, CTLIMAGECONTROL
|
|
If Not ScriptForge.SF_Utils._ValidateFile(pvValue, "Picture") Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _ControlModel.ImageURL = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue)
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("RowSource")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLLISTBOX
|
|
If Not IsArray(pvValue) Then
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "RowSource", V_STRING) Then GoTo Finally
|
|
pvArray = Array(pvArray)
|
|
ElseIf Not ScriptForge.SF_Utils._ValidateArray(pvValue, "RowSource", 1, V_STRING, True) Then
|
|
GoTo Finally
|
|
End If
|
|
If oSession.HasUnoProperty(_ControlModel, "StringItemList") Then _ControlModel.StringItemList = pvValue
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("TabIndex")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON, CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT _
|
|
, CTLFORMATTEDFIELD, CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD _
|
|
, CTLRADIOBUTTON, CTLSCROLLBAR, CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "TabIndex", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "TabIndex") Then
|
|
_ControlModel.TabStop = ( pvValue > 0 )
|
|
_ControlModel.TabIndex = Iif(pvValue > 0, pvValue, -1)
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("TipText")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "TipText", V_STRING) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _ControlModel.HelpText = pvValue
|
|
Case UCase("TripleState")
|
|
Select Case _ControlType
|
|
Case CTLCHECKBOX
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "TripleState", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "TriState") Then _ControlModel.TriState = pvValue
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case "URL"
|
|
Select Case _ControlType
|
|
Case CTLHYPERLINK
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "URL", V_STRING) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "URL") Then _ControlModel.URL = pvValue
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Value")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON 'Boolean, toggle buttons only
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Toggle") And oSession.HasUnoProperty(_ControlModel, "State") Then
|
|
If _ControlModel.Toggle Then _ControlModel.State = Iif(pvValue, 1, 0) Else _ControlModel.State = 2
|
|
End If
|
|
Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(ScriptForge.V_BOOLEAN, ScriptForge.V_NUMERIC), Array(0, 1, 2, True, False)) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "State") Then
|
|
If VarType(pvValue) = ScriptForge.V_BOOLEAN Then pvValue = Iif(pvValue, 1, 0)
|
|
_ControlModel.State = pvValue
|
|
End If
|
|
Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Text") Then _ControlModel.Text = pvValue
|
|
Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Value") Then _ControlModel.Value = pvValue
|
|
Case CTLDATEFIELD 'Date
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_DATE) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Date") Then
|
|
Set vSet = New com.sun.star.util.Date
|
|
vSet.Year = Year(pvValue)
|
|
vSet.Month = Month(pvValue)
|
|
vSet.Day = Day(pvValue)
|
|
_ControlModel.Date = vSet
|
|
End If
|
|
Case CTLFORMATTEDFIELD 'String or numeric
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then _ControlModel.EffectiveValue = pvValue
|
|
Case CTLLISTBOX 'String or array of strings depending on MultiSelection
|
|
' StringItemList is the list of the items displayed in the box
|
|
' SelectedItems is the list of the indexes in StringItemList of the selected items
|
|
' It can go beyond the limits of StringItemList
|
|
' It can contain multiple values even if the listbox is not multiselect
|
|
If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _
|
|
And oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
|
|
vSelection = Array()
|
|
If _ControlModel.MultiSelection Then
|
|
If Not ScriptForge.SF_Utils._ValidateArray(pvValue, "Value", 1, V_STRING, True) Then GoTo Finally
|
|
vList = _ControlModel.StringItemList
|
|
For i = LBound(pvValue) To UBound(pvValue)
|
|
sItem = pvValue(i)
|
|
lIndex = ScriptForge.SF_Array.IndexOf(vList, sItem)
|
|
If lIndex >= 0 Then vSelection = ScriptForge.SF_Array.Append(vSelection, lIndex)
|
|
Next i
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally
|
|
lIndex = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, pvValue)
|
|
If lIndex >= 0 Then vSelection = Array(lIndex)
|
|
End If
|
|
_ControlModel.SelectedItems = vSelection
|
|
End If
|
|
Case CTLPROGRESSBAR 'Numeric
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "ProgressValueMin") Then
|
|
If pvValue < _ControlModel.ProgressValueMin Then pvValue = _ControlModel.ProgressValueMin
|
|
End If
|
|
If oSession.HasUnoProperty(_ControlModel, "ProgressValueMax") Then
|
|
If pvValue > _ControlModel.ProgressValueMax Then pvValue = _ControlModel.ProgressValueMax
|
|
End If
|
|
If oSession.HasUnoProperty(_ControlModel, "ProgressValue") Then _ControlModel.ProgressValue = pvValue
|
|
Case CTLRADIOBUTTON 'Boolean
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "State") Then _ControlModel.State = Iif(pvValue, 1, 0)
|
|
Case CTLSCROLLBAR 'Numeric
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "ScrollValueMin") Then
|
|
If pvValue < _ControlModel.ScrollValueMin Then pvValue = _ControlModel.ScrollValueMin
|
|
End If
|
|
If oSession.HasUnoProperty(_ControlModel, "ScrollValueMax") Then
|
|
If pvValue > _ControlModel.ScrollValueMax Then pvValue = _ControlModel.ScrollValueMax
|
|
End If
|
|
If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then _ControlModel.ScrollValue = pvValue
|
|
Case CTLTIMEFIELD
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_DATE) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Time") Then
|
|
Set vSet = New com.sun.star.util.Time
|
|
vSet.Hours = Hour(pvValue)
|
|
vSet.Minutes = Minute(pvValue)
|
|
vSet.Seconds = Second(pvValue)
|
|
_ControlModel.Time = vSet
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Visible")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoMethod(_ControlView, "setVisible") Then
|
|
If pvValue Then
|
|
If oSession.HasUnoProperty(_ControlModel, "EnableVisible") Then _ControlModel.EnableVisible = True
|
|
End If
|
|
_ControlView.setVisible(pvValue)
|
|
End If
|
|
Case UCase("Width")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch
|
|
bSet = Resize(Width := pvValue)
|
|
Case "X"
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch
|
|
bSet = Resize(Left := pvValue)
|
|
Case "Y"
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch
|
|
bSet = Resize(Top := pvValue)
|
|
Case Else
|
|
bSet = False
|
|
End Select
|
|
Finally:
|
|
_PropertySet = bSet
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchType:
|
|
ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, psProperty)
|
|
GoTo Finally
|
|
End Function ' SFDialogs.SF_DialogControl._PropertySet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _Repr() As String
|
|
''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
|
''' Args:
|
|
''' Return:
|
|
''' "[DIALOGCONTROL]: Name, Type (dialogname)
|
|
_Repr = "[DIALOGCONTROL]: " & _Name & ", " & _ControlType & " (" & _DialogName & ")"
|
|
|
|
End Function ' SFDialogs.SF_DialogControl._Repr
|
|
|
|
REM ============================================ END OF SFDIALOGS.SF_DIALOGCONTROL
|
|
</script:module> |