forked from amazingfate/loongoffice
e7c4a88362
Set the tabulation index f a series of controls. The sequence of controls are given as an array of control names from the first to the last. Next controls will not be accessible (anymore ?) via the TAB key if >=1 of next conditions is met: - if they are not in the given list - if their type is FixedLine, GroupBox or ProgressBar - if the control is disabled Args: TabsList: an array of valid control names in the order of tabulation. Start: the tab index to be assigned to the 1st control in the list. Default = 1. Increment: the difference between 2 successive tab indexes. Default = 1. Returns: True when successful. The method is available from Basic and Python user scripts This change will require an update of the SF_Dialog help page. Change-Id: Ie854227691c4e182b49a521b1285deaa4de3d1ff Reviewed-on: https://gerrit.libreoffice.org/c/core/+/152166 Reviewed-by: Jean-Pierre Ledure <jp@ledure.be> Tested-by: Jenkins
2514 lines
124 KiB
XML
2514 lines
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> |