Anforderungen  |   Konzepte  |   Entwurf  |   Entwicklung  |   Qualitätssicherung  |   Lebenszyklus  |   Steuerung
 
 
 
 


Quelle  SF_FormControl.xba   Sprache: unbekannt

 
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_FormControl" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
REM ===   The ScriptForge library and its associated libraries are part of the LibreOffice project.    ===
REM ===      The SFDocuments library is one of the associated libraries.         ===
REM ===     Full documentation is available on https://help.libreoffice.org/        ===
REM =======================================================================================================================

Option Compatible
Option ClassModule

Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_FormControl
''' ==============
'''
'''  Manage the controls belonging to a form or subform stored in a document
'''  Each instance of the current class represents a single control within a form, a subform or a tablecontrol
'''  A prerequisite is that all controls within the same form, subform or tablecontrol must have
'''  a unique name. This is also true for the individual radio buttons belonging to the same group.
'''  A common group name must identify such a single group.
'''
'''  The focus is clearly set on getting and setting the values displayed by the controls of the form,
'''  not on their formatting. The latter is easily accessible via the XControlModel and XControlView
'''  UNO objects.
'''  Essentially a single property "Value" maps many alternative UNO properties depending each on
'''  the control type.
'''
'''  Service invocations:
'''   Dim myForm As Object, myControl As Object
'''    Set myForm = ... (read the comments in the SF_Form module)
'''    Set myControl = myForm.Controls("myTextBox")
'''    myControl.Value = "Current time = " & Now()
'''
'''   REM the control is the subject of an event
'''   Sub OnEvent(ByRef poEvent As Object)
'''   Dim myControl As Object
'''    Set myControl = CreateScriptService("SFDocuments.FormEvent", poEvent)
'''
'''  Detailed user documentation:
'''   https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_formcontrol.html?DbPAR=BASIC
'''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

REM ================================================================== EXCEPTIONS

Private Const FORMCONTROLTYPEERROR  = "FORMCONTROLTYPEERROR"

REM ============================================================= PRIVATE MEMBERS

Private [Me]    As Object
Private [_Parent]   As Object
Private ObjectType   As String  ' Must be FORMCONTROL
Private ServiceName   As String

' Control naming and context
Private _Name    As String
Private _IndexOfNames  As Long   ' Index in ElementNames array. Used to access SF_Form._ControlCache
Private _FormName   As String  ' Parent form name
Private _ParentForm   As Object  ' Parent form or subform instance
Private _ParentIsTable  As Boolean  ' True when parent is a table control

' Control UNO references
Private _ControlModel  As Object  ' com.sun.star.awt.XControlModel
Private _ControlView  As Object  ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl

' Control attributes
Private _ImplementationName As String
Private _ControlType  As String  ' One of the CTLxxx constants
Private _ClassId   As Integer  ' Numerical type of control

' Cache storage for table controls
Private _ControlNames  As Variant  ' Array of control names
Private _ControlCache  As Variant  ' Array of control objects sorted like ElementNames of XControlModel

REM ============================================================ MODULE CONSTANTS

'             ClassId
Private Const CTLBUTTON   = "Button"   ' 2
Private Const CTLCHECKBOX  = "CheckBox"  ' 5  
Private Const CTLCOMBOBOX  = "ComboBox"  ' 7
Private Const CTLCURRENCYFIELD = "CurrencyField" ' 18
Private Const CTLDATEFIELD  = "DateField"  ' 15
Private Const CTLFILECONTROL = "FileControl"  ' 12
Private Const CTLFIXEDTEXT  = "FixedText"  ' 10
Private Const CTLFORMATTEDFIELD = "FormattedField" ' Idem TextField
Private Const CTLGROUPBOX  = "GroupBox"  ' 8
Private Const CTLHIDDENCONTROL = "HiddenControl" ' 13
Private Const CTLIMAGEBUTTON = "ImageButton"  ' 4
Private Const CTLIMAGECONTROL = "ImageControl" ' 14
Private Const CTLLISTBOX  = "ListBox"   ' 6
Private Const CTLNAVIGATIONBAR = "NavigationBar" ' 22
Private Const CTLNUMERICFIELD = "NumericField" ' 17
Private Const CTLPATTERNFIELD = "PatternField" ' 19
Private Const CTLRADIOBUTTON = "RadioButton"  ' 3
Private Const CTLSCROLLBAR  = "ScrollBar"  ' 20
Private Const CTLSPINBUTTON  = "SpinButton"  ' 21
Private Const CTLTABLECONTROL = "TableControl" ' 11
Private Const CTLTEXTFIELD  = "TextField"  ' 9
Private Const CTLTIMEFIELD  = "TimeField"  ' 16

REM ====================================================== CONSTRUCTOR/DESTRUCTOR

REM -----------------------------------------------------------------------------
Private Sub Class_Initialize()
 Set [Me] = Nothing
 Set [_Parent] = Nothing
 ObjectType = "FORMCONTROL"
 ServiceName = "SFDocuments.FormControl"
 _Name = ""
 _IndexOfNames = -1
 _FormName = ""
 _ParentIsTable = False
 Set _ParentForm = Nothing
 Set _ControlModel = Nothing
 Set _ControlView = Nothing
 _ImplementationName = ""
 _ControlType = ""
 _ClassId = 0
 _ControlNames = Array()
 _ControlCache = Array()
End Sub  ' SFDocuments.SF_FormControl Constructor

REM -----------------------------------------------------------------------------
Private Sub Class_Terminate()
 Call Class_Initialize()
End Sub  ' SFDocuments.SF_FormControl Destructor

REM -----------------------------------------------------------------------------
Public Function Dispose() As Variant
 If Not IsNull([_Parent]) And _IndexOfNames >= 0 Then [_Parent]._ControlCache(_IndexOfNames) = Empty
 Call Class_Terminate()
 Set Dispose = Nothing
End Function ' SFDocuments.SF_FormControl Explicit Destructor

REM ================================================================== PROPERTIES

REM -----------------------------------------------------------------------------
Property Get Action() As Variant
''' The Action property specifies the action triggered when the button is clicked
''' Accepted values: none, submitForm, resetForm, refreshForm, moveToFirst, moveToLast,
'''      moveToNext, moveToPrev, saveRecord, moveToNew, deleteRecord, undoRecord
 Action = _PropertyGet("Action", "")
End Property ' SFDocuments.SF_FormControl.Action (get)

REM -----------------------------------------------------------------------------
Property Let Action(Optional ByVal pvAction As Variant)
''' Set the updatable property Action
 _PropertySet("Action", pvAction)
End Property ' SFDocuments.SF_FormControl.Action (let)

REM -----------------------------------------------------------------------------
Property Get Caption() As Variant
''' The Caption property refers to the text associated with the control
 Caption = _PropertyGet("Caption", "")
End Property ' SFDocuments.SF_FormControl.Caption (get)

REM -----------------------------------------------------------------------------
Property Let Caption(Optional ByVal pvCaption As Variant)
''' Set the updatable property Caption
 _PropertySet("Caption", pvCaption)
