diff options
Diffstat (limited to 'wizards')
| -rw-r--r-- | wizards/Package_sfdocuments.mk | 1 | ||||
| -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 |
5 files changed, 1915 insertions, 11 deletions
diff --git a/wizards/Package_sfdocuments.mk b/wizards/Package_sfdocuments.mk index 8d8be4597dd7..6f9cbf7f5ae2 100644 --- a/wizards/Package_sfdocuments.mk +++ b/wizards/Package_sfdocuments.mk @@ -24,6 +24,7 @@ $(eval $(call gb_Package_add_files,wizards_basicsrvsfdocuments,$(LIBO_SHARE_FOLD SF_Calc.xba \ SF_Document.xba \ SF_Form.xba \ + SF_FormControl.xba \ SF_Register.xba \ __License.xba \ dialog.xlb \ 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 |