diff options
| author | Jean-Pierre Ledure <jp@ledure.be> | 2021-02-02 12:12:43 +0100 |
|---|---|---|
| committer | Jean-Pierre Ledure <jp@ledure.be> | 2021-02-02 13:48:27 +0100 |
| commit | 8b3aa6c866a3e5534c1c6d175b324e45826da491 (patch) | |
| tree | 37f58728bd3175dc2c7cc859eb31a569b2552cc9 /wizards/source | |
| parent | 494fb41ff71e06557293adaf2b5e064ab8c0aef5 (diff) | |
ScriptForge - (new SF_FormControl): form control properties
The whole set of properties is created including
- updatable OnXxx event properties
- the Value property as a shortcut to the control content
for all the control types
Controls events management is included
Access to the subcontrols of table controls is included as well
Addition of the new file in the SFDocuments make file
Change-Id: I6308a71e3dd499d729cee1565002b6a9d84f7743
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/110289
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
Diffstat (limited to 'wizards/source')
| -rw-r--r-- | wizards/source/sfdocuments/SF_Form.xba | 61 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_FormControl.xba | 1823 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Register.xba | 40 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/script.xlb | 1 |
4 files changed, 1914 insertions, 11 deletions
diff --git a/wizards/source/sfdocuments/SF_Form.xba b/wizards/source/sfdocuments/SF_Form.xba index 9b259034e56d..5e1f011c8a1d 100644 --- a/wizards/source/sfdocuments/SF_Form.xba +++ b/wizards/source/sfdocuments/SF_Form.xba @@ -60,6 +60,11 @@ Option Explicit ''' ' To access a subform: myForm and mySubForm become distinct instances of the current class ''' Set mySubForm = myForm.SubForms("mySubForm") ''' +''' REM the form is the subject of an event +''' Sub OnEvent(ByRef poEvent As Object) +''' Dim myForm As Object +''' Set myForm = CreateScriptService("SFDocuments.FormEvent", poEvent) +''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS @@ -83,7 +88,7 @@ Private _FormDocument As Object ' com.sun.star.comp.sdb.Content - the con ' The form topmost container Private _Component As Object ' com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument -' EVents management +' Events management Private _CacheIndex As Long ' Index in central cache storage ' Form UNO references @@ -94,7 +99,8 @@ Private _Database As Object ' Database class instance ' Form attributes -' Persistent storage for controls +' Cache storage for controls +Private _ControlNames As Variant ' Array of control names Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of XForm REM ============================================================ MODULE CONSTANTS @@ -111,7 +117,7 @@ REM ---------------------------------------------------------------------------- Private Sub Class_Initialize() Set [Me] = Nothing Set [_Parent] = Nothing - ObjectType = "Form" + ObjectType = "FORM" ServiceName = "SFDocuments.Form" _Name = "" _SheetName = "" @@ -121,6 +127,7 @@ Private Sub Class_Initialize() _CacheIndex = -1 Set _Form = Nothing Set _Database = Nothing + _ControlNames = Array() _ControlCache = Array() End Sub ' SFDocuments.SF_Form Constructor @@ -554,13 +561,14 @@ Public Function Controls(Optional ByVal ControlName As Variant) As Variant ''' ControlName is invalid ''' Example: ''' Dim myForm As Object, myList As Variant, myControl As Object -''' Set myForm = CreateScriptService("SFDocuments.Form", Container, Library, FormName) +''' Set myForm = myDoc.Forms("myForm") ''' myList = myForm.Controls() ''' Set myControl = myForm.Controls("myTextBox") Dim oControl As Object ' The new control class instance Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache Dim vControl As Variant ' Alias of _ControlCache entry +Dim i As Long Const cstThisSub = "SFDocuments.Form.Controls" Const cstSubArgs = "[ControlName]" @@ -574,8 +582,51 @@ Check: End If Try: + ' Collect all control names if not yet done + If UBound(_ControlNames) < 0 Then + _ControlNames = _Form.getElementNames() + ' Remove all subforms from the list + For i = 0 To UBound(_ControlNames) + ' Subforms have no ClassId property + If Not ScriptForge.SF_Session.HasUnoProperty(_Form.getByName(_ControlNames(i)), "ClassId") Then _ControlNames(i) = "" + Next i + _ControlNames = ScriptForge.SF_Array.TrimArray(_ControlNames) + ' Size the cache accordingly + 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 _Form.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 + ' Create the new form control class instance + Set oControl = New SF_FormControl + With oControl + ._Name = ControlName + Set .[Me] = oControl + Set .[_Parent] = [Me] + Set ._ParentForm = [Me] + ._IndexOfNames = lIndexOfNames + ._FormName = _Name + ' Get model and view of the current control + Set ._ControlModel = _Form.getByName(ControlName) + ._Initialize() + End With + Else + Set oControl = vControl + End If + + Set Controls = oControl End If Finally: @@ -584,7 +635,7 @@ Finally: Catch: GoTo Finally CatchNotFound: - ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _FormModel.getElementNames()) + ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _Form.getElementNames()) GoTo Finally End Function ' SFDocuments.SF_Form.Controls diff --git a/wizards/source/sfdocuments/SF_FormControl.xba b/wizards/source/sfdocuments/SF_FormControl.xba new file mode 100644 index 000000000000..d136cb21769b --- /dev/null +++ b/wizards/source/sfdocuments/SF_FormControl.xba @@ -0,0 +1,1823 @@ +<?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) +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +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 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 dialog 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, _Form.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: +''' myModel.GetProperty("MyProperty") + +Const cstThisSub = "SFDocuments.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 ' SFDocuments.SF_FormControl.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 ' SFDocuments.SF_FormControl.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Timer class as an array + + Properties = Array( _ + "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 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 = "SFDocuments.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_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.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 ' 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 te 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 ' 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 + vDate = _ControlModel.DefaultDate + _PropertyGet = DateSerial(vDate.Year, vDate.Month, vDate.Day) + 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 + vDate = _ControlModel.DefaultTime + _PropertyGet = TimeSerial(vDate.Hours, vDate.Minutes, vDate.Seconds) + 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 + vDate = DateSerial(_ControlModel.Date.Year, _ControlModel.Date.Month, _ControlModel.Date.Day) + _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 + Set vDate = _ControlModel.Time + _PropertyGet = Format(TimeSerial(vDate.Hours, vDate.Minutes, vDate.Seconds), "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 + Set vDate = _ControlModel.Date + vGet = DateSerial(vDate.Year, vDate.Month, vDate.Day) + 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 exisence 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 + Set vDate = _ControlModel.Time + vGet = TimeSerial(vDate.Hours, vDate.Minutes, vDate.Seconds) + 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 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 [_Parent]._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 + _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 + et 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, "Vamue", 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 exisence 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: + GoTo Finally +CatchType: + ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _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>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/SF_Register.xba b/wizards/source/sfdocuments/SF_Register.xba index 5ddb307ba7a0..d2b0dafd341f 100644 --- a/wizards/source/sfdocuments/SF_Register.xba +++ b/wizards/source/sfdocuments/SF_Register.xba @@ -231,6 +231,11 @@ Public Function _FormEventManager(Optional ByRef pvArgs As Variant) As Object Dim oSource As Object ' Return value Dim vEvent As Variant ' Alias of pvArgs(0) +Dim oControlModel As Object ' com.sun.star.awt.XControlModel +Dim oParent As Object ' com.sun.star.form.OGridControlModel or com.sun.star.comp.forms.ODatabaseForm +Dim sParentType As String ' "com.sun.star.form.OGridControlModel" or "com.sun.star.comp.forms.ODatabaseForm" +Dim oSFParent As Object ' The parent as a ScriptForge instance: SF_Form or SF_FormControl +Dim oSFForm As Object ' The grand-parent SF_Form instance Dim oSession As Object : Set oSession = ScriptForge.SF_Session ' Never abort while an event is processed @@ -243,12 +248,30 @@ Check: If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally Try: - If oSession.UnoObjectType(vEvent) = "com.sun.star.lang.EventObject" Then + If oSession.HasUnoProperty(vEvent, "Source") Then + + ' FORM EVENT If oSession.UnoObjectType(vEvent.Source) = "com.sun.star.comp.forms.ODatabaseForm" Then - Set oSource = SF_Register._NewForm(vEvent.Source) - If oSource._CacheIndex < 0 Then oSource._Initialize() - Else ' TODO for controls + Set oSource = SF_Register._NewForm(vEvent.Source, pbForceInit := True) + + ' CONTROL EVENT + Else + ' A SF_FormControl instance is always created from its parent, either a form, a subform or a table control + Set oControlModel = vEvent.Source.Model ' The event source is a control view com.sun.star.awt.XControl + Set oParent = oControlModel.Parent + sParentType = oSession.UnoObjectType(oParent) + Select Case sParentType + Case "com.sun.star.form.OGridControlModel" + Set oSFForm = SF_Register._NewForm(oParent.Parent, pbForceInit := True) + Set oSFParent = oSFForm.Controls(oParent.Name) + Case "com.sun.star.comp.forms.ODatabaseForm" + Set oSFParent = SF_Register._NewForm(oParent, pbForceInit := True) + End Select + ' The final instance is derived from its parent instance + Set oSource = oSFParent.Controls(oControlModel.Name) + End If + End If Finally: @@ -417,11 +440,14 @@ Catch: End Function ' SFDocuments.SF_Register._NewDocument REM ----------------------------------------------------------------------------- -Public Function _NewForm(Optional ByRef poForm As Object) As Object +Public Function _NewForm(ByRef poForm As Object _ + , Optional pbForceInit As Boolean _ + ) As Object ''' Returns an existing or a new SF_Form instance based on the argument ''' If the instance is new (not found in cache), the minimal members are initialized ''' Args: ''' poForm: com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm +''' pbForceInit: when True, initialize the form instance. Default = False ''' Returns: ''' A SF_Form instance @@ -430,11 +456,13 @@ Dim oForm As Object ' Return value Try: Set oForm = SF_Register._FindFormInCache(poForm) If IsNull(oForm) Then ' Not found + If IsMissing(pbForceInit) Or IsEmpty(pbForceInit) Then pbForceInit = False Set oForm = New SF_Form With oForm ._Name = poForm.Name Set .[Me] = oForm Set ._Form = poForm + If pbForceInit Then ._Initialize() End With End If @@ -509,4 +537,4 @@ Catch: End Function ' SFDocuments.SF_Register._RegisterEventScript REM ============================================== END OF SFDOCUMENTS.SF_REGISTER -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/script.xlb b/wizards/source/sfdocuments/script.xlb index fc075b026fc1..b4c70afe4f2b 100644 --- a/wizards/source/sfdocuments/script.xlb +++ b/wizards/source/sfdocuments/script.xlb @@ -7,4 +7,5 @@ <library:element library:name="SF_Register"/> <library:element library:name="SF_Base"/> <library:element library:name="SF_Form"/> + <library:element library:name="SF_FormControl"/> </library:library>
\ No newline at end of file |