End Property ' SFDocuments.SF_FormControl.Caption (let)

REM -----------------------------------------------------------------------------
Property Get ControlSource() As Variant
''' The ControlSource property specifies the rowset field mapped onto the actual control
 ControlSource = _PropertyGet("ControlSource", "")
End Property ' SFDocuments.SF_FormControl.ControlSource (get)

REM -----------------------------------------------------------------------------
Property Get ControlType() As String
''' Return the type of the actual control: "CheckBox", "TextField", "DateField", ...
 ControlType = _PropertyGet("ControlType")
End Property ' SFDocuments.SF_FormControl.ControlType

REM -----------------------------------------------------------------------------
Property Get Default() As Variant
''' The Default property specifies whether a command button is the default (OK) button.
 Default = _PropertyGet("Default", False)
End Property ' SFDocuments.SF_FormControl.Default (get)

REM -----------------------------------------------------------------------------
Property Let Default(Optional ByVal pvDefault As Variant)
''' Set the updatable property Default
 _PropertySet("Default", pvDefault)
End Property ' SFDocuments.SF_FormControl.Default (let)

REM -----------------------------------------------------------------------------
Property Get DefaultValue() As Variant
''' The DefaultValue property specifies how the control is initialized in a new record
 DefaultValue = _PropertyGet("DefaultValue", Null)
End Property ' SFDocuments.SF_FormControl.DefaultValue (get)

REM -----------------------------------------------------------------------------
Property Let DefaultValue(Optional ByVal pvDefaultValue As Variant)
''' Set the updatable property DefaultValue
 _PropertySet("DefaultValue", pvDefaultValue)
End Property ' SFDocuments.SF_FormControl.DefaultValue (let)

REM -----------------------------------------------------------------------------
Property Get Enabled() As Variant
''' The Enabled property specifies if the control is accessible with the cursor.
 Enabled = _PropertyGet("Enabled", False)
End Property ' SFDocuments.SF_FormControl.Enabled (get)

REM -----------------------------------------------------------------------------
Property Let Enabled(Optional ByVal pvEnabled As Variant)
''' Set the updatable property Enabled
 _PropertySet("Enabled", pvEnabled)
End Property ' SFDocuments.SF_FormControl.Enabled (let)

REM -----------------------------------------------------------------------------
Property Get Format() As Variant
''' The Format property specifies the format in which to display dates and times.
 Format = _PropertyGet("Format", "")
End Property ' SFDocuments.SF_FormControl.Format (get)

REM -----------------------------------------------------------------------------
Property Let Format(Optional ByVal pvFormat As Variant)
''' Set the updatable property Format
''' NB: Format is read-only for formatted field controls
 _PropertySet("Format", pvFormat)
End Property ' SFDocuments.SF_FormControl.Format (let)

REM -----------------------------------------------------------------------------
Property Get ListCount() As Long
''' The ListCount property specifies the number of rows in a list box or a combo box
 ListCount = _PropertyGet("ListCount", 0)
End Property ' SFDocuments.SF_FormControl.ListCount (get)

REM -----------------------------------------------------------------------------
Property Get ListIndex() As Variant
''' The ListIndex property specifies which item is selected in a list box or combo box.
''' In case of multiple selection, the index of the first one is returned or only one is set
 ListIndex = _PropertyGet("ListIndex", -1)
End Property ' SFDocuments.SF_FormControl.ListIndex (get)

REM -----------------------------------------------------------------------------
Property Let ListIndex(Optional ByVal pvListIndex As Variant)
''' Set the updatable property ListIndex
 _PropertySet("ListIndex", pvListIndex)
End Property ' SFDocuments.SF_FormControl.ListIndex (let)

REM -----------------------------------------------------------------------------
Property Get ListSource() As Variant
''' The ListSource property specifies the data contained in a combobox or a listbox
''' as a zero-based array of string values
 ListSource = _PropertyGet("ListSource", "")
End Property ' SFDocuments.SF_FormControl.ListSource (get)

REM -----------------------------------------------------------------------------
Property Let ListSource(Optional ByVal pvListSource As Variant)
''' Set the updatable property ListSource
 _PropertySet("ListSource", pvListSource)
End Property ' SFDocuments.SF_FormControl.ListSource (let)

REM -----------------------------------------------------------------------------
Property Get ListSourceType() As Variant
''' The ListSourceType property specifies the kind of data source used to fill the list data of a listbox or a combobox
 ListSourceType = _PropertyGet("ListSourceType", "")
End Property ' SFDocuments.SF_FormControl.ListSourceType (get)

REM -----------------------------------------------------------------------------
Property Let ListSourceType(Optional ByVal pvListSourceType As Variant)
''' Set the updatable property ListSourceType
 _PropertySet("ListSourceType", pvListSourceType)
End Property ' SFDocuments.SF_FormControl.ListSourceType (let)

REM -----------------------------------------------------------------------------
Property Get Locked() As Variant
''' The Locked property specifies if a control is read-only
 Locked = _PropertyGet("Locked", False)
End Property ' SFDocuments.SF_FormControl.Locked (get)

REM -----------------------------------------------------------------------------
Property Let Locked(Optional ByVal pvLocked As Variant)
''' Set the updatable property Locked
 _PropertySet("Locked", pvLocked)
End Property ' SFDocuments.SF_FormControl.Locked (let)

REM -----------------------------------------------------------------------------
Property Get MultiSelect() As Variant
''' The MultiSelect property specifies whether a user can make multiple selections in a listbox
 MultiSelect = _PropertyGet("MultiSelect", False)
End Property ' SFDocuments.SF_FormControl.MultiSelect (get)

REM -----------------------------------------------------------------------------
Property Let MultiSelect(Optional ByVal pvMultiSelect As Variant)
''' Set the updatable property MultiSelect
 _PropertySet("MultiSelect", pvMultiSelect)
End Property ' SFDocuments.SF_FormControl.MultiSelect (let)

REM -----------------------------------------------------------------------------
Property Get Name() As String
''' Return the name of the actual control
 Name = _PropertyGet("Name")
End Property ' SFDocuments.SF_FormControl.Name

REM -----------------------------------------------------------------------------
Property Get OnActionPerformed() As Variant
''' Get the script associated with the OnActionPerformed event
 OnActionPerformed = _PropertyGet("OnActionPerformed", "")
End Property ' SFDocuments.SF_FormControl.OnActionPerformed (get)

REM -----------------------------------------------------------------------------
Property Let OnActionPerformed(Optional ByVal pvOnActionPerformed As Variant)
''' Set the updatable property OnActionPerformed
 _PropertySet("OnActionPerformed", pvOnActionPerformed)
End Property ' SFDocuments.SF_FormControl.OnActionPerformed (let)

REM -----------------------------------------------------------------------------
Property Get OnAdjustmentValueChanged() As Variant
''' Get the script associated with the OnAdjustmentValueChanged event
 OnAdjustmentValueChanged = _PropertyGet("OnAdjustmentValueChanged", "")
