diff options
Diffstat (limited to 'wizards/source/access2base/Control.xba')
| -rw-r--r-- | wizards/source/access2base/Control.xba | 2501 |
1 files changed, 2501 insertions, 0 deletions
diff --git a/wizards/source/access2base/Control.xba b/wizards/source/access2base/Control.xba new file mode 100644 index 000000000..b22bb819b --- /dev/null +++ b/wizards/source/access2base/Control.xba @@ -0,0 +1,2501 @@ +<?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="Control" script:language="StarBasic"> +REM ======================================================================================================================= +REM === The Access2Base library is a part of the LibreOffice project. === +REM === Full documentation is available on http://www.access2base.com === +REM ======================================================================================================================= + +Option Compatible +Option ClassModule + +Option Explicit + +REM ----------------------------------------------------------------------------------------------------------------------- +REM --- CLASS ROOT FIELDS --- +REM ----------------------------------------------------------------------------------------------------------------------- + +Private _Type As String ' Must be CONTROL +Private _This As Object ' Workaround for absence of This builtin function +Private _Parent As Object +Private _ImplementationName As String +Private _ClassId As Integer +Private _ParentType As String ' One of CTLPARENTISxxxx constants +Private _Shortcut As String +Private _Name As String +Private _FormComponent As Object ' com.sun.star.text.TextDocument +Private _MainForm As String ' To be propagated to all subcontrols +Private _DocEntry As Integer ' Doc- and DbContainer entries in Root structure +Private _DbEntry As Integer +Private _ControlType As Integer +Private _ThisProperties As Variant ' Buffer for properties list +Private _SubType As String +Private ControlModel As Object ' com.sun.star.comp.forms.XXXModel +Private ControlView As Object ' com.sun.star.comp.forms.XXXControl (NULL if form open in edit mode) +Private BoundField As Object ' com.sun.star.sdb.ODataColumn +Private LabelControl As Object ' com.sun.star.form.component.FixedText or com.sun.star.form.component.GroupBox + +REM ----------------------------------------------------------------------------------------------------------------------- +REM --- CONSTRUCTORS / DESTRUCTORS --- +REM ----------------------------------------------------------------------------------------------------------------------- +Private Sub Class_Initialize() + _Type = OBJCONTROL + Set _This = Nothing + Set _Parent = Nothing + _ClassId = -1 + _ParentType = "" + _Shortcut = "" + _Name = "" + Set _FormComponent = Nothing + _MainForm = "" + _DocEntry = -1 + _DbEntry = -1 + _ThisProperties = Array() + _SubType = "" + Set ControlModel = Nothing + Set ControlView = Nothing + Set BoundField = Nothing + Set LabelControl = Nothing + +End Sub ' Constructor + +REM ----------------------------------------------------------------------------------------------------------------------- +Private Sub Class_Terminate() + On Local Error Resume Next + Call Class_Initialize() +End Sub ' Destructor + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Sub Dispose() + Call Class_Terminate() +End Sub ' Explicit destructor + +REM ----------------------------------------------------------------------------------------------------------------------- +REM --- CLASS GET/LET/SET PROPERTIES --- +REM ----------------------------------------------------------------------------------------------------------------------- + +Property Get BackColor() As Variant + BackColor = _PropertyGet("BackColor") +End Property ' BackColor (get) + +Property Let BackColor(ByVal pvValue As Variant) + Call _PropertySet("BackColor", pvValue) +End Property ' BackColor (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get BorderColor() As Variant + BorderColor = _PropertyGet("BorderColor") +End Property ' BorderColor (get) + +Property Let BorderColor(ByVal pvValue As Variant) + Call _PropertySet("BorderColor", pvValue) +End Property ' BorderColor (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get BorderStyle() As Variant + BorderStyle = _PropertyGet("BorderStyle") +End Property ' BorderStyle (get) + +Property Let BorderStyle(ByVal pvValue As Variant) + Call _PropertySet("BorderStyle", pvValue) +End Property ' BorderStyle (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Cancel() As Variant + Cancel = _PropertyGet("Cancel") +End Property ' Cancel (get) + +Property Let Cancel(ByVal pvValue As Variant) + Call _PropertySet("Cancel", pvValue) +End Property ' Cancel (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Caption() As Variant + Caption = _PropertyGet("Caption") +End Property ' Caption (get) + +Property Let Caption(ByVal pvValue As Variant) + Call _PropertySet("Caption", pvValue) +End Property ' Caption (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get ControlSource() As Variant + ControlSource = _PropertyGet("ControlSource") +End Property ' ControlSource (get) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get ControlTipText() As Variant + ControlTipText = _PropertyGet("ControlTipText") +End Property ' ControlTipText (get) + +Property Let ControlTipText(ByVal pvValue As Variant) + Call _PropertySet("ControlTipText", pvValue) +End Property ' ControlTipText (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get ControlType() As Variant + ControlType = _PropertyGet("ControlType") +End Property ' ControlType (get) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Default() As Variant + Default = _PropertyGet("Default") +End Property ' Default (get) + +Property Let Default(ByVal pvValue As Variant) + Call _PropertySet("Default", pvValue) +End Property ' Default (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get DefaultValue() As Variant + DefaultValue = _PropertyGet("DefaultValue") +End Property ' DefaultValue (get) + +Property Let DefaultValue(ByVal pvValue As Variant) + Call _PropertySet("DefaultValue", pvValue) +End Property ' DefaultValue (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Enabled() As Variant + Enabled = _PropertyGet("Enabled") +End Property ' Enabled (get) + +Property Let Enabled(ByVal pvValue As Variant) + Call _PropertySet("Enabled", pvValue) +End Property ' Enabled (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get FontBold() As Variant + FontBold = _PropertyGet("FontBold") +End Property ' FontBold (get) + +Property Let FontBold(ByVal pvValue As Variant) + Call _PropertySet("FontBold", pvValue) +End Property ' FontBold (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get FontItalic() As Variant + FontItalic = _PropertyGet("FontItalic") +End Property ' FontItalic (get) + +Property Let FontItalic(ByVal pvValue As Variant) + Call _PropertySet("FontItalic", pvValue) +End Property ' FontItalic (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get FontName() As Variant + FontName = _PropertyGet("FontName") +End Property ' FontName (get) + +Property Let FontName(ByVal pvValue As Variant) + Call _PropertySet("FontName", pvValue) +End Property ' FontName (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get FontSize() As Variant + FontSize = _PropertyGet("FontSize") +End Property ' FontSize (get) + +Property Let FontSize(ByVal pvValue As Variant) + Call _PropertySet("FontSize", pvValue) +End Property ' FontSize (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get FontUnderline() As Variant + FontUnderline = _PropertyGet("FontUnderline") +End Property ' FontUnderline (get) + +Property Let FontUnderline(ByVal pvValue As Variant) + Call _PropertySet("FontUnderline", pvValue) +End Property ' FontUnderline (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get FontWeight() As Variant + FontWeight = _PropertyGet("FontWeight") +End Property ' FontWeight (get) + +Property Let FontWeight(ByVal pvValue As Variant) + Call _PropertySet("FontWeight", pvValue) +End Property ' FontWeight (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get ForeColor() As Variant + ForeColor = _PropertyGet("ForeColor") +End Property ' ForeColor (get) + +Property Let ForeColor(ByVal pvValue As Variant) + Call _PropertySet("ForeColor", pvValue) +End Property ' ForeColor (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Form() As Variant + Form = _PropertyGet("Form") +End Property ' Form (get) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Format() As Variant + Format = _PropertyGet("Format") +End Property ' Format (get) + +Property Let Format(ByVal pvValue As Variant) + Call _PropertySet("Format", pvValue) +End Property ' Format (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get ItemData(ByVal Optional pvIndex As Variant) As Variant + If IsMissing(pvIndex) Then ItemData = _PropertyGet("ItemData") Else ItemData = _PropertyGet("ItemData", pvIndex) +End Property ' ItemData (get) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get ListCount() As Variant + ListCount = _PropertyGet("ListCount") +End Property ' ListCount (get) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get ListIndex() As Variant + ListIndex = _PropertyGet("ListIndex") +End Property ' ListIndex (get) + +Property Let ListIndex(ByVal pvValue As Variant) + Call _PropertySet("ListIndex", pvValue) +End Property ' ListIndex (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Locked() As Variant + Locked = _PropertyGet("Locked") +End Property ' Locked (get) + +Property Let Locked(ByVal pvValue As Variant) + Call _PropertySet("Locked", pvValue) +End Property ' Locked (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get MultiSelect() As Variant + MultiSelect = _PropertyGet("MultiSelect") +End Property ' MultiSelect (get) + +Property Let MultiSelect(ByVal pvValue As Variant) + Call _PropertySet("MultiSelect", pvValue) +End Property ' MultiSelect (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Name() As String + Name = _PropertyGet("Name") +End Property ' Name (get) + +Public Function pName() As String ' For compatibility with < V0.9.0 + pName = _PropertyGet("Name") +End Function ' pName (get) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get ObjectType() As String + ObjectType = _PropertyGet("ObjectType") +End Property ' ObjectType (get) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnActionPerformed() As Variant + OnActionPerformed = _PropertyGet("OnActionPerformed") +End Property ' OnActionPerformed (get) + +Property Let OnActionPerformed(ByVal pvValue As Variant) + Call _PropertySet("OnActionPerformed", pvValue) +End Property ' OnActionPerformed (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnAdjustmentValueChanged() As Variant + OnAdjustmentValueChanged = _PropertyGet("OnAdjustmentValueChanged") +End Property ' OnAdjustmentValueChanged (get) + +Property Let OnAdjustmentValueChanged(ByVal pvValue As Variant) + Call _PropertySet("OnAdjustmentValueChanged", pvValue) +End Property ' OnAdjustmentValueChanged (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnApproveAction() As Variant + OnApproveAction = _PropertyGet("OnApproveAction") +End Property ' OnApproveAction (get) + +Property Let OnApproveAction(ByVal pvValue As Variant) + Call _PropertySet("OnApproveAction", pvValue) +End Property ' OnApproveAction (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnApproveReset() As Variant + OnApproveReset = _PropertyGet("OnApproveReset") +End Property ' OnApproveReset (get) + +Property Let OnApproveReset(ByVal pvValue As Variant) + Call _PropertySet("OnApproveReset", pvValue) +End Property ' OnApproveReset (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnApproveUpdate() As Variant + OnApproveUpdate = _PropertyGet("OnApproveUpdate") +End Property ' OnApproveUpdate (get) + +Property Let OnApproveUpdate(ByVal pvValue As Variant) + Call _PropertySet("OnApproveUpdate", pvValue) +End Property ' OnApproveUpdate (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnChanged() As Variant + OnChanged = _PropertyGet("OnChanged") +End Property ' OnChanged (get) + +Property Let OnChanged(ByVal pvValue As Variant) + Call _PropertySet("OnChanged", pvValue) +End Property ' OnChanged (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnErrorOccurred() As Variant + OnErrorOccurred = _PropertyGet("OnErrorOccurred") +End Property ' OnErrorOccurred (get) + +Property Let OnErrorOccurred(ByVal pvValue As Variant) + Call _PropertySet("OnErrorOccurred", pvValue) +End Property ' OnErrorOccurred (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnFocusGained() As Variant + OnFocusGained = _PropertyGet("OnFocusGained") +End Property ' OnFocusGained (get) + +Property Let OnFocusGained(ByVal pvValue As Variant) + Call _PropertySet("OnFocusGained", pvValue) +End Property ' OnFocusGained (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnFocusLost() As Variant + OnFocusLost = _PropertyGet("OnFocusLost") +End Property ' OnFocusLost (get) + +Property Let OnFocusLost(ByVal pvValue As Variant) + Call _PropertySet("OnFocusLost", pvValue) +End Property ' OnFocusLost (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnItemStateChanged() As Variant + OnItemStateChanged = _PropertyGet("OnItemStateChanged") +End Property ' OnItemStateChanged (get) + +Property Let OnItemStateChanged(ByVal pvValue As Variant) + Call _PropertySet("OnItemStateChanged", pvValue) +End Property ' OnItemStateChanged (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnKeyPressed() As Variant + OnKeyPressed = _PropertyGet("OnKeyPressed") +End Property ' OnKeyPressed (get) + +Property Let OnKeyPressed(ByVal pvValue As Variant) + Call _PropertySet("OnKeyPressed", pvValue) +End Property ' OnKeyPressed (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnKeyReleased() As Variant + OnKeyReleased = _PropertyGet("OnKeyReleased") +End Property ' OnKeyReleased (get) + +Property Let OnKeyReleased(ByVal pvValue As Variant) + Call _PropertySet("OnKeyReleased", pvValue) +End Property ' OnKeyReleased (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMouseDragged() As Variant + OnMouseDragged = _PropertyGet("OnMouseDragged") +End Property ' OnMouseDragged (get) + +Property Let OnMouseDragged(ByVal pvValue As Variant) + Call _PropertySet("OnMouseDragged", pvValue) +End Property ' OnMouseDragged (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMouseEntered() As Variant + OnMouseEntered = _PropertyGet("OnMouseEntered") +End Property ' OnMouseEntered (get) + +Property Let OnMouseEntered(ByVal pvValue As Variant) + Call _PropertySet("OnMouseEntered", pvValue) +End Property ' OnMouseEntered (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMouseExited() As Variant + OnMouseExited = _PropertyGet("OnMouseExited") +End Property ' OnMouseExited (get) + +Property Let OnMouseExited(ByVal pvValue As Variant) + Call _PropertySet("OnMouseExited", pvValue) +End Property ' OnMouseExited (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMouseMoved() As Variant + OnMouseMoved = _PropertyGet("OnMouseMoved") +End Property ' OnMouseMoved (get) + +Property Let OnMouseMoved(ByVal pvValue As Variant) + Call _PropertySet("OnMouseMoved", pvValue) +End Property ' OnMouseMoved (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMousePressed() As Variant + OnMousePressed = _PropertyGet("OnMousePressed") +End Property ' OnMousePressed (get) + +Property Let OnMousePressed(ByVal pvValue As Variant) + Call _PropertySet("OnMousePressed", pvValue) +End Property ' OnMousePressed (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnMouseReleased() As Variant + OnMouseReleased = _PropertyGet("OnMouseReleased") +End Property ' OnMouseReleased (get) + +Property Let OnMouseReleased(ByVal pvValue As Variant) + Call _PropertySet("OnMouseReleased", pvValue) +End Property ' OnMouseReleased (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnResetted() As Variant + OnResetted = _PropertyGet("OnResetted") +End Property ' OnResetted (get) + +Property Let OnResetted(ByVal pvValue As Variant) + Call _PropertySet("OnResetted", pvValue) +End Property ' OnResetted (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnTextChanged() As Variant + OnTextChanged = _PropertyGet("OnTextChanged") +End Property ' OnTextChanged (get) + +Property Let OnTextChanged(ByVal pvValue As Variant) + Call _PropertySet("OnTextChanged", pvValue) +End Property ' OnTextChanged (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OnUpdated() As Variant + OnUpdated = _PropertyGet("OnUpdated") +End Property ' OnUpdated (get) + +Property Let OnUpdated(ByVal pvValue As Variant) + Call _PropertySet("OnUpdated", pvValue) +End Property ' OnUpdated (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get OptionValue() As Variant + OptionValue = _PropertyGet("OptionValue") +End Property ' OptionValue (get) + +Property Let OptionValue(ByVal pvValue As Variant) + Call _PropertySet("OptionValue", pvValue) +End Property ' OptionValue (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Page() As Variant + Page = _PropertyGet("Page") +End Property ' Page (get) + +Property Let Page(ByVal pvValue As Variant) + Call _PropertySet("Page", pvValue) +End Property ' Page (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function Parent() As Object + Parent = _PropertyGet("Parent") +End Function ' Parent (get) V0.9.1 + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Picture() As Variant + Picture = _PropertyGet("Picture") +End Property ' Picture (get) + +Property Let Picture(ByVal pvValue As Variant) + Call _PropertySet("Picture", pvValue) +End Property ' Picture (set) V1.5.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function Properties(ByVal Optional pvIndex As Variant) As Variant +' Return +' a Collection object if pvIndex absent +' a Property object otherwise + + Utils._SetCalledSub("Control.Properties") +Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String + vPropertiesList = _PropertiesList() + sObject = Utils._PCase(_Type) + If IsMissing(pvIndex) Then + vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList) + Else + vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex) + vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) + End If + +Exit_Function: + Set Properties = vProperty + Utils._ResetCalledSub("Control.Properties") + Exit Function +End Function ' Properties + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Required() As Variant + Required = _PropertyGet("Required") +End Property ' Required (get) + +Property Let Required(ByVal pvValue As Variant) + Call _PropertySet("Required", pvValue) +End Property ' Required (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get RowSource() As Variant + RowSource = _PropertyGet("RowSource") +End Property ' RowSource (get) + +Property Let RowSource(ByVal pvValue As Variant) + Call _PropertySet("RowSource", pvValue) +End Property ' RowSource (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get RowSourceType() As Variant + RowSourceType = _PropertyGet("RowSourceType") +End Property ' RowSourceType (get) + +Property Let RowSourceType(ByVal pvValue As Variant) + Call _PropertySet("RowSourceType", pvValue) +End Property ' RowSourceType (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Selected(ByVal Optional pvIndex As Variant) As Variant + If IsMissing(pvIndex) Then Selected = _PropertyGet("Selected") Else Selected = _PropertyGet("Selected", pvIndex) +End Property ' Selected (get) + +Property Let Selected(ByVal pvValue As Variant) ' , ByVal Optional pvIndex As Variant) +' If IsMissing(pvIndex) Then Call _PropertySet("Selected", pvValue) Else Call _PropertySet("Selected", pvValue, pvIndex) + Call _PropertySet("Selected", pvValue) +End Property ' Selected (set) + +Public Function SelectedI(ByVal pvValue As variant, ByVal pvIndex As Variant) + Call _PropertySet("Selected", pvValue, pvIndex) +End Function + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get SelLength() As Variant + SelLength = _PropertyGet("SelLength") +End Property ' SelLength (get) + +Property Let SelLength(ByVal pvValue As Variant) + Call _PropertySet("SelLength", pvValue) +End Property ' SelLength (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get SelStart() As Variant + SelStart = _PropertyGet("SelStart") +End Property ' SelStart (get) + +Property Let SelStart(ByVal pvValue As Variant) + Call _PropertySet("SelStart", pvValue) +End Property ' SelStart (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get SelText() As Variant + SelText = _PropertyGet("SelText") +End Property ' SelText (get) + +Property Let SelText(ByVal pvValue As Variant) + Call _PropertySet("SelText", pvValue) +End Property ' SelText (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get SpecialEffect() As Variant + SpecialEffect = _PropertyGet("SpecialEffect") +End Property ' SpecialEffect (get) + +Property Let SpecialEffect(ByVal pvValue As Variant) + Call _PropertySet("SpecialEffect", pvValue) +End Property ' SpecialEffect (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get SubType() As Variant + SubType = _PropertyGet("SubType") +End Property ' SubType (get) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get TabIndex() As Variant + TabIndex = _PropertyGet("TabIndex") +End Property ' TabIndex (get) + +Property Let TabIndex(ByVal pvValue As Variant) + Call _PropertySet("TabIndex", pvValue) +End Property ' TabIndex (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get TabStop() As Variant + TabStop = _PropertyGet("TabStop") +End Property ' TabStop (get) + +Property Let TabStop(ByVal pvValue As Variant) + Call _PropertySet("TabStop", pvValue) +End Property ' TabStop (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Tag() As Variant + Tag = _PropertyGet("Tag") +End Property ' Tag (get) + +Property Let Tag(ByVal pvValue As Variant) + Call _PropertySet("Tag", pvValue) +End Property ' Tag (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Text() As Variant + Text = _PropertyGet("Text") +End Property ' Text (get) + +Public Function pText() As Variant + pText = _PropertyGet("Text") +End Function ' pText (get) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get TextAlign() As Variant + TextAlign = _PropertyGet("TextAlign") +End Property ' TextAlign (get) + +Property Let TextAlign(ByVal pvValue As Variant) + Call _PropertySet("TextAlign", pvValue) +End Property ' TextAlign (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get TripleState() As Variant + TripleState = _PropertyGet("TripleState") +End Property ' TripleState (get) + +Property Let TripleState(ByVal pvValue As Variant) + Call _PropertySet("TripleState", pvValue) +End Property ' TripleState (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Value() As Variant + Value = _PropertyGet("Value") +End Property ' Value (get) + +Property Let Value(ByVal pvValue As Variant) + Call _PropertySet("Value", pvValue) +End Property ' Value (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +Property Get Visible() As Variant + Visible = _PropertyGet("Visible") +End Property ' Visible (get) + +Property Let Visible(ByVal pvValue As Variant) + Call _PropertySet("Visible", pvValue) +End Property ' Visible (set) + +REM ----------------------------------------------------------------------------------------------------------------------- +REM --- CLASS METHODS --- +REM ----------------------------------------------------------------------------------------------------------------------- + +Public Function AddItem(ByVal Optional pvItem As Variant, ByVal Optional pvIndex) As Boolean +' Add an item in a Listbox + + Utils._SetCalledSub("Control.AddItem") + AddItem = False + If _ErrorHandler() Then On Local Error Goto Error_Function + + If IsMissing(pvItem) Then Call _TraceArguments() + If IsMissing(pvIndex) Then pvIndex = -1 + +Dim iArgNr As Integer + Select Case UCase(_A2B_.CalledSub) + Case UCase("AddItem") : iArgNr = 1 + Case UCase("Control.AddItem") : iArgNr = 0 + End Select + + If Not Utils._CheckArgument(pvItem, iArgNr + 1, vbString) Then Goto Exit_Function + If Not Utils._CheckArgument(pvIndex, iArgNr + 2, Utils._AddNumeric()) Then Goto Exit_Function + If _SubType <> CTLLISTBOX Then Goto Error_Control + If _ParentType <> CTLPARENTISDIALOG Then + If ControlModel.ListSourceType <> com.sun.star.form.ListSourceType.VALUELIST Then Goto Error_Control + End If + +Dim vRowSource() As Variant, iCount As Integer, i As Integer + If IsArray(ControlModel.StringItemList) Then vRowSource = ControlModel.StringItemList Else vRowSource = Array(ControlModel.StringItemList) + iCount = UBound(vRowSource) + If pvIndex < -1 Or pvIndex > iCount + 1 Then Goto Error_Index + ReDim Preserve vRowSource(0 To iCount + 1) + If pvIndex = -1 Then pvIndex = iCount + 1 + For i = iCount + 1 To pvIndex + 1 Step -1 + vRowSource(i) = vRowSource(i - 1) + Next i + vRowSource(pvIndex) = pvItem + + If _ParentType <> CTLPARENTISDIALOG Then + ControlModel.ListSource = vRowSource() + End If + ControlModel.StringItemList = vRowSource() + AddItem = True + +Exit_Function: + Utils._ResetCalledSub("Control.AddItem") + Exit Function +Error_Function: + TraceError(TRACEABORT, Err, "Control.AddItem", Erl) + AddItem = False + GoTo Exit_Function +Error_Control: + TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , "Control.AddItem") + AddItem = False + Goto Exit_Function +Error_Index: + TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(iArgNr + 2,pvIndex)) + AddItem = False + Goto Exit_Function +End Function ' AddItem V0.9.1 + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function Controls(Optional ByVal pvIndex As Variant) As Variant +' Return a Control object with name or index = pvIndex + +Const cstThisSub = "Control.Controls" +If _ErrorHandler() Then On Local Error Goto Error_Function + Utils._SetCalledSub(cstThisSub) + +Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer +Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String +Dim j As Integer, oView As Object + + If _SubType <> CTLGRIDCONTROL Then Goto Trace_Error_Context + Set ocControl = Nothing + iControlCount = ControlModel.getCount() + + If IsMissing(pvIndex) Then ' No argument, return Collection pseudo-object + Set oCounter = New Collect + Set oCounter._This = oCounter + oCounter._CollType = COLLCONTROLS + Set oCounter._Parent = _This + oCounter._Count = iControlCount + Set Controls = oCounter + Goto Exit_Function + End If + + If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function + + ' Start building the ocControl object + ' Determine exact name + Set ocControl = New Control + Set ocControl._This = ocControl + Set ocControl._Parent = _This + ocControl._ParentType = CTLPARENTISGRID + sParentShortcut = _Shortcut + sControls() = ControlModel.getElementNames() + + Select Case VarType(pvIndex) + Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal + If pvIndex < 0 Or pvIndex > iControlCount - 1 Then Goto Trace_Error_Index + ocControl._Name = sControls(pvIndex) + Case vbString ' Check control name validity (non case sensitive) + bFound = False + sIndex = UCase(Utils._Trim(pvIndex)) + For i = 0 To iControlCount - 1 + If UCase(sControls(i)) = sIndex Then + bFound = True + Exit For + End If + Next i + If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound + End Select + + With ocControl + ._Shortcut = sParentShortcut & "!" & Utils._Surround(._Name) + Set .ControlModel = ControlModel.getByName(._Name) + ._ImplementationName = .ControlModel.ColumnServiceName ' getImplementationName aborts for subcontrols !? + ._FormComponent = ParentComponent + ._MainForm = _MainForm + If Utils._hasUNOProperty(.ControlModel, "ClassId") Then ._ClassId = .ControlModel.ClassId + ' Complex bypass to find View of grid subcontrols ! + If Not IsNull(ControlView) Then ' Anticipate absence of ControlView in grid 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 = ._Name Then + Set .ControlView = oView + Exit For + End If + End If + Next i + End If + + ._Initialize() + ._DocEntry = _DocEntry + ._DbEntry = _DbEntry + End With + Set Controls = ocControl + +Exit_Function: + Utils._ResetCalledSub(cstThisSub) + Exit Function +Trace_Error_Index: + TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) + Set Controls = Nothing + Goto Exit_Function +Trace_NotFound: + TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, _Name)) + Set Controls = Nothing + Goto Exit_Function +Trace_Error_Context: + TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , "Grid.Controls") + Set Controls = Nothing + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, cstThisSub, Erl) + Set Controls = Nothing + GoTo Exit_Function +End Function ' Controls + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function getProperty(Optional ByVal pvProperty As Variant, ByVal Optional pvIndex As Variant) As Variant +' Return property value of psProperty property name + + Utils._SetCalledSub("Control.getProperty") + If IsMissing(pvProperty) Then Call _TraceArguments() + If IsMissing(pvIndex) Then + getProperty = _PropertyGet(pvProperty) + Else + getProperty = _PropertyGet(pvProperty, pvIndex) + End If + Utils._ResetCalledSub("Control.getProperty") + +End Function ' getProperty + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean +' Return True if object has a valid property called pvProperty (case-insensitive comparison !) + + If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) + Exit Function + +End Function ' hasProperty + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function RemoveItem(ByVal Optional pvIndex) As Boolean +' Remove an item from a Listbox +' Index may be a string value or an index-position + + Utils._SetCalledSub("Control.RemoveItem") + If _ErrorHandler() Then On Local Error Goto Error_Function + + If IsMissing(pvIndex) Then Call _TraceArguments() +Dim iArgNr As Integer + Select Case UCase(_A2B_.CalledSub) + Case UCase("RemoveItem") : iArgNr = 1 + Case UCase("Control.RemoveItem") : iArgNr = 0 + End Select + If Not Utils._CheckArgument(pvIndex, iArgNr + 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function + If _SubType <> CTLLISTBOX Then Goto Error_Control + If _ParentType <> CTLPARENTISDIALOG Then + If ControlModel.ListSourceType <> com.sun.star.form.ListSourceType.VALUELIST Then Goto Error_Control + End If + +Dim vRowSource() As Variant, iCount As Integer, i As Integer, j As integer, bFound As Boolean + If IsArray(ControlModel.StringItemList) Then vRowSource = ControlModel.StringItemList Else vRowSource = Array(ControlModel.StringItemList) + iCount = UBound(vRowSource) + + Select Case VarType(pvIndex) + Case vbString + bFound = False + For i = 0 To iCount + If vRowSource(i) = pvIndex Then + For j = i To iCount - 1 + vRowSource(j) = vRowSource(j + 1) + Next j + bFound = True + Exit For ' Remove only 1st occurrence of string + End If + Next i + Case Else + If pvIndex < 0 Or pvIndex > iCount Then Goto Error_Index + For i = pvIndex To iCount - 1 + vRowSource(i) = vRowSource(i + 1) + Next i + bFound = True + End Select + + If bFound Then + If iCount > 0 Then ' https://forum.openoffice.org/en/forum/viewtopic.php?f=47&t=75008 + ReDim Preserve vRowSource(0 To iCount - 1) + Else + vRowSource = Array() + End If + If _ParentType <> CTLPARENTISDIALOG Then + ControlModel.ListSource = vRowSource() + End If + ControlModel.StringItemList = vRowSource() + RemoveItem = True + Else + RemoveItem = False + End If + +Exit_Function: + Utils._ResetCalledSub("Control.RemoveItem") + Exit Function +Error_Function: + TraceError(TRACEABORT, Err, "Control.RemoveItem", Erl) + RemoveItem = False + GoTo Exit_Function +Error_Control: + TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, "Control.RemoveItem") + RemoveItem = False + Goto Exit_Function +Error_Index: + TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(2, pvIndex)) + RemoveItem = False + Goto Exit_Function +End Function ' RemoveItem V0.9.1 + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function Requery() As Boolean +' Refresh data displayed in a form, subform, combobox or listbox + Utils._SetCalledSub("Control.Requery") + If _ErrorHandler() Then On Local Error Goto Error_Function + Requery = False + + Select Case _SubType + Case CTLCOMBOBOX, CTLLISTBOX + If Utils._InList(ControlModel.ListSourceType, Array( _ + com.sun.star.form.ListSourceType.QUERY _ + , com.sun.star.form.ListSourceType.TABLE _ + , com.sun.star.form.ListSourceType.TABLEFIELDS _ + , com.sun.star.form.ListSourceType.SQL _ + , com.sun.star.form.ListSourceType.SQLPASSTHROUGH _ + )) Then + ControlModel.refresh() + End If + Case Else + Goto Error_Control + End Select + Requery = True + +Exit_Function: + Utils._ResetCalledSub("Control.Requery") + Exit Function +Error_Control: + TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, "Control.Requery") + Requery = False + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Control.Requery", Erl) + GoTo Exit_Function +End Function ' Requery + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function SetFocus() As Boolean +' Execute setFocus method + Utils._SetCalledSub("Control.SetFocus") + If _ErrorHandler() Then On Local Error Goto Error_Function + SetFocus = False + +Dim i As Integer, j As Integer, iColPosition As Integer +Dim ocControl As Object, ocGrid As Variant, oGridModel As Object + + If IsNull(ControlView) Then GoTo Exit_Function + If _ParentType = CTLPARENTISGRID Then 'setFocus method does not work on controlviews in grid ?!? + ' Find column position of control + iColPosition = -1 + ocGrid = getObject(_getUpperShortcut(_Shortcut, _Name)) ' return containing grid + Set oGridModel = ocGrid.ControlModel + j = -1 + For i = 0 To oGridModel.Count - 1 + Set ocControl = oGridModel.GetByIndex(i) + If Not ocControl.Hidden Then j = j + 1 ' Skip if hidden + If oGridModel.GetByIndex(i).Name = _Name Then + iColPosition = j + Exit For + End If + Next i + If iColPosition >= 0 Then + ocGrid.ControlView.setFocus() 'Set first focus on grid itself + ocGrid.ControlView.setCurrentColumnPosition(iColPosition) 'Deprecated but no alternative found + Else + Goto Error_Grid + End If + Else + ControlView.setFocus() + End If + SetFocus = True + +Exit_Function: + Utils._ResetCalledSub("Control.SetFocus") + Exit Function +Error_Function: + TraceError(TRACEABORT, Err, "Control.SetFocus", Erl) + Goto Exit_Function +Error_Grid: + TraceError(TRACEFATAL, ERRFOCUSINGRID, Utils._CalledSub(), 0, 1, Array(_Name, ocGrid._Name)) + Goto Exit_Function +End Function ' SetFocus V0.9.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean +' Return True if property setting OK + Utils._SetCalledSub("Control.setProperty") + If IsMissing(pvIndex) Then + setProperty = _PropertySet(psProperty, pvValue) + Else + setProperty = _PropertySet(psProperty, pvValue, pvIndex) + End If + Utils._ResetCalledSub("Control.setProperty") +End Function ' setProperty + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function SetSelected(ByVal Optional pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean +' Workaround for limitation of Basic: Property Let does not accept optional arguments + + If IsMissing(pvValue) Then Call _TraceArguments() + If IsMissing(pvIndex) Then + SetSelected = _PropertySet("Selected", pvValue) + Else + SetSelected = _PropertySet("Selected", pvValue, pvIndex) + End If + +End Function ' SetSelected + +REM ----------------------------------------------------------------------------------------------------------------------- +REM --- PRIVATE FUNCTIONS --- +REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _Formats(ByVal psControlType As String) As Variant +' Return allowed format entries for Date and Time control types + +Dim vFormats() As Variant + Select Case psControlType + 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 + + _Formats = vFormats + +End Function ' _Formats V0.9.1 + +REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _GetListener(ByVal psProperty As String) As String +' Return the X...Listener corresponding with the property in argument + + Select Case UCase(psProperty) + 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 ' _GetListener V1.7.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Sub _Initialize() +' Initialize new Control +' ControlModel, ParentType, Name, Shortcut, ControlView, ImplementationName, ClassId (if parent <> dialog) +' are presumed preexisting + + ' Identify SubType and ControlView +Dim sControlTypes() As Variant, i As Integer, vSplit() As Variant, sTrailer As String + sControlTypes = array( CTLCONTROL _ + , CTLCOMMANDBUTTON _ + , CTLRADIOBUTTON _ + , CTLIMAGEBUTTON _ + , CTLCHECKBOX _ + , CTLLISTBOX _ + , CTLCOMBOBOX _ + , CTLGROUPBOX _ + , CTLTEXTFIELD _ + , CTLFIXEDTEXT _ + , CTLGRIDCONTROL _ + , CTLFILECONTROL _ + , CTLHIDDENCONTROL _ + , CTLIMAGECONTROL _ + , CTLDATEFIELD _ + , CTLTIMEFIELD _ + , CTLNUMERICFIELD _ + , CTLCURRENCYFIELD _ + , CTLPATTERNFIELD _ + , CTLSCROLLBAR _ + , CTLSPINBUTTON _ + , CTLNAVIGATIONBAR _ + , CTLPROGRESSBAR _ + , CTLFIXEDLINE _ + ) + + Select Case _ParentType + Case CTLPARENTISDIALOG + vSplit = Split(ControlModel.getServiceName(), ".") + sTrailer = UCase(vSplit(UBound(vSplit))) + ' Manage homonyms + Select Case sTrailer + Case "BUTTON" : sTrailer = CTLCOMMANDBUTTON + Case "EDIT" : sTrailer = CTLTEXTFIELD + Case Else + End Select + If sTrailer <> CTLFORMATTEDFIELD Then + For i = 0 To UBound(sControlTypes) + If sControlTypes(i) = sTrailer Then + _ClassId = i + 1 + _SubType = sTrailer + _ControlType = _ClassId + Exit For + End If + Next i + Else + _ClassId = acFormattedField + _SubType = CTLFORMATTEDFIELD + _ControlType = _ClassId + End If + Case Else + 'Is ClassId one of the properties ? + If _ClassId > 0 Then ' All control types have a ClassId except subforms + _SubType = sControlTypes(_ClassId - 1) + _ControlType = _ClassId + If _SubType = CTLTEXTFIELD Then ' Formatted fields belong to the TextField family + 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 datagrid + _SubType = CTLFORMATTEDFIELD + _ControlType = acFormattedField + End If + End If + Else ' Initialize subform Control + If ControlModel.ImplementationName = "com.sun.star.comp.forms.ODatabaseForm" Then + _SubType = CTLSUBFORM + _ControlType = acSubform + End If + End If + End Select + +End Sub ' _Initialize + +REM ----------------------------------------------------------------------------------------------------------------------- +Public Function _ListboxBound() As Boolean +' Return True if listbox has a bound column + +Dim bListboxBound As Boolean, j As Integer +Dim vValue() As variant, vString As Variant + + bListboxBound = False + + If Not IsNull(ControlModel.ValueItemList) _ + And ControlModel.DataField <> "" _ + And Not IsNull(ControlModel.BoundField) _ + And Utils._InList(ControlModel.ListSourceType, 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 _ + )) Then ' MultiSelect behaviour changed in OpenOffice >= 3.3 + If IsArray(ControlModel.ValueItemList) Then + vValue = ControlModel.ValueItemList + vString = ControlModel.StringItemList + For j = 0 To UBound(vValue) + If VarType(vValue(j)) <> VarType(vString(j)) Then + bListboxBound = True + ElseIf vValue(j) <> vString(j) Then + bListboxBound = True + End If + If bListboxBound Then Exit For + Next j + End If + End If + + _ListboxBound = bListboxBound + +End Function ' _ListboxBound V0.9.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _PropertiesList() As Variant +' Based on ControlProperties.ods analysis + +Dim vFullPropertiesList() As Variant + + 'List established only once + If UBound(_ThisProperties) > -1 Then + _PropertiesList = _ThisProperties + Exit Function + End If + + vFullPropertiesList = Array( _ + "BackColor" _ + , "BorderColor" _ + , "BorderStyle" _ + , "Cancel" _ + , "Caption" _ + , "ControlSource" _ + , "ControlTipText" _ + , "ControlType" _ + , "Default" _ + , "DefaultValue" _ + , "Enabled" _ + , "FontBold" _ + , "FontItalic" _ + , "FontName" _ + , "FontSize" _ + , "FontUnderline" _ + , "FontWeight" _ + , "ForeColor" _ + , "Form" _ + , "Format" _ + , "ItemData" _ + , "LinkChildFields" _ + , "LinkMasterFields" _ + , "ListCount" _ + , "ListIndex" _ + , "Locked" _ + , "MultiSelect" _ + , "Name" _ + , "ObjectType" _ + , "OnActionPerformed" _ + , "OnAdjustmentValueChanged" _ + , "OnApproveAction" _ + , "OnApproveReset" _ + , "OnApproveUpdate" _ + , "OnChanged" _ + , "OnErrorOccurred" _ + , "OnFocusGained" _ + , "OnFocusLost" _ + , "OnItemStateChanged" _ + , "OnKeyPressed" _ + , "OnKeyReleased" _ + , "OnMouseDragged" _ + , "OnMouseEntered" _ + , "OnMouseExited" _ + , "OnMouseMoved" _ + , "OnMousePressed" _ + , "OnMouseReleased" _ + , "OnResetted" _ + , "OnTextChanged" _ + , "OnUpdated" _ + , "OptionValue" _ + , "Page" _ + , "Parent" _ + , "Picture" _ + , "Required" _ + , "RowSource" _ + , "RowSourceType" _ + , "Selected" _ + , "SelLength" _ + , "SelStart" _ + , "Seltext" _ + , "SpecialEffect" _ + , "SubType" _ + , "TabIndex" _ + , "TabStop" _ + , "Tag" _ + , "Text" _ + , "TextAlign" _ + , "TripleState" _ + , "Value" _ + , "Visible" _ + ) +Dim vPropertiesMatrix(25) As Variant + Select Case _ParentType + Case CTLPARENTISFORM, CTLPARENTISSUBFORM + vPropertiesMatrix(acCheckBox) = Array(0,4,5,6,7,9,10,11,12,13,14,15,16,17,27,28,29,32,36,37,38,39,40,41,42,43,44,45,46,47,52,54,61,62,63,64,65,67,68,69,70) + vPropertiesMatrix(acComboBox) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,20,23,24,25,27,28,29,32,33,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,52,54,55,56,62,63,64,65,66,67,69,70) + vPropertiesMatrix(acCommandButton) = Array(0,3,4,6,7,8,10,11,12,13,14,15,16,17,27,28,29,31,32,36,37,38,39,40,41,42,43,44,45,46,47,52,53,62,63,64,65,67,69,70) + vPropertiesMatrix(acCurrencyField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,63,64,65,67,69,70) + vPropertiesMatrix(acDateField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,19,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,63,64,65,66,67,69,70) + vPropertiesMatrix(acFileControl) = Array(0,1,2,6,7,9,10,11,12,13,14,15,16,17,25,27,28,32,36,37,39,40,41,42,43,44,45,46,47,48,52,62,63,64,65,66,69,70) + vPropertiesMatrix(acFixedText) = Array(0,1,2,4,6,7,10,11,12,13,14,15,16,17,27,28,36,37,39,40,41,42,43,44,45,46,52,62,65,67,70) + vPropertiesMatrix(acFormattedField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,19,25,27,28,32,33,35,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,63,64,65,66,67,69,70) + vPropertiesMatrix(acGridControl) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,27,28,32,33,35,36,37,39,40,41,42,43,44,45,46,47,49,52,62,63,64,65,70) + vPropertiesMatrix(acGroupBox) = Array(4,6,7,10,11,12,13,14,15,16,17,27,28,32,36,37,39,40,41,42,43,44,45,46,47,52,62,65,70) + vPropertiesMatrix(acHiddenControl) = Array(7,27,28,52,62,65,69,70) + vPropertiesMatrix(acImageButton) = Array(0,1,2,6,7,10,27,28,31,36,37,39,40,41,42,43,44,45,46,52,53,62,63,64,65,70) + vPropertiesMatrix(acImageControl) = Array(0,1,2,5,6,7,10,25,27,28,32,36,37,39,40,41,42,43,44,45,46,47,52,53,54,62,63,64,65,70) + vPropertiesMatrix(acListBox) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,20,23,24,25,26,27,28,29,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,49,52,54,55,56,57,62,63,64,65,67,69,70) + vPropertiesMatrix(acNavigationBar) = Array(0,2,6,7,10,11,12,13,14,15,16,17,27,28,36,37,39,40,41,42,43,44,45,46,52,62,63,64,65,70) + vPropertiesMatrix(acNumericField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,63,64,65,67,69,70) + vPropertiesMatrix(acPatternField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,58,59,60,62,63,64,65,66,67,69,70) + vPropertiesMatrix(acRadioButton) = Array(0,4,5,6,7,9,10,11,12,13,14,15,16,17,27,28,29,32,36,37,38,39,40,41,42,43,44,45,46,47,50,52,54,61,62,63,64,65,67,69,70) + vPropertiesMatrix(acScrollBar) = Array(0,1,2,6,7,10,27,28,30,32,33,36,37,39,40,41,42,43,44,45,46,47,49,52,62,63,64,65,69,70) + vPropertiesMatrix(acSpinButton) = Array(0,1,2,6,7,9,10,27,28,30,32,33,36,37,39,40,41,42,43,44,45,46,47,49,52,62,63,64,65,69,70) + vPropertiesMatrix(0) = Array(7,18,21,22,27,28,52,62) + vPropertiesMatrix(acTextField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,32,33,34,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,58,59,60,62,63,64,65,66,67,69,70) + vPropertiesMatrix(acTimeField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,19,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,63,64,65,66,67,69,70) + Case CTLPARENTISGROUP + ' To be duplicated from above !!! + vPropertiesMatrix(acRadioButton) = Array(0,4,5,6,7,9,10,11,12,13,14,15,16,17,27,28,29,32,36,37,38,39,40,41,42,43,44,45,46,47,50,52,54,61,62,63,64,65,67,69,70) + Case CTLPARENTISGRID + vPropertiesMatrix(acCheckBox) = Array(4,5,6,7,9,10,27,28,29,32,36,37,38,39,40,41,42,43,44,45,46,47,52,54,61,62,65,67,68,69) + vPropertiesMatrix(acComboBox) = Array(4,5,6,7,9,10,20,23,24,25,27,28,32,33,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,52,54,55,56,62,65,66,67,69) + vPropertiesMatrix(acCurrencyField) = Array(4,5,6,7,9,10,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,65,67,69) + vPropertiesMatrix(acDateField) = Array(4,5,6,7,9,10,19,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,65,66,67,69) + vPropertiesMatrix(acFormattedField) = Array(4,5,6,7,9,10,19,25,27,28,32,33,35,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,65,66,67,69) + vPropertiesMatrix(acListBox) = Array(4,5,6,7,9,10,20,23,24,25,26,27,28,32,33,35,36,37,38,39,40,41,42,43,44,45,46,47,49,52,54,55,56,57,62,65,67,69) + vPropertiesMatrix(acNumericField) = Array(4,5,6,7,9,10,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,65,67,69) + vPropertiesMatrix(acPatternField) = Array(4,5,6,7,9,10,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,58,59,60,62,65,66,67,69) + vPropertiesMatrix(acTextField) = Array(4,5,6,7,9,10,25,27,28,32,33,34,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,58,59,60,62,65,66,67,69) + vPropertiesMatrix(acTimeField) = Array(4,5,6,7,9,10,19,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,65,66,67,69) + Case CTLPARENTISDIALOG + vPropertiesMatrix(acCheckBox) = Array(0,4,6,7,10,11,12,13,14,15,16,17,27,28,29,36,37,38,39,40,41,42,43,44,45,46,51,52,61,62,63,64,65,67,68,69,70) + vPropertiesMatrix(acComboBox) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,20,23,24,25,27,28,29,36,37,38,39,40,41,42,43,44,45,46,48,51,52,55,62,63,64,65,66,67,69,70) + vPropertiesMatrix(acCommandButton) = Array(0,3,4,6,7,8,10,11,12,13,14,15,16,17,27,28,29,36,37,38,39,40,41,42,43,44,45,46,51,52,53,62,63,64,65,67,70) + vPropertiesMatrix(acCurrencyField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,67,69,70) + vPropertiesMatrix(acDateField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,19,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,66,67,69,70) + vPropertiesMatrix(acFileControl) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,66,67,69,70) + vPropertiesMatrix(acFixedLine) = Array(0,4,6,7,10,11,12,13,14,15,16,17,27,28,36,37,39,40,41,42,43,44,45,46,51,52,62,63,65,70) + vPropertiesMatrix(acFixedText) = Array(0,1,2,4,6,7,10,11,12,13,14,15,16,17,27,28,36,37,39,40,41,42,43,44,45,46,51,52,62,63,64,65,67,70) + vPropertiesMatrix(acFormattedField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,19,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,66,67,69,70) + vPropertiesMatrix(acGroupBox) = Array(4,6,7,10,11,12,13,14,15,16,17,27,28,36,37,39,40,41,42,43,44,45,46,51,52,62,63,65,70) + vPropertiesMatrix(acImageControl) = Array(0,1,2,6,7,10,27,28,36,37,39,40,41,42,43,44,45,46,51,52,53,62,63,64,65,70) + vPropertiesMatrix(acListBox) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,20,23,24,25,26,27,28,29,36,37,38,39,40,41,42,43,44,45,46,51,52,55,57,62,63,64,65,67,69,70) + vPropertiesMatrix(acNavigationBar) = Array(36,37,39,40,41,42,43,44,45,46) + vPropertiesMatrix(acNumericField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,67,69,70) + vPropertiesMatrix(acPatternField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,58,59,60,62,63,64,65,66,67,69,70) + vPropertiesMatrix(acProgressBar) = Array(0,1,2,6,7,10,27,28,36,37,39,40,41,42,43,44,45,46,51,52,62,63,65,69,70) + vPropertiesMatrix(acRadioButton) = Array(0,4,6,7,10,11,12,13,14,15,16,17,27,28,29,36,37,38,39,40,41,42,43,44,45,46,50,51,52,61,62,63,64,65,67,69,70) + vPropertiesMatrix(acScrollBar) = Array(0,1,2,6,7,10,27,28,30,36,37,39,40,41,42,43,44,45,46,51,52,62,63,64,65,69,70) + vPropertiesMatrix(acTextField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,58,59,60,62,63,64,65,66,67,69,70) + vPropertiesMatrix(acTimeField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,19,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,66,67,69,70) + End Select + +Dim i As Integer, iIndex As Integer + If _ControlType = acSubForm Then iIndex = 0 Else iIndex = _ControlType + If IsEmpty(vPropertiesMatrix(iIndex)) Then + _ThisProperties = Array() + Else + ReDim _ThisProperties(0 To UBound(vPropertiesMatrix(iIndex))) + For i = 0 To UBound(_ThisProperties) + _ThisProperties(i) = vFullPropertiesList(vPropertiesMatrix(iIndex)(i)) + Next i + End If + + _PropertiesList = _ThisProperties() + +End Function ' _PropertiesList + +REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _PropertyGet(ByVal psProperty As String, ByVal Optional pvIndex As Variant) As Variant +' Return property value of the psProperty property name + +Dim iArg As Integer + If _ErrorHandler() Then On Local Error Goto Error_Function + Utils._SetCalledSub("Control.get" & psProperty) + _PropertyGet = EMPTY + +'Check Index argument +Dim iArgNr As Integer + If Not IsMissing(pvIndex) Then + Select Case UCase(_A2B_.CalledSub) + Case UCase("getProperty") : iArgNr = 3 + Case UCase("Control.getProperty") : iArgNr = 2 + Case UCase("Control.get" & psProperty) : iArgNr = 1 + End Select + If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function + End If + +Dim vDefaultValue As Variant, oDefaultValue As Object, vValue As Variant, oValue As Object, iIndex As Integer +Dim lListIndex As Long, i As Integer, j As Integer, vCurrentValue As Variant, lListCount As Long +Dim vListboxValue As Variant, vListSource, bSelected() As Boolean, bListboxBound As Boolean +Dim vGet As Variant, vDate As Variant +Dim ofSubForm As Object +Dim vFormats() As Variant +Dim vSelection As Variant, sSelectedText As String +Dim oControlEvents As Object, sEventName As String + + If Not hasProperty(psProperty) Then Goto Trace_Error + + Select Case UCase(psProperty) + Case UCase("BackColor") + If Utils._hasUNOProperty(ControlModel, "BackgroundColor") Then _PropertyGet = ControlModel.BackgroundColor + Case UCase("BorderColor") + If Utils._hasUNOProperty(ControlModel, "BorderColor") Then _PropertyGet = ControlModel.BorderColor + Case UCase("BorderStyle") + If Utils._hasUNOProperty(ControlModel, "Border") Then _PropertyGet = ControlModel.Border + Case UCase("Cancel") + If Utils._hasUNOProperty(ControlModel, "PushButtonType") Then _PropertyGet = ( ControlModel.PushButtonType = com.sun.star.awt.PushButtonType.CANCEL ) + Case UCase("Caption") + If Utils._hasUNOProperty(ControlModel, "Label") Then _PropertyGet = ControlModel.Label + Case UCase("ControlSource") + If Utils._hasUNOProperty(ControlModel, "DataField") Then _PropertyGet = ControlModel.DataField + Case UCase("ControlTipText") + If Utils._hasUNOProperty(ControlModel, "HelpText") Then _PropertyGet = ControlModel.HelpText + Case UCase("ControlType") + _PropertyGet = _ControlType + Case UCase("Default") + If Utils._hasUNOProperty(ControlModel, "DefaultButton") Then _PropertyGet = ControlModel.DefaultButton + Case UCase("DefaultValue") + Select Case _SubType + Case CTLCHECKBOX, CTLRADIOBUTTON + If Utils._hasUNOProperty(ControlModel, "DefaultState") Then _PropertyGet = ControlModel.DefaultState + Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD + If Utils._hasUNOProperty(ControlModel, "DefaultText") Then _PropertyGet = ControlModel.DefaultText + Case CTLCURRENCYFIELD, CTLNUMERICFIELD + If Utils._hasUNOProperty(ControlModel, "DefaultValue") Then _PropertyGet = ControlModel.DefaultValue + Case CTLDATEFIELD + If Utils._hasUNOProperty(ControlModel, "DefaultDate") Then + Select Case VarType(ControlModel.DefaultDate) + Case vbLong ' AOO and LO <= 4.1 + vDefaultValue = ControlModel.DefaultDate + _PropertyGet = DateSerial(Left(vDefaultValue, 4), Mid(vDefaultValue, 5, 2), Right(vDefaultValue, 2)) + Case vbObject ' LO >= 4.2 com.sun.star.Util.Date + Set oDefaultValue = ControlModel.DefaultDate + _PropertyGet = DateSerial(oDefaultValue.Year,oDefaultValue.Month, oDefaultValue.Day) + Case vbEmpty + End Select + End If + Case CTLFORMATTEDFIELD + If Utils._hasUNOProperty(ControlModel, "EffectiveDefault") Then _PropertyGet = ControlModel.EffectiveDefault + Case CTLLISTBOX + If Utils._hasUNOProperty(ControlModel, "DefaultSelection") And Utils._hasUNOProperty(ControlModel, "StringItemList") Then + vDefaultValue = ControlModel.DefaultSelection + If IsArray(vDefaultValue) Then + If UBound(vDefaultValue) >= LBound(vDefaultValue) Then ' Is array initialized ? + iIndex = UBound(ControlModel.StringItemList) + If vDefaultValue(0) >= 0 And vDefaultValue(0) <= iIndex Then _PropertyGet = ControlModel.StringItemList(vDefaultValue(0)) + ' Only first default value is considered + End If + End If + End If + Case CTLSPINBUTTON + If Utils._hasUNOProperty(ControlModel, "DefaultSpinValue") Then _PropertyGet = ControlModel.DefaultSpinValue + Case CTLTIMEFIELD + If Utils._hasUNOProperty(ControlModel, "DefaultTime") Then + Select Case VarType(ControlModel.DefaultTime) + Case vbLong ' AOO and LO <= 4.1 + _PropertyGet = ControlModel.DefaultTime + Case vbObject ' LO >= 4.2 com.sun.star.Util.Time + Set oDefaultValue = ControlModel.DefaultTime + _PropertyGet = TimeSerial(oDefaultValue.Hours, oDefaultValue.Minutes, oDefaultValue.Seconds) + Case vbEmpty + End Select + End If + Case Else + Goto Trace_Error + End Select + Case UCase("Enabled") + If Utils._hasUNOProperty(ControlModel, "Enabled") Then _PropertyGet = ControlModel.Enabled + Case UCase("FontBold") + If Utils._hasUNOProperty(ControlModel, "FontWeight") Then _PropertyGet = ( ControlModel.FontWeight >= com.sun.star.awt.FontWeight.BOLD ) + Case UCase("FontItalic") + If Utils._hasUNOProperty(ControlModel, "FontSlant") Then _PropertyGet = ( ControlModel.FontSlant = com.sun.star.awt.FontSlant.ITALIC ) + Case UCase("FontName") + If Utils._hasUNOProperty(ControlModel, "FontName") Then _PropertyGet = ControlModel.FontName + Case UCase("FontSize") + If Utils._hasUNOProperty(ControlModel, "FontHeight") Then _PropertyGet = ControlModel.FontHeight + Case UCase("FontUnderline") + If Utils._hasUNOProperty(ControlModel, "FontUnderline") Then _PropertyGet = _ + Not ( ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.NONE _ + Or ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.DONTKNOW ) + Case UCase("FontWeight") + If Utils._hasUNOProperty(ControlModel, "FontWeight") Then _PropertyGet = ControlModel.FontWeight + Case UCase("ForeColor") + If Utils._hasUNOProperty(ControlModel, "TextColor") Then _PropertyGet = ControlModel.TextColor + Case UCase("Form") + Set ofSubForm = New SubForm ' Start building the SUBFORM object + With ofSubForm + Set ._This = ofSubForm + Set .DatabaseForm = ControlModel + ._Name = _Name + ._Shortcut = _Shortcut & ".Form" + ._MainForm = _MainForm + .ParentComponent = _FormComponent + ._DocEntry = _DocEntry + ._DbEntry = _DbEntry + ._OrderBy = ControlModel.Order + End With + set _PropertyGet = ofSubForm + Case UCase("Format") + vFormats = _Formats(_Subtype) + Select Case _SubType + Case CTLDATEFIELD + If Utils._hasUNOProperty(ControlModel, "DateFormat") Then + If ControlModel.DateFormat <= UBound(vFormats) Then _PropertyGet = vFormats(ControlModel.DateFormat) + End If + Case CTLTIMEFIELD + If Utils._hasUNOProperty(ControlModel, "TimeFormat") Then + If ControlModel.TimeFormat <= UBound(vFormats) Then _PropertyGet = vFormats(ControlModel.TimeFormat) + End If + Case Else + If Utils._hasUNOProperty(ControlModel, "FormatKey") Then + If Utils._hasUNOProperty(ControlModel, "FormatsSupplier") Then + _PropertyGet = ControlModel.FormatsSupplier.getNumberFormats.getByKey(ControlModel.FormatKey).FormatString + End If + End If + End Select + Case UCase("ItemData") + If Utils._hasUNOProperty(ControlModel, "StringItemList") Then + If IsMissing(pvIndex) Then + _PropertyGet = ControlModel.StringItemList + Else + If pvIndex < 0 Or pvIndex > UBound(ControlModel.StringItemList) Then Goto Trace_Error_Index + _PropertyGet = ControlModel.StringItemList(pvIndex) + End If + End If + Case UCase("ListCount") + If Utils._hasUNOProperty(ControlModel, "StringItemList") Then _PropertyGet = UBound(ControlModel.StringItemList) + 1 + Case UCase("ListIndex") + If Utils._hasUNOProperty(ControlModel, "StringItemList") Then + lListIndex = -1 ' Either Multiple selections or no selection at all + Select Case _SubType + Case CTLCOMBOBOX + If Not Utils._hasUNOProperty(ControlModel, "Text") Then Goto Trace_Error + iIndex = 0 + If ControlModel.Text <> "" Then + For j = 0 To UBound(ControlModel.StringItemList) + If ControlModel.StringItemList(j) = ControlModel.Text Then + lListIndex = j + iIndex = iIndex + 1 + End If + Next j + If iIndex <> 1 Then lListIndex = -1 ' Multiselection or synonyms rejected + End If + Case CTLLISTBOX ' No mean found to access bound column !! See mail Lionel 10/5/2013 for improvement + If Not Utils._hasUNOProperty(ControlModel, "SelectedItems") Then Goto Trace_Error + If UBound(ControlModel.SelectedItems) > 0 Then ' Several items selected + Else ' Mono selection + If _ParentType <> CTLPARENTISDIALOG Then ' getCurrentValue not found in dialog listboxes ?? + vCurrentValue = ControlModel.getCurrentValue() ' Space or uninitialized array if no selection at all + If IsArray(vCurrentValue) Then ' Is an array if MultiSelect + vListboxValue = "" + If UBound(vCurrentValue) = 0 Then vListboxValue = vCurrentValue(0) + Else + vListboxValue = vCurrentValue + End If + If vListboxValue <> "" Then ' Speed up search PM Pastim 12/02/2013 + If Ubound(ControlModel.SelectedItems) >= 0 Then lListIndex = Controlmodel.Selecteditems(0) + End If + Else + If Ubound(ControlModel.SelectedItems) >= 0 Then lListIndex = Controlmodel.Selecteditems(0) + End If + End If + End Select + _PropertyGet = lListIndex + End If + Case UCase("Locked") + If Utils._hasUNOProperty(ControlModel, "ReadOnly") Then _PropertyGet = ControlModel.ReadOnly + Case UCase("MultiSelect") + If Utils._hasUNOProperty(ControlModel, "MultiSelection") Then + _PropertyGet = ControlModel.MultiSelection ' Boolean in OO, Integer (0, 1 or 2) in VBA + ElseIf Utils._hasUNOProperty(ControlModel, "MultiSelectionSimpleMode") Then ' Not documented: only for GridControls !? Changed in OO >= 3,3 !? + _PropertyGet = ControlModel.MultiSelectionSimpleMode + Else + _PropertyGet = False + End If + 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") + Select Case _ParentType + Case CTLPARENTISDIALOG + Set oControlEvents = ControlModel.getEvents() + sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & Utils._GetEventName(psProperty) + If oControlEvents.hasByName(sEventName) Then + _PropertyGet = oControlEvents.getByName(sEventName).ScriptCode + Else + _PropertyGet = "" + End If + Case Else + _PropertyGet = Utils._GetEventScriptCode(ControlModel, psProperty, _Name) + End Select + Case UCase("OptionValue") + If Utils._hasUNOProperty(ControlModel, "RefValue") Then + If ControlModel.RefValue <> "" Then + _PropertyGet = ControlModel.RefValue + ElseIf Utils._hasUNOProperty(ControlModel, "Label") Then + _PropertyGet = ControlModel.Label + End If + End If + Case UCase("ObjectType") + _PropertyGet = _Type + Case UCase("Page") + If Utils._hasUNOProperty(ControlModel, "Step") Then _PropertyGet = ControlModel.Step + Case UCase("Parent") + Set _PropertyGet = _Parent + Case UCase("Picture") + _PropertyGet = ConvertToUrl(ControlModel.ImageURL) + Case UCase("Required") + If Utils._hasUNOProperty(ControlModel, "InputRequired") Then _PropertyGet = ControlModel.InputRequired + Case UCase("RowSource") + Select Case _ParentType + Case CTLPARENTISDIALOG + If Utils._hasUNOProperty(ControlModel, "StringItemList") Then + If IsArray(ControlModel.StringItemList) Then vListSource = ControlModel.StringItemList Else vListSource = Array(ControlModel.StringItemList) + _PropertyGet = Join(vListSource, ";") + End If + Case Else + If Utils._hasUNOProperty(ControlModel, "ListSource") Then + Select Case ControlModel.ListSourceType + Case com.sun.star.form.ListSourceType.VALUELIST _ + , com.sun.star.form.ListSourceType.TABLEFIELDS + If IsArray(ControlModel.StringItemList) Then vListSource = ControlModel.StringItemList Else vListSource = Array(ControlModel.StringItemList) + Case com.sun.star.form.ListSourceType.TABLE _ + , com.sun.star.form.ListSourceType.QUERY _ + , com.sun.star.form.ListSourceType.SQL _ + , com.sun.star.form.ListSourceType.SQLPASSTHROUGH + If IsArray(ControlModel.ListSource) Then vListSource = ControlModel.ListSource Else vListSource = Array(ControlModel.ListSource) + End Select + _PropertyGet = Join(vListSource, ";") + End If + End Select + Case UCase("RowSourceType") + If Utils._hasUNOProperty(ControlModel, "ListSourceType") Then _PropertyGet = ControlModel.ListSourceType + Case UCase("Selected") + If Utils._hasUNOProperty(ControlModel, "StringItemList") Then + lListIndex = UBound(ControlModel.StringItemList) + If Not IsMissing(pvIndex) Then + If pvIndex < 0 Or pvIndex > lListIndex Then Goto Trace_Error_Index + End If + If lListIndex < 0 Then ' Do nothing if listbox empty + _PropertyGet = Array() + Else + Redim bSelected(0 To lListIndex) + For j = 0 To lListIndex + bSelected(j) = False + Next j + For j = 0 To UBound(ControlModel.SelectedItems) + iIndex = ControlModel.SelectedItems(j) + If iIndex >= 0 And iIndex <= lListIndex Then bSelected(iIndex) = True + Next j + If IsMissing(pvIndex) Then _PropertyGet = bSelected Else _PropertyGet = bSelected(pvIndex) + End If + End If + Case UCase("SelLength") + If Utils._hasUNOProperty(ControlView, "Selection") Then + vSelection = ControlView.getSelection() + If vSelection.Max >= vSelection.Min Then + _PropertyGet = vSelection.Max - vSelection.Min + Else + _PropertyGet = 0 ' probably control does not have focus + End If + Else + _PropertyGet = 0 + End If + Case UCase("SelStart") + If Utils._hasUNOProperty(ControlView, "Selection") Then + vSelection = ControlView.getSelection() + If vSelection.Max >= vSelection.Min Then + _PropertyGet = vSelection.Min + 1 + Else + _PropertyGet = 1 ' probably control does not have focus + End If + Else + _PropertyGet = 1 + End If + Case UCase("SelText") + If Utils._hasUNOProperty(ControlView, "SelectedText") Then + _PropertyGet = ControlView.getSelectedText() + Else + _PropertyGet = "" + End If + Case UCase("SpecialEffect") + If Utils._hasUNOProperty(ControlModel, "VisualEffect") Then _PropertyGet = ControlModel.VisualEffect + Case UCase("SubType") + _PropertyGet = _SubType + Case UCase("TabIndex") + If Utils._hasUNOProperty(ControlModel, "TabIndex") Then _PropertyGet = ControlModel.TabIndex + Case UCase("TabStop") + If Utils._hasUNOProperty(ControlModel, "Tabstop") Then _PropertyGet = ControlModel.Tabstop + Case UCase("Tag") + If Utils._hasUNOProperty(ControlModel, "Tag") Then _PropertyGet = ControlModel.Tag + Case UCase("Text") + Select Case _SubType + Case CTLDATEFIELD + If Utils._hasUNOProperty(ControlModel, "Date") Then + If Utils._hasUNOProperty(ControlModel, "FormatKey") Then + If Utils._hasUNOProperty(ControlModel, "FormatsSupplier") Then + Select Case VarType(ControlModel.Date) + Case vbLong ' AOO and LO <= 4.1 + vDate = DateSerial(Left(ControlModel.Date, 4), Mid(ControlModel.Date, 5, 2), Right(ControlModel.Date, 2)) + Case vbObject ' LO >= 4.2 + vDate = DateSerial(ControlModel.Date.Year, ControlModel.Date.Month, ControlModel.Date.Day) + Case vbEmpty + End Select + _PropertyGet = Format(vDate, ControlModel.FormatsSupplier.getNumberFormats.getByKey(ControlModel.FormatKey).FormatString) + End If + End If + End If + Case CTLTIMEFIELD + If Utils._hasUNOProperty(ControlModel, "Text") Then + Select Case VarType(ControlModel.Time) + Case vbLong ' AOO and LO <= 4.1 + _PropertyGet = Format(ControlModel.Time, "HH:MM:SS") + Case vbObject ' LO >= 4.2 com.sun.star.Util.Time + Set oValue = ControlModel.Time + _PropertyGet = Format(TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds), "HH:MM:SS") + Case vbEmpty + End Select + End If + Case Else + If Utils._hasUNOProperty(ControlModel, "Text") Then _PropertyGet = ControlModel.Text + End Select + Case UCase("TextAlign") + If Utils._hasUNOProperty(ControlModel, "Tag") Then _PropertyGet = ControlModel.Tag + Case UCase("TripleState") + If Utils._hasUNOProperty(ControlModel, "TriState") Then _PropertyGet = ControlModel.TriState + Case UCase("Value") + Select Case _SubType + Case CTLCHECKBOX + If Utils._hasUNOProperty(ControlModel, "State") Then vGet = ControlModel.State + Case CTLCOMMANDBUTTON + vGet = False + If Utils._hasUNOProperty(ControlModel, "Toggle") Then + If Utils._hasUNOProperty(ControlModel, "State") Then vGet = ( ControlModel.State = 1 ) + End If + Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD + If Utils._hasUNOProperty(ControlModel, "Text") Then vGet = ControlModel.Text + Case CTLCURRENCYFIELD + If Utils._hasUNOProperty(ControlModel, "Value") Then vGet = ControlModel.Value + Case CTLDATEFIELD + If Utils._hasUNOProperty(ControlModel, "Date") Then + Select Case VarType(ControlModel.Date) + Case vbLong ' AOO and LO <= 4.1 + vValue = ControlModel.Date + vGet = DateSerial(Left(vValue, 4), Mid(vValue, 5, 2), Right(vValue, 2)) + Case vbObject ' LO >= 4.2 com.sun.star.Util.Date + Set oValue = ControlModel.Date + vGet = DateSerial(oValue.Year, oValue.Month, oValue.Day) + Case vbEmpty + End Select + End If + Case CTLFORMATTEDFIELD + If Utils._hasUNOProperty(ControlModel, "EffectiveValue") Then vGet = ControlModel.EffectiveValue + Case CTLHIDDENCONTROL + If Utils._hasUNOProperty(ControlModel, "HiddenValue") Then vGet = ControlModel.HiddenValue + Case CTLLISTBOX + If Not Utils._hasUNOProperty(ControlModel, "StringItemList") Then Goto Trace_Error + If Not Utils._hasUNOProperty(ControlModel, "SelectedItems") Then Goto Trace_Error + If UBound(ControlModel.SelectedItems) > 0 Then ' Several items selected + vGet = EMPTY ' Listbox has no value, only an array of Selected flags to identify values + Else ' Mono selection + Select Case _ParentType + Case CTLPARENTISDIALOG + If Ubound(ControlModel.SelectedItems) >= 0 Then + lListIndex = Controlmodel.Selecteditems(0) + If lListIndex > -1 And lListIndex <= UBound(ControlModel.StringItemList) Then + vGet = ControlModel.StringItemList(lListIndex) + Else + vGet = EMPTY + End If + End If + Case Else + 'getCurrentValue does not return any significant value anymore + ' Speed up getting value PM PASTIM 12/02/2013 + If Ubound(ControlModel.SelectedItems) >= 0 Then lListIndex = Controlmodel.Selecteditems(0) Else lListIndex = -1 + ' If listbox has hidden column = real bound field, then explore ValueItemList + If _ListboxBound() Then + If lListIndex > -1 Then vGet = ControlModel.ValueItemList(lListIndex) ' PASTIM + Else + If lListIndex > -1 Then vGet = ControlModel.getItemText(lListIndex) + End If + End Select + End If + Case CTLNUMERICFIELD + If Utils._hasUNOProperty(ControlModel, "Value") Then vGet = ControlModel.Value + Case CTLPROGRESSBAR + If Utils._hasUNOProperty(ControlModel, "ProgressValue") Then vGet = ControlModel.ProgressValue + Case CTLSCROLLBAR + If Utils._hasUNOProperty(ControlModel, "ScrollValue") Then vGet = ControlModel.ScrollValue + Case CTLSPINBUTTON + If Utils._hasUNOProperty(ControlModel, "SpinValue") Then vGet = ControlModel.SpinValue + Case CTLTIMEFIELD + If Utils._hasUNOProperty(ControlModel, "Time") Then + Select Case VarType(ControlModel.Time) + Case vbLong ' AOO and LO <= 4.1 + vGet = ControlModel.Time + Case vbObject ' LO >= 4.2 com.sun.star.Util.Time + Set oValue = ControlModel.Time + vGet = TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds) + Case vbEmpty + End Select + End If + Case Else + End Select + If _SubType <> CTLLISTBOX Then ' Give getCurrentValue an additional try + If IsEmpty(vGet) And Utils._hasUNOMethod(ControlModel, "getCurrentValue") Then vGet = ControlModel.getCurrentValue() + End If + _PropertyGet = vGet + Case UCase("Visible") + Select Case _SubType + Case CTLHIDDENCONTROL + _PropertyGet = False + Case Else + If Utils._hasUNOMethod(ControlView, "isVisible") Then _PropertyGet = CBool(ControlView.isVisible()) + End Select + Case Else + Goto Trace_Error + End Select + + If IsEmpty(_PropertyGet) Then TraceError(TRACEINFO, ERRPROPERTYINIT, Utils._CalledSub(), 0, , psProperty) + +Exit_Function: + Utils._ResetCalledSub("Control.get" & psProperty) + Exit Function +Trace_Error: + TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) + _PropertyGet = EMPTY + Goto Exit_Function +Trace_Error_Index: + TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty) + _PropertyGet = EMPTY + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Control._PropertyGet", Erl) + _PropertyGet = EMPTY + GoTo Exit_Function +End Function ' _PropertyGet V0.9.1 + +REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean +' Return True if property setting OK + + If _ErrorHandler() Then On Local Error Goto Error_Function + Utils._SetCalledSub("Control.set" & psProperty) + _PropertySet = True + +'Check Index argument + If Not IsMissing(pvIndex) Then + If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric()) Then Goto Exit_Function + End If +'Execute +Dim iArgNr As Integer, vButton As Variant, i As Integer +Dim odbDatabase As Object, vNames() As Variant, bFound As Boolean, sName As String +Dim bMultiSelect As Boolean, iCount As Integer, iSelectedItems() As Integer, lListCount As Long, bSelected() As Boolean +Dim vItemList() As Variant, vFormats() As Variant +Dim oStruct As Object, sValue As String +Dim vSelection As Variant, sText As String, lStart As long +Dim oControlEvents As Object, sListener As String, sEvent As String, sEventName As String, oEvent As Object + + _PropertySet = True + Select Case UCase(_A2B_.CalledSub) + Case UCase("setProperty") : iArgNr = 3 + Case UCase("Control.setProperty") : iArgNr = 2 + Case UCase("Control.set" & psProperty) : iArgNr = 1 + End Select + + If Not hasProperty(psProperty) Then Goto Trace_Error + + Select Case UCase(psProperty) + Case UCase("BackColor") + If Not Utils._hasUNOProperty(ControlModel, "BackgroundColor") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + ControlModel.BackgroundColor = CLng(pvValue) + Case UCase("BorderColor") + If Not Utils._hasUNOProperty(ControlModel, "BorderColor") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + ControlModel.BorderColor = CLng(pvValue) + Case UCase("BorderStyle") + If Not Utils._hasUNOProperty(ControlModel, "BorderColor") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 0 Or pvValue > 2 Then Goto Trace_Error_Value ' 0 = No border, 1 = 3D border, 2 = Normal border + ControlModel.Border = CLng(pvValue) + Case UCase("Cancel") + If Not Utils._hasUNOProperty(ControlModel, "PushButtonType") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If pvValue Then vButton = com.sun.star.awt.PushButtonType.CANCEL Else vButton = com.sun.star.awt.PushButtonType.STANDARD + ControlModel.PushButtonType = vButton + Case UCase("Caption") + If Not Utils._hasUNOProperty(ControlModel, "Label") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + ControlModel.Label = pvValue + Case UCase("ControlTipText") + If Not Utils._hasUNOProperty(ControlModel, "HelpText") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + ControlModel.HelpText = pvValue + Case UCase("Default") + If Not Utils._hasUNOProperty(ControlModel, "DefaultButton") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + ControlModel.DefaultButton = pvValue + Case UCase("DefaultValue") + Select Case _SubType + Case CTLDATEFIELD + If Not Utils._hasUNOProperty(ControlModel, "DefaultDate") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value + Select Case VarType(ControlModel.DefaultDate) + Case vbEmpty, vbLong ' AOO and LO <= 4.1 + ControlModel.DefaultDate = Year(pvValue) * 10000 + Month(pvValue) * 100 + Day(pvValue) + Case vbObject ' LO >= 4.2 com.sun.star.Util.Date + ControlModel.DefaultDate.Year = Year(pvValue) + ControlModel.DefaultDate.Month = Month(pvValue) + ControlModel.DefaultDate.Day = Day(pvValue) + End Select + Case CTLLISTBOX + If Not Utils._hasUNOProperty(ControlModel, "DefaultSelection") Or Not Utils._hasUNOProperty(ControlModel, "StringItemList") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + For i = 0 To UBound(ControlModel.StringItemList) + If UCase(pvValue) = UCase(ControlModel.StringItemList(i)) Then + ControlModel.DefaultSelection = Array(i) + Exit For + End If + Next i + Case CTLSPINBUTTON + If Not Utils._hasUNOProperty(ControlModel, "DefaultSpinValue") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + ControlModel.DefaultSpinValue = pvValue + Case CTLCHECKBOX + If Not Utils._hasUNOProperty(ControlModel, "DefaultState") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 0 Or pvValue > 2 Then Goto Trace_Error_Value ' 0 = Not checked 1 = Checked 2 = don't know + ControlModel.DefaultState = pvValue + Case CTLRADIOBUTTON + If Not Utils._hasUNOProperty(ControlModel, "DefaultState") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 0 Or pvValue > 1 Then Goto Trace_Error_Value ' 0 = Not checked 1 = Checked + ControlModel.DefaultState = pvValue + Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD + If Not Utils._hasUNOProperty(ControlModel, "DefaultText") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + ControlModel.DefaultText = pvValue + Case CTLTIMEFIELD + If Not Utils._hasUNOProperty(ControlModel, "DefaultTime") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue >= 0 And pvValue <= 23595999 Then + Select Case VarType(ControlModel.DefaultTime) + Case vbEmpty, vbLong ' AOO and LO <= 4.1 + ControlModel.DefaultTime = pvValue + Case vbObject ' LO >= 4.2 com.sun.star.Util.Time + ControlModel.DefaultDate.Hours = Hour(pvValue) + ControlModel.DefaultDate.Minutes = Minute(pvValue) + ControlModel.DefaultDate.Seconds = Second(pvValue) + End Select + Else Goto Trace_Error_Value + End If + Case CTLCURRENCYFIELD, CTLNUMERICFIELD + If Not Utils._hasUNOProperty(ControlModel, "DefaultValue") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + ControlModel.DefaultValue = pvValue + Case CTLFORMATTEDFIELD + If Not Utils._hasUNOProperty(ControlModel, "EffectiveDefault") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + ControlModel.EffectiveDefault = pvValue ' Thanks, PASTIM + Case Else + Goto Trace_Error + End Select + Case UCase("Enabled") + If Not Utils._hasUNOProperty(ControlModel, "Enabled") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + ControlModel.Enabled = pvValue + Case UCase("FontBold") + If Not Utils._hasUNOProperty(ControlModel, "FontWeight") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If pvValue Then ' Iif construction does not work ! + ControlModel.FontWeight = com.sun.star.awt.FontWeight.BOLD + Else + ControlModel.FontWeight = com.sun.star.awt.FontWeight.NORMAL + End If + Case UCase("FontItalic") + If Not Utils._hasUNOProperty(ControlModel, "FontSlant") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If pvValue Then ' Iif construction does not work ! + ControlModel.FontSlant = com.sun.star.awt.FontSlant.ITALIC + Else + ControlModel.FontSlant = com.sun.star.awt.FontSlant.NONE + End If + Case UCase("FontName") + If Not Utils._hasUNOProperty(ControlModel, "FontName") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + ControlModel.FontName = pvValue + Case UCase("FontSize") + If Not Utils._hasUNOProperty(ControlModel, "FontHeight") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 1 Or pvValue > 127 Then Goto Trace_Error_Value + ControlModel.FontHeight = pvValue + Case UCase("FontUnderline") + If Not Utils._hasUNOProperty(ControlModel, "FontUnderline") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If pvValue Then ' Iif construction does not work ! + ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.SINGLE + Else + ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.NONE + End If + Case UCase("FontWeight") + If Not Utils._hasUNOProperty(ControlModel, "FontWeight") Then Goto Trace_Error + If Not Utils._IsScalar(CSng(pvValue), vbSingle, Array( _ + com.sun.star.awt.FontWeight.THIN _ + , com.sun.star.awt.FontWeight.ULTRALIGHT _ + , com.sun.star.awt.FontWeight.LIGHT _ + , com.sun.star.awt.FontWeight.SEMILIGHT _ + , com.sun.star.awt.FontWeight.NORMAL _ + , com.sun.star.awt.FontWeight.SEMIBOLD _ + , com.sun.star.awt.FontWeight.BOLD _ + , com.sun.star.awt.FontWeight.ULTRABOLD _ + , com.sun.star.awt.FontWeight.BLACK _ + )) Then Goto Trace_Error_Value + ControlModel.FontWeight = pvValue + Case UCase("Format") + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + vFormats = _Formats(_SubType) + Select Case _SubType + Case CTLDATEFIELD, CTLTIMEFIELD + bFound = False + For i = 0 To UBound(vFormats) + If UCase(pvValue) = UCase(vFormats(i)) Then + If _SubType = CTLDATEFIELD Then + If Utils._hasUNOProperty(ControlModel, "DateFormat") Then ControlModel.DateFormat = i Else Goto Trace_Error + Else + If Utils._hasUNOProperty(ControlModel, "TimeFormat") Then ControlModel.TimeFormat = i Else Goto Trace_Error + End If + bFound = True + Exit For + End If + Next i + If Not bFound Then Goto Trace_Error_Value + Case Else + Goto Trace_Error + End Select + Case UCase("ForeColor") + If Not Utils._hasUNOProperty(ControlModel, "TextColor") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + ControlModel.TextColor = CLng(pvValue) + Case UCase("ListIndex") + If Not Utils._hasUNOProperty(ControlModel, "StringItemList") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 0 Or pvValue > UBound(ControlModel.StringItemList) Then Goto Trace_Error_Value + Select Case _SubType + Case CTLCOMBOBOX + ControlModel.Text = ControlModel.StringItemList(pvValue) + Case CTLLISTBOX + ControlModel.SelectedItems = Array(pvValue) + End Select + Case UCase("Locked") + If Not Utils._hasUNOProperty(ControlModel, "ReadOnly") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + ControlModel.ReadOnly = pvValue + Case UCase("MultiSelect") + If Not Utils._hasUNOProperty(ControlModel, "MultiSelection") And Not Utils._hasUNOProperty(ControlModel, "MultiSelectionSimpleMode") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If Utils._hasUNOProperty(ControlModel, "MultiSelection") Then + ControlModel.MultiSelection = pvValue + ElseIf Utils._hasUNOProperty(ControlModel, "MultiSelectionSimpleMode") Then + ControlModel.MultiSelectionSimpleMode = pvValue + End If + If Not pvValue Then ControlModel.SelectedItems = Array() ' Cancel selections when MultiSelect becomes False + 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 Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + Select Case _ParentType + Case CTLPARENTISDIALOG + If Not Utils._RegisterDialogEventScript(ControlModel _ + , psProperty _ + , _GetListener(psProperty) _ + , pvValue _ + ) Then GoTo Trace_Error + Case Else + If Not Utils._RegisterEventScript(ControlModel _ + , psProperty _ + , _GetListener(psProperty) _ + , pvValue _ + , _Name _ + ) Then GoTo Trace_Error + End Select + Case UCase("OptionValue") + If Not Utils._hasUNOProperty(ControlModel, "RefValue") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + If Not Utils._hasUNOProperty(ControlModel, "Label") Then + If pvValue = "" Then Goto Trace_Error_Value + If ControlModel.RefValue <> "" Then ControlModel.RefValue = pvValue + Else + ControlModel.Label = pvValue + End If + Case UCase("Page") + If Not Utils._hasUNOProperty(ControlModel, "Step") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 0 Then Goto Trace_Error_Value + ControlModel.Step = pvValue + Case UCase("Picture") + If Not Utils._hasUNOProperty(ControlModel, "ImageURL") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + ControlModel.ImageURL = ConvertToUrl(pvValue) + Case UCase("Required") + If Not Utils._hasUNOProperty(ControlModel, "InputRequired") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + ControlModel.InputRequired = pvValue + Case UCase("RowSource") + Select Case _ParentType + Case CTLPARENTISDIALOG + If Not Utils._hasUNOProperty(ControlModel, "StringItemList") Then Goto Trace_Error + ControlModel.StringItemList = Split(pvValue, ";") + Case Else + If Not Utils._hasUNOProperty(ControlModel, "ListSource") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + Select Case ControlModel.ListSourceType + Case com.sun.star.form.ListSourceType.QUERY _ + , com.sun.star.form.ListSourceType.TABLE _ + , com.sun.star.form.ListSourceType.TABLEFIELDS + Set odbDatabase = Application._CurrentDb(_DocEntry, _DbEntry) + If ControlModel.ListSourceType = com.sun.star.form.ListSourceType.QUERY Then vNames = odbDatabase.Connection.getQueries.GetElementNames _ + Else vNames = odbDatabase.Connection.getTables.GetElementNames + bFound = False ' Check existence of table or query and find its correct (case-sensitive) name + For i = 0 To UBound(vNames) + If UCase(vNames(i)) = UCase(pvValue) Then + bFound = True + sName = vNames(i) + Exit For + End If + Next i + If Not bFound Then Goto Trace_Error_Value + If _SubType = CTLCOMBOBOX Then ControlModel.ListSource = sName Else ControlModel.ListSource = Array(sName) + ControlModel.refresh() + Case com.sun.star.form.ListSourceType.SQL + Set odbDatabase = Application._CurrentDb(_DocEntry, _DbEntry) + If _SubType = CTLCOMBOBOX Then ControlModel.ListSource = odbDatabase._ReplaceSquareBrackets(pvValue) Else ControlModel.ListSource = Array(odbDatabase._ReplaceSquareBrackets(pvValue)) + ControlModel.refresh() + Case com.sun.star.form.ListSourceType.VALUELIST ' Forbidden for COMBOBOX ! + If _SubType = CTLCOMBOBOX Then Goto Trace_Error + ControlModel.ListSource = Split(pvValue, ";") + ControlModel.StringItemList = ControlModel.ListSource + Case com.sun.star.form.ListSourceType.SQLPASSTHROUGH + If _SubType = CTLCOMBOBOX Then ControlModel.ListSource = pvValue Else ControlModel.ListSource = Array(pvValue) + ControlModel.refresh() + End Select + End Select + If _SubType = CTLLISTBOX Then ControlModel.SelectedItems = Array() + Case UCase("RowSourceType") ' Refresh done when RowSource changes, not RowSourceType + If Not Utils._hasUNOProperty(ControlModel, "ListSourceType") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If Not Utils._IsScalar(pvValue, Utils._AddNumeric(), Array( _ + com.sun.star.form.ListSourceType.VALUELIST _ + , com.sun.star.form.ListSourceType.TABLE _ + , com.sun.star.form.ListSourceType.QUERY _ + , com.sun.star.form.ListSourceType.SQL _ + , com.sun.star.form.ListSourceType.SQLPASSTHROUGH _ + , com.sun.star.form.ListSourceType.TABLEFIELDS _ + )) Then Goto Trace_Error_Value + ControlModel.ListSourceType = pvValue + Case UCase("Selected") + If Not Utils._hasUNOProperty(ControlModel, "SelectedItems") Then Goto Trace_Error + If Not Utils._hasUNOProperty(ControlModel, "StringItemList") Then Goto Trace_Error + If Utils._hasUNOProperty(ControlModel, "MultiSelection") Then + bMultiSelect = ControlModel.MultiSelection + ElseIf Utils._hasUNOProperty(ControlModel, "MultiSelectionSimpleMode") Then + bMultiSelect = ControlModel.MultiSelectionSimpleMode + Else: Goto Trace_Error + End If + lListCount = UBound(ControlModel.StringItemList) + 1 + If IsMissing(pvIndex) Then ' Full boolean array passed + If Not IsArray(pvValue) Then Goto Trace_Error_Array + If LBound(pvValue) <> 0 Or UBound(pvValue) < 0 Then Goto Trace_Error_Array + If Not Utils._CheckArgument(pvValue(0), iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If UBound(pvValue) <> lListCount - 1 Then Goto Trace_Error_Index + iCount = 0 + For i = 0 To UBound(pvValue) ' Count True values + If pvValue(i) Then iCount = iCount + 1 + Next i + If iCount > 0 Then + Redim iSelectedItems(0 To iCount - 1) + iCount = 0 + For i = 0 To UBound(pvValue) + If pvValue(i) Then + iSelectedItems(iCount) = i + iCount = iCount + 1 + End If + Next i + ControlModel.SelectedItems = iSelectedItems ' iSelectedItems maps OO internals (size = # of selected items) + Else + ControlModel.SelectedItems = Array() + End If + Else ' Single boolean value passed + If Not Utils._CheckArgument(pvIndex, iArgNr + 1, Utils._AddNumeric()) Then Goto Exit_Function + If pvIndex < 0 Or pvIndex >= lListCount Then Goto Trace_Error_Index + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + ReDim bSelected(0 To lListCount - 1) ' bSelected maps VBA internals (size = # of displayed items) + If Not bMultiSelect Then ' Set all other values to False + For i = 0 To lListCount - 1 + If i = pvIndex Then + bSelected(i) = pvValue ' All entries = False except one + Else + bSelected(i) = False + End If + Next i + Else + For i = 0 To lListCount - 1 + bSelected(i) = False + Next i + iSelectedItems = ControlModel.SelectedItems + iCount = UBound(iSelectedItems) + For i = 0 To iCount + bSelected(iSelectedItems(i)) = True + Next i + bSelected(pvIndex) = pvValue + End If + iCount = 0 ' Rebuild SelectedItems + For i = 0 To lListCount - 1 + If bSelected(i) Then iCount = iCount + 1 + Next i + If iCount > 0 Then + Redim iSelectedItems(0 To iCount - 1) + iCount = 0 + For i = 0 To lListCount - 1 + If bSelected(i) Then + iSelectedItems(iCount) = i + iCount = iCount + 1 + End If + Next i + ControlModel.SelectedItems = iSelectedItems + Else + ControlModel.SelectedItems = Array() + End If + End If + Case UCase("SelLength") + If Not Utils._hasUNOProperty(ControlView, "Selection") Then Goto trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 0 Then Goto Trace_Error_Value + vSelection = ControlView.getSelection() + vSelection.Max = vSelection.Min + pvValue + ControlView.setSelection(vSelection) + Case UCase("SelStart") + If Not Utils._hasUNOProperty(ControlView, "Selection") Then Goto trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 1 Or pvValue > Len(ControlModel.Text) + 1 Then Goto Trace_Error_Value + vSelection = ControlView.getSelection() + vSelection.Min = pvValue - 1 + vSelection.Max = pvValue - 1 ' Also reset length to 0 + ControlView.setSelection(vSelection) + Case UCase("SelText") + If Not Utils._hasUNOProperty(ControlView, "Selection") Then Goto trace_Error + If Not Utils._hasUNOProperty(ControlModel, "Text") Then Goto trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + If Len(pvValue) > 0 Then + vSelection = ControlView.getSelection() + sText = ControlModel.Text + lStart = InStr(1, sText, pvValue, 0) ' Case sensitive ! + If lStart > 0 Then + vSelection.Min = lStart - 1 + vSelection.Max = lStart + Len(pvValue) - 1 + ControlView.setSelection(vSelection) + End If + End If + Case UCase("SpecialEffect") + If Not Utils._hasUNOProperty(ControlModel, "VisualEffect") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 0 Or pvValue > 2 Then Goto Trace_Error_Value ' 0 = None, 1 = Look3D, 2 = Flat + ControlModel.VisualEffect = pvValue + Case UCase("TabIndex") + If Not Utils._hasUNOProperty(ControlModel, "TabIndex") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < -1 Then Goto Trace_Error_Value + ControlModel.TabIndex = pvValue + Case UCase("TabStop") + If Not Utils._hasUNOProperty(ControlModel, "Tabstop") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + ControlModel.Tabstop = pvValue + Case UCase("Tag") + If Not Utils._hasUNOProperty(ControlModel, "Tag") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + ControlModel.Tag = pvValue + Case UCase("TextAlign") + If Not Utils._hasUNOProperty(ControlModel, "Align") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If pvValue < 0 Or pvValue > 2 Then Goto Trace_Error_Value ' 0 = Left, 1 = Center, 2 = Right + ControlModel.Align = pvValue + Case UCase("TripleState") + If Not Utils._hasUNOProperty(ControlModel, "TriState") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + ControlModel.TriState = pvValue + Case UCase("Value") + Select Case _SubType + Case CTLCHECKBOX + If Not Utils._hasUNOProperty(ControlModel, "State") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(vbBoolean), , False) Then Goto Trace_Error_Value + If VarType(pvValue) = vbBoolean Then pvValue = Iif(pvValue, 1, 0) + If pvValue < 0 Or pvValue > 2 Then Goto Trace_Error_Value ' 0 = Not checked 1 = Checked 2 = don't know + ControlModel.State = pvValue + Case CTLCOMMANDBUTTON + If Not Utils._hasUNOProperty(ControlModel, "State") Then Goto Trace_Error + If Not Utils._hasUNOProperty(ControlModel, "Toggle") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If pvValue Then ControlModel.State = 1 Else ControlModel.State = 0 + Case CTLCOMBOBOX + If Not Utils._hasUNOProperty(ControlModel, "Text") Or Not Utils._hasUNOProperty(ControlModel, "StringItemList") _ + Then Goto Trace_Error + If pvValue <> "" Then + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, ControlModel.StringItemList, False) Then Goto Trace_Error_Value + End If + ControlModel.Text = pvValue + Case CTLCURRENCYFIELD, CTLNUMERICFIELD + If Not Utils._hasUNOProperty(ControlModel, "Value") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + ControlModel.Value = pvValue + Case CTLDATEFIELD + If Not Utils._hasUNOProperty(ControlModel, "Date") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value + Select Case _InspectPropertyType(ControlModel, "Date") + Case "long" ' AOO and LO <= 4.1 + 'ControlModel.Date = Year(pvValue) * 10000 + Month(pvValue) * 100 + Day(pvValue) ' Gives error in dialogs ?!? + ControlModel.setPropertyValue("Date", Year(pvValue) * 10000 + Month(pvValue) * 100 + Day(pvValue)) + Case "com.sun.star.util.Date" ' LO >= 4.2 + 'Direct assignment of ControlModel.Date.Xxx has no effect ?!? + Set oStruct = CreateUnoStruct("com.sun.star.util.Date") + oStruct.Year = Year(pvValue) + oStruct.Month = Month(pvValue) + oStruct.Day = Day(pvValue) + Set ControlModel.Date = oStruct + End Select + Case CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD + If Not Utils._hasUNOProperty(ControlModel, "Text") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value + ControlModel.Text = pvValue + Case CTLFORMATTEDFIELD + If Not Utils._hasUNOProperty(ControlModel, "EffectiveValue") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(vbString), , False) Then Goto Trace_Error_Value + ControlModel.EffectiveValue = pvValue + Case CTLHIDDENCONTROL + If Not Utils._hasUNOProperty(ControlModel, "HiddenValue") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(Array(vbString, vbBoolean, vbDate)), , False) Then Goto Trace_Error_Value + ControlModel.HiddenValue = pvValue + Case CTLLISTBOX + If Not Utils._hasUNOProperty(ControlModel, "SelectedItems") Or Not Utils._hasUNOProperty(ControlModel, "StringItemList") _ + Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(Array(vbString, vbDate)), , False) Then Goto Trace_Error_Value ' PASTIM + If IsArray(pvValue) Then Goto Trace_Error_Value ' Setting the value on a listbox is allowed only if single value and value in the list + ' Check ValueItemList + bFound = False + Select Case _ParentType + Case CTLPARENTISDIALOG + vItemList = ControlModel.StringItemList + Case Else + If _ListboxBound() Then ' Performance improvement (PASTIM PM 9 Feb 2013) + If Not Utils._hasUNOProperty(ControlModel, "ValueItemList") Then Goto Trace_Error + vItemList = ControlModel.ValueItemList + Else + vItemList = ControlModel.StringItemList + End If + End Select + For i = 0 To UBound(vItemList) + If pvValue = vItemList(i) Then + bFound = True + Exit For + End If + Next i + If bFound Then ControlModel.SelectedItems = Array(i) Else Goto Trace_Error_Value + Case CTLPROGRESSBAR + If Not Utils._hasUNOProperty(ControlModel, "ProgressValue") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If Utils._hasUNOProperty(ControlModel, "ProgressValueMin") Then + If pvValue < ControlModel.ProgressValueMin Then Goto Trace_Error_Value + End If + If Utils._hasUNOProperty(ControlModel, "ProgressValueMax") Then + If pvValue > ControlModel.ProgressValueMax Then Goto Trace_Error_Value + End If + ControlModel.ProgressValue = pvValue + Case CTLSCROLLBAR + If Not Utils._hasUNOProperty(ControlModel, "ScrollValue") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If Utils._hasUNOProperty(ControlModel, "ScrollValueMin") Then + If pvValue < ControlModel.ScrollValueMin Then Goto Trace_Error_Value + End If + If Utils._hasUNOProperty(ControlModel, "ScrollValueMax") Then + If pvValue > ControlModel.ScrollValueMax Then Goto Trace_Error_Value + End If + ControlModel.ScrollValue = pvValue + Case CTLSPINBUTTON + If Not Utils._hasUNOProperty(ControlModel, "SpinValue") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + If Utils._hasUNOProperty(ControlModel, "SpinValueMin") Then + If pvValue < ControlModel.SpinValueMin Then Goto Trace_Error_Value + End If + If Utils._hasUNOProperty(ControlModel, "SpinValueMax") Then + If pvValue > ControlModel.SpinValueMax Then Goto Trace_Error_Value + End If + ControlModel.SpinValue = pvValue + Case CTLTIMEFIELD + If Not Utils._hasUNOProperty(ControlModel, "Time") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value + Select Case _InspectPropertyType(ControlModel, "Time") + Case "long" ' AOO and LO <= 4.0 + ControlModel.Time = CLng(pvValue) + Case "com.sun.star.util.Time" ' LO >= 4.1 + 'Direct assignment of ControlModel.Time.Xxx gives error ?!? + Set oStruct = CreateUnoStruct("com.sun.star.util.Time") + sValue = Right("00000000" & Str(CLng(pvValue)), 8) + oStruct.Hours = Val(Left(sValue, 2)) + oStruct.Minutes = Val(Mid(sValue, 3, 2)) + oStruct.Seconds = Val(Mid(sValue, 5, 2)) + Set ControlModel.Time = oStruct + End Select + Case Else + Goto Trace_Error + End Select + ' FINAL COMMITMENT + If Utils._hasUNOMethod(ControlModel, "commit") Then ControlModel.commit() ' f.i. checkboxes have no commit method ?? [PASTIM] + Case UCase("Visible") + If _SubType = CTLHIDDENCONTROL Then Goto Trace_Error ' Hidden remains hidden !! + If Not Utils._hasUNOMethod(ControlView, "setVisible") Then Goto Trace_Error + If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value + If pvValue Then ControlModel.EnableVisible = True + ControlView.setVisible(pvValue) + Case Else + Goto Trace_Error + End Select + +Exit_Function: + Utils._ResetCalledSub("Control.set" & psProperty) + Exit Function +Trace_Error: + TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) + _PropertySet = False + Goto Exit_Function +Trace_Error_Value: + TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) + _PropertySet = False + Goto Exit_Function +Trace_Error_Index: + TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty) + _PropertySet = False + Goto Exit_Function +Trace_Error_Array: + TraceError(TRACEFATAL, ERRPROPERTYNOTARRAY, Utils._CalledSub(), 0, 1, iArgNr) + _PropertySet = False + Goto Exit_Function +Error_Function: + TraceError(TRACEABORT, Err, "Control._PropertySet", Erl) + _PropertySet = False + GoTo Exit_Function +End Function ' _PropertySet V1.1.0 + +</script:module> |