ef08207a29
New methods in the SF_Calc service:
Charts(), to list charts or to instantiate a chart service
CreateChart, to create a new chart in a given Calc sheet
The SF_Chart service has next properties to parameter the type
and the characteristics of the (new or pre-existing) chart
ChartType, Deep, Dim3d, Exploded, Filled, Legend, Percent, Stacked,
Title, XTitle, YTitle
Next methods are available:
Resize, to move and resize the chart shape
ExportToFile, to export the chart as a graphical object
Supported: gif, jpeg, png, svg and tiff
New error messages in SF_Root and SF_Exception.
Corresponding labels are integrated in the POT file
Full support under Basic and Python
Review of make file of the SFDocuments library
Change-Id: Id8db3098ff24fbf2efcbdd9c6dcd4f02ff5972af
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/119824
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
1888 lines
No EOL
93 KiB
XML
1888 lines
No EOL
93 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_FormControl" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
|
|
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
|
REM === The SFDocuments library is one of the associated libraries. ===
|
|
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
|
REM =======================================================================================================================
|
|
|
|
Option Compatible
|
|
Option ClassModule
|
|
|
|
Option Explicit
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''' SF_FormControl
|
|
''' ================
|
|
''' Manage the controls belonging to a form or subform stored in a document
|
|
''' Each instance of the current class represents a single control within a form, a subform or a tablecontrol
|
|
''' A prerequisite is that all controls within the same form, subform or tablecontrol must have
|
|
''' a unique name. This is also true for the individual radio buttons belonging to the same group.
|
|
''' A common group name must identify such a single group.
|
|
'''
|
|
''' The focus is clearly set on getting and setting the values displayed by the controls of the form,
|
|
''' not on their formatting. The latter is easily accessible via the XControlModel and XControlView
|
|
''' UNO objects.
|
|
''' Essentially a single property "Value" maps many alternative UNO properties depending each on
|
|
''' the control type.
|
|
'''
|
|
''' Service invocations:
|
|
''' Dim myForm As Object, myControl As Object
|
|
''' Set myForm = ... (read the comments in the SF_Form module)
|
|
''' Set myControl = myForm.Controls("myTextBox")
|
|
''' myControl.Value = "Current time = " & Now()
|
|
'''
|
|
''' REM the control is the subject of an event
|
|
''' Sub OnEvent(ByRef poEvent As Object)
|
|
''' Dim myControl As Object
|
|
''' Set myControl = CreateScriptService("SFDocuments.FormEvent", poEvent)
|
|
'''
|
|
''' Detailed user documentation:
|
|
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_formcontrol.html?DbPAR=BASIC
|
|
'''
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
Private Const FORMCONTROLTYPEERROR = "FORMCONTROLTYPEERROR"
|
|
|
|
REM ============================================================= PRIVATE MEMBERS
|
|
|
|
Private [Me] As Object
|
|
Private [_Parent] As Object
|
|
Private ObjectType As String ' Must be FORMCONTROL
|
|
Private ServiceName As String
|
|
|
|
' Control naming and context
|
|
Private _Name As String
|
|
Private _IndexOfNames As Long ' Index in ElementNames array. Used to access SF_Form._ControlCache
|
|
Private _FormName As String ' Parent form name
|
|
Private _ParentForm As Object ' Parent form or subform instance
|
|
Private _ParentIsTable As Boolean ' True when parent is a table control
|
|
|
|
' Control UNO references
|
|
Private _ControlModel As Object ' com.sun.star.awt.XControlModel
|
|
Private _ControlView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
|
|
|
|
' Control attributes
|
|
Private _ImplementationName As String
|
|
Private _ControlType As String ' One of the CTLxxx constants
|
|
Private _ClassId As Integer ' Numerical type of control
|
|
|
|
' Cache storage for table controls
|
|
Private _ControlNames As Variant ' Array of control names
|
|
Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of XControlModel
|
|
|
|
REM ============================================================ MODULE CONSTANTS
|
|
|
|
' ClassId
|
|
Private Const CTLBUTTON = "Button" ' 2
|
|
Private Const CTLCHECKBOX = "CheckBox" ' 5
|
|
Private Const CTLCOMBOBOX = "ComboBox" ' 7
|
|
Private Const CTLCURRENCYFIELD = "CurrencyField" ' 18
|
|
Private Const CTLDATEFIELD = "DateField" ' 15
|
|
Private Const CTLFILECONTROL = "FileControl" ' 12
|
|
Private Const CTLFIXEDTEXT = "FixedText" ' 10
|
|
Private Const CTLFORMATTEDFIELD = "FormattedField" ' Idem TextField
|
|
Private Const CTLGROUPBOX = "GroupBox" ' 8
|
|
Private Const CTLHIDDENCONTROL = "HiddenControl" ' 13
|
|
Private Const CTLIMAGEBUTTON = "ImageButton" ' 4
|
|
Private Const CTLIMAGECONTROL = "ImageControl" ' 14
|
|
Private Const CTLLISTBOX = "ListBox" ' 6
|
|
Private Const CTLNAVIGATIONBAR = "NavigationBar" ' 22
|
|
Private Const CTLNUMERICFIELD = "NumericField" ' 17
|
|
Private Const CTLPATTERNFIELD = "PatternField" ' 19
|
|
Private Const CTLRADIOBUTTON = "RadioButton" ' 3
|
|
Private Const CTLSCROLLBAR = "ScrollBar" ' 20
|
|
Private Const CTLSPINBUTTON = "SpinButton" ' 21
|
|
Private Const CTLTABLECONTROL = "TableControl" ' 11
|
|
Private Const CTLTEXTFIELD = "TextField" ' 9
|
|
Private Const CTLTIMEFIELD = "TimeField" ' 16
|
|
|
|
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Initialize()
|
|
Set [Me] = Nothing
|
|
Set [_Parent] = Nothing
|
|
ObjectType = "FORMCONTROL"
|
|
ServiceName = "SFDocuments.FormControl"
|
|
_Name = ""
|
|
_IndexOfNames = -1
|
|
_FormName = ""
|
|
_ParentIsTable = False
|
|
Set _ParentForm = Nothing
|
|
Set _ControlModel = Nothing
|
|
Set _ControlView = Nothing
|
|
_ImplementationName = ""
|
|
_ControlType = ""
|
|
_ClassId = 0
|
|
_ControlNames = Array()
|
|
_ControlCache = Array()
|
|
End Sub ' SFDocuments.SF_FormControl Constructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Terminate()
|
|
Call Class_Initialize()
|
|
End Sub ' SFDocuments.SF_FormControl Destructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Dispose() As Variant
|
|
If Not IsNull([_Parent]) And _IndexOfNames >= 0 Then [_Parent]._ControlCache(_IndexOfNames) = Empty
|
|
Call Class_Terminate()
|
|
Set Dispose = Nothing
|
|
End Function ' SFDocuments.SF_FormControl Explicit Destructor
|
|
|
|
REM ================================================================== PROPERTIES
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Action() As Variant
|
|
''' The Action property specifies the action triggered when the button is clicked
|
|
''' Accepted values: none, submitForm, resetForm, refreshForm, moveToFirst, moveToLast,
|
|
''' moveToNext, moveToPrev, saveRecord, moveToNew, deleteRecord, undoRecord
|
|
Action = _PropertyGet("Action", "")
|
|
End Property ' SFDocuments.SF_FormControl.Action (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Action(Optional ByVal pvAction As Variant)
|
|
''' Set the updatable property Action
|
|
_PropertySet("Action", pvAction)
|
|
End Property ' SFDocuments.SF_FormControl.Action (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Caption() As Variant
|
|
''' The Caption property refers to the text associated with the control
|
|
Caption = _PropertyGet("Caption", "")
|
|
End Property ' SFDocuments.SF_FormControl.Caption (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Caption(Optional ByVal pvCaption As Variant)
|
|
''' Set the updatable property Caption
|
|
_PropertySet("Caption", pvCaption)
|
|
End Property ' SFDocuments.SF_FormControl.Caption (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ControlSource() As Variant
|
|
''' The ControlSource property specifies the rowset field mapped onto the actual control
|
|
ControlSource = _PropertyGet("ControlSource", "")
|
|
End Property ' SFDocuments.SF_FormControl.ControlSource (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ControlType() As String
|
|
''' Return the type of the actual control: "CheckBox", "TextField", "DateField", ...
|
|
ControlType = _PropertyGet("ControlType")
|
|
End Property ' SFDocuments.SF_FormControl.ControlType
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Default() As Variant
|
|
''' The Default property specifies whether a command button is the default (OK) button.
|
|
Default = _PropertyGet("Default", False)
|
|
End Property ' SFDocuments.SF_FormControl.Default (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Default(Optional ByVal pvDefault As Variant)
|
|
''' Set the updatable property Default
|
|
_PropertySet("Default", pvDefault)
|
|
End Property ' SFDocuments.SF_FormControl.Default (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get DefaultValue() As Variant
|
|
''' The DefaultValue property specifies how the control is initialized in a new record
|
|
DefaultValue = _PropertyGet("DefaultValue", Null)
|
|
End Property ' SFDocuments.SF_FormControl.DefaultValue (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let DefaultValue(Optional ByVal pvDefaultValue As Variant)
|
|
''' Set the updatable property DefaultValue
|
|
_PropertySet("DefaultValue", pvDefaultValue)
|
|
End Property ' SFDocuments.SF_FormControl.DefaultValue (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Enabled() As Variant
|
|
''' The Enabled property specifies if the control is accessible with the cursor.
|
|
Enabled = _PropertyGet("Enabled", False)
|
|
End Property ' SFDocuments.SF_FormControl.Enabled (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Enabled(Optional ByVal pvEnabled As Variant)
|
|
''' Set the updatable property Enabled
|
|
_PropertySet("Enabled", pvEnabled)
|
|
End Property ' SFDocuments.SF_FormControl.Enabled (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Format() As Variant
|
|
''' The Format property specifies the format in which to display dates and times.
|
|
Format = _PropertyGet("Format", "")
|
|
End Property ' SFDocuments.SF_FormControl.Format (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Format(Optional ByVal pvFormat As Variant)
|
|
''' Set the updatable property Format
|
|
''' NB: Format is read-only for formatted field controls
|
|
_PropertySet("Format", pvFormat)
|
|
End Property ' SFDocuments.SF_FormControl.Format (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ListCount() As Long
|
|
''' The ListCount property specifies the number of rows in a list box or a combo box
|
|
ListCount = _PropertyGet("ListCount", 0)
|
|
End Property ' SFDocuments.SF_FormControl.ListCount (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ListIndex() As Variant
|
|
''' The ListIndex property specifies which item is selected in a list box or combo box.
|
|
''' In case of multiple selection, the index of the first one is returned or only one is set
|
|
ListIndex = _PropertyGet("ListIndex", -1)
|
|
End Property ' SFDocuments.SF_FormControl.ListIndex (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let ListIndex(Optional ByVal pvListIndex As Variant)
|
|
''' Set the updatable property ListIndex
|
|
_PropertySet("ListIndex", pvListIndex)
|
|
End Property ' SFDocuments.SF_FormControl.ListIndex (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ListSource() As Variant
|
|
''' The ListSource property specifies the data contained in a combobox or a listbox
|
|
''' as a zero-based array of string values
|
|
ListSource = _PropertyGet("ListSource", "")
|
|
End Property ' SFDocuments.SF_FormControl.ListSource (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let ListSource(Optional ByVal pvListSource As Variant)
|
|
''' Set the updatable property ListSource
|
|
_PropertySet("ListSource", pvListSource)
|
|
End Property ' SFDocuments.SF_FormControl.ListSource (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ListSourceType() As Variant
|
|
''' The ListSourceType property specifies the kind of data source used to fill the list data of a listbox or a combobox
|
|
ListSourceType = _PropertyGet("ListSourceType", "")
|
|
End Property ' SFDocuments.SF_FormControl.ListSourceType (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let ListSourceType(Optional ByVal pvListSourceType As Variant)
|
|
''' Set the updatable property ListSourceType
|
|
_PropertySet("ListSourceType", pvListSourceType)
|
|
End Property ' SFDocuments.SF_FormControl.ListSourceType (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Locked() As Variant
|
|
''' The Locked property specifies if a control is read-only
|
|
Locked = _PropertyGet("Locked", False)
|
|
End Property ' SFDocuments.SF_FormControl.Locked (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Locked(Optional ByVal pvLocked As Variant)
|
|
''' Set the updatable property Locked
|
|
_PropertySet("Locked", pvLocked)
|
|
End Property ' SFDocuments.SF_FormControl.Locked (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get MultiSelect() As Variant
|
|
''' The MultiSelect property specifies whether a user can make multiple selections in a listbox
|
|
MultiSelect = _PropertyGet("MultiSelect", False)
|
|
End Property ' SFDocuments.SF_FormControl.MultiSelect (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let MultiSelect(Optional ByVal pvMultiSelect As Variant)
|
|
''' Set the updatable property MultiSelect
|
|
_PropertySet("MultiSelect", pvMultiSelect)
|
|
End Property ' SFDocuments.SF_FormControl.MultiSelect (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Name() As String
|
|
''' Return the name of the actual control
|
|
Name = _PropertyGet("Name")
|
|
End Property ' SFDocuments.SF_FormControl.Name
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnActionPerformed() As Variant
|
|
''' Get the script associated with the OnActionPerformed event
|
|
OnActionPerformed = _PropertyGet("OnActionPerformed", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnActionPerformed (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnActionPerformed(Optional ByVal pvOnActionPerformed As Variant)
|
|
''' Set the updatable property OnActionPerformed
|
|
_PropertySet("OnActionPerformed", pvOnActionPerformed)
|
|
End Property ' SFDocuments.SF_FormControl.OnActionPerformed (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnAdjustmentValueChanged() As Variant
|
|
''' Get the script associated with the OnAdjustmentValueChanged event
|
|
OnAdjustmentValueChanged = _PropertyGet("OnAdjustmentValueChanged", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnAdjustmentValueChanged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnAdjustmentValueChanged(Optional ByVal pvOnAdjustmentValueChanged As Variant)
|
|
''' Set the updatable property OnAdjustmentValueChanged
|
|
_PropertySet("OnAdjustmentValueChanged", pvOnAdjustmentValueChanged)
|
|
End Property ' SFDocuments.SF_FormControl.OnAdjustmentValueChanged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnApproveAction() As Variant
|
|
''' Get the script associated with the OnApproveAction event
|
|
OnApproveAction = _PropertyGet("OnApproveAction", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnApproveAction (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnApproveAction(Optional ByVal pvOnApproveAction As Variant)
|
|
''' Set the updatable property OnApproveAction
|
|
_PropertySet("OnApproveAction", pvOnApproveAction)
|
|
End Property ' SFDocuments.SF_FormControl.OnApproveAction (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnApproveReset() As Variant
|
|
''' Get the script associated with the OnApproveReset event
|
|
OnApproveReset = _PropertyGet("OnApproveReset", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnApproveReset (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnApproveReset(Optional ByVal pvOnApproveReset As Variant)
|
|
''' Set the updatable property OnApproveReset
|
|
_PropertySet("OnApproveReset", pvOnApproveReset)
|
|
End Property ' SFDocuments.SF_FormControl.OnApproveReset (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnApproveUpdate() As Variant
|
|
''' Get the script associated with the OnApproveUpdate event
|
|
OnApproveUpdate = _PropertyGet("OnApproveUpdate", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnApproveUpdate (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnApproveUpdate(Optional ByVal pvOnApproveUpdate As Variant)
|
|
''' Set the updatable property OnApproveUpdate
|
|
_PropertySet("OnApproveUpdate", pvOnApproveUpdate)
|
|
End Property ' SFDocuments.SF_FormControl.OnApproveUpdate (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnChanged() As Variant
|
|
''' Get the script associated with the OnChanged event
|
|
OnChanged = _PropertyGet("OnChanged", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnChanged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnChanged(Optional ByVal pvOnChanged As Variant)
|
|
''' Set the updatable property OnChanged
|
|
_PropertySet("OnChanged", pvOnChanged)
|
|
End Property ' SFDocuments.SF_FormControl.OnChanged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnErrorOccurred() As Variant
|
|
''' Get the script associated with the OnErrorOccurred event
|
|
OnErrorOccurred = _PropertyGet("OnErrorOccurred", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnErrorOccurred (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnErrorOccurred(Optional ByVal pvOnErrorOccurred As Variant)
|
|
''' Set the updatable property OnErrorOccurred
|
|
_PropertySet("OnErrorOccurred", pvOnErrorOccurred)
|
|
End Property ' SFDocuments.SF_FormControl.OnErrorOccurred (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnFocusGained() As Variant
|
|
''' Get the script associated with the OnFocusGained event
|
|
OnFocusGained = _PropertyGet("OnFocusGained", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnFocusGained (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant)
|
|
''' Set the updatable property OnFocusGained
|
|
_PropertySet("OnFocusGained", pvOnFocusGained)
|
|
End Property ' SFDocuments.SF_FormControl.OnFocusGained (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnFocusLost() As Variant
|
|
''' Get the script associated with the OnFocusLost event
|
|
OnFocusLost = _PropertyGet("OnFocusLost", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnFocusLost (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant)
|
|
''' Set the updatable property OnFocusLost
|
|
_PropertySet("OnFocusLost", pvOnFocusLost)
|
|
End Property ' SFDocuments.SF_FormControl.OnFocusLost (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnItemStateChanged() As Variant
|
|
''' Get the script associated with the OnItemStateChanged event
|
|
OnItemStateChanged = _PropertyGet("OnItemStateChanged", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnItemStateChanged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnItemStateChanged(Optional ByVal pvOnItemStateChanged As Variant)
|
|
''' Set the updatable property OnItemStateChanged
|
|
_PropertySet("OnItemStateChanged", pvOnItemStateChanged)
|
|
End Property ' SFDocuments.SF_FormControl.OnItemStateChanged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnKeyPressed() As Variant
|
|
''' Get the script associated with the OnKeyPressed event
|
|
OnKeyPressed = _PropertyGet("OnKeyPressed", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnKeyPressed (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant)
|
|
''' Set the updatable property OnKeyPressed
|
|
_PropertySet("OnKeyPressed", pvOnKeyPressed)
|
|
End Property ' SFDocuments.SF_FormControl.OnKeyPressed (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnKeyReleased() As Variant
|
|
''' Get the script associated with the OnKeyReleased event
|
|
OnKeyReleased = _PropertyGet("OnKeyReleased", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnKeyReleased (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant)
|
|
''' Set the updatable property OnKeyReleased
|
|
_PropertySet("OnKeyReleased", pvOnKeyReleased)
|
|
End Property ' SFDocuments.SF_FormControl.OnKeyReleased (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseDragged() As Variant
|
|
''' Get the script associated with the OnMouseDragged event
|
|
OnMouseDragged = _PropertyGet("OnMouseDragged", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnMouseDragged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant)
|
|
''' Set the updatable property OnMouseDragged
|
|
_PropertySet("OnMouseDragged", pvOnMouseDragged)
|
|
End Property ' SFDocuments.SF_FormControl.OnMouseDragged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseEntered() As Variant
|
|
''' Get the script associated with the OnMouseEntered event
|
|
OnMouseEntered = _PropertyGet("OnMouseEntered", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnMouseEntered (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant)
|
|
''' Set the updatable property OnMouseEntered
|
|
_PropertySet("OnMouseEntered", pvOnMouseEntered)
|
|
End Property ' SFDocuments.SF_FormControl.OnMouseEntered (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseExited() As Variant
|
|
''' Get the script associated with the OnMouseExited event
|
|
OnMouseExited = _PropertyGet("OnMouseExited", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnMouseExited (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant)
|
|
''' Set the updatable property OnMouseExited
|
|
_PropertySet("OnMouseExited", pvOnMouseExited)
|
|
End Property ' SFDocuments.SF_FormControl.OnMouseExited (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseMoved() As Variant
|
|
''' Get the script associated with the OnMouseMoved event
|
|
OnMouseMoved = _PropertyGet("OnMouseMoved", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnMouseMoved (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant)
|
|
''' Set the updatable property OnMouseMoved
|
|
_PropertySet("OnMouseMoved", pvOnMouseMoved)
|
|
End Property ' SFDocuments.SF_FormControl.OnMouseMoved (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMousePressed() As Variant
|
|
''' Get the script associated with the OnMousePressed event
|
|
OnMousePressed = _PropertyGet("OnMousePressed", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnMousePressed (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant)
|
|
''' Set the updatable property OnMousePressed
|
|
_PropertySet("OnMousePressed", pvOnMousePressed)
|
|
End Property ' SFDocuments.SF_FormControl.OnMousePressed (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnMouseReleased() As Variant
|
|
''' Get the script associated with the OnMouseReleased event
|
|
OnMouseReleased = _PropertyGet("OnMouseReleased", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnMouseReleased (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant)
|
|
''' Set the updatable property OnMouseReleased
|
|
_PropertySet("OnMouseReleased", pvOnMouseReleased)
|
|
End Property ' SFDocuments.SF_FormControl.OnMouseReleased (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnResetted() As Variant
|
|
''' Get the script associated with the OnResetted event
|
|
OnResetted = _PropertyGet("OnResetted", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnResetted (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnResetted(Optional ByVal pvOnResetted As Variant)
|
|
''' Set the updatable property OnResetted
|
|
_PropertySet("OnResetted", pvOnResetted)
|
|
End Property ' SFDocuments.SF_FormControl.OnResetted (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnTextChanged() As Variant
|
|
''' Get the script associated with the OnTextChanged event
|
|
OnTextChanged = _PropertyGet("OnTextChanged", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnTextChanged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnTextChanged(Optional ByVal pvOnTextChanged As Variant)
|
|
''' Set the updatable property OnTextChanged
|
|
_PropertySet("OnTextChanged", pvOnTextChanged)
|
|
End Property ' SFDocuments.SF_FormControl.OnTextChanged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnUpdated() As Variant
|
|
''' Get the script associated with the OnUpdated event
|
|
OnUpdated = _PropertyGet("OnUpdated", "")
|
|
End Property ' SFDocuments.SF_FormControl.OnUpdated (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnUpdated(Optional ByVal pvOnUpdated As Variant)
|
|
''' Set the updatable property OnUpdated
|
|
_PropertySet("OnUpdated", pvOnUpdated)
|
|
End Property ' SFDocuments.SF_FormControl.OnUpdated (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Parent() As Object
|
|
''' Return the Parent form or [table]control object of the actual control
|
|
Parent = _PropertyGet("Parent", Nothing)
|
|
End Property ' SFDocuments.SF_FormControl.Parent
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Picture() As Variant
|
|
''' The Picture property specifies a bitmap or other type of graphic to be displayed on the specified control
|
|
Picture = _PropertyGet("Picture", "")
|
|
End Property ' SFDocuments.SF_FormControl.Picture (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Picture(Optional ByVal pvPicture As Variant)
|
|
''' Set the updatable property Picture
|
|
_PropertySet("Picture", pvPicture)
|
|
End Property ' SFDocuments.SF_FormControl.Picture (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Required() As Variant
|
|
''' A control is said Required when it must not contain a null value
|
|
Required = _PropertyGet("Required", False)
|
|
End Property ' SFDocuments.SF_FormControl.Required (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Required(Optional ByVal pvRequired As Variant)
|
|
''' Set the updatable property Required
|
|
_PropertySet("Required", pvRequired)
|
|
End Property ' SFDocuments.SF_FormControl.Required (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Text() As Variant
|
|
''' The Text property specifies the actual content of the control like it is displayed on the screen
|
|
Text = _PropertyGet("Text", "")
|
|
End Property ' SFDocuments.SF_FormControl.Text (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get TipText() As Variant
|
|
''' The TipText property specifies the text that appears in a screentip when you hold the mouse pointer over a control
|
|
TipText = _PropertyGet("TipText", "")
|
|
End Property ' SFDocuments.SF_FormControl.TipText (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let TipText(Optional ByVal pvTipText As Variant)
|
|
''' Set the updatable property TipText
|
|
_PropertySet("TipText", pvTipText)
|
|
End Property ' SFDocuments.SF_FormControl.TipText (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get TripleState() As Variant
|
|
''' The TripleState property specifies how a check box will display Null values
|
|
''' When True, the control will cycle through states for Yes, No, and Null values. The control appears dimmed (grayed) when its Value property is set to Null.
|
|
''' When False, the control will cycle through states for Yes and No values. Null values display as if they were No values.
|
|
TripleState = _PropertyGet("TripleState", False)
|
|
End Property ' SFDocuments.SF_FormControl.TripleState (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let TripleState(Optional ByVal pvTripleState As Variant)
|
|
''' Set the updatable property TripleState
|
|
_PropertySet("TripleState", pvTripleState)
|
|
End Property ' SFDocuments.SF_FormControl.TripleState (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Value() As Variant
|
|
''' The Value property specifies the data contained in the control
|
|
Value = _PropertyGet("Value", Empty)
|
|
End Property ' SFDocuments.SF_FormControl.Value (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Value(Optional ByVal pvValue As Variant)
|
|
''' Set the updatable property Value
|
|
_PropertySet("Value", pvValue)
|
|
End Property ' SFDocuments.SF_FormControl.Value (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Visible() As Variant
|
|
''' The Visible property specifies if the control is accessible with the cursor.
|
|
Visible = _PropertyGet("Visible", True)
|
|
End Property ' SFDocuments.SF_FormControl.Visible (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Visible(Optional ByVal pvVisible As Variant)
|
|
''' Set the updatable property Visible
|
|
_PropertySet("Visible", pvVisible)
|
|
End Property ' SFDocuments.SF_FormControl.Visible (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XControlModel() As Object
|
|
''' The XControlModel property returns the model UNO object of the control
|
|
XControlModel = _PropertyGet("XControlModel", Nothing)
|
|
End Property ' SFDocuments.SF_FormControl.XControlModel (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XControlView() As Object
|
|
''' The XControlView property returns the view UNO object of the control
|
|
XControlView = _PropertyGet("XControlView", Nothing)
|
|
End Property ' SFDocuments.SF_FormControl.XControlView (get)
|
|
|
|
REM ===================================================================== METHODS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Controls(Optional ByVal ControlName As Variant) As Variant
|
|
''' Return either
|
|
''' - the list of the controls contained in the actual table control
|
|
''' - a Form Control object based on its name
|
|
''' Args:
|
|
''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
|
|
''' Returns:
|
|
''' A zero-base array of strings if ControlName is absent
|
|
''' An instance of the SF_FormControl class if ControlName exists
|
|
''' Exceptions:
|
|
''' ControlName is invalid
|
|
''' Example:
|
|
''' Dim myGrid As Object, myList As Variant, myControl As Object
|
|
''' Set myGrid = myForm.Controls("myTableControl")
|
|
''' myList = myGrid.Controls()
|
|
''' Set myControl = myGrid.Controls("myCheckBox")
|
|
|
|
Dim oControl As Object ' The new control class instance
|
|
Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache
|
|
Dim vControl As Variant ' Alias of _ControlCache entry
|
|
Dim oView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
|
|
Dim i As Long
|
|
Const cstThisSub = "SFDocuments.FormControl.Controls"
|
|
Const cstSubArgs = "[ControlName]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set Controls = Nothing
|
|
|
|
Check:
|
|
If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If _ControlType <> CTLTABLECONTROL Then GoTo Catch
|
|
If Not [_Parent]._IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Collect all control names if not yet done
|
|
If UBound(_ControlNames) < 0 Then
|
|
_ControlNames = _ControlModel.getElementNames()
|
|
If UBound(_ControlNames) >= 0 Then
|
|
ReDim _ControlCache(0 To UBound(_ControlNames))
|
|
End If
|
|
End If
|
|
|
|
' Return the list of controls or a FormControl instance
|
|
If Len(ControlName) = 0 Then
|
|
Controls = _ControlNames
|
|
|
|
Else
|
|
|
|
If Not _ControlModel.hasByName(ControlName) Then GoTo CatchNotFound
|
|
lIndexOfNames = ScriptForge.SF_Array.IndexOf(_ControlNames, ControlName, CaseSensitive := True)
|
|
' Reuse cache when relevant
|
|
vControl = _ControlCache(lIndexOfNames)
|
|
|
|
If IsEmpty(vControl) Then
|
|
' Not in cache => Create the new form control class instance
|
|
Set oControl = New SF_FormControl
|
|
With oControl
|
|
._Name = ControlName
|
|
Set .[Me] = oControl
|
|
Set .[_Parent] = [Me]
|
|
._ParentIsTable = True
|
|
._IndexOfNames = lIndexOfNames
|
|
._FormName = _FormName
|
|
Set ._ParentForm = _ParentForm
|
|
' Get model and view of the current control
|
|
Set ._ControlModel = _ControlModel.getByName(ControlName)
|
|
._ImplementationName = ._ControlModel.ColumnServiceName ' getImplementationName aborts for subcontrols !?
|
|
' Bypass to find the control view: cannot be done from the top component
|
|
If Not IsNull(_ControlView) Then ' Anticipate absence of ControlView in table controls when edit mode
|
|
For i = 0 to _ControlView.getCount() - 1
|
|
Set oView = _ControlView.GetByIndex(i)
|
|
If Not IsNull(oView) Then
|
|
If oView.getModel.Name = ControlName Then
|
|
Set ._ControlView = oView
|
|
Exit For
|
|
End If
|
|
End If
|
|
Next i
|
|
End If
|
|
._Initialize()
|
|
End With
|
|
Else
|
|
Set oControl = vControl
|
|
End If
|
|
|
|
Set Controls = oControl
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotFound:
|
|
ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _ControlModel.getElementNames())
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_FormControl.Controls
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
|
|
''' Return the actual value of the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Returns:
|
|
''' The actual value of the property
|
|
''' If the property does not exist, returns Null
|
|
''' Exceptions:
|
|
''' see the exceptions of the individual properties
|
|
''' Examples:
|
|
''' myControl.GetProperty("MyProperty")
|
|
|
|
Dim vDefault As Variant ' Default value when property not applicable on control type
|
|
Const cstThisSub = "SFDocuments.FormControl.GetProperty"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
GetProperty = Null
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
' FormControl properties are far from applicable to all control types
|
|
' Getting a property must never abort to not interfere with the Basic IDE watch function
|
|
' Hence a default value must be provided
|
|
Select Case UCase(PropertyName)
|
|
Case UCase("Default") : vDefault = False
|
|
Case UCase("DefaultValue") : vDefault = Null
|
|
Case UCase("Enabled") : vDefault = False
|
|
Case UCase("ListCount") : vDefault = 0
|
|
Case UCase("ListIndex") : vDefault = -1
|
|
Case UCase("Locked") : vDefault = False
|
|
Case UCase("MultiSelect") : vDefault = False
|
|
Case UCase("Parent") : vDefault = Nothing
|
|
Case UCase("Required") : vDefault = False
|
|
Case UCase("TripleState") : vDefault = False
|
|
Case UCase("Value") : vDefault = Empty
|
|
Case UCase("Visible") : vDefault = True
|
|
Case UCase("XControlModel") : vDefault = Nothing
|
|
Case UCase("XControlView") : vDefault = Nothing
|
|
Case Else : vDefault = ""
|
|
End Select
|
|
|
|
GetProperty = _PropertyGet(PropertyName, vDefault)
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_FormControl.GetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Methods() As Variant
|
|
''' Return the list of public methods of the FormControl service as an array
|
|
|
|
Methods = Array( _
|
|
"AddSubNode" _
|
|
, "AddSubTree" _
|
|
, "CreateRoot" _
|
|
, "FindNode" _
|
|
, "SetFocus" _
|
|
, "WriteLine" _
|
|
)
|
|
|
|
End Function ' SFDocuments.SF_FormControl.Methods
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Properties() As Variant
|
|
''' Return the list or properties of the FormControl class as an array
|
|
|
|
Properties = Array( _
|
|
"Action" _
|
|
, "Cancel" _
|
|
, "Caption" _
|
|
, "ControlSource" _
|
|
, "ControlType" _
|
|
, "Default" _
|
|
, "DefaultValue" _
|
|
, "Enabled" _
|
|
, "Format" _
|
|
, "ListCount" _
|
|
, "ListIndex" _
|
|
, "ListSource" _
|
|
, "ListSourceType" _
|
|
, "Locked" _
|
|
, "MultiSelect" _
|
|
, "Name" _
|
|
, "OnActionPerformed" _
|
|
, "OnAdjustmentValueChanged" _
|
|
, "OnApproveAction" _
|
|
, "OnApproveReset" _
|
|
, "OnApproveUpdate" _
|
|
, "OnChanged" _
|
|
, "OnErrorOccurred" _
|
|
, "OnFocusGained" _
|
|
, "OnFocusLost" _
|
|
, "OnItemStateChanged" _
|
|
, "OnKeyPressed" _
|
|
, "OnKeyReleased" _
|
|
, "OnMouseDragged" _
|
|
, "OnMouseEntered" _
|
|
, "OnMouseExited" _
|
|
, "OnMouseMoved" _
|
|
, "OnMousePressed" _
|
|
, "OnMouseReleased" _
|
|
, "OnResetted" _
|
|
, "OnTextChanged" _
|
|
, "OnUpdated" _
|
|
, "Parent" _
|
|
, "Picture" _
|
|
, "Required" _
|
|
, "Text" _
|
|
, "TipText" _
|
|
, "TripleState" _
|
|
, "Value" _
|
|
, "Visible" _
|
|
, "XControlModel" _
|
|
, "XControlView" _
|
|
)
|
|
|
|
End Function ' SFDocuments.SF_FormControl.Properties
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetFocus() As Boolean
|
|
''' Set the focus on the current Control instance
|
|
''' Probably called from after an event occurrence
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if focusing is successful
|
|
''' Example:
|
|
''' Dim oDoc As Object, oForm As Object, oControl As Object
|
|
''' Set oDoc = CreateScriptService("SFDocuments.Document", ThisComponent)
|
|
''' Set oForm = oDoc.Forms(0)
|
|
''' Set oControl = oForm.Controls("thisControl")
|
|
''' oControl.SetFocus()
|
|
|
|
Dim bSetFocus As Boolean ' Return value
|
|
Dim iColPosition As Integer ' Position of control in table
|
|
Dim oTableModel As Object ' XControlModel of parent table
|
|
Dim oControl As Object ' com.sun.star.awt.XControlModel
|
|
Dim i As Integer, j As Integer
|
|
Const cstThisSub = "SFDocuments.FormControl.SetFocus"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bSetFocus = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _ParentForm._IsStillAlive() Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
If Not IsNull(_ControlView) Then
|
|
If _ParentIsTable Then ' setFocus() method does not work on controlviews in table control ?!?
|
|
' Find the column position of the current instance in the parent table control
|
|
iColPosition = -1
|
|
Set oTableModel = [_Parent]._ControlModel
|
|
j = -1
|
|
For i = 0 To oTableModel.Count - 1
|
|
Set oControl = oTableModel.getByIndex(i)
|
|
If Not oControl.Hidden Then j = j + 1 ' Skip hidden columns
|
|
If oControl.Name = _Name Then
|
|
iColPosition = j
|
|
Exit For
|
|
End If
|
|
Next i
|
|
If iColPosition >= 0 Then
|
|
[_Parent]._ControlView.setFocus() 'Set first focus on table control itself
|
|
[_Parent]._ControlView.setCurrentColumnPosition(iColPosition) 'Deprecated but no alternative found
|
|
End If
|
|
Else
|
|
_ControlView.setFocus()
|
|
End If
|
|
bSetFocus = True
|
|
End If
|
|
bSetFocus = True
|
|
|
|
Finally:
|
|
SetFocus = bSetFocus
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFControls.SF_FormControl.SetFocus
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetProperty(Optional ByVal PropertyName As Variant _
|
|
, Optional ByRef Value As Variant _
|
|
) As Boolean
|
|
''' Set a new value to the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Value: its new value
|
|
''' Exceptions
|
|
''' ARGUMENTERROR The property does not exist
|
|
|
|
Const cstThisSub = "SFDocuments.FormControl.SetProperty"
|
|
Const cstSubArgs = "PropertyName, Value"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
SetProperty = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
SetProperty = _PropertySet(PropertyName, Value)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_FormControl.SetProperty
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _FormatsList() As Variant
|
|
''' Return the allowed format entries as a zero-based array for Date and Time control types
|
|
|
|
Dim vFormats() As Variant ' Return value
|
|
|
|
Select Case _ControlType
|
|
Case CTLDATEFIELD
|
|
vFormats = Array( _
|
|
"Standard (short)" _
|
|
, "Standard (short YY)" _
|
|
, "Standard (short YYYY)" _
|
|
, "Standard (long)" _
|
|
, "DD/MM/YY" _
|
|
, "MM/DD/YY" _
|
|
, "YY/MM/DD" _
|
|
, "DD/MM/YYYY" _
|
|
, "MM/DD/YYYY" _
|
|
, "YYYY/MM/DD" _
|
|
, "YY-MM-DD" _
|
|
, "YYYY-MM-DD" _
|
|
)
|
|
Case CTLTIMEFIELD
|
|
vFormats = Array( _
|
|
"24h short" _
|
|
, "24h long" _
|
|
, "12h short" _
|
|
, "12h long" _
|
|
)
|
|
Case Else
|
|
vFormats = Array()
|
|
End Select
|
|
|
|
_FormatsList = vFormats
|
|
|
|
End Function ' SFDocuments.SF_FormControl._FormatsList
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _GetEventName(ByVal psProperty As String) As String
|
|
''' Return the LO internal event name derived from the SF property name
|
|
''' The SF property name is not case sensitive, while the LO name is case-sensitive
|
|
' Corrects the typo on ErrorOccur(r?)ed, if necessary
|
|
|
|
Dim vProperties As Variant ' Array of class properties
|
|
Dim sProperty As String ' Correctly cased property name
|
|
|
|
vProperties = Properties()
|
|
sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
|
|
|
|
_GetEventName = LCase(Mid(sProperty, 3, 1)) & Right(sProperty, Len(sProperty) - 3)
|
|
|
|
End Function ' SFDocuments.SF_FormControl._GetEventName
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _GetListener(ByVal psEventName As String) As String
|
|
''' Getting/Setting macros triggered by events requires a Listener-EventName pair
|
|
''' Return the X...Listener corresponding with the event name in argument
|
|
|
|
Select Case UCase(psEventName)
|
|
Case UCase("OnActionPerformed")
|
|
_GetListener = "XActionListener"
|
|
Case UCase("OnAdjustmentValueChanged")
|
|
_GetListener = "XAdjustmentListener"
|
|
Case UCase("OnApproveAction")
|
|
_GetListener = "XApproveActionListener"
|
|
Case UCase("OnApproveReset"), UCase("OnResetted")
|
|
_GetListener = "XResetListener"
|
|
Case UCase("OnApproveUpdate"), UCase("OnUpdated")
|
|
_GetListener = "XUpdateListener"
|
|
Case UCase("OnChanged")
|
|
_GetListener = "XChangeListener"
|
|
Case UCase("OnErrorOccurred")
|
|
_GetListener = "XErrorListener"
|
|
Case UCase("OnFocusGained"), UCase("OnFocusLost")
|
|
_GetListener = "XFocusListener"
|
|
Case UCase("OnItemStateChanged")
|
|
_GetListener = "XItemListener"
|
|
Case UCase("OnKeyPressed"), UCase("OnKeyReleased")
|
|
_GetListener = "XKeyListener"
|
|
Case UCase("OnMouseDragged"), UCase("OnMouseMoved")
|
|
_GetListener = "XMouseMotionListener"
|
|
Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased")
|
|
_GetListener = "XMouseListener"
|
|
Case UCase("OnTextChanged")
|
|
_GetListener = "XTextListener"
|
|
End Select
|
|
|
|
End Function ' SFDocuments.SF_FormControl._GetListener
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub _Initialize()
|
|
''' Complete the object creation process:
|
|
''' - Initialization of private members
|
|
''' - Collection of specific attributes
|
|
''' - Synchronization with parent form instance
|
|
|
|
Dim vControlTypes As Variant ' Array of control types ordered by the ClassId property of XControlModel - 2
|
|
Const acHiddenControl = 13 ' Class Id of an hidden control: has no ControlView
|
|
|
|
vControlTypes = array( CTLBUTTON _
|
|
, CTLRADIOBUTTON _
|
|
, CTLIMAGEBUTTON _
|
|
, CTLCHECKBOX _
|
|
, CTLLISTBOX _
|
|
, CTLCOMBOBOX _
|
|
, CTLGROUPBOX _
|
|
, CTLTEXTFIELD _
|
|
, CTLFIXEDTEXT _
|
|
, CTLTABLECONTROL _
|
|
, CTLFILECONTROL _
|
|
, CTLHIDDENCONTROL _
|
|
, CTLIMAGECONTROL _
|
|
, CTLDATEFIELD _
|
|
, CTLTIMEFIELD _
|
|
, CTLNUMERICFIELD _
|
|
, CTLCURRENCYFIELD _
|
|
, CTLPATTERNFIELD _
|
|
, CTLSCROLLBAR _
|
|
, CTLSPINBUTTON _
|
|
, CTLNAVIGATIONBAR _
|
|
)
|
|
|
|
Try:
|
|
' _implementationName is set elsewhere for controls in table control
|
|
If Len(_ImplementationName) = 0 Then _ImplementationName = ScriptForge.SF_Session.UnoObjectType(_ControlModel)
|
|
_ClassId = _ControlModel.ClassId
|
|
|
|
' Identify the control type, ignore subforms and pay attention to formatted fields
|
|
If ScriptForge.SF_Session.HasUnoproperty(_ControlModel, "ClassId") Then ' All control types have a ClassId property except subforms
|
|
_ControlType = vControlTypes(_ClassId - 2)
|
|
' Formatted fields belong to the TextField family
|
|
If _ControlType = CTLTEXTFIELD Then
|
|
If _ImplementationName = "com.sun.star.comp.forms.OFormattedFieldWrapper" _
|
|
Or _ImplementationName = "com.sun.star.comp.forms.OFormattedFieldWrapper_ForcedFormatted" _
|
|
Or _ImplementationName = "com.sun.star.form.component.FormattedField" Then ' When in table control
|
|
_ControlType = CTLFORMATTEDFIELD
|
|
End If
|
|
End If
|
|
Else
|
|
Exit Sub ' Ignore subforms, should not happen
|
|
End If
|
|
|
|
With [_Parent]
|
|
' Set control view if not set yet
|
|
If IsNull(_ControlView) Then
|
|
If _ClassId > 0 And _ClassId <> acHiddenControl Then ' No view on hidden controls
|
|
If IsNull(._FormDocument) Then ' Usual document
|
|
Set _ControlView = ._Component.CurrentController.getControl(_ControlModel)
|
|
Else ' Base form document
|
|
Set _ControlView = ._FormDocument.Component.CurrentController.getControl(_ControlModel)
|
|
End If
|
|
End If
|
|
End If
|
|
End With
|
|
|
|
' Store the SF_FormControl object in the parent cache
|
|
Set _Parent._ControlCache(_IndexOfNames) = [Me]
|
|
|
|
Finally:
|
|
Exit Sub
|
|
End Sub ' SFDocuments.SF_FormControl._Initialize
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _ListboxBound() As Boolean
|
|
''' Return True if the actual control, which is a listbox, has a bound column
|
|
''' Called before setting the value of a listbox, i.e. the value to be rewritten in the underlying table data
|
|
''' The existence of a bound column is derived from the comparison between StringItemList and ValueItemList
|
|
''' String ... : the strings displayed in the list box
|
|
''' Value ... : the database values
|
|
''' If they are different, then there is a bound column
|
|
|
|
Dim bListboxBound As Boolean ' Return value
|
|
Dim vValue() As variant ' Alias of the control model ValueItemList
|
|
Dim vString() As Variant ' Alias of the control model StringItemList
|
|
Dim i As Long
|
|
|
|
bListboxBound = False
|
|
|
|
With _ControlModel
|
|
If Not IsNull(.ValueItemList) _
|
|
And .DataField <> "" _
|
|
And Not IsNull(.BoundField) _
|
|
And ScriptForge.SF_Array.Contains(Array( _
|
|
com.sun.star.form.ListSourceType.TABLE _
|
|
, com.sun.star.form.ListSourceType.QUERY _
|
|
, com.sun.star.form.ListSourceType.SQL _
|
|
, com.sun.star.form.ListSourceType.SQLPASSTHROUGH _
|
|
), .ListSourceType) Then
|
|
If IsArray(.ValueItemList) Then
|
|
vValue = .ValueItemList
|
|
vString = .StringItemList
|
|
For i = 0 To UBound(vValue)
|
|
If VarType(vValue(i)) <> VarType(vString(i)) Then
|
|
bListboxBound = True
|
|
ElseIf vValue(i) <> vString(i) Then
|
|
bListboxBound = True
|
|
End If
|
|
If bListboxBound Then Exit For
|
|
Next i
|
|
End If
|
|
End If
|
|
End With
|
|
|
|
_ListboxBound = bListboxBound
|
|
|
|
End Function ' _ListboxBound V0.9.0
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertyGet(Optional ByVal psProperty As String _
|
|
, Optional ByVal pvDefault As Variant _
|
|
) As Variant
|
|
''' Return the value of the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
''' pvDefault: the value returned when the property is not applicable on the control's type
|
|
''' Getting a non-existing property for a specific control type should
|
|
''' not generate an error to not disrupt the Basic IDE debugger
|
|
|
|
Dim vGet As Variant ' Return value
|
|
Static oSession As Object ' Alias of SF_Session
|
|
Dim vSelection As Variant ' Alias of Model.SelectedItems or Model.Selection
|
|
Dim vList As Variant ' Alias of Model.StringItemList
|
|
Dim lIndex As Long ' Index in StringItemList
|
|
Dim sItem As String ' A single item
|
|
Dim vDate As Variant ' Date after conversion from com.sun.star.util.Date or com.sun.star.util.Time
|
|
Dim vValues As Variant ' Array of listbox values
|
|
Dim oControlEvents As Object ' com.sun.star.container.XNameContainer
|
|
Dim sEventName As String ' Internal event name
|
|
Const cstUnoUrl = ".uno:FormController/"
|
|
Dim i As Long
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = ""
|
|
|
|
cstThisSub = "SFDocuments.FormControl.get" & psProperty
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
If Not _ParentForm._IsStillAlive() Then GoTo Finally
|
|
|
|
If IsMissing(pvDefault) Or IsEmpty(pvDefault) Then pvDefault = Null
|
|
_PropertyGet = pvDefault
|
|
|
|
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
Select Case UCase(psProperty)
|
|
Case UCase("Action")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON
|
|
If oSession.HasUNOProperty(_ControlModel, "ButtonType") Then
|
|
Select Case _ControlModel.ButtonType
|
|
Case com.sun.star.form.FormButtonType.PUSH : _PropertyGet = "none"
|
|
Case com.sun.star.form.FormButtonType.SUBMIT : _PropertyGet = "submitForm"
|
|
Case com.sun.star.form.FormButtonType.RESET : _PropertyGet = "resetForm"
|
|
Case com.sun.star.form.FormButtonType.URL
|
|
' ".uno:FormController/moveToFirst"
|
|
If Left(_ControlModel.TargetURL, Len(cstUnoUrl)) = cstUnoUrl Then
|
|
_PropertyGet = Mid(_ControlModel.TargetURL, Len(cstUnoUrl) + 1)
|
|
ElseIf Left(_ControlModel.TargetURL, 4) = "http" Then
|
|
_PropertyGet = "openWebPage"
|
|
ElseIf Left(_ControlModel.TargetURL, 4) = "file" Then
|
|
_PropertyGet ="openDocument"
|
|
End If
|
|
End Select
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Caption")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
|
|
If oSession.HasUNOProperty(_ControlModel, "Label") Then _PropertyGet = _ControlModel.Label
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("ControlSource")
|
|
Select Case _ControlType
|
|
Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFORMATTEDFIELD, CTLIMAGECONTROL, CTLLISTBOX _
|
|
, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLRADIOBUTTON, CTLTEXTFIELD, CTLTIMEFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "DataField") Then _PropertyGet = _ControlModel.DataField
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("ControlType")
|
|
_PropertyGet = _ControlType
|
|
Case UCase("Default")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON
|
|
If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _PropertyGet = _ControlModel.DefaultButton
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("DefaultValue")
|
|
Select Case _ControlType
|
|
Case CTLCHECKBOX, CTLRADIOBUTTON
|
|
If oSession.HasUNOProperty(_ControlModel, "DefaultState") Then _PropertyGet = _ControlModel.DefaultState
|
|
Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "DefaultText") Then _PropertyGet = _ControlModel.DefaultText
|
|
Case CTLCURRENCYFIELD, CTLNUMERICFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "DefaultValue") Then _PropertyGet = _ControlModel.DefaultValue
|
|
Case CTLDATEFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "DefaultDate") Then
|
|
If Not IsEmpty(_ControlModel.DefaultDate) Then
|
|
With _ControlModel.DefaultDate
|
|
vDate = DateSerial(.Year, .Month, .Day)
|
|
End With
|
|
_PropertyGet = vDate
|
|
End If
|
|
End If
|
|
Case CTLFORMATTEDFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "EffectiveDefault") Then _PropertyGet = _ControlModel.EffectiveDefault
|
|
Case CTLLISTBOX
|
|
If oSession.HasUNOProperty(_ControlModel, "DefaultSelection") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
|
|
vList = _ControlModel.DefaultSelection
|
|
If IsArray(vList) Then
|
|
If UBound(vList) >= LBound(vList) Then ' Is array initialized ?
|
|
lIndex = UBound(_ControlModel.StringItemList)
|
|
If vList(0) >= 0 And vList(0) <= lIndex Then _PropertyGet = _ControlModel.StringItemList(vList(0))
|
|
' Only first default value is considered
|
|
End If
|
|
End If
|
|
End If
|
|
Case CTLSPINBUTTON
|
|
If oSession.HasUNOProperty(_ControlModel, "DefaultSpinValue") Then _PropertyGet = _ControlModel.DefaultSpinValue
|
|
Case CTLTIMEFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "DefaultTime") Then
|
|
If Not IsEmpty(_ControlModel.DefaultTime) Then
|
|
With _ControlModel.DefaultTime
|
|
vDate = TimeSerial(.Hours, .Minutes, .Seconds)
|
|
End With
|
|
_PropertyGet = vDate
|
|
End If
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Enabled")
|
|
Select Case _ControlType
|
|
Case CTLHIDDENCONTROL : GoTo CatchType
|
|
Case Else
|
|
If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _PropertyGet = _ControlModel.Enabled
|
|
End Select
|
|
Case UCase("Format")
|
|
Select Case _ControlType
|
|
Case CTLDATEFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = _FormatsList()(_ControlModel.DateFormat)
|
|
Case CTLTIMEFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = _FormatsList()(_ControlModel.TimeFormat)
|
|
Case CTLFORMATTEDFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") And oSession.HasUNOProperty(_ControlModel, "FormatKey") Then
|
|
_PropertyGet = _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("ListCount")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLLISTBOX
|
|
If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("ListIndex")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX
|
|
_PropertyGet = -1 ' Not found, multiselection
|
|
If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
|
|
_PropertyGet = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, _ControlModel.Text, CaseSensitive := True)
|
|
End If
|
|
Case CTLLISTBOX
|
|
_PropertyGet = -1 ' Not found, multiselection
|
|
If oSession.HasUNOProperty(_ControlModel, "SelectedItems") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
|
|
vSelection = _ControlModel.SelectedItems
|
|
If UBound(vSelection) >= 0 Then _PropertyGet = vSelection(0)
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("ListSource")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLLISTBOX
|
|
If oSession.HasUNOProperty(_ControlModel, "ListSource") Then
|
|
With com.sun.star.form.ListSourceType
|
|
Select Case _ControlModel.ListSourceType
|
|
Case .VALUELIST _
|
|
, .TABLEFIELDS
|
|
If IsArray(_ControlModel.StringItemList) Then vValues = _ControlModel.StringItemList Else vValues = Array(_ControlModel.StringItemList)
|
|
Case .TABLE _
|
|
, .QUERY _
|
|
, .SQL _
|
|
, .SQLPASSTHROUGH
|
|
If IsArray(_ControlModel.ListSource) Then vValues = _ControlModel.ListSource Else vValues = Array(_ControlModel.ListSource)
|
|
End Select
|
|
End With
|
|
_PropertyGet = Join(vValues, ";")
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("ListSourceType")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLLISTBOX
|
|
If oSession.HasUnoProperty(_ControlModel, "ListSourceType") Then _PropertyGet = _ControlModel.ListSourceType
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Locked")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLIMAGECONTROL _
|
|
, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
|
|
If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _PropertyGet = _ControlModel.ReadOnly
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("MultiSelect")
|
|
Select Case _ControlType
|
|
Case CTLLISTBOX
|
|
If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
|
|
_PropertyGet = _ControlModel.MultiSelection
|
|
ElseIf oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then ' Not documented: gridcontrols only TBC ??
|
|
_PropertyGet = _ControlModel.MultiSelectionSimpleMode
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Name")
|
|
_PropertyGet = _Name
|
|
Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnApproveAction"), UCase("OnApproveReset"), UCase("OnApproveUpdate") _
|
|
, UCase("OnChanged"), UCase("OnErrorOccurred"), UCase("OnFocusGained"), UCase("OnFocusLost") _
|
|
, UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
|
|
, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
|
|
, UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted") _
|
|
, UCase("OnTextChanged"), UCase("OnUpdated")
|
|
If IsNull(_ControlModel) Then _PropertyGet = "" Else _PropertyGet = SF_Register._GetEventScriptCode(_ControlModel, psProperty, _Name)
|
|
Case UCase("Parent")
|
|
Set _PropertyGet = [_Parent]
|
|
Case UCase("Picture")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON, CTLIMAGEBUTTON, CTLIMAGECONTROL
|
|
If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_ControlModel.ImageURL)
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Required")
|
|
Select Case _ControlType
|
|
Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD _
|
|
, CTLPATTERNFIELD, CTLRADIOBUTTON, CTLTEXTFIELD, CTLTIMEFIELD
|
|
If oSession.HasUnoProperty(_ControlModel, "InputRequired") Then _PropertyGet = _ControlModel.InputRequired
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Text")
|
|
Select Case _ControlType
|
|
Case CTLDATEFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "Date") _
|
|
And oSession.HasUNOProperty(_ControlModel, "FormatKey") _
|
|
And oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") Then
|
|
If Not IsEmpty(_ControlModel.Date) Then
|
|
With _ControlModel.Date
|
|
vDate = DateSerial(.Year, .Month, .Day)
|
|
End With
|
|
_PropertyGet = Format(vDate, _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString)
|
|
End If
|
|
End If
|
|
Case CTLTIMEFIELD
|
|
If oSession.HasUNOProperty(_ControlModel, "Text") Then
|
|
If Not IsEmpty(_ControlModel.Time) Then
|
|
With _ControlModel.Time
|
|
vDate = TimeSerial(.Hours, .Minutes, .Seconds)
|
|
End With
|
|
_PropertyGet = Format(vDate, "HH:MM:SS")
|
|
End If
|
|
End If
|
|
Case CTLCOMBOBOX, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLPATTERNFIELD, CTLTEXTFIELD
|
|
If oSession.HasUnoProperty(_ControlModel, "Text") Then _PropertyGet = _ControlModel.Text
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("TipText")
|
|
Select Case _ControlType
|
|
Case CTLHIDDENCONTROL : GoTo CatchType
|
|
Case Else
|
|
If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _PropertyGet = _ControlModel.HelpText
|
|
End Select
|
|
Case UCase("TripleState")
|
|
Select Case _ControlType
|
|
Case CTLCHECKBOX
|
|
If oSession.HasUnoProperty(_ControlModel, "TriState") Then _PropertyGet = _ControlModel.TriState
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Value") ' Default values are set here by control type, not in the 2nd argument (pvDefault)
|
|
vGet = pvDefault
|
|
Select Case _ControlType
|
|
Case CTLBUTTON 'Boolean, toggle buttons only
|
|
vGet = False
|
|
If oSession.HasUnoProperty(_ControlModel, "Toggle") Then
|
|
If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 )
|
|
End If
|
|
Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know
|
|
If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = _ControlModel.State Else vGet = 2
|
|
Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String
|
|
If oSession.HasUnoProperty(_ControlModel, "Text") Then vGet = _ControlModel.Text Else vGet = ""
|
|
Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
|
|
If oSession.HasUnoProperty(_ControlModel, "Value") Then vGet = _ControlModel.Value Else vGet = 0
|
|
Case CTLDATEFIELD 'Date
|
|
vGet = CDate(1)
|
|
If oSession.HasUnoProperty(_ControlModel, "Date") Then
|
|
If VarType(_ControlModel.Date) = ScriptForge.V_OBJECT Then ' com.sun.star.util.Date
|
|
With _ControlModel.Date
|
|
vDate = DateSerial(.Year, .Month, .Day)
|
|
End With
|
|
vGet = vDate
|
|
Else ' .Date = Empty
|
|
End If
|
|
End If
|
|
Case CTLFORMATTEDFIELD 'String or numeric
|
|
If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then vGet = _ControlModel.EffectiveValue Else vGet = ""
|
|
Case CTLHIDDENCONTROL 'String
|
|
If oSession.HasUnoProperty(_ControlModel, "HiddenValue") Then vGet = _ControlModel.HiddenValue Else vGet = ""
|
|
Case CTLLISTBOX 'String or array of strings depending on MultiSelection
|
|
' StringItemList is the list of the items displayed in the box
|
|
' ValueItemList is the list of the values in the underlying database field
|
|
' SelectedItems is the list of the indexes in StringItemList of the selected items
|
|
' It can go beyond the limits of StringItemList
|
|
' It can contain multiple values even if the listbox is not multiselect
|
|
If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _
|
|
And oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
|
|
vSelection = _ControlModel.SelectedItems
|
|
' The list of allowed values depends on the existence of a bound column
|
|
If _ListBoxBound() Then vList = _ControlModel.ValueItemList Else vList = _ControlModel.StringItemList
|
|
If _ControlModel.MultiSelection Then vValues = Array()
|
|
For i = 0 To UBound(vSelection)
|
|
lIndex = vSelection(i)
|
|
If lIndex >= 0 And lIndex <= UBound(vList) Then
|
|
If Not _ControlModel.MultiSelection Then
|
|
vValues = vList(lIndex)
|
|
Exit For
|
|
End If
|
|
vValues = ScriptForge.SF_Array.Append(vValues, vList(lIndex))
|
|
End If
|
|
Next i
|
|
vGet = vValues
|
|
Else
|
|
vGet = ""
|
|
End If
|
|
Case CTLRADIOBUTTON 'Boolean
|
|
If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 ) Else vGet = False
|
|
Case CTLSCROLLBAR 'Numeric
|
|
vGet = 0
|
|
If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then
|
|
If Not IsEmpty(_ControlModel.ScrollValue) Then vGet = _ControlModel.ScrollValue
|
|
End If
|
|
Case CTLSPINBUTTON
|
|
If oSession.HasUnoProperty(_ControlModel, "SpinValue") Then vGet = _ControlModel.SpinValue Else vGet = 0
|
|
Case CTLTIMEFIELD
|
|
vGet = CDate(0)
|
|
If oSession.HasUnoProperty(_ControlModel, "Time") Then
|
|
If VarType(_ControlModel.Time) = ScriptForge.V_OBJECT Then ' com.sun.star.Util.Time
|
|
With _ControlModel.Time
|
|
vDate = TimeSerial(.Hours, .Minutes, .Seconds)
|
|
End With
|
|
vGet = vDate
|
|
Else ' .Time = Empty
|
|
End If
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
_PropertyGet = vGet
|
|
Case UCase("Visible")
|
|
If oSession.HasUnoMethod(_ControlView, "isVisible") Then _PropertyGet = CBool(_ControlView.isVisible())
|
|
Case UCase("XControlModel")
|
|
Set _PropertyGet = _ControlModel
|
|
Case UCase("XControlView")
|
|
Set _PropertyGet = _ControlView
|
|
Case Else
|
|
_PropertyGet = Null
|
|
End Select
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchType:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_FormControl._PropertyGet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertySet(Optional ByVal psProperty As String _
|
|
, Optional ByVal pvValue As Variant _
|
|
) As Boolean
|
|
''' Set the new value of the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
''' pvValue: the new value of the given property
|
|
|
|
Dim bSet As Boolean ' Return value
|
|
Static oSession As Object ' Alias of SF_Session
|
|
Dim sFormName As String ' Full form identification for error messages
|
|
Dim vSet As Variant ' Value to set in UNO model or view property
|
|
Dim vActions As Variant ' Action property: list of available actions
|
|
Dim sAction As String ' A single action
|
|
Dim vFormats As Variant ' Format property: output of _FormatsList()
|
|
Dim iFormat As Integer ' Format property: index in vFormats
|
|
Dim vSelection As Variant ' Alias of Model.SelectedItems
|
|
Dim vList As Variant ' Alias of Model.StringItemList
|
|
Dim lIndex As Long ' Index in StringItemList
|
|
Dim sItem As String ' A single item
|
|
Dim oDatabase As Object ' The database object related to the parent form of the control instance
|
|
Dim i As Long
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = "Value"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bSet = False
|
|
|
|
cstThisSub = "SFDocuments.FormControl.set" & psProperty
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
If Not _ParentForm._IsStillAlive() Then GoTo Finally
|
|
|
|
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
bSet = True
|
|
Select Case UCase(psProperty)
|
|
Case UCase("Action")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON
|
|
vActions = Array("none", "submitForm", "resetForm", "refreshForm", "moveToFirst", "moveToLast", "moveToNext", "moveToPrev" _
|
|
, "saveRecord", "moveToNew", "deleteRecord", "undoRecord")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Action", ScriptForge.V_STRING, vActions) Then GoTo Finally
|
|
If oSession.HasUNOProperty(_ControlModel, "ButtonType") Then
|
|
sAction = vActions(ScriptForge.SF_Array.IndexOf(vActions, pvValue, CaseSensitive := False))
|
|
_ControlModel.TargetURL = ""
|
|
Select Case sAction
|
|
Case "none" : vSet = com.sun.star.form.FormButtonType.PUSH
|
|
Case "submitForm" : vSet = com.sun.star.form.FormButtonType.SUBMIT
|
|
Case "resetForm" : vSet = com.sun.star.form.FormButtonType.RESET
|
|
Case Else
|
|
vSet = com.sun.star.form.FormButtonType.URL
|
|
_ControlModel.TargetURL = ".uno:FormController/" & sAction
|
|
End Select
|
|
_ControlModel.ButtonType = vSet
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Caption")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Caption", V_STRING) Then GoTo Finally
|
|
If oSession.HasUNOProperty(_ControlModel, "Label") Then _ControlModel.Label = pvValue
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Default")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Default", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _ControlModel.DefaultButton = pvValue
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Enabled")
|
|
Select Case _ControlType
|
|
Case CTLHIDDENCONTROL : GoTo CatchType
|
|
Case Else
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Enabled", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _ControlModel.Enabled = pvValue
|
|
End Select
|
|
Case UCase("Format")
|
|
Select Case _ControlType
|
|
Case CTLDATEFIELD, CTLTIMEFIELD
|
|
vFormats = _FormatsList()
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING, vFormats) Then GoTo Finally
|
|
iFormat = ScriptForge.SF_Array.IndexOf(vFormats, pvValue, CaseSensitive := False)
|
|
If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then
|
|
_ControlModel.DateFormat = iFormat
|
|
ElseIf oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then
|
|
_ControlModel.TimeFormat = iFormat
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("ListIndex")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "ListIndex", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX
|
|
If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
|
|
If pvValue >= 0 And pvValue <= UBound(_ControlModel.StringItemList) Then _ControlModel.Text = _ControlModel.StringItemList(CInt(pvValue))
|
|
End If
|
|
Case CTLLISTBOX
|
|
If oSession.HasUNOProperty(_ControlModel, "SelectedItems") Then _ControlModel.SelectedItems = Array(CInt(pvValue))
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("ListSource")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLLISTBOX
|
|
If oSession.HasUNOProperty(_ControlModel, "ListSource") Then
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
|
|
With com.sun.star.form.ListSourceType
|
|
Select Case _ControlModel.ListSourceType
|
|
Case .QUERY _
|
|
, .TABLE _
|
|
, .TABLEFIELDS
|
|
Set oDatabase = _ParentForm.GetDatabase()
|
|
If _ControlModel.ListSourceType = .QUERY Then vList = oDatabase.Queries Else vList = oDatabase.Tables
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING, vList) Then Goto Finally
|
|
If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = pvValue Else _ControlModel.ListSource = Array(pvValue)
|
|
_ControlModel.refresh()
|
|
Case .SQL
|
|
Set oDatabase = _ParentForm.GetDatabase()
|
|
If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = oDatabase._ReplaceSquareBrackets(pvValue) Else _ControlModel.ListSource = Array(oDatabase._ReplaceSquareBrackets(pvValue))
|
|
_ControlModel.refresh()
|
|
Case .VALUELIST ' ListBox only !
|
|
_ControlModel.ListSource = Split(pvValue, ";")
|
|
_ControlModel.StringItemList = _ControlModel.ListSource
|
|
Case .SQLPASSTHROUGH
|
|
If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = pvValue Else _ControlModel.ListSource = Array(pvValue)
|
|
_ControlModel.refresh()
|
|
End Select
|
|
End With
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("ListSourceType")
|
|
With com.sun.star.form.ListSourceType
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "ListSourceType", ScriptForge.V_NUMERIC, Array( _
|
|
.TABLE _
|
|
, .QUERY _
|
|
, .SQL _
|
|
, .SQLPASSTHROUGH _
|
|
, .TABLEFIELDS _
|
|
)) Then GoTo Finally
|
|
Case CTLLISTBOX
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "ListSourceType", ScriptForge.V_NUMERIC, Array( _
|
|
.VALUELIST _
|
|
, .TABLE _
|
|
, .QUERY _
|
|
, .SQL _
|
|
, .SQLPASSTHROUGH _
|
|
, .TABLEFIELDS _
|
|
)) Then GoTo Finally
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
End With
|
|
If oSession.HasUnoProperty(_ControlModel, "ListSourceType") Then _ControlModel.ListSourceType = pvValue
|
|
Case UCase("Locked")
|
|
Select Case _ControlType
|
|
Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLIMAGECONTROL _
|
|
, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Locked", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _ControlModel.ReadOnly = pvValue
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("MultiSelect")
|
|
Select Case _ControlType
|
|
Case CTLLISTBOX
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then _ControlModel.MultiSelection = pvValue
|
|
If oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then _ControlModel.MultiSelectionSimpleMode = pvValue
|
|
If oSession.HasUnoProperty(_ControlModel, "SelectedItems") Then
|
|
' Cancel selections when MultiSelect becomes False
|
|
If Not pvValue And UBound(_ControlModel.SelectedItems) > 0 Then
|
|
lIndex = _ControlModel.SelectedItems(0)
|
|
_ControlModel.SelectedItems = Array(lIndex)
|
|
End If
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnApproveAction"), UCase("OnApproveReset"), UCase("OnApproveUpdate") _
|
|
, UCase("OnChanged"), UCase("OnErrorOccurred"), UCase("OnFocusGained"), UCase("OnFocusLost") _
|
|
, UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
|
|
, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
|
|
, UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted") _
|
|
, UCase("OnTextChanged"), UCase("OnUpdated")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
|
|
If Not IsNull(_ControlModel) Then
|
|
bSet = SF_Register._RegisterEventScript(_ControlModel _
|
|
, psProperty _
|
|
, _GetListener(psProperty) _
|
|
, pvValue _
|
|
, _Name _
|
|
)
|
|
End If
|
|
Case UCase("Picture")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON, CTLIMAGEBUTTON, CTLIMAGECONTROL
|
|
If Not ScriptForge.SF_Utils._ValidateFile(pvValue, "Picture") Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _ControlModel.ImageURL = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue)
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("TipText")
|
|
Select Case _ControlType
|
|
Case CTLHIDDENCONTROL : GoTo CatchType
|
|
Case Else
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "TipText", V_STRING) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _ControlModel.HelpText = pvValue
|
|
End Select
|
|
Case UCase("TripleState")
|
|
Select Case _ControlType
|
|
Case CTLCHECKBOX
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "TripleState", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "TriState") Then _ControlModel.TriState = pvValue
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
Case UCase("Value")
|
|
Select Case _ControlType
|
|
Case CTLBUTTON 'Boolean, toggle buttons only
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Toggle") And oSession.HasUnoProperty(_ControlModel, "State") Then
|
|
_ControlModel.State = Iif(pvValue, 1, 0)
|
|
End If
|
|
Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(ScriptForge.V_BOOLEAN, ScriptForge.V_NUMERIC), Array(0, 1, 2, True, False)) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "State") Then
|
|
If VarType(pvValue) = ScriptForge.V_BOOLEAN Then pvValue = Iif(pvValue, 1, 0)
|
|
_ControlModel.State = pvValue
|
|
End If
|
|
Case CTLCOMBOBOX
|
|
If oSession.HasUnoProperty(_ControlModel, "Text") And oSession.HasUnoProperty(_ControlModel, "StringItemList") Then
|
|
If pvValue <> "" Then
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING, _ControlModel.StringItemList) Then Goto Finally
|
|
End If
|
|
_ControlModel.Text = pvValue
|
|
End If
|
|
Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Value") Then _ControlModel.Value = pvValue
|
|
Case CTLDATEFIELD 'Date
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_DATE) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Date") Then
|
|
Set vSet = New com.sun.star.util.Date
|
|
vSet.Year = Year(pvValue)
|
|
vSet.Month = Month(pvValue)
|
|
vSet.Day = Day(pvValue)
|
|
_ControlModel.Date = vSet
|
|
End If
|
|
Case CTLFILECONTROL
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Text") Then _ControlModel.Text = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue)
|
|
Case CTLFORMATTEDFIELD 'String or numeric
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then _ControlModel.EffectiveValue = pvValue
|
|
Case CTLHIDDENCONTROL 'String
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "HiddenValue") Then _ControlModel.HiddenValue = pvValue
|
|
Case CTLLISTBOX 'String or number - Only a single value may be set
|
|
' StringItemList is the list of the items displayed in the box
|
|
' ValueItemList is the list of the values in the underlying database field
|
|
' SelectedItems is the list of the indexes in StringItemList of the selected items
|
|
If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") Then
|
|
' Setting the value on a listbox is allowed only if single value and value in the list
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
|
|
' The list of allowed values depends on the existence of a bound column
|
|
If _ListboxBound() Then vList = _ControlModel.ValueItemList Else vList = _ControlModel.StringItemList
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", , vList) Then GoTo Finally
|
|
_ControlModel.SelectedItems = Array(ScriptForge.SF_Array.IndexOf(vList, pvValue, CaseSensitive := True))
|
|
End If
|
|
Case CTLPATTERNFIELD, CTLTEXTFIELD 'String
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Text") Then _ControlModel.Text = pvValue
|
|
Case CTLRADIOBUTTON 'Boolean
|
|
' A group of radio buttons is presumed sharing the same GroupName
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "State") Then _ControlModel.State = Iif(pvValue, 1, 0)
|
|
Case CTLSCROLLBAR 'Numeric
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "ScrollValueMin") Then
|
|
If pvValue < _ControlModel.ScrollValueMin Then pvValue = _ControlModel.ScrollValueMin
|
|
End If
|
|
If oSession.HasUnoProperty(_ControlModel, "ScrollValueMax") Then
|
|
If pvValue > _ControlModel.ScrollValueMax Then pvValue = _ControlModel.ScrollValueMax
|
|
End If
|
|
If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then _ControlModel.ScrollValue = pvValue
|
|
Case CTLSPINBUTTON 'Numeric
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "SpinValueMin") Then
|
|
If pvValue < _ControlModel.SpinValueMin Then pvValue = _ControlModel.SpinValueMin
|
|
End If
|
|
If oSession.HasUnoProperty(_ControlModel, "SpinValueMax") Then
|
|
If pvValue > _ControlModel.SpinValueMax Then pvValue = _ControlModel.SpinValueMax
|
|
End If
|
|
If oSession.HasUnoProperty(_ControlModel, "SpinValue") Then _ControlModel.SpinValue = pvValue
|
|
Case CTLTIMEFIELD
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_DATE) Then GoTo Finally
|
|
If oSession.HasUnoProperty(_ControlModel, "Time") Then
|
|
Set vSet = New com.sun.star.util.Time
|
|
vSet.Hours = Hour(pvValue)
|
|
vSet.Minutes = Minute(pvValue)
|
|
vSet.Seconds = Second(pvValue)
|
|
_ControlModel.Time = vSet
|
|
End If
|
|
Case Else : GoTo CatchType
|
|
End Select
|
|
' FINAL COMMITMENT
|
|
If oSession.HasUNOMethod(_ControlModel, "commit") Then _ControlModel.commit() ' f.i. checkboxes have no commit method ??
|
|
Case UCase("Visible")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If oSession.HasUnoMethod(_ControlView, "setVisible") Then
|
|
If pvValue Then _ControlModel.EnableVisible = True
|
|
_ControlView.setVisible(pvValue)
|
|
End If
|
|
Case Else
|
|
bSet = False
|
|
End Select
|
|
|
|
Finally:
|
|
_PropertySet = bSet
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
bSet = False
|
|
GoTo Finally
|
|
CatchType:
|
|
If Len(_ParentForm._FormDocumentName) > 0 Then sFormName = _ParentForm._FormDocumentName & "." Else sFormName = ""
|
|
ScriptForge.SF_Exception.RaiseFatal(FORMCONTROLTYPEERROR, _Name, sFormName & _FormName, _ControlType, psProperty)
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_FormControl._PropertySet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _Repr() As String
|
|
''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
|
''' Args:
|
|
''' Return:
|
|
''' "[FORMCONTROL]: Name, Type (formname)
|
|
_Repr = "[FORMCONTROL]: " & _Name & ", " & _ControlType & " (" & _FormName & ")"
|
|
|
|
End Function ' SFDocuments.SF_FormControl._Repr
|
|
|
|
REM ============================================ END OF SFDOCUMENTS.SF_FORMCONTROL
|
|
</script:module> |