End Property ' SFDocuments.SF_FormControl.OnAdjustmentValueChanged (get)

REM -----------------------------------------------------------------------------
Property Let OnAdjustmentValueChanged(Optional ByVal pvOnAdjustmentValueChanged As Variant)
''' Set the updatable property OnAdjustmentValueChanged
 _PropertySet("OnAdjustmentValueChanged", pvOnAdjustmentValueChanged)
End Property ' SFDocuments.SF_FormControl.OnAdjustmentValueChanged (let)

REM -----------------------------------------------------------------------------
Property Get OnApproveAction() As Variant
''' Get the script associated with the OnApproveAction event
 OnApproveAction = _PropertyGet("OnApproveAction", "")
End Property ' SFDocuments.SF_FormControl.OnApproveAction (get)

REM -----------------------------------------------------------------------------
Property Let OnApproveAction(Optional ByVal pvOnApproveAction As Variant)
''' Set the updatable property OnApproveAction
 _PropertySet("OnApproveAction", pvOnApproveAction)
End Property ' SFDocuments.SF_FormControl.OnApproveAction (let)

REM -----------------------------------------------------------------------------
Property Get OnApproveReset() As Variant
''' Get the script associated with the OnApproveReset event
 OnApproveReset = _PropertyGet("OnApproveReset", "")
End Property ' SFDocuments.SF_FormControl.OnApproveReset (get)

REM -----------------------------------------------------------------------------
Property Let OnApproveReset(Optional ByVal pvOnApproveReset As Variant)
''' Set the updatable property OnApproveReset
 _PropertySet("OnApproveReset", pvOnApproveReset)
End Property ' SFDocuments.SF_FormControl.OnApproveReset (let)

REM -----------------------------------------------------------------------------
Property Get OnApproveUpdate() As Variant
''' Get the script associated with the OnApproveUpdate event
 OnApproveUpdate = _PropertyGet("OnApproveUpdate", "")
End Property ' SFDocuments.SF_FormControl.OnApproveUpdate (get)

REM -----------------------------------------------------------------------------
Property Let OnApproveUpdate(Optional ByVal pvOnApproveUpdate As Variant)
''' Set the updatable property OnApproveUpdate
 _PropertySet("OnApproveUpdate", pvOnApproveUpdate)
End Property ' SFDocuments.SF_FormControl.OnApproveUpdate (let)

REM -----------------------------------------------------------------------------
Property Get OnChanged() As Variant
''' Get the script associated with the OnChanged event
 OnChanged = _PropertyGet("OnChanged", "")
End Property ' SFDocuments.SF_FormControl.OnChanged (get)

REM -----------------------------------------------------------------------------
Property Let OnChanged(Optional ByVal pvOnChanged As Variant)
''' Set the updatable property OnChanged
 _PropertySet("OnChanged", pvOnChanged)
End Property ' SFDocuments.SF_FormControl.OnChanged (let)

REM -----------------------------------------------------------------------------
Property Get OnErrorOccurred() As Variant
''' Get the script associated with the OnErrorOccurred event
 OnErrorOccurred = _PropertyGet("OnErrorOccurred", "")
End Property ' SFDocuments.SF_FormControl.OnErrorOccurred (get)

REM -----------------------------------------------------------------------------
Property Let OnErrorOccurred(Optional ByVal pvOnErrorOccurred As Variant)
''' Set the updatable property OnErrorOccurred
 _PropertySet("OnErrorOccurred", pvOnErrorOccurred)
End Property ' SFDocuments.SF_FormControl.OnErrorOccurred (let)

REM -----------------------------------------------------------------------------
Property Get OnFocusGained() As Variant
''' Get the script associated with the OnFocusGained event
 OnFocusGained = _PropertyGet("OnFocusGained", "")
End Property ' SFDocuments.SF_FormControl.OnFocusGained (get)

REM -----------------------------------------------------------------------------
Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant)
''' Set the updatable property OnFocusGained
 _PropertySet("OnFocusGained", pvOnFocusGained)
End Property ' SFDocuments.SF_FormControl.OnFocusGained (let)

REM -----------------------------------------------------------------------------
Property Get OnFocusLost() As Variant
''' Get the script associated with the OnFocusLost event
 OnFocusLost = _PropertyGet("OnFocusLost", "")
End Property ' SFDocuments.SF_FormControl.OnFocusLost (get)

REM -----------------------------------------------------------------------------
Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant)
''' Set the updatable property OnFocusLost
 _PropertySet("OnFocusLost", pvOnFocusLost)
End Property ' SFDocuments.SF_FormControl.OnFocusLost (let)

REM -----------------------------------------------------------------------------
Property Get OnItemStateChanged() As Variant
''' Get the script associated with the OnItemStateChanged event
 OnItemStateChanged = _PropertyGet("OnItemStateChanged", "")
End Property ' SFDocuments.SF_FormControl.OnItemStateChanged (get)

REM -----------------------------------------------------------------------------
Property Let OnItemStateChanged(Optional ByVal pvOnItemStateChanged As Variant)
''' Set the updatable property OnItemStateChanged
 _PropertySet("OnItemStateChanged", pvOnItemStateChanged)
End Property ' SFDocuments.SF_FormControl.OnItemStateChanged (let)

REM -----------------------------------------------------------------------------
Property Get OnKeyPressed() As Variant
''' Get the script associated with the OnKeyPressed event
 OnKeyPressed = _PropertyGet("OnKeyPressed", "")
End Property ' SFDocuments.SF_FormControl.OnKeyPressed (get)

REM -----------------------------------------------------------------------------
Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant)
''' Set the updatable property OnKeyPressed
 _PropertySet("OnKeyPressed", pvOnKeyPressed)
End Property ' SFDocuments.SF_FormControl.OnKeyPressed (let)

REM -----------------------------------------------------------------------------
Property Get OnKeyReleased() As Variant
''' Get the script associated with the OnKeyReleased event
 OnKeyReleased = _PropertyGet("OnKeyReleased", "")
End Property ' SFDocuments.SF_FormControl.OnKeyReleased (get)

REM -----------------------------------------------------------------------------
Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant)
''' Set the updatable property OnKeyReleased
 _PropertySet("OnKeyReleased", pvOnKeyReleased)
End Property ' SFDocuments.SF_FormControl.OnKeyReleased (let)

REM -----------------------------------------------------------------------------
Property Get OnMouseDragged() As Variant
''' Get the script associated with the OnMouseDragged event
 OnMouseDragged = _PropertyGet("OnMouseDragged", "")
End Property ' SFDocuments.SF_FormControl.OnMouseDragged (get)

