| blob | a48c22b6c1c5b2360c433e4450e121009f4d0b05 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_FormControl" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === The SFDocuments library is one of the associated libraries. ===
6 REM === Full documentation is available on https://help.libreoffice.org/ ===
7 REM =======================================================================================================================
9 Option Compatible
10 Option ClassModule
12 Option Explicit
14 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
15 ''' SF_FormControl
16 ''' ================
17 ''' Manage the controls belonging to a form or subform stored in a document
18 ''' Each instance of the current class represents a single control within a form, a subform or a tablecontrol
19 ''' A prerequisite is that all controls within the same form, subform or tablecontrol must have
20 ''' a unique name. This is also true for the individual radio buttons belonging to the same group.
21 ''' A common group name must identify such a single group.
22 '''
23 ''' The focus is clearly set on getting and setting the values displayed by the controls of the form,
24 ''' not on their formatting. The latter is easily accessible via the XControlModel and XControlView
25 ''' UNO objects.
26 ''' Essentially a single property "Value" maps many alternative UNO properties depending each on
27 ''' the control type.
28 '''
29 ''' Service invocations:
30 ''' Dim myForm As Object, myControl As Object
31 ''' Set myForm = ... (read the comments in the SF_Form module)
34 '''
35 ''' REM the control is the subject of an event
36 ''' Sub OnEvent(ByRef poEvent As Object)
37 ''' Dim myControl As Object
38 ''' Set myControl = CreateScriptService("SFDocuments.FormEvent", poEvent)
39 '''
40 ''' Detailed user documentation:
41 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_formcontrol.html?DbPAR=BASIC
42 '''
43 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
45 REM ================================================================== EXCEPTIONS
49 REM ============================================================= PRIVATE MEMBERS
51 Private [Me] As Object
52 Private [_Parent] As Object
53 Private ObjectType As String ' Must be FORMCONTROL
54 Private ServiceName As String
56 ' Control naming and context
57 Private _Name As String
58 Private _IndexOfNames As Long ' Index in ElementNames array. Used to access SF_Form._ControlCache
59 Private _FormName As String ' Parent form name
60 Private _ParentForm As Object ' Parent form or subform instance
61 Private _ParentIsTable As Boolean ' True when parent is a table control
63 ' Control UNO references
64 Private _ControlModel As Object ' com.sun.star.awt.XControlModel
65 Private _ControlView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
67 ' Control attributes
68 Private _ImplementationName As String
69 Private _ControlType As String ' One of the CTLxxx constants
70 Private _ClassId As Integer ' Numerical type of control
72 ' Cache storage for table controls
73 Private _ControlNames As Variant ' Array of control names
74 Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of XControlModel
76 REM ============================================================ MODULE CONSTANTS
78 ' ClassId
102 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
104 REM -----------------------------------------------------------------------------
105 Private Sub Class_Initialize()
106 Set [Me] = Nothing
107 Set [_Parent] = Nothing
110 _Name = ""
111 _IndexOfNames = -1
112 _FormName = ""
113 _ParentIsTable = False
114 Set _ParentForm = Nothing
115 Set _ControlModel = Nothing
116 Set _ControlView = Nothing
117 _ImplementationName = ""
118 _ControlType = ""
119 _ClassId = 0
120 _ControlNames = Array()
121 _ControlCache = Array()
122 End Sub ' SFDocuments.SF_FormControl Constructor
124 REM -----------------------------------------------------------------------------
125 Private Sub Class_Terminate()
126 Call Class_Initialize()
127 End Sub ' SFDocuments.SF_FormControl Destructor
129 REM -----------------------------------------------------------------------------
130 Public Function Dispose() As Variant
131 If Not IsNull([_Parent]) And _IndexOfNames >= 0 Then [_Parent]._ControlCache(_IndexOfNames) = Empty
132 Call Class_Terminate()
133 Set Dispose = Nothing
134 End Function ' SFDocuments.SF_FormControl Explicit Destructor
136 REM ================================================================== PROPERTIES
138 REM -----------------------------------------------------------------------------
139 Property Get Action() As Variant
140 ''' The Action property specifies the action triggered when the button is clicked
141 ''' Accepted values: none, submitForm, resetForm, refreshForm, moveToFirst, moveToLast,
142 ''' moveToNext, moveToPrev, saveRecord, moveToNew, deleteRecord, undoRecord
144 End Property ' SFDocuments.SF_FormControl.Action (get)
146 REM -----------------------------------------------------------------------------
147 Property Let Action(Optional ByVal pvAction As Variant)
148 ''' Set the updatable property Action
150 End Property ' SFDocuments.SF_FormControl.Action (let)
152 REM -----------------------------------------------------------------------------
153 Property Get Caption() As Variant
154 ''' The Caption property refers to the text associated with the control
156 End Property ' SFDocuments.SF_FormControl.Caption (get)
158 REM -----------------------------------------------------------------------------
159 Property Let Caption(Optional ByVal pvCaption As Variant)
160 ''' Set the updatable property Caption
162 End Property ' SFDocuments.SF_FormControl.Caption (let)
164 REM -----------------------------------------------------------------------------
165 Property Get ControlSource() As Variant
166 ''' The ControlSource property specifies the rowset field mapped onto the actual control
168 End Property ' SFDocuments.SF_FormControl.ControlSource (get)
170 REM -----------------------------------------------------------------------------
171 Property Get ControlType() As String
172 ''' Return the type of the actual control: "CheckBox", "TextField", "DateField", ...
174 End Property ' SFDocuments.SF_FormControl.ControlType
176 REM -----------------------------------------------------------------------------
177 Property Get Default() As Variant
178 ''' The Default property specifies whether a command button is the default (OK) button.
180 End Property ' SFDocuments.SF_FormControl.Default (get)
182 REM -----------------------------------------------------------------------------
183 Property Let Default(Optional ByVal pvDefault As Variant)
184 ''' Set the updatable property Default
186 End Property ' SFDocuments.SF_FormControl.Default (let)
188 REM -----------------------------------------------------------------------------
189 Property Get DefaultValue() As Variant
190 ''' The DefaultValue property specifies how the control is initialized in a new record
192 End Property ' SFDocuments.SF_FormControl.DefaultValue (get)
194 REM -----------------------------------------------------------------------------
195 Property Let DefaultValue(Optional ByVal pvDefaultValue As Variant)
196 ''' Set the updatable property DefaultValue
198 End Property ' SFDocuments.SF_FormControl.DefaultValue (let)
200 REM -----------------------------------------------------------------------------
201 Property Get Enabled() As Variant
202 ''' The Enabled property specifies if the control is accessible with the cursor.
204 End Property ' SFDocuments.SF_FormControl.Enabled (get)
206 REM -----------------------------------------------------------------------------
207 Property Let Enabled(Optional ByVal pvEnabled As Variant)
208 ''' Set the updatable property Enabled
210 End Property ' SFDocuments.SF_FormControl.Enabled (let)
212 REM -----------------------------------------------------------------------------
213 Property Get Format() As Variant
214 ''' The Format property specifies the format in which to display dates and times.
216 End Property ' SFDocuments.SF_FormControl.Format (get)
218 REM -----------------------------------------------------------------------------
219 Property Let Format(Optional ByVal pvFormat As Variant)
220 ''' Set the updatable property Format
221 ''' NB: Format is read-only for formatted field controls
223 End Property ' SFDocuments.SF_FormControl.Format (let)
225 REM -----------------------------------------------------------------------------
226 Property Get ListCount() As Long
227 ''' The ListCount property specifies the number of rows in a list box or a combo box
229 End Property ' SFDocuments.SF_FormControl.ListCount (get)
231 REM -----------------------------------------------------------------------------
232 Property Get ListIndex() As Variant
233 ''' The ListIndex property specifies which item is selected in a list box or combo box.
234 ''' In case of multiple selection, the index of the first one is returned or only one is set
236 End Property ' SFDocuments.SF_FormControl.ListIndex (get)
238 REM -----------------------------------------------------------------------------
239 Property Let ListIndex(Optional ByVal pvListIndex As Variant)
240 ''' Set the updatable property ListIndex
242 End Property ' SFDocuments.SF_FormControl.ListIndex (let)
244 REM -----------------------------------------------------------------------------
245 Property Get ListSource() As Variant
246 ''' The ListSource property specifies the data contained in a combobox or a listbox
247 ''' as a zero-based array of string values
249 End Property ' SFDocuments.SF_FormControl.ListSource (get)
251 REM -----------------------------------------------------------------------------
252 Property Let ListSource(Optional ByVal pvListSource As Variant)
253 ''' Set the updatable property ListSource
255 End Property ' SFDocuments.SF_FormControl.ListSource (let)
257 REM -----------------------------------------------------------------------------
258 Property Get ListSourceType() As Variant
259 ''' The ListSourceType property specifies the kind of data source used to fill the list data of a listbox or a combobox
261 End Property ' SFDocuments.SF_FormControl.ListSourceType (get)
263 REM -----------------------------------------------------------------------------
264 Property Let ListSourceType(Optional ByVal pvListSourceType As Variant)
265 ''' Set the updatable property ListSourceType
267 End Property ' SFDocuments.SF_FormControl.ListSourceType (let)
269 REM -----------------------------------------------------------------------------
270 Property Get Locked() As Variant
271 ''' The Locked property specifies if a control is read-only
273 End Property ' SFDocuments.SF_FormControl.Locked (get)
275 REM -----------------------------------------------------------------------------
276 Property Let Locked(Optional ByVal pvLocked As Variant)
277 ''' Set the updatable property Locked
279 End Property ' SFDocuments.SF_FormControl.Locked (let)
281 REM -----------------------------------------------------------------------------
282 Property Get MultiSelect() As Variant
283 ''' The MultiSelect property specifies whether a user can make multiple selections in a listbox
285 End Property ' SFDocuments.SF_FormControl.MultiSelect (get)
287 REM -----------------------------------------------------------------------------
288 Property Let MultiSelect(Optional ByVal pvMultiSelect As Variant)
289 ''' Set the updatable property MultiSelect
291 End Property ' SFDocuments.SF_FormControl.MultiSelect (let)
293 REM -----------------------------------------------------------------------------
294 Property Get Name() As String
295 ''' Return the name of the actual control
297 End Property ' SFDocuments.SF_FormControl.Name
299 REM -----------------------------------------------------------------------------
300 Property Get OnActionPerformed() As Variant
301 ''' Get the script associated with the OnActionPerformed event
303 End Property ' SFDocuments.SF_FormControl.OnActionPerformed (get)
305 REM -----------------------------------------------------------------------------
306 Property Let OnActionPerformed(Optional ByVal pvOnActionPerformed As Variant)
307 ''' Set the updatable property OnActionPerformed
309 End Property ' SFDocuments.SF_FormControl.OnActionPerformed (let)
311 REM -----------------------------------------------------------------------------
312 Property Get OnAdjustmentValueChanged() As Variant
313 ''' Get the script associated with the OnAdjustmentValueChanged event
315 End Property ' SFDocuments.SF_FormControl.OnAdjustmentValueChanged (get)
317 REM -----------------------------------------------------------------------------
318 Property Let OnAdjustmentValueChanged(Optional ByVal pvOnAdjustmentValueChanged As Variant)
319 ''' Set the updatable property OnAdjustmentValueChanged
321 End Property ' SFDocuments.SF_FormControl.OnAdjustmentValueChanged (let)
323 REM -----------------------------------------------------------------------------
324 Property Get OnApproveAction() As Variant
325 ''' Get the script associated with the OnApproveAction event
327 End Property ' SFDocuments.SF_FormControl.OnApproveAction (get)
329 REM -----------------------------------------------------------------------------
330 Property Let OnApproveAction(Optional ByVal pvOnApproveAction As Variant)
331 ''' Set the updatable property OnApproveAction
333 End Property ' SFDocuments.SF_FormControl.OnApproveAction (let)
335 REM -----------------------------------------------------------------------------
336 Property Get OnApproveReset() As Variant
337 ''' Get the script associated with the OnApproveReset event
339 End Property ' SFDocuments.SF_FormControl.OnApproveReset (get)
341 REM -----------------------------------------------------------------------------
342 Property Let OnApproveReset(Optional ByVal pvOnApproveReset As Variant)
343 ''' Set the updatable property OnApproveReset
345 End Property ' SFDocuments.SF_FormControl.OnApproveReset (let)
347 REM -----------------------------------------------------------------------------
348 Property Get OnApproveUpdate() As Variant
349 ''' Get the script associated with the OnApproveUpdate event
351 End Property ' SFDocuments.SF_FormControl.OnApproveUpdate (get)
353 REM -----------------------------------------------------------------------------
354 Property Let OnApproveUpdate(Optional ByVal pvOnApproveUpdate As Variant)
355 ''' Set the updatable property OnApproveUpdate
357 End Property ' SFDocuments.SF_FormControl.OnApproveUpdate (let)
359 REM -----------------------------------------------------------------------------
360 Property Get OnChanged() As Variant
361 ''' Get the script associated with the OnChanged event
363 End Property ' SFDocuments.SF_FormControl.OnChanged (get)
365 REM -----------------------------------------------------------------------------
366 Property Let OnChanged(Optional ByVal pvOnChanged As Variant)
367 ''' Set the updatable property OnChanged
369 End Property ' SFDocuments.SF_FormControl.OnChanged (let)
371 REM -----------------------------------------------------------------------------
372 Property Get OnErrorOccurred() As Variant
373 ''' Get the script associated with the OnErrorOccurred event
375 End Property ' SFDocuments.SF_FormControl.OnErrorOccurred (get)
377 REM -----------------------------------------------------------------------------
378 Property Let OnErrorOccurred(Optional ByVal pvOnErrorOccurred As Variant)
379 ''' Set the updatable property OnErrorOccurred
381 End Property ' SFDocuments.SF_FormControl.OnErrorOccurred (let)
383 REM -----------------------------------------------------------------------------
384 Property Get OnFocusGained() As Variant
385 ''' Get the script associated with the OnFocusGained event
387 End Property ' SFDocuments.SF_FormControl.OnFocusGained (get)
389 REM -----------------------------------------------------------------------------
390 Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant)
391 ''' Set the updatable property OnFocusGained
393 End Property ' SFDocuments.SF_FormControl.OnFocusGained (let)
395 REM -----------------------------------------------------------------------------
396 Property Get OnFocusLost() As Variant
397 ''' Get the script associated with the OnFocusLost event
399 End Property ' SFDocuments.SF_FormControl.OnFocusLost (get)
401 REM -----------------------------------------------------------------------------
402 Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant)
403 ''' Set the updatable property OnFocusLost
405 End Property ' SFDocuments.SF_FormControl.OnFocusLost (let)
407 REM -----------------------------------------------------------------------------
408 Property Get OnItemStateChanged() As Variant
409 ''' Get the script associated with the OnItemStateChanged event
411 End Property ' SFDocuments.SF_FormControl.OnItemStateChanged (get)
413 REM -----------------------------------------------------------------------------
414 Property Let OnItemStateChanged(Optional ByVal pvOnItemStateChanged As Variant)
415 ''' Set the updatable property OnItemStateChanged
417 End Property ' SFDocuments.SF_FormControl.OnItemStateChanged (let)
419 REM -----------------------------------------------------------------------------
420 Property Get OnKeyPressed() As Variant
421 ''' Get the script associated with the OnKeyPressed event
423 End Property ' SFDocuments.SF_FormControl.OnKeyPressed (get)
425 REM -----------------------------------------------------------------------------
426 Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant)
427 ''' Set the updatable property OnKeyPressed
429 End Property ' SFDocuments.SF_FormControl.OnKeyPressed (let)
431 REM -----------------------------------------------------------------------------
432 Property Get OnKeyReleased() As Variant
433 ''' Get the script associated with the OnKeyReleased event
435 End Property ' SFDocuments.SF_FormControl.OnKeyReleased (get)
437 REM -----------------------------------------------------------------------------
438 Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant)
439 ''' Set the updatable property OnKeyReleased
441 End Property ' SFDocuments.SF_FormControl.OnKeyReleased (let)
443 REM -----------------------------------------------------------------------------
444 Property Get OnMouseDragged() As Variant
445 ''' Get the script associated with the OnMouseDragged event
447 End Property ' SFDocuments.SF_FormControl.OnMouseDragged (get)
449 REM -----------------------------------------------------------------------------
450 Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant)
451 ''' Set the updatable property OnMouseDragged
453 End Property ' SFDocuments.SF_FormControl.OnMouseDragged (let)
455 REM -----------------------------------------------------------------------------
456 Property Get OnMouseEntered() As Variant
457 ''' Get the script associated with the OnMouseEntered event
459 End Property ' SFDocuments.SF_FormControl.OnMouseEntered (get)
461 REM -----------------------------------------------------------------------------
462 Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant)
463 ''' Set the updatable property OnMouseEntered
465 End Property ' SFDocuments.SF_FormControl.OnMouseEntered (let)
467 REM -----------------------------------------------------------------------------
468 Property Get OnMouseExited() As Variant
469 ''' Get the script associated with the OnMouseExited event
471 End Property ' SFDocuments.SF_FormControl.OnMouseExited (get)
473 REM -----------------------------------------------------------------------------
474 Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant)
475 ''' Set the updatable property OnMouseExited
477 End Property ' SFDocuments.SF_FormControl.OnMouseExited (let)
479 REM -----------------------------------------------------------------------------
480 Property Get OnMouseMoved() As Variant
481 ''' Get the script associated with the OnMouseMoved event
483 End Property ' SFDocuments.SF_FormControl.OnMouseMoved (get)
485 REM -----------------------------------------------------------------------------
486 Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant)
487 ''' Set the updatable property OnMouseMoved
489 End Property ' SFDocuments.SF_FormControl.OnMouseMoved (let)
491 REM -----------------------------------------------------------------------------
492 Property Get OnMousePressed() As Variant
493 ''' Get the script associated with the OnMousePressed event
495 End Property ' SFDocuments.SF_FormControl.OnMousePressed (get)
497 REM -----------------------------------------------------------------------------
498 Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant)
499 ''' Set the updatable property OnMousePressed
501 End Property ' SFDocuments.SF_FormControl.OnMousePressed (let)
503 REM -----------------------------------------------------------------------------
504 Property Get OnMouseReleased() As Variant
505 ''' Get the script associated with the OnMouseReleased event
507 End Property ' SFDocuments.SF_FormControl.OnMouseReleased (get)
509 REM -----------------------------------------------------------------------------
510 Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant)
511 ''' Set the updatable property OnMouseReleased
513 End Property ' SFDocuments.SF_FormControl.OnMouseReleased (let)
515 REM -----------------------------------------------------------------------------
516 Property Get OnResetted() As Variant
517 ''' Get the script associated with the OnResetted event
519 End Property ' SFDocuments.SF_FormControl.OnResetted (get)
521 REM -----------------------------------------------------------------------------
522 Property Let OnResetted(Optional ByVal pvOnResetted As Variant)
523 ''' Set the updatable property OnResetted
525 End Property ' SFDocuments.SF_FormControl.OnResetted (let)
527 REM -----------------------------------------------------------------------------
528 Property Get OnTextChanged() As Variant
529 ''' Get the script associated with the OnTextChanged event
531 End Property ' SFDocuments.SF_FormControl.OnTextChanged (get)
533 REM -----------------------------------------------------------------------------
534 Property Let OnTextChanged(Optional ByVal pvOnTextChanged As Variant)
535 ''' Set the updatable property OnTextChanged
537 End Property ' SFDocuments.SF_FormControl.OnTextChanged (let)
539 REM -----------------------------------------------------------------------------
540 Property Get OnUpdated() As Variant
541 ''' Get the script associated with the OnUpdated event
543 End Property ' SFDocuments.SF_FormControl.OnUpdated (get)
545 REM -----------------------------------------------------------------------------
546 Property Let OnUpdated(Optional ByVal pvOnUpdated As Variant)
547 ''' Set the updatable property OnUpdated
549 End Property ' SFDocuments.SF_FormControl.OnUpdated (let)
551 REM -----------------------------------------------------------------------------
552 Property Get Parent() As Object
553 ''' Return the Parent form or [table]control object of the actual control
555 End Property ' SFDocuments.SF_FormControl.Parent
557 REM -----------------------------------------------------------------------------
558 Property Get Picture() As Variant
559 ''' The Picture property specifies a bitmap or other type of graphic to be displayed on the specified control
561 End Property ' SFDocuments.SF_FormControl.Picture (get)
563 REM -----------------------------------------------------------------------------
564 Property Let Picture(Optional ByVal pvPicture As Variant)
565 ''' Set the updatable property Picture
567 End Property ' SFDocuments.SF_FormControl.Picture (let)
569 REM -----------------------------------------------------------------------------
570 Property Get Required() As Variant
571 ''' A control is said Required when it must not contain a null value
573 End Property ' SFDocuments.SF_FormControl.Required (get)
575 REM -----------------------------------------------------------------------------
576 Property Let Required(Optional ByVal pvRequired As Variant)
577 ''' Set the updatable property Required
579 End Property ' SFDocuments.SF_FormControl.Required (let)
581 REM -----------------------------------------------------------------------------
582 Property Get Text() As Variant
583 ''' The Text property specifies the actual content of the control like it is displayed on the screen
585 End Property ' SFDocuments.SF_FormControl.Text (get)
587 REM -----------------------------------------------------------------------------
588 Property Get TipText() As Variant
589 ''' The TipText property specifies the text that appears in a screentip when you hold the mouse pointer over a control
591 End Property ' SFDocuments.SF_FormControl.TipText (get)
593 REM -----------------------------------------------------------------------------
594 Property Let TipText(Optional ByVal pvTipText As Variant)
595 ''' Set the updatable property TipText
597 End Property ' SFDocuments.SF_FormControl.TipText (let)
599 REM -----------------------------------------------------------------------------
600 Property Get TripleState() As Variant
601 ''' The TripleState property specifies how a check box will display Null values
602 ''' When True, the control will cycle through states for Yes, No, and Null values. The control appears dimmed (grayed) when its Value property is set to Null.
603 ''' When False, the control will cycle through states for Yes and No values. Null values display as if they were No values.
605 End Property ' SFDocuments.SF_FormControl.TripleState (get)
607 REM -----------------------------------------------------------------------------
608 Property Let TripleState(Optional ByVal pvTripleState As Variant)
609 ''' Set the updatable property TripleState
611 End Property ' SFDocuments.SF_FormControl.TripleState (let)
613 REM -----------------------------------------------------------------------------
614 Property Get Value() As Variant
615 ''' The Value property specifies the data contained in the control
617 End Property ' SFDocuments.SF_FormControl.Value (get)
619 REM -----------------------------------------------------------------------------
620 Property Let Value(Optional ByVal pvValue As Variant)
621 ''' Set the updatable property Value
623 End Property ' SFDocuments.SF_FormControl.Value (let)
625 REM -----------------------------------------------------------------------------
626 Property Get Visible() As Variant
627 ''' The Visible property specifies if the control is accessible with the cursor.
629 End Property ' SFDocuments.SF_FormControl.Visible (get)
631 REM -----------------------------------------------------------------------------
632 Property Let Visible(Optional ByVal pvVisible As Variant)
633 ''' Set the updatable property Visible
635 End Property ' SFDocuments.SF_FormControl.Visible (let)
637 REM -----------------------------------------------------------------------------
638 Property Get XControlModel() As Object
639 ''' The XControlModel property returns the model UNO object of the control
641 End Property ' SFDocuments.SF_FormControl.XControlModel (get)
643 REM -----------------------------------------------------------------------------
644 Property Get XControlView() As Object
645 ''' The XControlView property returns the view UNO object of the control
647 End Property ' SFDocuments.SF_FormControl.XControlView (get)
649 REM ===================================================================== METHODS
651 REM -----------------------------------------------------------------------------
652 Public Function Controls(Optional ByVal ControlName As Variant) As Variant
653 ''' Return either
654 ''' - the list of the controls contained in the actual table control
655 ''' - a Form Control object based on its name
656 ''' Args:
657 ''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
658 ''' Returns:
659 ''' A zero-base array of strings if ControlName is absent
660 ''' An instance of the SF_FormControl class if ControlName exists
661 ''' Exceptions:
662 ''' ControlName is invalid
663 ''' Example:
664 ''' Dim myGrid As Object, myList As Variant, myControl As Object
666 ''' myList = myGrid.Controls()
669 Dim oControl As Object ' The new control class instance
670 Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache
671 Dim vControl As Variant ' Alias of _ControlCache entry
672 Dim oView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
673 Dim i As Long
677 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
678 Set Controls = Nothing
680 Check:
681 If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
682 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
683 If _ControlType <> CTLTABLECONTROL Then GoTo Catch
684 If Not [_Parent]._IsStillAlive() Then GoTo Finally
685 If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
686 End If
688 Try:
689 ' Collect all control names if not yet done
691 _ControlNames = _ControlModel.getElementNames()
693 ReDim _ControlCache(0 To UBound(_ControlNames))
694 End If
695 End If
697 ' Return the list of controls or a FormControl instance
698 If Len(ControlName) = 0 Then
699 Controls = _ControlNames
701 Else
703 If Not _ControlModel.hasByName(ControlName) Then GoTo CatchNotFound
704 lIndexOfNames = ScriptForge.SF_Array.IndexOf(_ControlNames, ControlName, CaseSensitive := True)
705 ' Reuse cache when relevant
706 vControl = _ControlCache(lIndexOfNames)
708 If IsEmpty(vControl) Then
710 Set oControl = New SF_FormControl
711 With oControl
712 ._Name = ControlName
713 Set .[Me] = oControl
714 Set .[_Parent] = [Me]
715 ._ParentIsTable = True
716 ._IndexOfNames = lIndexOfNames
717 ._FormName = _FormName
718 Set ._ParentForm = _ParentForm
719 ' Get model and view of the current control
720 Set ._ControlModel = _ControlModel.getByName(ControlName)
721 ._ImplementationName = ._ControlModel.ColumnServiceName ' getImplementationName aborts for subcontrols !?
722 ' Bypass to find the control view: cannot be done from the top component
723 If Not IsNull(_ControlView) Then ' Anticipate absence of ControlView in table controls when edit mode
725 Set oView = _ControlView.GetByIndex(i)
726 If Not IsNull(oView) Then
727 If oView.getModel.Name = ControlName Then
728 Set ._ControlView = oView
729 Exit For
730 End If
731 End If
732 Next i
733 End If
734 ._Initialize()
735 End With
736 Else
737 Set oControl = vControl
738 End If
740 Set Controls = oControl
741 End If
743 Finally:
744 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
745 Exit Function
746 Catch:
747 GoTo Finally
748 CatchNotFound:
749 ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _ControlModel.getElementNames())
750 GoTo Finally
751 End Function ' SFDocuments.SF_FormControl.Controls
753 REM -----------------------------------------------------------------------------
754 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
755 ''' Return the actual value of the given property
756 ''' Args:
757 ''' PropertyName: the name of the property as a string
758 ''' Returns:
759 ''' The actual value of the property
760 ''' If the property does not exist, returns Null
761 ''' Exceptions:
762 ''' see the exceptions of the individual properties
763 ''' Examples:
766 Dim vDefault As Variant ' Default value when property not applicable on control type
768 Const cstSubArgs = ""
770 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
771 GetProperty = Null
773 Check:
774 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
775 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
776 End If
778 Try:
779 ' FormControl properties are far from applicable to all control types
780 ' Getting a property must never abort to not interfere with the Basic IDE watch function
781 ' Hence a default value must be provided
782 Select Case UCase(PropertyName)
797 Case Else : vDefault = ""
798 End Select
800 GetProperty = _PropertyGet(PropertyName, vDefault)
802 Finally:
803 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
804 Exit Function
805 Catch:
806 GoTo Finally
807 End Function ' SFDocuments.SF_FormControl.GetProperty
809 REM -----------------------------------------------------------------------------
810 Public Function Methods() As Variant
811 ''' Return the list of public methods of the FormControl service as an array
813 Methods = Array( _
820 )
822 End Function ' SFDocuments.SF_FormControl.Methods
824 REM -----------------------------------------------------------------------------
825 Public Function Properties() As Variant
826 ''' Return the list or properties of the FormControl class as an array
828 Properties = Array( _
876 )
878 End Function ' SFDocuments.SF_FormControl.Properties
880 REM -----------------------------------------------------------------------------
881 Public Function SetFocus() As Boolean
882 ''' Set the focus on the current Control instance
883 ''' Probably called from after an event occurrence
884 ''' Args:
885 ''' Returns:
886 ''' True if focusing is successful
887 ''' Example:
888 ''' Dim oDoc As Object, oForm As Object, oControl As Object
889 ''' Set oDoc = CreateScriptService("SFDocuments.Document", ThisComponent)
892 ''' oControl.SetFocus()
894 Dim bSetFocus As Boolean ' Return value
895 Dim iColPosition As Integer ' Position of control in table
896 Dim oTableModel As Object ' XControlModel of parent table
897 Dim oControl As Object ' com.sun.star.awt.XControlModel
898 Dim i As Integer, j As Integer
900 Const cstSubArgs = ""
902 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
903 bSetFocus = False
905 Check:
906 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
907 If Not _ParentForm._IsStillAlive() Then GoTo Finally
908 End If
910 Try:
911 If Not IsNull(_ControlView) Then
912 If _ParentIsTable Then ' setFocus() method does not work on controlviews in table control ?!?
913 ' Find the column position of the current instance in the parent table control
914 iColPosition = -1
915 Set oTableModel = [_Parent]._ControlModel
916 j = -1
918 Set oControl = oTableModel.getByIndex(i)
920 If oControl.Name = _Name Then
921 iColPosition = j
922 Exit For
923 End If
924 Next i
926 [_Parent]._ControlView.setFocus() 'Set first focus on table control itself
927 [_Parent]._ControlView.setCurrentColumnPosition(iColPosition) 'Deprecated but no alternative found
928 End If
929 Else
930 _ControlView.setFocus()
931 End If
932 bSetFocus = True
933 End If
934 bSetFocus = True
936 Finally:
937 SetFocus = bSetFocus
938 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
939 Exit Function
940 Catch:
941 GoTo Finally
942 End Function ' SFControls.SF_FormControl.SetFocus
944 REM -----------------------------------------------------------------------------
945 Public Function SetProperty(Optional ByVal PropertyName As Variant _
946 , Optional ByRef Value As Variant _
947 ) As Boolean
948 ''' Set a new value to the given property
949 ''' Args:
950 ''' PropertyName: the name of the property as a string
951 ''' Value: its new value
952 ''' Exceptions
953 ''' ARGUMENTERROR The property does not exist
958 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
959 SetProperty = False
961 Check:
962 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
963 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
964 End If
966 Try:
967 SetProperty = _PropertySet(PropertyName, Value)
969 Finally:
970 SF_Utils._ExitFunction(cstThisSub)
971 Exit Function
972 Catch:
973 GoTo Finally
974 End Function ' SFDocuments.SF_FormControl.SetProperty
976 REM =========================================================== PRIVATE FUNCTIONS
978 REM -----------------------------------------------------------------------------
979 Private Function _FormatsList() As Variant
980 ''' Return the allowed format entries as a zero-based array for Date and Time control types
982 Dim vFormats() As Variant ' Return value
984 Select Case _ControlType
985 Case CTLDATEFIELD
986 vFormats = Array( _
999 )
1000 Case CTLTIMEFIELD
1001 vFormats = Array( _
1006 )
1007 Case Else
1008 vFormats = Array()
1009 End Select
1011 _FormatsList = vFormats
1013 End Function ' SFDocuments.SF_FormControl._FormatsList
1015 REM -----------------------------------------------------------------------------
1016 Public Function _GetEventName(ByVal psProperty As String) As String
1017 ''' Return the LO internal event name derived from the SF property name
1018 ''' The SF property name is not case sensitive, while the LO name is case-sensitive
1019 ' Corrects the typo on ErrorOccur(r?)ed, if necessary
1021 Dim vProperties As Variant ' Array of class properties
1022 Dim sProperty As String ' Correctly cased property name
1024 vProperties = Properties()
1025 sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
1029 End Function ' SFDocuments.SF_FormControl._GetEventName
1031 REM -----------------------------------------------------------------------------
1032 Private Function _GetListener(ByVal psEventName As String) As String
1033 ''' Getting/Setting macros triggered by events requires a Listener-EventName pair
1034 ''' Return the X...Listener corresponding with the event name in argument
1036 Select Case UCase(psEventName)
1059 Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased")
1063 End Select
1065 End Function ' SFDocuments.SF_FormControl._GetListener
1067 REM -----------------------------------------------------------------------------
1068 Public Sub _Initialize()
1069 ''' Complete the object creation process:
1070 ''' - Initialization of private members
1071 ''' - Collection of specific attributes
1072 ''' - Synchronization with parent form instance
1074 Dim vControlTypes As Variant ' Array of control types ordered by the ClassId property of XControlModel - 2
1077 vControlTypes = array( CTLBUTTON _
1078 , CTLRADIOBUTTON _
1079 , CTLIMAGEBUTTON _
1080 , CTLCHECKBOX _
1081 , CTLLISTBOX _
1082 , CTLCOMBOBOX _
1083 , CTLGROUPBOX _
1084 , CTLTEXTFIELD _
1085 , CTLFIXEDTEXT _
1086 , CTLTABLECONTROL _
1087 , CTLFILECONTROL _
1088 , CTLHIDDENCONTROL _
1089 , CTLIMAGECONTROL _
1090 , CTLDATEFIELD _
1091 , CTLTIMEFIELD _
1092 , CTLNUMERICFIELD _
1093 , CTLCURRENCYFIELD _
1094 , CTLPATTERNFIELD _
1095 , CTLSCROLLBAR _
1096 , CTLSPINBUTTON _
1097 , CTLNAVIGATIONBAR _
1098 )
1100 Try:
1101 ' _implementationName is set elsewhere for controls in table control
1102 If Len(_ImplementationName) = 0 Then _ImplementationName = ScriptForge.SF_Session.UnoObjectType(_ControlModel)
1103 _ClassId = _ControlModel.ClassId
1105 ' Identify the control type, ignore subforms and pay attention to formatted fields
1106 If ScriptForge.SF_Session.HasUnoproperty(_ControlModel, "ClassId") Then ' All control types have a ClassId property except subforms
1107 _ControlType = vControlTypes(_ClassId - 2)
1108 ' Formatted fields belong to the TextField family
1109 If _ControlType = CTLTEXTFIELD Then
1111 Or _ImplementationName = "com.sun.star.comp.forms.OFormattedFieldWrapper_ForcedFormatted" _
1112 Or _ImplementationName = "com.sun.star.form.component.FormattedField" Then ' When in table control
1113 _ControlType = CTLFORMATTEDFIELD
1114 End If
1115 End If
1116 Else
1117 Exit Sub ' Ignore subforms, should not happen
1118 End If
1120 With [_Parent]
1121 ' Set control view if not set yet
1122 If IsNull(_ControlView) Then
1123 If _ClassId > 0 And _ClassId <> acHiddenControl Then ' No view on hidden controls
1124 If IsNull(._FormDocument) Then ' Usual document
1125 Set _ControlView = ._Component.CurrentController.getControl(_ControlModel)
1126 Else ' Base form document
1127 Set _ControlView = ._FormDocument.Component.CurrentController.getControl(_ControlModel)
1128 End If
1129 End If
1130 End If
1131 End With
1133 ' Store the SF_FormControl object in the parent cache
1134 Set _Parent._ControlCache(_IndexOfNames) = [Me]
1136 Finally:
1137 Exit Sub
1138 End Sub ' SFDocuments.SF_FormControl._Initialize
1140 REM -----------------------------------------------------------------------------
1141 Private Function _ListboxBound() As Boolean
1142 ''' Return True if the actual control, which is a listbox, has a bound column
1143 ''' Called before setting the value of a listbox, i.e. the value to be rewritten in the underlying table data
1144 ''' The existence of a bound column is derived from the comparison between StringItemList and ValueItemList
1145 ''' String ... : the strings displayed in the list box
1146 ''' Value ... : the database values
1147 ''' If they are different, then there is a bound column
1149 Dim bListboxBound As Boolean ' Return value
1150 Dim vValue() As Variant ' Alias of the control model ValueItemList
1151 Dim vString() As Variant ' Alias of the control model StringItemList
1152 Dim i As Long
1154 bListboxBound = False
1156 With _ControlModel
1157 If Not IsNull(.ValueItemList) _
1158 And .DataField <> "" _
1159 And Not IsNull(.BoundField) _
1160 And ScriptForge.SF_Array.Contains(Array( _
1161 com.sun.star.form.ListSourceType.TABLE _
1162 , com.sun.star.form.ListSourceType.QUERY _
1163 , com.sun.star.form.ListSourceType.SQL _
1164 , com.sun.star.form.ListSourceType.SQLPASSTHROUGH _
1165 ), .ListSourceType) Then
1166 If IsArray(.ValueItemList) Then
1167 vValue = .ValueItemList
1168 vString = .StringItemList
1169 For i = 0 To UBound(vValue)
1170 If VarType(vValue(i)) <> VarType(vString(i)) Then
1171 bListboxBound = True
1172 ElseIf vValue(i) <> vString(i) Then
1173 bListboxBound = True
1174 End If
1175 If bListboxBound Then Exit For
1176 Next i
1177 End If
1178 End If
1179 End With
1181 _ListboxBound = bListboxBound
1185 REM -----------------------------------------------------------------------------
1186 Private Function _PropertyGet(Optional ByVal psProperty As String _
1187 , Optional ByVal pvDefault As Variant _
1188 ) As Variant
1189 ''' Return the value of the named property
1190 ''' Args:
1191 ''' psProperty: the name of the property
1192 ''' pvDefault: the value returned when the property is not applicable on the control's type
1193 ''' Getting a non-existing property for a specific control type should
1194 ''' not generate an error to not disrupt the Basic IDE debugger
1196 Dim vGet As Variant ' Return value
1197 Static oSession As Object ' Alias of SF_Session
1198 Dim vSelection As Variant ' Alias of Model.SelectedItems or Model.Selection
1199 Dim vList As Variant ' Alias of Model.StringItemList
1200 Dim lIndex As Long ' Index in StringItemList
1201 Dim sItem As String ' A single item
1202 Dim vDate As Variant ' Date after conversion from com.sun.star.util.Date or com.sun.star.util.Time
1203 Dim vValues As Variant ' Array of listbox values
1204 Dim oControlEvents As Object ' com.sun.star.container.XNameContainer
1205 Dim sEventName As String ' Internal event name
1207 Dim i As Long
1208 Dim cstThisSub As String
1209 Const cstSubArgs = ""
1212 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1214 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1215 If Not _ParentForm._IsStillAlive() Then GoTo Finally
1217 If IsMissing(pvDefault) Or IsEmpty(pvDefault) Then pvDefault = Null
1218 _PropertyGet = pvDefault
1220 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1221 Select Case UCase(psProperty)
1223 Select Case _ControlType
1224 Case CTLBUTTON
1226 Select Case _ControlModel.ButtonType
1230 Case com.sun.star.form.FormButtonType.URL
1232 If Left(_ControlModel.TargetURL, Len(cstUnoUrl)) = cstUnoUrl Then
1233 _PropertyGet = Mid(_ControlModel.TargetURL, Len(cstUnoUrl) + 1)
1238 End If
1239 End Select
1240 End If
1241 Case Else : GoTo CatchType
1242 End Select
1244 Select Case _ControlType
1245 Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
1246 If oSession.HasUNOProperty(_ControlModel, "Label") Then _PropertyGet = _ControlModel.Label
1247 Case Else : GoTo CatchType
1248 End Select
1250 Select Case _ControlType
1251 Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFORMATTEDFIELD, CTLIMAGECONTROL, CTLLISTBOX _
1252 , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLRADIOBUTTON, CTLTEXTFIELD, CTLTIMEFIELD
1253 If oSession.HasUNOProperty(_ControlModel, "DataField") Then _PropertyGet = _ControlModel.DataField
1254 Case Else : GoTo CatchType
1255 End Select
1257 _PropertyGet = _ControlType
1259 Select Case _ControlType
1260 Case CTLBUTTON
1261 If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _PropertyGet = _ControlModel.DefaultButton
1262 Case Else : GoTo CatchType
1263 End Select
1265 Select Case _ControlType
1266 Case CTLCHECKBOX, CTLRADIOBUTTON
1267 If oSession.HasUNOProperty(_ControlModel, "DefaultState") Then _PropertyGet = _ControlModel.DefaultState
1268 Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD
1269 If oSession.HasUNOProperty(_ControlModel, "DefaultText") Then _PropertyGet = _ControlModel.DefaultText
1270 Case CTLCURRENCYFIELD, CTLNUMERICFIELD
1271 If oSession.HasUNOProperty(_ControlModel, "DefaultValue") Then _PropertyGet = _ControlModel.DefaultValue
1272 Case CTLDATEFIELD
1274 If Not IsEmpty(_ControlModel.DefaultDate) Then
1275 With _ControlModel.DefaultDate
1276 vDate = DateSerial(.Year, .Month, .Day)
1277 End With
1278 _PropertyGet = vDate
1279 End If
1280 End If
1281 Case CTLFORMATTEDFIELD
1282 If oSession.HasUNOProperty(_ControlModel, "EffectiveDefault") Then _PropertyGet = _ControlModel.EffectiveDefault
1283 Case CTLLISTBOX
1284 If oSession.HasUNOProperty(_ControlModel, "DefaultSelection") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
1285 vList = _ControlModel.DefaultSelection
1286 If IsArray(vList) Then
1288 lIndex = UBound(_ControlModel.StringItemList)
1289 If vList(0) >= 0 And vList(0) <= lIndex Then _PropertyGet = _ControlModel.StringItemList(vList(0))
1290 ' Only first default value is considered
1291 End If
1292 End If
1293 End If
1294 Case CTLSPINBUTTON
1295 If oSession.HasUNOProperty(_ControlModel, "DefaultSpinValue") Then _PropertyGet = _ControlModel.DefaultSpinValue
1296 Case CTLTIMEFIELD
1298 If Not IsEmpty(_ControlModel.DefaultTime) Then
1299 With _ControlModel.DefaultTime
1300 vDate = TimeSerial(.Hours, .Minutes, .Seconds)
1301 End With
1302 _PropertyGet = vDate
1303 End If
1304 End If
1305 Case Else : GoTo CatchType
1306 End Select
1308 Select Case _ControlType
1309 Case CTLHIDDENCONTROL : GoTo CatchType
1310 Case Else
1311 If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _PropertyGet = _ControlModel.Enabled
1312 End Select
1314 Select Case _ControlType
1315 Case CTLDATEFIELD
1316 If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = _FormatsList()(_ControlModel.DateFormat)
1317 Case CTLTIMEFIELD
1318 If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = _FormatsList()(_ControlModel.TimeFormat)
1319 Case CTLFORMATTEDFIELD
1320 If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") And oSession.HasUNOProperty(_ControlModel, "FormatKey") Then
1321 _PropertyGet = _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString
1322 End If
1323 Case Else : GoTo CatchType
1324 End Select
1326 Select Case _ControlType
1327 Case CTLCOMBOBOX, CTLLISTBOX
1328 If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1
1329 Case Else : GoTo CatchType
1330 End Select
1332 Select Case _ControlType
1333 Case CTLCOMBOBOX
1335 If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
1336 _PropertyGet = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, _ControlModel.Text, CaseSensitive := True)
1337 End If
1338 Case CTLLISTBOX
1340 If oSession.HasUNOProperty(_ControlModel, "SelectedItems") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
1341 vSelection = _ControlModel.SelectedItems
1343 End If
1344 Case Else : GoTo CatchType
1345 End Select
1347 Select Case _ControlType
1348 Case CTLCOMBOBOX, CTLLISTBOX
1350 With com.sun.star.form.ListSourceType
1351 Select Case _ControlModel.ListSourceType
1352 Case .VALUELIST _
1353 , .TABLEFIELDS
1354 If IsArray(_ControlModel.StringItemList) Then vValues = _ControlModel.StringItemList Else vValues = Array(_ControlModel.StringItemList)
1355 Case .TABLE _
1356 , .QUERY _
1357 , .SQL _
1358 , .SQLPASSTHROUGH
1359 If IsArray(_ControlModel.ListSource) Then vValues = _ControlModel.ListSource Else vValues = Array(_ControlModel.ListSource)
1360 End Select
1361 End With
1363 End If
1364 Case Else : GoTo CatchType
1365 End Select
1367 Select Case _ControlType
1368 Case CTLCOMBOBOX, CTLLISTBOX
1369 If oSession.HasUnoProperty(_ControlModel, "ListSourceType") Then _PropertyGet = _ControlModel.ListSourceType
1370 Case Else : GoTo CatchType
1371 End Select
1373 Select Case _ControlType
1374 Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLIMAGECONTROL _
1375 , CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
1376 If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _PropertyGet = _ControlModel.ReadOnly
1377 Case Else : GoTo CatchType
1378 End Select
1380 Select Case _ControlType
1381 Case CTLLISTBOX
1383 _PropertyGet = _ControlModel.MultiSelection
1384 ElseIf oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then ' Not documented: gridcontrols only TBC ??
1385 _PropertyGet = _ControlModel.MultiSelectionSimpleMode
1386 End If
1387 Case Else : GoTo CatchType
1388 End Select
1390 _PropertyGet = _Name
1391 Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnApproveAction"), UCase("OnApproveReset"), UCase("OnApproveUpdate") _
1392 , UCase("OnChanged"), UCase("OnErrorOccurred"), UCase("OnFocusGained"), UCase("OnFocusLost") _
1393 , UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
1394 , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
1395 , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted") _
1397 If IsNull(_ControlModel) Then _PropertyGet = "" Else _PropertyGet = SF_Register._GetEventScriptCode(_ControlModel, psProperty, _Name)
1399 Set _PropertyGet = [_Parent]
1401 Select Case _ControlType
1402 Case CTLBUTTON, CTLIMAGEBUTTON, CTLIMAGECONTROL
1403 If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_ControlModel.ImageURL)
1404 Case Else : GoTo CatchType
1405 End Select
1407 Select Case _ControlType
1408 Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD _
1409 , CTLPATTERNFIELD, CTLRADIOBUTTON, CTLTEXTFIELD, CTLTIMEFIELD
1410 If oSession.HasUnoProperty(_ControlModel, "InputRequired") Then _PropertyGet = _ControlModel.InputRequired
1411 Case Else : GoTo CatchType
1412 End Select
1414 Select Case _ControlType
1415 Case CTLDATEFIELD
1419 If Not IsEmpty(_ControlModel.Date) Then
1420 With _ControlModel.Date
1421 vDate = DateSerial(.Year, .Month, .Day)
1422 End With
1423 _PropertyGet = Format(vDate, _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString)
1424 End If
1425 End If
1426 Case CTLTIMEFIELD
1428 If Not IsEmpty(_ControlModel.Time) Then
1429 With _ControlModel.Time
1430 vDate = TimeSerial(.Hours, .Minutes, .Seconds)
1431 End With
1433 End If
1434 End If
1435 Case CTLCOMBOBOX, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLPATTERNFIELD, CTLTEXTFIELD
1436 If oSession.HasUnoProperty(_ControlModel, "Text") Then _PropertyGet = _ControlModel.Text
1437 Case Else : GoTo CatchType
1438 End Select
1440 Select Case _ControlType
1441 Case CTLHIDDENCONTROL : GoTo CatchType
1442 Case Else
1443 If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _PropertyGet = _ControlModel.HelpText
1444 End Select
1446 Select Case _ControlType
1447 Case CTLCHECKBOX
1448 If oSession.HasUnoProperty(_ControlModel, "TriState") Then _PropertyGet = _ControlModel.TriState
1449 Case Else : GoTo CatchType
1450 End Select
1451 Case UCase("Value") ' Default values are set here by control type, not in the 2nd argument (pvDefault)
1452 vGet = pvDefault
1453 Select Case _ControlType
1454 Case CTLBUTTON 'Boolean, toggle buttons only
1455 vGet = False
1457 If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 )
1458 End If
1460 If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = _ControlModel.State Else vGet = 2
1461 Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String
1462 If oSession.HasUnoProperty(_ControlModel, "Text") Then vGet = _ControlModel.Text Else vGet = ""
1463 Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
1464 If oSession.HasUnoProperty(_ControlModel, "Value") Then vGet = _ControlModel.Value Else vGet = 0
1465 Case CTLDATEFIELD 'Date
1466 vGet = CDate(1)
1468 If VarType(_ControlModel.Date) = ScriptForge.V_OBJECT Then ' com.sun.star.util.Date
1469 With _ControlModel.Date
1470 vDate = DateSerial(.Year, .Month, .Day)
1471 End With
1472 vGet = vDate
1473 Else ' .Date = Empty
1474 End If
1475 End If
1476 Case CTLFORMATTEDFIELD 'String or numeric
1477 If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then vGet = _ControlModel.EffectiveValue Else vGet = ""
1478 Case CTLHIDDENCONTROL 'String
1479 If oSession.HasUnoProperty(_ControlModel, "HiddenValue") Then vGet = _ControlModel.HiddenValue Else vGet = ""
1480 Case CTLLISTBOX 'String or array of strings depending on MultiSelection
1481 ' StringItemList is the list of the items displayed in the box
1482 ' ValueItemList is the list of the values in the underlying database field
1483 ' SelectedItems is the list of the indexes in StringItemList of the selected items
1484 ' It can go beyond the limits of StringItemList
1485 ' It can contain multiple values even if the listbox is not multiselect
1486 If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _
1488 vSelection = _ControlModel.SelectedItems
1489 ' The list of allowed values depends on the existence of a bound column
1490 If _ListBoxBound() Then vList = _ControlModel.ValueItemList Else vList = _ControlModel.StringItemList
1491 If _ControlModel.MultiSelection Then vValues = Array()
1492 For i = 0 To UBound(vSelection)
1493 lIndex = vSelection(i)
1495 If Not _ControlModel.MultiSelection Then
1496 vValues = vList(lIndex)
1497 Exit For
1498 End If
1499 vValues = ScriptForge.SF_Array.Append(vValues, vList(lIndex))
1500 End If
1501 Next i
1502 vGet = vValues
1503 Else
1504 vGet = ""
1505 End If
1506 Case CTLRADIOBUTTON 'Boolean
1507 If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 ) Else vGet = False
1508 Case CTLSCROLLBAR 'Numeric
1509 vGet = 0
1511 If Not IsEmpty(_ControlModel.ScrollValue) Then vGet = _ControlModel.ScrollValue
1512 End If
1513 Case CTLSPINBUTTON
1514 If oSession.HasUnoProperty(_ControlModel, "SpinValue") Then vGet = _ControlModel.SpinValue Else vGet = 0
1515 Case CTLTIMEFIELD
1516 vGet = CDate(0)
1518 If VarType(_ControlModel.Time) = ScriptForge.V_OBJECT Then ' com.sun.star.Util.Time
1519 With _ControlModel.Time
1520 vDate = TimeSerial(.Hours, .Minutes, .Seconds)
1521 End With
1522 vGet = vDate
1523 Else ' .Time = Empty
1524 End If
1525 End If
1526 Case Else : GoTo CatchType
1527 End Select
1528 _PropertyGet = vGet
1530 If oSession.HasUnoMethod(_ControlView, "isVisible") Then _PropertyGet = CBool(_ControlView.isVisible())
1532 Set _PropertyGet = _ControlModel
1534 Set _PropertyGet = _ControlView
1535 Case Else
1536 _PropertyGet = Null
1537 End Select
1539 Finally:
1540 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1541 Exit Function
1542 Catch:
1543 GoTo Finally
1544 CatchType:
1545 GoTo Finally
1546 End Function ' SFDocuments.SF_FormControl._PropertyGet
1548 REM -----------------------------------------------------------------------------
1549 Private Function _PropertySet(Optional ByVal psProperty As String _
1550 , Optional ByVal pvValue As Variant _
1551 ) As Boolean
1552 ''' Set the new value of the named property
1553 ''' Args:
1554 ''' psProperty: the name of the property
1555 ''' pvValue: the new value of the given property
1557 Dim bSet As Boolean ' Return value
1558 Static oSession As Object ' Alias of SF_Session
1559 Dim sFormName As String ' Full form identification for error messages
1560 Dim vSet As Variant ' Value to set in UNO model or view property
1561 Dim vActions As Variant ' Action property: list of available actions
1562 Dim sAction As String ' A single action
1563 Dim vFormats As Variant ' Format property: output of _FormatsList()
1564 Dim iFormat As Integer ' Format property: index in vFormats
1565 Dim vSelection As Variant ' Alias of Model.SelectedItems
1566 Dim vList As Variant ' Alias of Model.StringItemList
1567 Dim lIndex As Long ' Index in StringItemList
1568 Dim sItem As String ' A single item
1569 Dim oDatabase As Object ' The database object related to the parent form of the control instance
1570 Dim i As Long
1571 Dim cstThisSub As String
1574 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1575 bSet = False
1578 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1579 If Not _ParentForm._IsStillAlive() Then GoTo Finally
1581 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1582 bSet = True
1583 Select Case UCase(psProperty)
1585 Select Case _ControlType
1586 Case CTLBUTTON
1587 vActions = Array("none", "submitForm", "resetForm", "refreshForm", "moveToFirst", "moveToLast", "moveToNext", "moveToPrev" _
1588 , "saveRecord", "moveToNew", "deleteRecord", "undoRecord")
1589 If Not ScriptForge.SF_Utils._Validate(pvValue, "Action", ScriptForge.V_STRING, vActions) Then GoTo Finally
1591 sAction = vActions(ScriptForge.SF_Array.IndexOf(vActions, pvValue, CaseSensitive := False))
1592 _ControlModel.TargetURL = ""
1593 Select Case sAction
1597 Case Else
1598 vSet = com.sun.star.form.FormButtonType.URL
1600 End Select
1601 _ControlModel.ButtonType = vSet
1602 End If
1603 Case Else : GoTo CatchType
1604 End Select
1606 Select Case _ControlType
1607 Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
1608 If Not ScriptForge.SF_Utils._Validate(pvValue, "Caption", V_STRING) Then GoTo Finally
1609 If oSession.HasUNOProperty(_ControlModel, "Label") Then _ControlModel.Label = pvValue
1610 Case Else : GoTo CatchType
1611 End Select
1613 Select Case _ControlType
1614 Case CTLBUTTON
1615 If Not ScriptForge.SF_Utils._Validate(pvValue, "Default", ScriptForge.V_BOOLEAN) Then GoTo Finally
1616 If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _ControlModel.DefaultButton = pvValue
1617 Case Else : GoTo CatchType
1618 End Select
1620 Select Case _ControlType
1621 Case CTLHIDDENCONTROL : GoTo CatchType
1622 Case Else
1623 If Not ScriptForge.SF_Utils._Validate(pvValue, "Enabled", ScriptForge.V_BOOLEAN) Then GoTo Finally
1624 If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _ControlModel.Enabled = pvValue
1625 End Select
1627 Select Case _ControlType
1628 Case CTLDATEFIELD, CTLTIMEFIELD
1629 vFormats = _FormatsList()
1630 If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING, vFormats) Then GoTo Finally
1631 iFormat = ScriptForge.SF_Array.IndexOf(vFormats, pvValue, CaseSensitive := False)
1633 _ControlModel.DateFormat = iFormat
1635 _ControlModel.TimeFormat = iFormat
1636 End If
1637 Case Else : GoTo CatchType
1638 End Select
1640 If Not ScriptForge.SF_Utils._Validate(pvValue, "ListIndex", ScriptForge.V_NUMERIC) Then GoTo Finally
1641 Select Case _ControlType
1642 Case CTLCOMBOBOX
1643 If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
1644 If pvValue >= 0 And pvValue <= UBound(_ControlModel.StringItemList) Then _ControlModel.Text = _ControlModel.StringItemList(CInt(pvValue))
1645 End If
1646 Case CTLLISTBOX
1647 If oSession.HasUNOProperty(_ControlModel, "SelectedItems") Then _ControlModel.SelectedItems = Array(CInt(pvValue))
1648 Case Else : GoTo CatchType
1649 End Select
1651 Select Case _ControlType
1652 Case CTLCOMBOBOX, CTLLISTBOX
1654 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
1655 With com.sun.star.form.ListSourceType
1656 Select Case _ControlModel.ListSourceType
1657 Case .QUERY _
1658 , .TABLE _
1659 , .TABLEFIELDS
1660 Set oDatabase = _ParentForm.GetDatabase()
1661 If _ControlModel.ListSourceType = .QUERY Then vList = oDatabase.Queries Else vList = oDatabase.Tables
1662 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING, vList) Then Goto Finally
1663 If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = pvValue Else _ControlModel.ListSource = Array(pvValue)
1664 _ControlModel.refresh()
1665 Case .SQL
1666 Set oDatabase = _ParentForm.GetDatabase()
1667 If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = oDatabase._ReplaceSquareBrackets(pvValue) Else _ControlModel.ListSource = Array(oDatabase._ReplaceSquareBrackets(pvValue))
1668 _ControlModel.refresh()
1669 Case .VALUELIST ' ListBox only !
1671 _ControlModel.StringItemList = _ControlModel.ListSource
1672 Case .SQLPASSTHROUGH
1673 If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = pvValue Else _ControlModel.ListSource = Array(pvValue)
1674 _ControlModel.refresh()
1675 End Select
1676 End With
1677 End If
1678 Case Else : GoTo CatchType
1679 End Select
1681 With com.sun.star.form.ListSourceType
1682 Select Case _ControlType
1683 Case CTLCOMBOBOX
1684 If Not ScriptForge.SF_Utils._Validate(pvValue, "ListSourceType", ScriptForge.V_NUMERIC, Array( _
1685 .TABLE _
1686 , .QUERY _
1687 , .SQL _
1688 , .SQLPASSTHROUGH _
1689 , .TABLEFIELDS _
1690 )) Then GoTo Finally
1691 Case CTLLISTBOX
1692 If Not ScriptForge.SF_Utils._Validate(pvValue, "ListSourceType", ScriptForge.V_NUMERIC, Array( _
1693 .VALUELIST _
1694 , .TABLE _
1695 , .QUERY _
1696 , .SQL _
1697 , .SQLPASSTHROUGH _
1698 , .TABLEFIELDS _
1699 )) Then GoTo Finally
1700 Case Else : GoTo CatchType
1701 End Select
1702 End With
1703 If oSession.HasUnoProperty(_ControlModel, "ListSourceType") Then _ControlModel.ListSourceType = pvValue
1705 Select Case _ControlType
1706 Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLIMAGECONTROL _
1707 , CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
1708 If Not ScriptForge.SF_Utils._Validate(pvValue, "Locked", ScriptForge.V_BOOLEAN) Then GoTo Finally
1709 If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _ControlModel.ReadOnly = pvValue
1710 Case Else : GoTo CatchType
1711 End Select
1713 Select Case _ControlType
1714 Case CTLLISTBOX
1715 If Not ScriptForge.SF_Utils._Validate(pvValue, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
1716 If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then _ControlModel.MultiSelection = pvValue
1717 If oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then _ControlModel.MultiSelectionSimpleMode = pvValue
1719 ' Cancel selections when MultiSelect becomes False
1721 lIndex = _ControlModel.SelectedItems(0)
1722 _ControlModel.SelectedItems = Array(lIndex)
1723 End If
1724 End If
1725 Case Else : GoTo CatchType
1726 End Select
1727 Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnApproveAction"), UCase("OnApproveReset"), UCase("OnApproveUpdate") _
1728 , UCase("OnChanged"), UCase("OnErrorOccurred"), UCase("OnFocusGained"), UCase("OnFocusLost") _
1729 , UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
1730 , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
1731 , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted") _
1733 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
1734 If Not IsNull(_ControlModel) Then
1735 bSet = SF_Register._RegisterEventScript(_ControlModel _
1736 , psProperty _
1737 , _GetListener(psProperty) _
1738 , pvValue _
1739 , _Name _
1740 )
1741 End If
1743 Select Case _ControlType
1744 Case CTLBUTTON, CTLIMAGEBUTTON, CTLIMAGECONTROL
1746 If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _ControlModel.ImageURL = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue)
1747 Case Else : GoTo CatchType
1748 End Select
1750 Select Case _ControlType
1751 Case CTLHIDDENCONTROL : GoTo CatchType
1752 Case Else
1753 If Not ScriptForge.SF_Utils._Validate(pvValue, "TipText", V_STRING) Then GoTo Finally
1754 If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _ControlModel.HelpText = pvValue
1755 End Select
1757 Select Case _ControlType
1758 Case CTLCHECKBOX
1759 If Not ScriptForge.SF_Utils._Validate(pvValue, "TripleState", ScriptForge.V_BOOLEAN) Then GoTo Finally
1760 If oSession.HasUnoProperty(_ControlModel, "TriState") Then _ControlModel.TriState = pvValue
1761 Case Else : GoTo CatchType
1762 End Select
1764 Select Case _ControlType
1765 Case CTLBUTTON 'Boolean, toggle buttons only
1766 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
1767 If oSession.HasUnoProperty(_ControlModel, "Toggle") And oSession.HasUnoProperty(_ControlModel, "State") Then
1769 End If
1771 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(ScriptForge.V_BOOLEAN, ScriptForge.V_NUMERIC), Array(0, 1, 2, True, False)) Then GoTo Finally
1774 _ControlModel.State = pvValue
1775 End If
1776 Case CTLCOMBOBOX
1777 If oSession.HasUnoProperty(_ControlModel, "Text") And oSession.HasUnoProperty(_ControlModel, "StringItemList") Then
1778 If pvValue <> "" Then
1779 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING, _ControlModel.StringItemList) Then Goto Finally
1780 End If
1781 _ControlModel.Text = pvValue
1782 End If
1783 Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
1784 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
1785 If oSession.HasUnoProperty(_ControlModel, "Value") Then _ControlModel.Value = pvValue
1786 Case CTLDATEFIELD 'Date
1789 Set vSet = New com.sun.star.util.Date
1790 vSet.Year = Year(pvValue)
1791 vSet.Month = Month(pvValue)
1792 vSet.Day = Day(pvValue)
1793 _ControlModel.Date = vSet
1794 End If
1795 Case CTLFILECONTROL
1797 If oSession.HasUnoProperty(_ControlModel, "Text") Then _ControlModel.Text = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue)
1798 Case CTLFORMATTEDFIELD 'String or numeric
1799 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
1800 If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then _ControlModel.EffectiveValue = pvValue
1801 Case CTLHIDDENCONTROL 'String
1803 If oSession.HasUnoProperty(_ControlModel, "HiddenValue") Then _ControlModel.HiddenValue = pvValue
1804 Case CTLLISTBOX 'String or number - Only a single value may be set
1805 ' StringItemList is the list of the items displayed in the box
1806 ' ValueItemList is the list of the values in the underlying database field
1807 ' SelectedItems is the list of the indexes in StringItemList of the selected items
1808 If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") Then
1809 ' Setting the value on a listbox is allowed only if single value and value in the list
1810 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
1811 ' The list of allowed values depends on the existence of a bound column
1812 If _ListboxBound() Then vList = _ControlModel.ValueItemList Else vList = _ControlModel.StringItemList
1814 _ControlModel.SelectedItems = Array(ScriptForge.SF_Array.IndexOf(vList, pvValue, CaseSensitive := True))
1815 End If
1816 Case CTLPATTERNFIELD, CTLTEXTFIELD 'String
1819 Case CTLRADIOBUTTON 'Boolean
1820 ' A group of radio buttons is presumed sharing the same GroupName
1821 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
1822 If oSession.HasUnoProperty(_ControlModel, "State") Then _ControlModel.State = Iif(pvValue, 1, 0)
1823 Case CTLSCROLLBAR 'Numeric
1824 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
1826 If pvValue < _ControlModel.ScrollValueMin Then pvValue = _ControlModel.ScrollValueMin
1827 End If
1829 If pvValue > _ControlModel.ScrollValueMax Then pvValue = _ControlModel.ScrollValueMax
1830 End If
1831 If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then _ControlModel.ScrollValue = pvValue
1832 Case CTLSPINBUTTON 'Numeric
1833 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
1835 If pvValue < _ControlModel.SpinValueMin Then pvValue = _ControlModel.SpinValueMin
1836 End If
1838 If pvValue > _ControlModel.SpinValueMax Then pvValue = _ControlModel.SpinValueMax
1839 End If
1840 If oSession.HasUnoProperty(_ControlModel, "SpinValue") Then _ControlModel.SpinValue = pvValue
1841 Case CTLTIMEFIELD
1844 Set vSet = New com.sun.star.util.Time
1845 vSet.Hours = Hour(pvValue)
1846 vSet.Minutes = Minute(pvValue)
1847 vSet.Seconds = Second(pvValue)
1848 _ControlModel.Time = vSet
1849 End If
1850 Case Else : GoTo CatchType
1851 End Select
1852 ' FINAL COMMITMENT
1853 If oSession.HasUNOMethod(_ControlModel, "commit") Then _ControlModel.commit() ' f.i. checkboxes have no commit method ??
1855 If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Finally
1857 If pvValue Then _ControlModel.EnableVisible = True
1858 _ControlView.setVisible(pvValue)
1859 End If
1860 Case Else
1861 bSet = False
1862 End Select
1864 Finally:
1865 _PropertySet = bSet
1866 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1867 Exit Function
1868 Catch:
1869 bSet = False
1870 GoTo Finally
1871 CatchType:
1872 If Len(_ParentForm._FormDocumentName) > 0 Then sFormName = _ParentForm._FormDocumentName & "." Else sFormName = ""
1873 ScriptForge.SF_Exception.RaiseFatal(FORMCONTROLTYPEERROR, _Name, sFormName & _FormName, _ControlType, psProperty)
1874 GoTo Finally
1875 End Function ' SFDocuments.SF_FormControl._PropertySet
1877 REM -----------------------------------------------------------------------------
1878 Private Function _Repr() As String
1879 ''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
1880 ''' Args:
1881 ''' Return:
1882 ''' "[FORMCONTROL]: Name, Type (formname)
1883 _Repr = "[FORMCONTROL]: " & _Name & ", " & _ControlType & " (" & _FormName & ")"
1885 End Function ' SFDocuments.SF_FormControl._Repr
1887 REM ============================================ END OF SFDOCUMENTS.SF_FORMCONTROL
1888 </script:module>