Current File : //usr/lib/libreoffice/share/basic/SFDocuments/SF_FormControl.xba
<?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_FormControl" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
REM === The SFDocuments 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_FormControl
''' ==============
'''
''' Manage the controls belonging to a form or subform stored in a document
''' Each instance of the current class represents a single control within a form, a subform or a tablecontrol
''' A prerequisite is that all controls within the same form, subform or tablecontrol must have
''' a unique name. This is also true for the individual radio buttons belonging to the same group.
''' A common group name must identify such a single group.
'''
''' The focus is clearly set on getting and setting the values displayed by the controls of the form,
''' 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.
'''
''' Service invocations:
''' Dim myForm As Object, myControl As Object
''' Set myForm = ... (read the comments in the SF_Form module)
''' Set myControl = myForm.Controls("myTextBox")
''' myControl.Value = "Current time = " & Now()
'''
''' REM the control is the subject of an event
''' Sub OnEvent(ByRef poEvent As Object)
''' Dim myControl As Object
''' Set myControl = CreateScriptService("SFDocuments.FormEvent", poEvent)
'''
''' Detailed user documentation:
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_formcontrol.html?DbPAR=BASIC
'''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
REM ================================================================== EXCEPTIONS
Private Const FORMCONTROLTYPEERROR = "FORMCONTROLTYPEERROR"
REM ============================================================= PRIVATE MEMBERS
Private [Me] As Object
Private [_Parent] As Object
Private ObjectType As String ' Must be FORMCONTROL
Private ServiceName As String
' Control naming and context
Private _Name As String
Private _IndexOfNames As Long ' Index in ElementNames array. Used to access SF_Form._ControlCache
Private _FormName As String ' Parent form name
Private _ParentForm As Object ' Parent form or subform instance
Private _ParentIsTable As Boolean ' True when parent is a table control
' Control UNO references
Private _ControlModel As Object ' com.sun.star.awt.XControlModel
Private _ControlView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
' Control attributes
Private _ImplementationName As String
Private _ControlType As String ' One of the CTLxxx constants
Private _ClassId As Integer ' Numerical type of control
' Cache storage for table controls
Private _ControlNames As Variant ' Array of control names
Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of XControlModel
REM ============================================================ MODULE CONSTANTS
' ClassId
Private Const CTLBUTTON = "Button" ' 2
Private Const CTLCHECKBOX = "CheckBox" ' 5
Private Const CTLCOMBOBOX = "ComboBox" ' 7
Private Const CTLCURRENCYFIELD = "CurrencyField" ' 18
Private Const CTLDATEFIELD = "DateField" ' 15
Private Const CTLFILECONTROL = "FileControl" ' 12
Private Const CTLFIXEDTEXT = "FixedText" ' 10
Private Const CTLFORMATTEDFIELD = "FormattedField" ' Idem TextField
Private Const CTLGROUPBOX = "GroupBox" ' 8
Private Const CTLHIDDENCONTROL = "HiddenControl" ' 13
Private Const CTLIMAGEBUTTON = "ImageButton" ' 4
Private Const CTLIMAGECONTROL = "ImageControl" ' 14
Private Const CTLLISTBOX = "ListBox" ' 6
Private Const CTLNAVIGATIONBAR = "NavigationBar" ' 22
Private Const CTLNUMERICFIELD = "NumericField" ' 17
Private Const CTLPATTERNFIELD = "PatternField" ' 19
Private Const CTLRADIOBUTTON = "RadioButton" ' 3
Private Const CTLSCROLLBAR = "ScrollBar" ' 20
Private Const CTLSPINBUTTON = "SpinButton" ' 21
Private Const CTLTABLECONTROL = "TableControl" ' 11
Private Const CTLTEXTFIELD = "TextField" ' 9
Private Const CTLTIMEFIELD = "TimeField" ' 16
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
REM -----------------------------------------------------------------------------
Private Sub Class_Initialize()
Set [Me] = Nothing
Set [_Parent] = Nothing
ObjectType = "FORMCONTROL"
ServiceName = "SFDocuments.FormControl"
_Name = ""
_IndexOfNames = -1
_FormName = ""
_ParentIsTable = False
Set _ParentForm = Nothing
Set _ControlModel = Nothing
Set _ControlView = Nothing
_ImplementationName = ""
_ControlType = ""
_ClassId = 0
_ControlNames = Array()
_ControlCache = Array()
End Sub ' SFDocuments.SF_FormControl Constructor
REM -----------------------------------------------------------------------------
Private Sub Class_Terminate()
Call Class_Initialize()
End Sub ' SFDocuments.SF_FormControl Destructor
REM -----------------------------------------------------------------------------
Public Function Dispose() As Variant
If Not IsNull([_Parent]) And _IndexOfNames >= 0 Then [_Parent]._ControlCache(_IndexOfNames) = Empty
Call Class_Terminate()
Set Dispose = Nothing
End Function ' SFDocuments.SF_FormControl Explicit Destructor
REM ================================================================== PROPERTIES
REM -----------------------------------------------------------------------------
Property Get Action() As Variant
''' The Action property specifies the action triggered when the button is clicked
''' Accepted values: none, submitForm, resetForm, refreshForm, moveToFirst, moveToLast,
''' moveToNext, moveToPrev, saveRecord, moveToNew, deleteRecord, undoRecord
Action = _PropertyGet("Action", "")
End Property ' SFDocuments.SF_FormControl.Action (get)
REM -----------------------------------------------------------------------------
Property Let Action(Optional ByVal pvAction As Variant)
''' Set the updatable property Action
_PropertySet("Action", pvAction)
End Property ' SFDocuments.SF_FormControl.Action (let)
REM -----------------------------------------------------------------------------
Property Get Caption() As Variant
''' The Caption property refers to the text associated with the control
Caption = _PropertyGet("Caption", "")
End Property ' SFDocuments.SF_FormControl.Caption (get)
REM -----------------------------------------------------------------------------
Property Let Caption(Optional ByVal pvCaption As Variant)
''' Set the updatable property Caption
_PropertySet("Caption", pvCaption)
End Property ' SFDocuments.SF_FormControl.Caption (let)
REM -----------------------------------------------------------------------------
Property Get ControlSource() As Variant
''' The ControlSource property specifies the rowset field mapped onto the actual control
ControlSource = _PropertyGet("ControlSource", "")
End Property ' SFDocuments.SF_FormControl.ControlSource (get)
REM -----------------------------------------------------------------------------
Property Get ControlType() As String
''' Return the type of the actual control: "CheckBox", "TextField", "DateField", ...
ControlType = _PropertyGet("ControlType")
End Property ' SFDocuments.SF_FormControl.ControlType
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 ' SFDocuments.SF_FormControl.Default (get)
REM -----------------------------------------------------------------------------
Property Let Default(Optional ByVal pvDefault As Variant)
''' Set the updatable property Default
_PropertySet("Default", pvDefault)
End Property ' SFDocuments.SF_FormControl.Default (let)
REM -----------------------------------------------------------------------------
Property Get DefaultValue() As Variant
''' The DefaultValue property specifies how the control is initialized in a new record
DefaultValue = _PropertyGet("DefaultValue", Null)
End Property ' SFDocuments.SF_FormControl.DefaultValue (get)
REM -----------------------------------------------------------------------------
Property Let DefaultValue(Optional ByVal pvDefaultValue As Variant)
''' Set the updatable property DefaultValue
_PropertySet("DefaultValue", pvDefaultValue)
End Property ' SFDocuments.SF_FormControl.DefaultValue (let)
REM -----------------------------------------------------------------------------
Property Get Enabled() As Variant
''' The Enabled property specifies if the control is accessible with the cursor.
Enabled = _PropertyGet("Enabled", False)
End Property ' SFDocuments.SF_FormControl.Enabled (get)
REM -----------------------------------------------------------------------------
Property Let Enabled(Optional ByVal pvEnabled As Variant)
''' Set the updatable property Enabled
_PropertySet("Enabled", pvEnabled)
End Property ' SFDocuments.SF_FormControl.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 ' SFDocuments.SF_FormControl.Format (get)
REM -----------------------------------------------------------------------------
Property Let Format(Optional ByVal pvFormat As Variant)
''' Set the updatable property Format
''' NB: Format is read-only for formatted field controls
_PropertySet("Format", pvFormat)
End Property ' SFDocuments.SF_FormControl.Format (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 ' SFDocuments.SF_FormControl.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 ' SFDocuments.SF_FormControl.ListIndex (get)
REM -----------------------------------------------------------------------------
Property Let ListIndex(Optional ByVal pvListIndex As Variant)
''' Set the updatable property ListIndex
_PropertySet("ListIndex", pvListIndex)
End Property ' SFDocuments.SF_FormControl.ListIndex (let)
REM -----------------------------------------------------------------------------
Property Get ListSource() As Variant
''' The ListSource property specifies the data contained in a combobox or a listbox
''' as a zero-based array of string values
ListSource = _PropertyGet("ListSource", "")
End Property ' SFDocuments.SF_FormControl.ListSource (get)
REM -----------------------------------------------------------------------------
Property Let ListSource(Optional ByVal pvListSource As Variant)
''' Set the updatable property ListSource
_PropertySet("ListSource", pvListSource)
End Property ' SFDocuments.SF_FormControl.ListSource (let)
REM -----------------------------------------------------------------------------
Property Get ListSourceType() As Variant
''' The ListSourceType property specifies the kind of data source used to fill the list data of a listbox or a combobox
ListSourceType = _PropertyGet("ListSourceType", "")
End Property ' SFDocuments.SF_FormControl.ListSourceType (get)
REM -----------------------------------------------------------------------------
Property Let ListSourceType(Optional ByVal pvListSourceType As Variant)
''' Set the updatable property ListSourceType
_PropertySet("ListSourceType", pvListSourceType)
End Property ' SFDocuments.SF_FormControl.ListSourceType (let)
REM -----------------------------------------------------------------------------
Property Get Locked() As Variant
''' The Locked property specifies if a control is read-only
Locked = _PropertyGet("Locked", False)
End Property ' SFDocuments.SF_FormControl.Locked (get)
REM -----------------------------------------------------------------------------
Property Let Locked(Optional ByVal pvLocked As Variant)
''' Set the updatable property Locked
_PropertySet("Locked", pvLocked)
End Property ' SFDocuments.SF_FormControl.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 ' SFDocuments.SF_FormControl.MultiSelect (get)
REM -----------------------------------------------------------------------------
Property Let MultiSelect(Optional ByVal pvMultiSelect As Variant)
''' Set the updatable property MultiSelect
_PropertySet("MultiSelect", pvMultiSelect)
End Property ' SFDocuments.SF_FormControl.MultiSelect (let)
REM -----------------------------------------------------------------------------
Property Get Name() As String
''' Return the name of the actual control
Name = _PropertyGet("Name")
End Property ' SFDocuments.SF_FormControl.Name
REM -----------------------------------------------------------------------------
Property Get OnActionPerformed() As Variant
''' Get the script associated with the OnActionPerformed event
OnActionPerformed = _PropertyGet("OnActionPerformed", "")
End Property ' SFDocuments.SF_FormControl.OnActionPerformed (get)
REM -----------------------------------------------------------------------------
Property Let OnActionPerformed(Optional ByVal pvOnActionPerformed As Variant)
''' Set the updatable property OnActionPerformed
_PropertySet("OnActionPerformed", pvOnActionPerformed)
End Property ' SFDocuments.SF_FormControl.OnActionPerformed (let)
REM -----------------------------------------------------------------------------
Property Get OnAdjustmentValueChanged() As Variant
''' Get the script associated with the OnAdjustmentValueChanged event
OnAdjustmentValueChanged = _PropertyGet("OnAdjustmentValueChanged", "")
End Property ' SFDocuments.SF_FormControl.OnAdjustmentValueChanged (get)
REM -----------------------------------------------------------------------------
Property Let OnAdjustmentValueChanged(Optional ByVal pvOnAdjustmentValueChanged As Variant)
''' Set the updatable property OnAdjustmentValueChanged
_PropertySet("OnAdjustmentValueChanged", pvOnAdjustmentValueChanged)
End Property ' SFDocuments.SF_FormControl.OnAdjustmentValueChanged (let)
REM -----------------------------------------------------------------------------
Property Get OnApproveAction() As Variant
''' Get the script associated with the OnApproveAction event
OnApproveAction = _PropertyGet("OnApproveAction", "")
End Property ' SFDocuments.SF_FormControl.OnApproveAction (get)
REM -----------------------------------------------------------------------------
Property Let OnApproveAction(Optional ByVal pvOnApproveAction As Variant)
''' Set the updatable property OnApproveAction
_PropertySet("OnApproveAction", pvOnApproveAction)
End Property ' SFDocuments.SF_FormControl.OnApproveAction (let)
REM -----------------------------------------------------------------------------
Property Get OnApproveReset() As Variant
''' Get the script associated with the OnApproveReset event
OnApproveReset = _PropertyGet("OnApproveReset", "")
End Property ' SFDocuments.SF_FormControl.OnApproveReset (get)
REM -----------------------------------------------------------------------------
Property Let OnApproveReset(Optional ByVal pvOnApproveReset As Variant)
''' Set the updatable property OnApproveReset
_PropertySet("OnApproveReset", pvOnApproveReset)
End Property ' SFDocuments.SF_FormControl.OnApproveReset (let)
REM -----------------------------------------------------------------------------
Property Get OnApproveUpdate() As Variant
''' Get the script associated with the OnApproveUpdate event
OnApproveUpdate = _PropertyGet("OnApproveUpdate", "")
End Property ' SFDocuments.SF_FormControl.OnApproveUpdate (get)
REM -----------------------------------------------------------------------------
Property Let OnApproveUpdate(Optional ByVal pvOnApproveUpdate As Variant)
''' Set the updatable property OnApproveUpdate
_PropertySet("OnApproveUpdate", pvOnApproveUpdate)
End Property ' SFDocuments.SF_FormControl.OnApproveUpdate (let)
REM -----------------------------------------------------------------------------
Property Get OnChanged() As Variant
''' Get the script associated with the OnChanged event
OnChanged = _PropertyGet("OnChanged", "")
End Property ' SFDocuments.SF_FormControl.OnChanged (get)
REM -----------------------------------------------------------------------------
Property Let OnChanged(Optional ByVal pvOnChanged As Variant)
''' Set the updatable property OnChanged
_PropertySet("OnChanged", pvOnChanged)
End Property ' SFDocuments.SF_FormControl.OnChanged (let)
REM -----------------------------------------------------------------------------
Property Get OnErrorOccurred() As Variant
''' Get the script associated with the OnErrorOccurred event
OnErrorOccurred = _PropertyGet("OnErrorOccurred", "")
End Property ' SFDocuments.SF_FormControl.OnErrorOccurred (get)
REM -----------------------------------------------------------------------------
Property Let OnErrorOccurred(Optional ByVal pvOnErrorOccurred As Variant)
''' Set the updatable property OnErrorOccurred
_PropertySet("OnErrorOccurred", pvOnErrorOccurred)
End Property ' SFDocuments.SF_FormControl.OnErrorOccurred (let)
REM -----------------------------------------------------------------------------
Property Get OnFocusGained() As Variant
''' Get the script associated with the OnFocusGained event
OnFocusGained = _PropertyGet("OnFocusGained", "")
End Property ' SFDocuments.SF_FormControl.OnFocusGained (get)
REM -----------------------------------------------------------------------------
Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant)
''' Set the updatable property OnFocusGained
_PropertySet("OnFocusGained", pvOnFocusGained)
End Property ' SFDocuments.SF_FormControl.OnFocusGained (let)
REM -----------------------------------------------------------------------------
Property Get OnFocusLost() As Variant
''' Get the script associated with the OnFocusLost event
OnFocusLost = _PropertyGet("OnFocusLost", "")
End Property ' SFDocuments.SF_FormControl.OnFocusLost (get)
REM -----------------------------------------------------------------------------
Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant)
''' Set the updatable property OnFocusLost
_PropertySet("OnFocusLost", pvOnFocusLost)
End Property ' SFDocuments.SF_FormControl.OnFocusLost (let)
REM -----------------------------------------------------------------------------
Property Get OnItemStateChanged() As Variant
''' Get the script associated with the OnItemStateChanged event
OnItemStateChanged = _PropertyGet("OnItemStateChanged", "")
End Property ' SFDocuments.SF_FormControl.OnItemStateChanged (get)
REM -----------------------------------------------------------------------------
Property Let OnItemStateChanged(Optional ByVal pvOnItemStateChanged As Variant)
''' Set the updatable property OnItemStateChanged
_PropertySet("OnItemStateChanged", pvOnItemStateChanged)
End Property ' SFDocuments.SF_FormControl.OnItemStateChanged (let)
REM -----------------------------------------------------------------------------
Property Get OnKeyPressed() As Variant
''' Get the script associated with the OnKeyPressed event
OnKeyPressed = _PropertyGet("OnKeyPressed", "")
End Property ' SFDocuments.SF_FormControl.OnKeyPressed (get)
REM -----------------------------------------------------------------------------
Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant)
''' Set the updatable property OnKeyPressed
_PropertySet("OnKeyPressed", pvOnKeyPressed)
End Property ' SFDocuments.SF_FormControl.OnKeyPressed (let)
REM -----------------------------------------------------------------------------
Property Get OnKeyReleased() As Variant
''' Get the script associated with the OnKeyReleased event
OnKeyReleased = _PropertyGet("OnKeyReleased", "")
End Property ' SFDocuments.SF_FormControl.OnKeyReleased (get)
REM -----------------------------------------------------------------------------
Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant)
''' Set the updatable property OnKeyReleased
_PropertySet("OnKeyReleased", pvOnKeyReleased)
End Property ' SFDocuments.SF_FormControl.OnKeyReleased (let)
REM -----------------------------------------------------------------------------
Property Get OnMouseDragged() As Variant
''' Get the script associated with the OnMouseDragged event
OnMouseDragged = _PropertyGet("OnMouseDragged", "")
End Property ' SFDocuments.SF_FormControl.OnMouseDragged (get)
REM -----------------------------------------------------------------------------
Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant)
''' Set the updatable property OnMouseDragged
_PropertySet("OnMouseDragged", pvOnMouseDragged)
End Property ' SFDocuments.SF_FormControl.OnMouseDragged (let)
REM -----------------------------------------------------------------------------
Property Get OnMouseEntered() As Variant
''' Get the script associated with the OnMouseEntered event
OnMouseEntered = _PropertyGet("OnMouseEntered", "")
End Property ' SFDocuments.SF_FormControl.OnMouseEntered (get)
REM -----------------------------------------------------------------------------
Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant)
''' Set the updatable property OnMouseEntered
_PropertySet("OnMouseEntered", pvOnMouseEntered)
End Property ' SFDocuments.SF_FormControl.OnMouseEntered (let)
REM -----------------------------------------------------------------------------
Property Get OnMouseExited() As Variant
''' Get the script associated with the OnMouseExited event
OnMouseExited = _PropertyGet("OnMouseExited", "")
End Property ' SFDocuments.SF_FormControl.OnMouseExited (get)
REM -----------------------------------------------------------------------------
Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant)
''' Set the updatable property OnMouseExited
_PropertySet("OnMouseExited", pvOnMouseExited)
End Property ' SFDocuments.SF_FormControl.OnMouseExited (let)
REM -----------------------------------------------------------------------------
Property Get OnMouseMoved() As Variant
''' Get the script associated with the OnMouseMoved event
OnMouseMoved = _PropertyGet("OnMouseMoved", "")
End Property ' SFDocuments.SF_FormControl.OnMouseMoved (get)
REM -----------------------------------------------------------------------------
Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant)
''' Set the updatable property OnMouseMoved
_PropertySet("OnMouseMoved", pvOnMouseMoved)
End Property ' SFDocuments.SF_FormControl.OnMouseMoved (let)
REM -----------------------------------------------------------------------------
Property Get OnMousePressed() As Variant
''' Get the script associated with the OnMousePressed event
OnMousePressed = _PropertyGet("OnMousePressed", "")
End Property ' SFDocuments.SF_FormControl.OnMousePressed (get)
REM -----------------------------------------------------------------------------
Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant)
''' Set the updatable property OnMousePressed
_PropertySet("OnMousePressed", pvOnMousePressed)
End Property ' SFDocuments.SF_FormControl.OnMousePressed (let)
REM -----------------------------------------------------------------------------
Property Get OnMouseReleased() As Variant
''' Get the script associated with the OnMouseReleased event
OnMouseReleased = _PropertyGet("OnMouseReleased", "")
End Property ' SFDocuments.SF_FormControl.OnMouseReleased (get)
REM -----------------------------------------------------------------------------
Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant)
''' Set the updatable property OnMouseReleased
_PropertySet("OnMouseReleased", pvOnMouseReleased)
End Property ' SFDocuments.SF_FormControl.OnMouseReleased (let)
REM -----------------------------------------------------------------------------
Property Get OnResetted() As Variant
''' Get the script associated with the OnResetted event
OnResetted = _PropertyGet("OnResetted", "")
End Property ' SFDocuments.SF_FormControl.OnResetted (get)
REM -----------------------------------------------------------------------------
Property Let OnResetted(Optional ByVal pvOnResetted As Variant)
''' Set the updatable property OnResetted
_PropertySet("OnResetted", pvOnResetted)
End Property ' SFDocuments.SF_FormControl.OnResetted (let)
REM -----------------------------------------------------------------------------
Property Get OnTextChanged() As Variant
''' Get the script associated with the OnTextChanged event
OnTextChanged = _PropertyGet("OnTextChanged", "")
End Property ' SFDocuments.SF_FormControl.OnTextChanged (get)
REM -----------------------------------------------------------------------------
Property Let OnTextChanged(Optional ByVal pvOnTextChanged As Variant)
''' Set the updatable property OnTextChanged
_PropertySet("OnTextChanged", pvOnTextChanged)
End Property ' SFDocuments.SF_FormControl.OnTextChanged (let)
REM -----------------------------------------------------------------------------
Property Get OnUpdated() As Variant
''' Get the script associated with the OnUpdated event
OnUpdated = _PropertyGet("OnUpdated", "")
End Property ' SFDocuments.SF_FormControl.OnUpdated (get)
REM -----------------------------------------------------------------------------
Property Let OnUpdated(Optional ByVal pvOnUpdated As Variant)
''' Set the updatable property OnUpdated
_PropertySet("OnUpdated", pvOnUpdated)
End Property ' SFDocuments.SF_FormControl.OnUpdated (let)
REM -----------------------------------------------------------------------------
Property Get Parent() As Object
''' Return the Parent form or [table]control object of the actual control
Parent = _PropertyGet("Parent", Nothing)
End Property ' SFDocuments.SF_FormControl.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 ' SFDocuments.SF_FormControl.Picture (get)
REM -----------------------------------------------------------------------------
Property Let Picture(Optional ByVal pvPicture As Variant)
''' Set the updatable property Picture
_PropertySet("Picture", pvPicture)
End Property ' SFDocuments.SF_FormControl.Picture (let)
REM -----------------------------------------------------------------------------
Property Get Required() As Variant
''' A control is said Required when it must not contain a null value
Required = _PropertyGet("Required", False)
End Property ' SFDocuments.SF_FormControl.Required (get)
REM -----------------------------------------------------------------------------
Property Let Required(Optional ByVal pvRequired As Variant)
''' Set the updatable property Required
_PropertySet("Required", pvRequired)
End Property ' SFDocuments.SF_FormControl.Required (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 ' SFDocuments.SF_FormControl.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 ' SFDocuments.SF_FormControl.TipText (get)
REM -----------------------------------------------------------------------------
Property Let TipText(Optional ByVal pvTipText As Variant)
''' Set the updatable property TipText
_PropertySet("TipText", pvTipText)
End Property ' SFDocuments.SF_FormControl.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 ' SFDocuments.SF_FormControl.TripleState (get)
REM -----------------------------------------------------------------------------
Property Let TripleState(Optional ByVal pvTripleState As Variant)
''' Set the updatable property TripleState
_PropertySet("TripleState", pvTripleState)
End Property ' SFDocuments.SF_FormControl.TripleState (let)
REM -----------------------------------------------------------------------------
Property Get Value() As Variant
''' The Value property specifies the data contained in the control
Value = _PropertyGet("Value", Empty)
End Property ' SFDocuments.SF_FormControl.Value (get)
REM -----------------------------------------------------------------------------
Property Let Value(Optional ByVal pvValue As Variant)
''' Set the updatable property Value
_PropertySet("Value", pvValue)
End Property ' SFDocuments.SF_FormControl.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 ' SFDocuments.SF_FormControl.Visible (get)
REM -----------------------------------------------------------------------------
Property Let Visible(Optional ByVal pvVisible As Variant)
''' Set the updatable property Visible
_PropertySet("Visible", pvVisible)
End Property ' SFDocuments.SF_FormControl.Visible (let)
REM -----------------------------------------------------------------------------
Property Get XControlModel() As Object
''' The XControlModel property returns the model UNO object of the control
XControlModel = _PropertyGet("XControlModel", Nothing)
End Property ' SFDocuments.SF_FormControl.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 ' SFDocuments.SF_FormControl.XControlView (get)
REM ===================================================================== METHODS
REM -----------------------------------------------------------------------------
Public Function Controls(Optional ByVal ControlName As Variant) As Variant
''' Return either
''' - the list of the controls contained in the actual table control
''' - a Form Control object based on its name
''' Args:
''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
''' Returns:
''' A zero-base array of strings if ControlName is absent
''' An instance of the SF_FormControl class if ControlName exists
''' Exceptions:
''' ControlName is invalid
''' Example:
''' Dim myGrid As Object, myList As Variant, myControl As Object
''' Set myGrid = myForm.Controls("myTableControl")
''' myList = myGrid.Controls()
''' Set myControl = myGrid.Controls("myCheckBox")
Dim oControl As Object ' The new control class instance
Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache
Dim vControl As Variant ' Alias of _ControlCache entry
Dim oView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
Dim i As Long
Const cstThisSub = "SFDocuments.FormControl.Controls"
Const cstSubArgs = "[ControlName]"
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Set Controls = Nothing
Check:
If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If _ControlType <> CTLTABLECONTROL Then GoTo Catch
If Not [_Parent]._IsStillAlive() Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
End If
Try:
' Collect all control names if not yet done
If UBound(_ControlNames) < 0 Then
_ControlNames = _ControlModel.getElementNames()
If UBound(_ControlNames) >= 0 Then
ReDim _ControlCache(0 To UBound(_ControlNames))
End If
End If
' Return the list of controls or a FormControl instance
If Len(ControlName) = 0 Then
Controls = _ControlNames
Else
If Not _ControlModel.hasByName(ControlName) Then GoTo CatchNotFound
lIndexOfNames = ScriptForge.SF_Array.IndexOf(_ControlNames, ControlName, CaseSensitive := True)
' Reuse cache when relevant
vControl = _ControlCache(lIndexOfNames)
If IsEmpty(vControl) Then
' Not in cache => Create the new form control class instance
Set oControl = New SF_FormControl
With oControl
._Name = ControlName
Set .[Me] = oControl
Set .[_Parent] = [Me]
._ParentIsTable = True
._IndexOfNames = lIndexOfNames
._FormName = _FormName
Set ._ParentForm = _ParentForm
' Get model and view of the current control
Set ._ControlModel = _ControlModel.getByName(ControlName)
._ImplementationName = ._ControlModel.ColumnServiceName ' getImplementationName aborts for subcontrols !?
' Bypass to find the control view: cannot be done from the top component
If Not IsNull(_ControlView) Then ' Anticipate absence of ControlView in table controls when edit mode
For i = 0 to _ControlView.getCount() - 1
Set oView = _ControlView.GetByIndex(i)
If Not IsNull(oView) Then
If oView.getModel.Name = ControlName Then
Set ._ControlView = oView
Exit For
End If
End If
Next i
End If
._Initialize()
End With
Else
Set oControl = vControl
End If
Set Controls = oControl
End If
Finally:
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchNotFound:
ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _ControlModel.getElementNames())
GoTo Finally
End Function ' SFDocuments.SF_FormControl.Controls
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:
''' myControl.GetProperty("MyProperty")
Dim vDefault As Variant ' Default value when property not applicable on control type
Const cstThisSub = "SFDocuments.FormControl.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:
' FormControl properties are far from applicable to all control types
' Getting a property must never abort to not interfere with the Basic IDE watch function
' Hence a default value must be provided
Select Case UCase(PropertyName)
Case UCase("Default") : vDefault = False
Case UCase("DefaultValue") : vDefault = Null
Case UCase("Enabled") : vDefault = False
Case UCase("ListCount") : vDefault = 0
Case UCase("ListIndex") : vDefault = -1
Case UCase("Locked") : vDefault = False
Case UCase("MultiSelect") : vDefault = False
Case UCase("Parent") : vDefault = Nothing
Case UCase("Required") : vDefault = False
Case UCase("TripleState") : vDefault = False
Case UCase("Value") : vDefault = Empty
Case UCase("Visible") : vDefault = True
Case UCase("XControlModel") : vDefault = Nothing
Case UCase("XControlView") : vDefault = Nothing
Case Else : vDefault = ""
End Select
GetProperty = _PropertyGet(PropertyName, vDefault)
Finally:
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SFDocuments.SF_FormControl.GetProperty
REM -----------------------------------------------------------------------------
Public Function Methods() As Variant
''' Return the list of public methods of the FormControl service as an array
Methods = Array( _
"AddSubNode" _
, "AddSubTree" _
, "CreateRoot" _
, "FindNode" _
, "SetFocus" _
, "WriteLine" _
)
End Function ' SFDocuments.SF_FormControl.Methods
REM -----------------------------------------------------------------------------
Public Function Properties() As Variant
''' Return the list or properties of the FormControl class as an array
Properties = Array( _
"Action" _
, "Cancel" _
, "Caption" _
, "ControlSource" _
, "ControlType" _
, "Default" _
, "DefaultValue" _
, "Enabled" _
, "Format" _
, "ListCount" _
, "ListIndex" _
, "ListSource" _
, "ListSourceType" _
, "Locked" _
, "MultiSelect" _
, "Name" _
, "OnActionPerformed" _
, "OnAdjustmentValueChanged" _
, "OnApproveAction" _
, "OnApproveReset" _
, "OnApproveUpdate" _
, "OnChanged" _
, "OnErrorOccurred" _
, "OnFocusGained" _
, "OnFocusLost" _
, "OnItemStateChanged" _
, "OnKeyPressed" _
, "OnKeyReleased" _
, "OnMouseDragged" _
, "OnMouseEntered" _
, "OnMouseExited" _
, "OnMouseMoved" _
, "OnMousePressed" _
, "OnMouseReleased" _
, "OnResetted" _
, "OnTextChanged" _
, "OnUpdated" _
, "Parent" _
, "Picture" _
, "Required" _
, "Text" _
, "TipText" _
, "TripleState" _
, "Value" _
, "Visible" _
, "XControlModel" _
, "XControlView" _
)
End Function ' SFDocuments.SF_FormControl.Properties
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 oDoc As Object, oForm As Object, oControl As Object
''' Set oDoc = CreateScriptService("SFDocuments.Document", ThisComponent)
''' Set oForm = oDoc.Forms(0)
''' Set oControl = oForm.Controls("thisControl")
''' oControl.SetFocus()
Dim bSetFocus As Boolean ' Return value
Dim iColPosition As Integer ' Position of control in table
Dim oTableModel As Object ' XControlModel of parent table
Dim oControl As Object ' com.sun.star.awt.XControlModel
Dim i As Integer, j As Integer
Const cstThisSub = "SFDocuments.FormControl.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 _ParentForm._IsStillAlive() Then GoTo Finally
End If
Try:
If Not IsNull(_ControlView) Then
If _ParentIsTable Then ' setFocus() method does not work on controlviews in table control ?!?
' Find the column position of the current instance in the parent table control
iColPosition = -1
Set oTableModel = [_Parent]._ControlModel
j = -1
For i = 0 To oTableModel.Count - 1
Set oControl = oTableModel.getByIndex(i)
If Not oControl.Hidden Then j = j + 1 ' Skip hidden columns
If oControl.Name = _Name Then
iColPosition = j
Exit For
End If
Next i
If iColPosition >= 0 Then
[_Parent]._ControlView.setFocus() 'Set first focus on table control itself
[_Parent]._ControlView.setCurrentColumnPosition(iColPosition) 'Deprecated but no alternative found
End If
Else
_ControlView.setFocus()
End If
bSetFocus = True
End If
bSetFocus = True
Finally:
SetFocus = bSetFocus
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SFControls.SF_FormControl.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 = "SFDocuments.FormControl.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 ScriptForge.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 ' SFDocuments.SF_FormControl.SetProperty
REM =========================================================== PRIVATE FUNCTIONS
REM -----------------------------------------------------------------------------
Private Function _FormatsList() As Variant
''' Return the allowed format entries as a zero-based array for Date and Time control types
Dim vFormats() As Variant ' Return value
Select Case _ControlType
Case CTLDATEFIELD
vFormats = Array( _
"Standard (short)" _
, "Standard (short YY)" _
, "Standard (short YYYY)" _
, "Standard (long)" _
, "DD/MM/YY" _
, "MM/DD/YY" _
, "YY/MM/DD" _
, "DD/MM/YYYY" _
, "MM/DD/YYYY" _
, "YYYY/MM/DD" _
, "YY-MM-DD" _
, "YYYY-MM-DD" _
)
Case CTLTIMEFIELD
vFormats = Array( _
"24h short" _
, "24h long" _
, "12h short" _
, "12h long" _
)
Case Else
vFormats = Array()
End Select
_FormatsList = vFormats
End Function ' SFDocuments.SF_FormControl._FormatsList
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 ' SFDocuments.SF_FormControl._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("OnApproveAction")
_GetListener = "XApproveActionListener"
Case UCase("OnApproveReset"), UCase("OnResetted")
_GetListener = "XResetListener"
Case UCase("OnApproveUpdate"), UCase("OnUpdated")
_GetListener = "XUpdateListener"
Case UCase("OnChanged")
_GetListener = "XChangeListener"
Case UCase("OnErrorOccurred")
_GetListener = "XErrorListener"
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"
End Select
End Function ' SFDocuments.SF_FormControl._GetListener
REM -----------------------------------------------------------------------------
Public Sub _Initialize()
''' Complete the object creation process:
''' - Initialization of private members
''' - Collection of specific attributes
''' - Synchronization with parent form instance
Dim vControlTypes As Variant ' Array of control types ordered by the ClassId property of XControlModel - 2
Const acHiddenControl = 13 ' Class Id of an hidden control: has no ControlView
vControlTypes = array( CTLBUTTON _
, CTLRADIOBUTTON _
, CTLIMAGEBUTTON _
, CTLCHECKBOX _
, CTLLISTBOX _
, CTLCOMBOBOX _
, CTLGROUPBOX _
, CTLTEXTFIELD _
, CTLFIXEDTEXT _
, CTLTABLECONTROL _
, CTLFILECONTROL _
, CTLHIDDENCONTROL _
, CTLIMAGECONTROL _
, CTLDATEFIELD _
, CTLTIMEFIELD _
, CTLNUMERICFIELD _
, CTLCURRENCYFIELD _
, CTLPATTERNFIELD _
, CTLSCROLLBAR _
, CTLSPINBUTTON _
, CTLNAVIGATIONBAR _
)
Try:
' _implementationName is set elsewhere for controls in table control
If Len(_ImplementationName) = 0 Then _ImplementationName = ScriptForge.SF_Session.UnoObjectType(_ControlModel)
_ClassId = _ControlModel.ClassId
' Identify the control type, ignore subforms and pay attention to formatted fields
If ScriptForge.SF_Session.HasUnoproperty(_ControlModel, "ClassId") Then ' All control types have a ClassId property except subforms
_ControlType = vControlTypes(_ClassId - 2)
' Formatted fields belong to the TextField family
If _ControlType = CTLTEXTFIELD Then
If _ImplementationName = "com.sun.star.comp.forms.OFormattedFieldWrapper" _
Or _ImplementationName = "com.sun.star.comp.forms.OFormattedFieldWrapper_ForcedFormatted" _
Or _ImplementationName = "com.sun.star.form.component.FormattedField" Then ' When in table control
_ControlType = CTLFORMATTEDFIELD
End If
End If
Else
Exit Sub ' Ignore subforms, should not happen
End If
With [_Parent]
' Set control view if not set yet
If IsNull(_ControlView) Then
If _ClassId > 0 And _ClassId <> acHiddenControl Then ' No view on hidden controls
If IsNull(._FormDocument) Then ' Usual document
Set _ControlView = ._Component.CurrentController.getControl(_ControlModel)
Else ' Base form document
Set _ControlView = ._FormDocument.Component.CurrentController.getControl(_ControlModel)
End If
End If
End If
End With
' Store the SF_FormControl object in the parent cache
Set [_Parent]._ControlCache(_IndexOfNames) = [Me]
Finally:
Exit Sub
End Sub ' SFDocuments.SF_FormControl._Initialize
REM -----------------------------------------------------------------------------
Private Function _ListboxBound() As Boolean
''' Return True if the actual control, which is a listbox, has a bound column
''' Called before setting the value of a listbox, i.e. the value to be rewritten in the underlying table data
''' The existence of a bound column is derived from the comparison between StringItemList and ValueItemList
''' String ... : the strings displayed in the list box
''' Value ... : the database values
''' If they are different, then there is a bound column
Dim bListboxBound As Boolean ' Return value
Dim vValue() As Variant ' Alias of the control model ValueItemList
Dim vString() As Variant ' Alias of the control model StringItemList
Dim i As Long
bListboxBound = False
With _ControlModel
If Not IsNull(.ValueItemList) _
And .DataField <> "" _
And Not IsNull(.BoundField) _
And ScriptForge.SF_Array.Contains(Array( _
com.sun.star.form.ListSourceType.TABLE _
, com.sun.star.form.ListSourceType.QUERY _
, com.sun.star.form.ListSourceType.SQL _
, com.sun.star.form.ListSourceType.SQLPASSTHROUGH _
), .ListSourceType) Then
If IsArray(.ValueItemList) Then
vValue = .ValueItemList
vString = .StringItemList
For i = 0 To UBound(vValue)
If VarType(vValue(i)) <> VarType(vString(i)) Then
bListboxBound = True
ElseIf vValue(i) <> vString(i) Then
bListboxBound = True
End If
If bListboxBound Then Exit For
Next i
End If
End If
End With
_ListboxBound = bListboxBound
End Function ' _ListboxBound V0.9.0
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 ' Date after conversion from com.sun.star.util.Date or com.sun.star.util.Time
Dim vValues As Variant ' Array of listbox values
Dim oControlEvents As Object ' com.sun.star.container.XNameContainer
Dim sEventName As String ' Internal event name
Const cstUnoUrl = ".uno:FormController/"
Dim i As Long
Dim cstThisSub As String
Const cstSubArgs = ""
cstThisSub = "SFDocuments.FormControl.get" & psProperty
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
If Not _ParentForm._IsStillAlive() Then GoTo Finally
If IsMissing(pvDefault) Or IsEmpty(pvDefault) Then pvDefault = Null
_PropertyGet = pvDefault
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
Select Case UCase(psProperty)
Case UCase("Action")
Select Case _ControlType
Case CTLBUTTON
If oSession.HasUNOProperty(_ControlModel, "ButtonType") Then
Select Case _ControlModel.ButtonType
Case com.sun.star.form.FormButtonType.PUSH : _PropertyGet = "none"
Case com.sun.star.form.FormButtonType.SUBMIT : _PropertyGet = "submitForm"
Case com.sun.star.form.FormButtonType.RESET : _PropertyGet = "resetForm"
Case com.sun.star.form.FormButtonType.URL
' ".uno:FormController/moveToFirst"
If Left(_ControlModel.TargetURL, Len(cstUnoUrl)) = cstUnoUrl Then
_PropertyGet = Mid(_ControlModel.TargetURL, Len(cstUnoUrl) + 1)
ElseIf Left(_ControlModel.TargetURL, 4) = "http" Then
_PropertyGet = "openWebPage"
ElseIf Left(_ControlModel.TargetURL, 4) = "file" Then
_PropertyGet ="openDocument"
End If
End Select
End If
Case Else : GoTo CatchType
End Select
Case UCase("Caption")
Select Case _ControlType
Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
If oSession.HasUNOProperty(_ControlModel, "Label") Then _PropertyGet = _ControlModel.Label
Case Else : GoTo CatchType
End Select
Case UCase("ControlSource")
Select Case _ControlType
Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFORMATTEDFIELD, CTLIMAGECONTROL, CTLLISTBOX _
, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLRADIOBUTTON, CTLTEXTFIELD, CTLTIMEFIELD
If oSession.HasUNOProperty(_ControlModel, "DataField") Then _PropertyGet = _ControlModel.DataField
Case Else : GoTo CatchType
End Select
Case UCase("ControlType")
_PropertyGet = _ControlType
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("DefaultValue")
Select Case _ControlType
Case CTLCHECKBOX, CTLRADIOBUTTON
If oSession.HasUNOProperty(_ControlModel, "DefaultState") Then _PropertyGet = _ControlModel.DefaultState
Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD
If oSession.HasUNOProperty(_ControlModel, "DefaultText") Then _PropertyGet = _ControlModel.DefaultText
Case CTLCURRENCYFIELD, CTLNUMERICFIELD
If oSession.HasUNOProperty(_ControlModel, "DefaultValue") Then _PropertyGet = _ControlModel.DefaultValue
Case CTLDATEFIELD
If oSession.HasUNOProperty(_ControlModel, "DefaultDate") Then
If Not IsEmpty(_ControlModel.DefaultDate) Then
With _ControlModel.DefaultDate
vDate = DateSerial(.Year, .Month, .Day)
End With
_PropertyGet = vDate
End If
End If
Case CTLFORMATTEDFIELD
If oSession.HasUNOProperty(_ControlModel, "EffectiveDefault") Then _PropertyGet = _ControlModel.EffectiveDefault
Case CTLLISTBOX
If oSession.HasUNOProperty(_ControlModel, "DefaultSelection") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
vList = _ControlModel.DefaultSelection
If IsArray(vList) Then
If UBound(vList) >= LBound(vList) Then ' Is array initialized ?
lIndex = UBound(_ControlModel.StringItemList)
If vList(0) >= 0 And vList(0) <= lIndex Then _PropertyGet = _ControlModel.StringItemList(vList(0))
' Only first default value is considered
End If
End If
End If
Case CTLSPINBUTTON
If oSession.HasUNOProperty(_ControlModel, "DefaultSpinValue") Then _PropertyGet = _ControlModel.DefaultSpinValue
Case CTLTIMEFIELD
If oSession.HasUNOProperty(_ControlModel, "DefaultTime") Then
If Not IsEmpty(_ControlModel.DefaultTime) Then
With _ControlModel.DefaultTime
vDate = TimeSerial(.Hours, .Minutes, .Seconds)
End With
_PropertyGet = vDate
End If
End If
Case Else : GoTo CatchType
End Select
Case UCase("Enabled")
Select Case _ControlType
Case CTLHIDDENCONTROL : GoTo CatchType
Case Else
If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _PropertyGet = _ControlModel.Enabled
End Select
Case UCase("Format")
Select Case _ControlType
Case CTLDATEFIELD
If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = _FormatsList()(_ControlModel.DateFormat)
Case CTLTIMEFIELD
If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = _FormatsList()(_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("ListCount")
Select Case _ControlType
Case CTLCOMBOBOX, CTLLISTBOX
If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1
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 Else : GoTo CatchType
End Select
Case UCase("ListSource")
Select Case _ControlType
Case CTLCOMBOBOX, CTLLISTBOX
If oSession.HasUNOProperty(_ControlModel, "ListSource") Then
With com.sun.star.form.ListSourceType
Select Case _ControlModel.ListSourceType
Case .VALUELIST _
, .TABLEFIELDS
If IsArray(_ControlModel.StringItemList) Then vValues = _ControlModel.StringItemList Else vValues = Array(_ControlModel.StringItemList)
Case .TABLE _
, .QUERY _
, .SQL _
, .SQLPASSTHROUGH
If IsArray(_ControlModel.ListSource) Then vValues = _ControlModel.ListSource Else vValues = Array(_ControlModel.ListSource)
End Select
End With
_PropertyGet = Join(vValues, ";")
End If
Case Else : GoTo CatchType
End Select
Case UCase("ListSourceType")
Select Case _ControlType
Case CTLCOMBOBOX, CTLLISTBOX
If oSession.HasUnoProperty(_ControlModel, "ListSourceType") Then _PropertyGet = _ControlModel.ListSourceType
Case Else : GoTo CatchType
End Select
Case UCase("Locked")
Select Case _ControlType
Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLIMAGECONTROL _
, 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("OnApproveAction"), UCase("OnApproveReset"), UCase("OnApproveUpdate") _
, UCase("OnChanged"), UCase("OnErrorOccurred"), UCase("OnFocusGained"), UCase("OnFocusLost") _
, UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
, UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted") _
, UCase("OnTextChanged"), UCase("OnUpdated")
If IsNull(_ControlModel) Then _PropertyGet = "" Else _PropertyGet = SF_Register._GetEventScriptCode(_ControlModel, psProperty, _Name)
Case UCase("Parent")
Set _PropertyGet = [_Parent]
Case UCase("Picture")
Select Case _ControlType
Case CTLBUTTON, CTLIMAGEBUTTON, CTLIMAGECONTROL
If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_ControlModel.ImageURL)
Case Else : GoTo CatchType
End Select
Case UCase("Required")
Select Case _ControlType
Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD _
, CTLPATTERNFIELD, CTLRADIOBUTTON, CTLTEXTFIELD, CTLTIMEFIELD
If oSession.HasUnoProperty(_ControlModel, "InputRequired") Then _PropertyGet = _ControlModel.InputRequired
Case Else : GoTo CatchType
End Select
Case UCase("Text")
Select Case _ControlType
Case CTLDATEFIELD
If oSession.HasUNOProperty(_ControlModel, "Date") _
And oSession.HasUNOProperty(_ControlModel, "FormatKey") _
And oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") Then
If Not IsEmpty(_ControlModel.Date) Then
With _ControlModel.Date
vDate = DateSerial(.Year, .Month, .Day)
End With
_PropertyGet = Format(vDate, _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString)
End If
End If
Case CTLTIMEFIELD
If oSession.HasUNOProperty(_ControlModel, "Text") Then
If Not IsEmpty(_ControlModel.Time) Then
With _ControlModel.Time
vDate = TimeSerial(.Hours, .Minutes, .Seconds)
End With
_PropertyGet = Format(vDate, "HH:MM:SS")
End If
End If
Case CTLCOMBOBOX, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLPATTERNFIELD, CTLTEXTFIELD
If oSession.HasUnoProperty(_ControlModel, "Text") Then _PropertyGet = _ControlModel.Text
Case Else : GoTo CatchType
End Select
Case UCase("TipText")
Select Case _ControlType
Case CTLHIDDENCONTROL : GoTo CatchType
Case Else
If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _PropertyGet = _ControlModel.HelpText
End Select
Case UCase("TripleState")
Select Case _ControlType
Case CTLCHECKBOX
If oSession.HasUnoProperty(_ControlModel, "TriState") Then _PropertyGet = _ControlModel.TriState
Case Else : GoTo CatchType
End Select
Case UCase("Value") ' Default values are set here by control type, not in the 2nd argument (pvDefault)
vGet = pvDefault
Select Case _ControlType
Case CTLBUTTON 'Boolean, toggle buttons only
vGet = False
If oSession.HasUnoProperty(_ControlModel, "Toggle") Then
If oSession.HasUnoProperty(_ControlModel, "State") 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
With _ControlModel.Date
vDate = DateSerial(.Year, .Month, .Day)
End With
vGet = vDate
Else ' .Date = Empty
End If
End If
Case CTLFORMATTEDFIELD 'String or numeric
If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then vGet = _ControlModel.EffectiveValue Else vGet = ""
Case CTLHIDDENCONTROL 'String
If oSession.HasUnoProperty(_ControlModel, "HiddenValue") Then vGet = _ControlModel.HiddenValue Else vGet = ""
Case CTLLISTBOX 'String or array of strings depending on MultiSelection
' StringItemList is the list of the items displayed in the box
' ValueItemList is the list of the values in the underlying database field
' 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
' The list of allowed values depends on the existence of a bound column
If _ListBoxBound() Then vList = _ControlModel.ValueItemList Else 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 CTLRADIOBUTTON 'Boolean
If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 ) Else vGet = False
Case CTLSCROLLBAR 'Numeric
vGet = 0
If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then
If Not IsEmpty(_ControlModel.ScrollValue) Then vGet = _ControlModel.ScrollValue
End If
Case CTLSPINBUTTON
If oSession.HasUnoProperty(_ControlModel, "SpinValue") Then vGet = _ControlModel.SpinValue Else vGet = 0
Case CTLTIMEFIELD
vGet = CDate(0)
If oSession.HasUnoProperty(_ControlModel, "Time") Then
If VarType(_ControlModel.Time) = ScriptForge.V_OBJECT Then ' com.sun.star.Util.Time
With _ControlModel.Time
vDate = TimeSerial(.Hours, .Minutes, .Seconds)
End With
vGet = vDate
Else ' .Time = Empty
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("XControlModel")
Set _PropertyGet = _ControlModel
Case UCase("XControlView")
Set _PropertyGet = _ControlView
Case Else
_PropertyGet = Null
End Select
Finally:
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchType:
GoTo Finally
End Function ' SFDocuments.SF_FormControl._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 sFormName As String ' Full form identification for error messages
Dim vSet As Variant ' Value to set in UNO model or view property
Dim vActions As Variant ' Action property: list of available actions
Dim sAction As String ' A single action
Dim vFormats As Variant ' Format property: output of _FormatsList()
Dim iFormat As Integer ' Format property: index in vFormats
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 oDatabase As Object ' The database object related to the parent form of the control instance
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 = "SFDocuments.FormControl.set" & psProperty
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
If Not _ParentForm._IsStillAlive() Then GoTo Finally
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
bSet = True
Select Case UCase(psProperty)
Case UCase("Action")
Select Case _ControlType
Case CTLBUTTON
vActions = Array("none", "submitForm", "resetForm", "refreshForm", "moveToFirst", "moveToLast", "moveToNext", "moveToPrev" _
, "saveRecord", "moveToNew", "deleteRecord", "undoRecord")
If Not ScriptForge.SF_Utils._Validate(pvValue, "Action", ScriptForge.V_STRING, vActions) Then GoTo Finally
If oSession.HasUNOProperty(_ControlModel, "ButtonType") Then
sAction = vActions(ScriptForge.SF_Array.IndexOf(vActions, pvValue, CaseSensitive := False))
_ControlModel.TargetURL = ""
Select Case sAction
Case "none" : vSet = com.sun.star.form.FormButtonType.PUSH
Case "submitForm" : vSet = com.sun.star.form.FormButtonType.SUBMIT
Case "resetForm" : vSet = com.sun.star.form.FormButtonType.RESET
Case Else
vSet = com.sun.star.form.FormButtonType.URL
_ControlModel.TargetURL = ".uno:FormController/" & sAction
End Select
_ControlModel.ButtonType = vSet
End If
Case Else : GoTo CatchType
End Select
Case UCase("Caption")
Select Case _ControlType
Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDTEXT, CTLGROUPBOX, 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("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")
Select Case _ControlType
Case CTLHIDDENCONTROL : GoTo CatchType
Case Else
If Not ScriptForge.SF_Utils._Validate(pvValue, "Enabled", ScriptForge.V_BOOLEAN) Then GoTo Finally
If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _ControlModel.Enabled = pvValue
End Select
Case UCase("Format")
Select Case _ControlType
Case CTLDATEFIELD, CTLTIMEFIELD
vFormats = _FormatsList()
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 Else : GoTo CatchType
End Select
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
If pvValue >= 0 And pvValue <= UBound(_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 Else : GoTo CatchType
End Select
Case UCase("ListSource")
Select Case _ControlType
Case CTLCOMBOBOX, CTLLISTBOX
If oSession.HasUNOProperty(_ControlModel, "ListSource") Then
If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
With com.sun.star.form.ListSourceType
Select Case _ControlModel.ListSourceType
Case .QUERY _
, .TABLE _
, .TABLEFIELDS
Set oDatabase = _ParentForm.GetDatabase()
If _ControlModel.ListSourceType = .QUERY Then vList = oDatabase.Queries Else vList = oDatabase.Tables
If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING, vList) Then Goto Finally
If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = pvValue Else _ControlModel.ListSource = Array(pvValue)
_ControlModel.refresh()
Case .SQL
Set oDatabase = _ParentForm.GetDatabase()
If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = oDatabase._ReplaceSquareBrackets(pvValue) Else _ControlModel.ListSource = Array(oDatabase._ReplaceSquareBrackets(pvValue))
_ControlModel.refresh()
Case .VALUELIST ' ListBox only !
_ControlModel.ListSource = Split(pvValue, ";")
_ControlModel.StringItemList = _ControlModel.ListSource
Case .SQLPASSTHROUGH
If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = pvValue Else _ControlModel.ListSource = Array(pvValue)
_ControlModel.refresh()
End Select
End With
End If
Case Else : GoTo CatchType
End Select
Case UCase("ListSourceType")
With com.sun.star.form.ListSourceType
Select Case _ControlType
Case CTLCOMBOBOX
If Not ScriptForge.SF_Utils._Validate(pvValue, "ListSourceType", ScriptForge.V_NUMERIC, Array( _
.TABLE _
, .QUERY _
, .SQL _
, .SQLPASSTHROUGH _
, .TABLEFIELDS _
)) Then GoTo Finally
Case CTLLISTBOX
If Not ScriptForge.SF_Utils._Validate(pvValue, "ListSourceType", ScriptForge.V_NUMERIC, Array( _
.VALUELIST _
, .TABLE _
, .QUERY _
, .SQL _
, .SQLPASSTHROUGH _
, .TABLEFIELDS _
)) Then GoTo Finally
Case Else : GoTo CatchType
End Select
End With
If oSession.HasUnoProperty(_ControlModel, "ListSourceType") Then _ControlModel.ListSourceType = pvValue
Case UCase("Locked")
Select Case _ControlType
Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLIMAGECONTROL _
, 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
' Cancel selections when MultiSelect becomes False
If Not pvValue And UBound(_ControlModel.SelectedItems) > 0 Then
lIndex = _ControlModel.SelectedItems(0)
_ControlModel.SelectedItems = Array(lIndex)
End If
End If
Case Else : GoTo CatchType
End Select
Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnApproveAction"), UCase("OnApproveReset"), UCase("OnApproveUpdate") _
, UCase("OnChanged"), UCase("OnErrorOccurred"), UCase("OnFocusGained"), UCase("OnFocusLost") _
, UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
, UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted") _
, UCase("OnTextChanged"), UCase("OnUpdated")
If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
If Not IsNull(_ControlModel) Then
bSet = SF_Register._RegisterEventScript(_ControlModel _
, psProperty _
, _GetListener(psProperty) _
, pvValue _
, _Name _
)
End If
Case UCase("Picture")
Select Case _ControlType
Case CTLBUTTON, CTLIMAGEBUTTON, 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("TipText")
Select Case _ControlType
Case CTLHIDDENCONTROL : GoTo CatchType
Case Else
If Not ScriptForge.SF_Utils._Validate(pvValue, "TipText", V_STRING) Then GoTo Finally
If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _ControlModel.HelpText = pvValue
End Select
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 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
_ControlModel.State = Iif(pvValue, 1, 0)
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
If oSession.HasUnoProperty(_ControlModel, "Text") And oSession.HasUnoProperty(_ControlModel, "StringItemList") Then
If pvValue <> "" Then
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING, _ControlModel.StringItemList) Then Goto Finally
End If
_ControlModel.Text = pvValue
End If
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 CTLFILECONTROL
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally
If oSession.HasUnoProperty(_ControlModel, "Text") Then _ControlModel.Text = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue)
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 CTLHIDDENCONTROL 'String
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally
If oSession.HasUnoProperty(_ControlModel, "HiddenValue") Then _ControlModel.HiddenValue = pvValue
Case CTLLISTBOX 'String or number - Only a single value may be set
' StringItemList is the list of the items displayed in the box
' ValueItemList is the list of the values in the underlying database field
' SelectedItems is the list of the indexes in StringItemList of the selected items
If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") Then
' Setting the value on a listbox is allowed only if single value and value in the list
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
' The list of allowed values depends on the existence of a bound column
If _ListboxBound() Then vList = _ControlModel.ValueItemList Else vList = _ControlModel.StringItemList
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", , vList) Then GoTo Finally
_ControlModel.SelectedItems = Array(ScriptForge.SF_Array.IndexOf(vList, pvValue, CaseSensitive := True))
End If
Case 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 CTLRADIOBUTTON 'Boolean
' A group of radio buttons is presumed sharing the same GroupName
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 CTLSPINBUTTON 'Numeric
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
If oSession.HasUnoProperty(_ControlModel, "SpinValueMin") Then
If pvValue < _ControlModel.SpinValueMin Then pvValue = _ControlModel.SpinValueMin
End If
If oSession.HasUnoProperty(_ControlModel, "SpinValueMax") Then
If pvValue > _ControlModel.SpinValueMax Then pvValue = _ControlModel.SpinValueMax
End If
If oSession.HasUnoProperty(_ControlModel, "SpinValue") Then _ControlModel.SpinValue = 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
' FINAL COMMITMENT
If oSession.HasUNOMethod(_ControlModel, "commit") Then _ControlModel.commit() ' f.i. checkboxes have no commit method ??
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 _ControlModel.EnableVisible = True
_ControlView.setVisible(pvValue)
End If
Case Else
bSet = False
End Select
Finally:
_PropertySet = bSet
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
bSet = False
GoTo Finally
CatchType:
If Len(_ParentForm._FormDocumentName) > 0 Then sFormName = _ParentForm._FormDocumentName & "." Else sFormName = ""
ScriptForge.SF_Exception.RaiseFatal(FORMCONTROLTYPEERROR, _Name, sFormName & _FormName, _ControlType, psProperty)
GoTo Finally
End Function ' SFDocuments.SF_FormControl._PropertySet
REM -----------------------------------------------------------------------------
Private Function _Repr() As String
''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
''' Args:
''' Return:
''' "[FORMCONTROL]: Name, Type (formname)
_Repr = "[FORMCONTROL]: " & _Name & ", " & _ControlType & " (" & _FormName & ")"
End Function ' SFDocuments.SF_FormControl._Repr
REM ============================================ END OF SFDOCUMENTS.SF_FORMCONTROL
</script:module>
Mini Shell