REM -----------------------------------------------------------------------------
Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant)
''' Set the updatable property OnMouseDragged
 _PropertySet("OnMouseDragged", pvOnMouseDragged)
End Property ' SFDocuments.SF_FormControl.OnMouseDragged (let)

REM -----------------------------------------------------------------------------
Property Get OnMouseEntered() As Variant
''' Get the script associated with the OnMouseEntered event
 OnMouseEntered = _PropertyGet("OnMouseEntered", "")
End Property ' SFDocuments.SF_FormControl.OnMouseEntered (get)

REM -----------------------------------------------------------------------------
Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant)
''' Set the updatable property OnMouseEntered
 _PropertySet("OnMouseEntered", pvOnMouseEntered)
End Property ' SFDocuments.SF_FormControl.OnMouseEntered (let)

REM -----------------------------------------------------------------------------
Property Get OnMouseExited() As Variant
''' Get the script associated with the OnMouseExited event
 OnMouseExited = _PropertyGet("OnMouseExited", "")
End Property ' SFDocuments.SF_FormControl.OnMouseExited (get)

REM -----------------------------------------------------------------------------
Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant)
''' Set the updatable property OnMouseExited
 _PropertySet("OnMouseExited", pvOnMouseExited)
End Property ' SFDocuments.SF_FormControl.OnMouseExited (let)

REM -----------------------------------------------------------------------------
Property Get OnMouseMoved() As Variant
''' Get the script associated with the OnMouseMoved event
 OnMouseMoved = _PropertyGet("OnMouseMoved", "")
End Property ' SFDocuments.SF_FormControl.OnMouseMoved (get)

REM -----------------------------------------------------------------------------
Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant)
''' Set the updatable property OnMouseMoved
 _PropertySet("OnMouseMoved", pvOnMouseMoved)
End Property ' SFDocuments.SF_FormControl.OnMouseMoved (let)

REM -----------------------------------------------------------------------------
Property Get OnMousePressed() As Variant
''' Get the script associated with the OnMousePressed event
 OnMousePressed = _PropertyGet("OnMousePressed", "")
End Property ' SFDocuments.SF_FormControl.OnMousePressed (get)

REM -----------------------------------------------------------------------------
Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant)
''' Set the updatable property OnMousePressed
 _PropertySet("OnMousePressed", pvOnMousePressed)
End Property ' SFDocuments.SF_FormControl.OnMousePressed (let)

REM -----------------------------------------------------------------------------
Property Get OnMouseReleased() As Variant
''' Get the script associated with the OnMouseReleased event
 OnMouseReleased = _PropertyGet("OnMouseReleased", "")
End Property ' SFDocuments.SF_FormControl.OnMouseReleased (get)

REM -----------------------------------------------------------------------------
Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant)
''' Set the updatable property OnMouseReleased
 _PropertySet("OnMouseReleased", pvOnMouseReleased)
End Property ' SFDocuments.SF_FormControl.OnMouseReleased (let)

REM -----------------------------------------------------------------------------
Property Get OnResetted() As Variant
''' Get the script associated with the OnResetted event
 OnResetted = _PropertyGet("OnResetted", "")
End Property ' SFDocuments.SF_FormControl.OnResetted (get)

REM -----------------------------------------------------------------------------
Property Let OnResetted(Optional ByVal pvOnResetted As Variant)
''' Set the updatable property OnResetted
 _PropertySet("OnResetted", pvOnResetted)
End Property ' SFDocuments.SF_FormControl.OnResetted (let)

REM -----------------------------------------------------------------------------
Property Get OnTextChanged() As Variant
''' Get the script associated with the OnTextChanged event
 OnTextChanged = _PropertyGet("OnTextChanged", "")
End Property ' SFDocuments.SF_FormControl.OnTextChanged (get)

REM -----------------------------------------------------------------------------
Property Let OnTextChanged(Optional ByVal pvOnTextChanged As Variant)
''' Set the updatable property OnTextChanged
 _PropertySet("OnTextChanged", pvOnTextChanged)
End Property ' SFDocuments.SF_FormControl.OnTextChanged (let)

REM -----------------------------------------------------------------------------
Property Get OnUpdated() As Variant
''' Get the script associated with the OnUpdated event
 OnUpdated = _PropertyGet("OnUpdated", "")
End Property ' SFDocuments.SF_FormControl.OnUpdated (get)

REM -----------------------------------------------------------------------------
Property Let OnUpdated(Optional ByVal pvOnUpdated As Variant)
''' Set the updatable property OnUpdated
 _PropertySet("OnUpdated", pvOnUpdated)
End Property ' SFDocuments.SF_FormControl.OnUpdated (let)

REM -----------------------------------------------------------------------------
Property Get Parent() As Object
''' Return the Parent form or [table]control object of the actual control
 Parent = _PropertyGet("Parent", Nothing)
End Property ' SFDocuments.SF_FormControl.Parent

REM -----------------------------------------------------------------------------
Property Get Picture() As Variant
''' The Picture property specifies a bitmap or other type of graphic to be displayed on the specified control
 Picture = _PropertyGet("Picture", "")
End Property ' SFDocuments.SF_FormControl.Picture (get)

REM -----------------------------------------------------------------------------
Property Let Picture(Optional ByVal pvPicture As Variant)
''' Set the updatable property Picture
 _PropertySet("Picture", pvPicture)
End Property ' SFDocuments.SF_FormControl.Picture (let)

REM -----------------------------------------------------------------------------
Property Get Required() As Variant
''' A control is said Required when it must not contain a null value
 Required = _PropertyGet("Required", False)
End Property ' SFDocuments.SF_FormControl.Required (get)

REM -----------------------------------------------------------------------------
Property Let Required(Optional ByVal pvRequired As Variant)
''' Set the updatable property Required
 _PropertySet("Required", pvRequired)
End Property ' SFDocuments.SF_FormControl.Required (let)

REM -----------------------------------------------------------------------------
Property Get Text() As Variant
''' The Text property specifies the actual content of the control like it is displayed on the screen
 Text = _PropertyGet("Text", "")
End Property ' SFDocuments.SF_FormControl.Text (get)

REM -----------------------------------------------------------------------------
Property Get TipText() As Variant
''' The TipText property specifies the text that appears in a screentip when you hold the mouse pointer over a control
 TipText = _PropertyGet("TipText", "")
End Property ' SFDocuments.SF_FormControl.TipText (get)

REM -----------------------------------------------------------------------------
Property Let TipText(Optional ByVal pvTipText As Variant)
''' Set the updatable property TipText
 _PropertySet("TipText", pvTipText)
End Property ' SFDocuments.SF_FormControl.TipText (let)

REM -----------------------------------------------------------------------------
Property Get TripleState() As Variant
''' The TripleState property specifies how a check box will display Null values
''' When True, the control will cycle through states for Yes, No, and Null values. The control appears dimmed (grayed) when its Value property is set to Null.
''' When False, the control will cycle through states for Yes and No values. Null values display as if they were No values.
 TripleState = _PropertyGet("TripleState", False)
End Property ' SFDocuments.SF_FormControl.TripleState (get)

REM -----------------------------------------------------------------------------
Property Let TripleState(Optional ByVal pvTripleState As Variant)
''' Set the updatable property TripleState
 _PropertySet("TripleState", pvTripleState)
End Property ' SFDocuments.SF_FormControl.TripleState (let)

REM -----------------------------------------------------------------------------
Property Get Value() As Variant
''' The Value property specifies the data contained in the control
 Value = _PropertyGet("Value", Empty)
End Property ' SFDocuments.SF_FormControl.Value (get)

REM -----------------------------------------------------------------------------
Property Let Value(Optional ByVal pvValue As Variant)
''' Set the updatable property Value
 _PropertySet("Value", pvValue)
End Property ' SFDocuments.SF_FormControl.Value (let)

REM -----------------------------------------------------------------------------
Property Get Visible() As Variant
''' The Visible property specifies if the control is accessible with the cursor.
 Visible = _PropertyGet("Visible", True)
End Property ' SFDocuments.SF_FormControl.Visible (get)

REM -----------------------------------------------------------------------------
Property Let Visible(Optional ByVal pvVisible As Variant)
''' Set the updatable property Visible
 _PropertySet("Visible", pvVisible)
End Property ' SFDocuments.SF_FormControl.Visible (let)

REM -----------------------------------------------------------------------------
Property Get XControlModel() As Object
''' The XControlModel property returns the model UNO object of the control
 XControlModel = _PropertyGet("XControlModel", Nothing)
End Property ' SFDocuments.SF_FormControl.XControlModel (get)

REM -----------------------------------------------------------------------------
Property Get XControlView() As Object
''' The XControlView property returns the view UNO object of the control
 XControlView = _PropertyGet("XControlView", Nothing)
End Property ' SFDocuments.SF_FormControl.XControlView (get)

REM ===================================================================== METHODS

REM -----------------------------------------------------------------------------
Public Function Controls(Optional ByVal ControlName As Variant) As Variant
''' Return either
'''  - the list of the controls contained in the actual table control
'''  - a Form Control object based on its name
''' Args:
'''  ControlName: a valid control name as a case-sensitive string. If absent the list is returned
''' Returns:
'''  A zero-base array of strings if ControlName is absent
'''  An instance of the SF_FormControl class if ControlName exists
''' Exceptions:
'''  ControlName is invalid
''' Example:
'''   Dim myGrid As Object, myList As Variant, myControl As Object
'''    Set myGrid = myForm.Controls("myTableControl")
'''    myList = myGrid.Controls()
'''    Set myControl = myGrid.Controls("myCheckBox")

Dim oControl As Object    ' The new control class instance
Dim lIndexOfNames As Long   ' Index in ElementNames array. Used to access _ControlCache
Dim vControl As Variant    ' Alias of _ControlCache entry
Dim oView As Object     ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
Dim i As Long
Const cstThisSub = "SFDocuments.FormControl.Controls"
Const cstSubArgs = "[ControlName]"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 Set Controls = Nothing

Check:
 If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If _ControlType <> CTLTABLECONTROL Then GoTo Catch
  If Not [_Parent]._IsStillAlive() Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
 End If

Try:
 ' Collect all control names if not yet done
 If UBound(_ControlNames) < 0 Then
  _ControlNames = _ControlModel.getElementNames()
  If UBound(_ControlNames) >= 0 Then
   ReDim _ControlCache(0 To UBound(_ControlNames))
  End If
 End If

 ' Return the list of controls or a FormControl instance
 If Len(ControlName) = 0 Then
  Controls = _ControlNames

 Else

  If Not _ControlModel.hasByName(ControlName) Then GoTo CatchNotFound
  lIndexOfNames = ScriptForge.SF_Array.IndexOf(_ControlNames, ControlName, CaseSensitive := True)
  ' Reuse cache when relevant
  vControl = _ControlCache(lIndexOfNames)

  If IsEmpty(vControl) Then
   ' Not in cache => Create the new form control class instance
   Set oControl = New SF_FormControl
   With oControl
    ._Name = ControlName
    Set .[Me] = oControl
    Set .[_Parent] = [Me]
    ._ParentIsTable = True
    ._IndexOfNames = lIndexOfNames
    ._FormName = _FormName
    Set ._ParentForm = _ParentForm
    ' Get model and view of the current control
    Set ._ControlModel = _ControlModel.getByName(ControlName)
    ._ImplementationName = ._ControlModel.ColumnServiceName ' getImplementationName aborts for subcontrols !?
    ' Bypass to find the control view: cannot be done from the top component
    If Not IsNull(_ControlView) Then  ' Anticipate absence of ControlView in table controls when edit mode
     For i = 0 to _ControlView.getCount() - 1
      Set oView = _ControlView.GetByIndex(i)
      If Not IsNull(oView) Then
       If oView.getModel.Name = ControlName Then
        Set ._ControlView = oView
        Exit For
       End If
      End If
     Next i
    End If
    ._Initialize()
   End With
  Else
   Set oControl = vControl
  End If

  Set Controls = oControl
 End If

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
CatchNotFound:
 ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _ControlModel.getElementNames(), True)
 GoTo Finally
End Function ' SFDocuments.SF_FormControl.Controls

REM -----------------------------------------------------------------------------
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
''' Return the actual value of the given property
''' Args:
'''  PropertyName: the name of the property as a string
''' Returns:
'''  The actual value of the property
'''  If the property does not exist, returns Null
''' Exceptions:
'''  see the exceptions of the individual properties
''' Examples:
'''  myControl.GetProperty("MyProperty")

Dim vDefault As Variant   ' Default value when property not applicable on control type
Const cstThisSub = "SFDocuments.FormControl.GetProperty"
Const cstSubArgs = ""

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 GetProperty = Null

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
 End If

Try:
 ' FormControl properties are far from applicable to all control types
 ' Getting a property must never abort to not interfere with the Basic IDE watch function
 ' Hence a default value must be provided
 Select Case UCase(PropertyName)
  Case UCase("Default")  : vDefault = False
  Case UCase("DefaultValue") : vDefault = Null
  Case UCase("Enabled")  : vDefault = False
  Case UCase("ListCount")  : vDefault = 0
  Case UCase("ListIndex")  : vDefault = -1
  Case UCase("Locked")  : vDefault = False
  Case UCase("MultiSelect") : vDefault = False
  Case UCase("Parent")  : vDefault = Nothing
  Case UCase("Required")  : vDefault = False
  Case UCase("TripleState") : vDefault = False
  Case UCase("Value")   : vDefault = Empty
  Case UCase("Visible")  : vDefault = True
  Case UCase("XControlModel") : vDefault = Nothing
  Case UCase("XControlView") : vDefault = Nothing
  Case Else     : vDefault = ""
 End Select

 GetProperty = _PropertyGet(PropertyName, vDefault)

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_FormControl.GetProperty

REM -----------------------------------------------------------------------------
Public Function Methods() As Variant
''' Return the list of public methods of the FormControl service as an array

 Methods = Array( _
     "AddSubNode" _
     , "AddSubTree" _
     , "CreateRoot" _
     , "FindNode" _
     , "SetFocus" _
     , "WriteLine" _
     )

End Function ' SFDocuments.SF_FormControl.Methods

REM -----------------------------------------------------------------------------
Public Function Properties() As Variant
''' Return the list or properties of the FormControl class as an array

 Properties = Array( _
     "Action" _
     , "Cancel" _
     , "Caption" _
     , "ControlSource" _
     , "ControlType" _
     , "Default" _
     , "DefaultValue" _
     , "Enabled" _
     , "Format" _
     , "ListCount" _
     , "ListIndex" _
     , "ListSource" _
     , "ListSourceType" _
     , "Locked" _
     , "MultiSelect" _
     , "Name" _
     , "OnActionPerformed" _
     , "OnAdjustmentValueChanged" _
     , "OnApproveAction" _
     , "OnApproveReset" _
     , "OnApproveUpdate" _
     , "OnChanged" _
     , "OnErrorOccurred" _
     , "OnFocusGained" _
     , "OnFocusLost" _
     , "OnItemStateChanged" _
     , "OnKeyPressed" _
     , "OnKeyReleased" _
     , "OnMouseDragged" _
     , "OnMouseEntered" _
     , "OnMouseExited" _
     , "OnMouseMoved" _
     , "OnMousePressed" _
     , "OnMouseReleased" _
     , "OnResetted" _
     , "OnTextChanged" _
     , "OnUpdated" _
     , "Parent" _
     , "Picture" _
     , "Required" _
     , "Text" _
     , "TipText" _
     , "TripleState" _
     , "Value" _
     , "Visible" _
     , "XControlModel" _
     , "XControlView" _
     )

End Function ' SFDocuments.SF_FormControl.Properties

REM -----------------------------------------------------------------------------
Public Function SetFocus() As Boolean
''' Set the focus on the current Control instance
''' Probably called from after an event occurrence
''' Args:
''' Returns:
'''  True if focusing is successful
''' Example:
'''  Dim oDoc As Object, oForm As Object, oControl As Object
'''   Set oDoc = CreateScriptService("SFDocuments.Document", ThisComponent)
'''   Set oForm = oDoc.Forms(0)
'''   Set oControl = oForm.Controls("thisControl")
'''   oControl.SetFocus()

Dim bSetFocus As Boolean  ' Return value
Dim iColPosition As Integer  ' Position of control in table
Dim oTableModel As Object  ' XControlModel of parent table
Dim oControl As Object   ' com.sun.star.awt.XControlModel
Dim i As Integer, j As Integer
Const cstThisSub = "SFDocuments.FormControl.SetFocus"
Const cstSubArgs = ""

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bSetFocus = False

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _ParentForm._IsStillAlive() Then GoTo Finally
 End If

Try:
 If Not IsNull(_ControlView) Then
  If _ParentIsTable Then ' setFocus() method does not work on controlviews in table control ?!?
   ' Find the column position of the current instance in the parent table control
   iColPosition = -1
   Set oTableModel = [_Parent]._ControlModel
   j = -1
   For i = 0 To oTableModel.Count - 1
    Set oControl = oTableModel.getByIndex(i)
    If Not oControl.Hidden Then j = j + 1  ' Skip hidden columns
    If oControl.Name = _Name Then
     iColPosition = j
     Exit For
    End If
   Next i
   If iColPosition >= 0 Then
    [_Parent]._ControlView.setFocus()        'Set first focus on table control itself
    [_Parent]._ControlView.setCurrentColumnPosition(iColPosition) 'Deprecated but no alternative found
   End If
  Else
   _ControlView.setFocus()
  End If
  bSetFocus = True
 End If
 bSetFocus = True

Finally:
 SetFocus = bSetFocus
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFControls.SF_FormControl.SetFocus

REM -----------------------------------------------------------------------------
Public Function SetProperty(Optional ByVal PropertyName As Variant _
        , Optional ByRef Value As Variant _
        ) As Boolean
''' Set a new value to the given property
''' Args:
'''  PropertyName: the name of the property as a string
'''  Value: its new value
''' Exceptions
'''  ARGUMENTERROR  The property does not exist

Const cstThisSub = "SFDocuments.FormControl.SetProperty"
Const cstSubArgs = "PropertyName, Value"

 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 SetProperty = False

Check:
 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
 End If

Try:
 SetProperty = _PropertySet(PropertyName, Value)

Finally:
 SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_FormControl.SetProperty

REM =========================================================== PRIVATE FUNCTIONS

REM -----------------------------------------------------------------------------
Private Function _FormatsList() As Variant
''' Return the allowed format entries as a zero-based array for Date and Time control types

Dim vFormats() As Variant  ' Return value

 Select Case _ControlType
  Case CTLDATEFIELD
   vFormats = Array( _
    "Standard (short)" _
    , "Standard (short YY)" _
    , "Standard (short YYYY)" _
    , "Standard (long)" _
    , "DD/MM/YY" _
    , "MM/DD/YY" _
    , "YY/MM/DD" _
    , "DD/MM/YYYY" _
    , "MM/DD/YYYY" _
    , "YYYY/MM/DD" _
    , "YY-MM-DD" _
    , "YYYY-MM-DD" _
    )
  Case CTLTIMEFIELD
   vFormats = Array( _
    "24h short" _
    , "24h long" _
    , "12h short" _
    , "12h long" _
    )
  Case Else
   vFormats = Array()
 End Select
 
 _FormatsList = vFormats

End Function ' SFDocuments.SF_FormControl._FormatsList

REM -----------------------------------------------------------------------------
Public Function _GetEventName(ByVal psProperty As String) As String
''' Return the LO internal event name derived from the SF property name
''' The SF property name is not case sensitive, while the LO name is case-sensitive
' Corrects the typo on ErrorOccur(r?)ed, if necessary

Dim vProperties As Variant   ' Array of class properties
Dim sProperty As String    ' Correctly cased property name

 vProperties = Properties()
 sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))

 _GetEventName = LCase(Mid(sProperty, 3, 1)) & Right(sProperty, Len(sProperty) - 3)
 
End Function ' SFDocuments.SF_FormControl._GetEventName

REM -----------------------------------------------------------------------------
Private Function _GetListener(ByVal psEventName As String) As String
''' Getting/Setting macros triggered by events requires a Listener-EventName pair
''' Return the X...Listener corresponding with the event name in argument

 Select Case UCase(psEventName)
  Case UCase("OnActionPerformed")
   _GetListener = "XActionListener"
  Case UCase("OnAdjustmentValueChanged")
   _GetListener = "XAdjustmentListener"
  Case UCase("OnApproveAction")
   _GetListener = "XApproveActionListener"
  Case UCase("OnApproveReset"), UCase("OnResetted")
   _GetListener = "XResetListener"
  Case UCase("OnApproveUpdate"), UCase("OnUpdated")
   _GetListener = "XUpdateListener"
  Case UCase("OnChanged")
   _GetListener = "XChangeListener"
  Case UCase("OnErrorOccurred")
   _GetListener = "XErrorListener"
  Case UCase("OnFocusGained"), UCase("OnFocusLost")
   _GetListener = "XFocusListener"
  Case UCase("OnItemStateChanged")
   _GetListener = "XItemListener"
  Case UCase("OnKeyPressed"), UCase("OnKeyReleased")
   _GetListener = "XKeyListener"
  Case UCase("OnMouseDragged"), UCase("OnMouseMoved")
   _GetListener = "XMouseMotionListener"
  Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased")
   _GetListener = "XMouseListener"
  Case UCase("OnTextChanged")
   _GetListener = "XTextListener"
 End Select
 
End Function ' SFDocuments.SF_FormControl._GetListener

REM -----------------------------------------------------------------------------
Public Sub _Initialize()
''' Complete the object creation process:
'''  - Initialization of private members
'''  - Collection of specific attributes
'''  - Synchronization with parent form instance

Dim vControlTypes As Variant  ' Array of control types ordered by the ClassId property of XControlModel - 2
Const acHiddenControl = 13   ' Class Id of an hidden control: has no ControlView

 vControlTypes = array( CTLBUTTON _
       , CTLRADIOBUTTON _
       , CTLIMAGEBUTTON _
       , CTLCHECKBOX _
       , CTLLISTBOX _
       , CTLCOMBOBOX _
       , CTLGROUPBOX _
       , CTLTEXTFIELD _
       , CTLFIXEDTEXT _
       , CTLTABLECONTROL _
       , CTLFILECONTROL _
       , CTLHIDDENCONTROL _
       , CTLIMAGECONTROL _
       , CTLDATEFIELD _
       , CTLTIMEFIELD _
       , CTLNUMERICFIELD _
       , CTLCURRENCYFIELD _
       , CTLPATTERNFIELD _
       , CTLSCROLLBAR _
       , CTLSPINBUTTON _
       , CTLNAVIGATIONBAR _
      )

Try:
 ' _implementationName is set elsewhere for controls in table control
 If Len(_ImplementationName) = 0 Then _ImplementationName = ScriptForge.SF_Session.UnoObjectType(_ControlModel)
 _ClassId = _ControlModel.ClassId

 ' Identify the control type, ignore subforms and pay attention to formatted fields
 If ScriptForge.SF_Session.HasUnoproperty(_ControlModel, "ClassId") Then  ' All control types have a ClassId property except subforms
  _ControlType = vControlTypes(_ClassId - 2)
  ' Formatted fields belong to the TextField family
  If _ControlType = CTLTEXTFIELD Then
   If _ImplementationName = "com.sun.star.comp.forms.OFormattedFieldWrapper" _
    Or _ImplementationName = "com.sun.star.comp.forms.OFormattedFieldWrapper_ForcedFormatted" _
    Or _ImplementationName = "com.sun.star.form.component.FormattedField" Then  ' When in table control
      _ControlType = CTLFORMATTEDFIELD
   End If
  End If
 Else
  Exit Sub ' Ignore subforms, should not happen
 End If

 With [_Parent]
  ' Set control view if not set yet
  If IsNull(_ControlView) Then
   If _ClassId > 0 And _ClassId <> acHiddenControl Then ' No view on hidden controls
    If IsNull(._FormDocument) Then  ' Usual document
     Set _ControlView = ._Component.CurrentController.getControl(_ControlModel)
    Else        ' Base form document
     Set _ControlView = ._FormDocument.Component.CurrentController.getControl(_ControlModel)
    End If
   End If
  End If
 End With

 ' Store  the SF_FormControl object in the parent cache
 Set [_Parent]._ControlCache(_IndexOfNames) = [Me]

Finally:
 Exit Sub
End Sub   ' SFDocuments.SF_FormControl._Initialize

REM -----------------------------------------------------------------------------
Private Function _ListboxBound() As Boolean
''' Return True if the actual control, which is a listbox, has a bound column
''' Called before setting the value of a listbox, i.e. the value to be rewritten in the underlying table data
''' The existence of a bound column is derived from the comparison between StringItemList and ValueItemList
'''  String ... : the strings displayed in the list box
'''  Value ...  : the database values
'''  If they are different, then there is a bound column

Dim bListboxBound As Boolean  ' Return value
Dim vValue() As Variant    ' Alias of the control model ValueItemList
Dim vString() As Variant   ' Alias of the control model StringItemList
Dim i As Long

 bListboxBound = False

 With _ControlModel
  If Not IsNull(.ValueItemList) _
   And .DataField <> "" _
   And Not IsNull(.BoundField) _
   And ScriptForge.SF_Array.Contains(Array( _
      com.sun.star.form.ListSourceType.TABLE _
      , com.sun.star.form.ListSourceType.QUERY _
      , com.sun.star.form.ListSourceType.SQL _
      , com.sun.star.form.ListSourceType.SQLPASSTHROUGH _
   ), .ListSourceType) Then
   If IsArray(.ValueItemList) Then
    vValue = .ValueItemList
    vString = .StringItemList
    For i = 0 To UBound(vValue)
     If VarType(vValue(i)) <> VarType(vString(i)) Then
      bListboxBound = True
     ElseIf vValue(i) <> vString(i) Then
      bListboxBound = True
     End If
     If bListboxBound Then Exit For
    Next i
   End If
  End If
 End With
 
 _ListboxBound = bListboxBound

End Function  ' _ListboxBound V0.9.0

REM -----------------------------------------------------------------------------
Private Function _PropertyGet(Optional ByVal psProperty As String _
        , Optional ByVal pvDefault As Variant _
        ) As Variant
''' Return the value of the named property
''' Args:
'''  psProperty: the name of the property
'''  pvDefault: the value returned when the property is not applicable on the control's type
'''   Getting a non-existing property for a specific control type should
'''   not generate an error to not disrupt the Basic IDE debugger

Dim vGet As Variant       ' Return value
Static oSession As Object     ' Alias of SF_Session
Dim vSelection As Variant     ' Alias of Model.SelectedItems or Model.Selection
Dim vList As Variant      ' Alias of Model.StringItemList
Dim lIndex As Long       ' Index in StringItemList
Dim sItem As String       ' A single item
Dim vDate As Variant      ' Date after conversion from com.sun.star.util.Date or com.sun.star.util.Time
Dim vValues As Variant      ' Array of listbox values
Dim oControlEvents As Object    ' com.sun.star.container.XNameContainer
Dim sEventName As String     ' Internal event name
Const cstUnoUrl = ".uno:FormController/"
Dim i As Long
Dim cstThisSub As String
Const cstSubArgs = ""

 cstThisSub = "SFDocuments.FormControl.get" & psProperty
 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch

 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
 If Not _ParentForm._IsStillAlive() Then GoTo Finally

 If IsMissing(pvDefault) Or IsEmpty(pvDefault) Then pvDefault = Null
 _PropertyGet = pvDefault

 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
 Select Case UCase(psProperty)
  Case UCase("Action")
   Select Case _ControlType
    Case CTLBUTTON
     If oSession.HasUNOProperty(_ControlModel, "ButtonType") Then
      Select Case _ControlModel.ButtonType
       Case com.sun.star.form.FormButtonType.PUSH  : _PropertyGet = "none"
       Case com.sun.star.form.FormButtonType.SUBMIT : _PropertyGet = "submitForm"
       Case com.sun.star.form.FormButtonType.RESET  : _PropertyGet = "resetForm"
       Case com.sun.star.form.FormButtonType.URL
        ' ".uno:FormController/moveToFirst"
        If Left(_ControlModel.TargetURL, Len(cstUnoUrl)) = cstUnoUrl Then
         _PropertyGet = Mid(_ControlModel.TargetURL, Len(cstUnoUrl) + 1)
        ElseIf Left(_ControlModel.TargetURL, 4) = "http" Then
         _PropertyGet = "openWebPage"
        ElseIf Left(_ControlModel.TargetURL, 4) = "file" Then
         _PropertyGet ="openDocument"
        End If
      End Select
     End If
    Case Else : GoTo CatchType
   End Select
  Case UCase("Caption")
   Select Case _ControlType
    Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
     If oSession.HasUNOProperty(_ControlModel, "Label") Then _PropertyGet = _ControlModel.Label
    Case Else : GoTo CatchType
   End Select
  Case UCase("ControlSource")
   Select Case _ControlType
    Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFORMATTEDFIELD, CTLIMAGECONTROL, CTLLISTBOX _
     , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLRADIOBUTTON, CTLTEXTFIELD, CTLTIMEFIELD
     If oSession.HasUNOProperty(_ControlModel, "DataField") Then _PropertyGet = _ControlModel.DataField
    Case Else : GoTo CatchType
   End Select
  Case UCase("ControlType")
   _PropertyGet = _ControlType
  Case UCase("Default")
   Select Case _ControlType
    Case CTLBUTTON
     If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _PropertyGet = _ControlModel.DefaultButton
    Case Else : GoTo CatchType
   End Select
  Case UCase("DefaultValue")
   Select Case _ControlType
    Case CTLCHECKBOX, CTLRADIOBUTTON
     If oSession.HasUNOProperty(_ControlModel, "DefaultState") Then _PropertyGet = _ControlModel.DefaultState
    Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD
     If oSession.HasUNOProperty(_ControlModel, "DefaultText") Then _PropertyGet = _ControlModel.DefaultText
    Case CTLCURRENCYFIELD, CTLNUMERICFIELD
     If oSession.HasUNOProperty(_ControlModel, "DefaultValue") Then _PropertyGet = _ControlModel.DefaultValue
    Case CTLDATEFIELD
     If oSession.HasUNOProperty(_ControlModel, "DefaultDate") Then
      If Not IsEmpty(_ControlModel.DefaultDate) Then
       With _ControlModel.DefaultDate
        vDate = DateSerial(.Year, .Month, .Day)
       End With
       _PropertyGet = vDate
      End If
     End If
    Case CTLFORMATTEDFIELD
     If oSession.HasUNOProperty(_ControlModel, "EffectiveDefault") Then _PropertyGet = _ControlModel.EffectiveDefault
    Case CTLLISTBOX
     If oSession.HasUNOProperty(_ControlModel, "DefaultSelection") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
      vList = _ControlModel.DefaultSelection
      If IsArray(vList) Then
       If UBound(vList) >= LBound(vList) Then  ' Is array initialized ?
        lIndex = UBound(_ControlModel.StringItemList)
        If vList(0) >= 0 And vList(0) <= lIndex Then _PropertyGet = _ControlModel.StringItemList(vList(0))
            ' Only first default value is considered
       End If
      End If
     End If
    Case CTLSPINBUTTON
     If oSession.HasUNOProperty(_ControlModel, "DefaultSpinValue") Then _PropertyGet = _ControlModel.DefaultSpinValue
    Case CTLTIMEFIELD
     If oSession.HasUNOProperty(_ControlModel, "DefaultTime") Then
      If Not IsEmpty(_ControlModel.DefaultTime) Then
       With _ControlModel.DefaultTime
        vDate = TimeSerial(.Hours, .Minutes, .Seconds)
       End With
       _PropertyGet = vDate
      End If
     End If
    Case Else : GoTo CatchType
   End Select
  Case UCase("Enabled")
   Select Case _ControlType
    Case CTLHIDDENCONTROL : GoTo CatchType
    Case Else
     If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _PropertyGet = _ControlModel.Enabled
   End Select
  Case UCase("Format")
   Select Case _ControlType
    Case CTLDATEFIELD
     If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = _FormatsList()(_ControlModel.DateFormat)
    Case CTLTIMEFIELD
     If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = _FormatsList()(_ControlModel.TimeFormat)
    Case CTLFORMATTEDFIELD
     If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") And oSession.HasUNOProperty(_ControlModel, "FormatKey") Then
      _PropertyGet = _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString
     End If
    Case Else : GoTo CatchType
   End Select
  Case UCase("ListCount")
   Select Case _ControlType
    Case CTLCOMBOBOX, CTLLISTBOX
     If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1
    Case Else : GoTo CatchType
   End Select
  Case UCase("ListIndex")
   Select Case _ControlType
    Case CTLCOMBOBOX
     _PropertyGet = -1 ' Not found, multiselection
     If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
      _PropertyGet = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, _ControlModel.Text, CaseSensitive := True)
     End If
    Case CTLLISTBOX
     _PropertyGet = -1 ' Not found, multiselection
     If oSession.HasUNOProperty(_ControlModel, "SelectedItems") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
      vSelection = _ControlModel.SelectedItems
--> --------------------

--> maximum size reached

--> --------------------

[ Dauer der Verarbeitung: 0.18 Sekunden  (vorverarbeitet)  ]

                                                                                                                                                                                                                                                                                                                                                                                                     


Neuigkeiten

     Aktuelles
     Motto des Tages

Software

     Produkte
     Quellcodebibliothek

Aktivitäten

     Artikel über Sicherheit
     Anleitung zur Aktivierung von SSL

Muße

     Gedichte
     Musik
     Bilder

Jenseits des Üblichen ....
    

Besucherstatistik

Besucherstatistik

Monitoring

Montastic status badge