| blob | c1f83a03832ac240e1ce096f82b21819f50f4be2 |
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 '''
18 ''' Manage the controls belonging to a form or subform stored in a document
19 ''' Each instance of the current class represents a single control within a form, a subform or a tablecontrol
20 ''' A prerequisite is that all controls within the same form, subform or tablecontrol must have
21 ''' a unique name. This is also true for the individual radio buttons belonging to the same group.
22 ''' A common group name must identify such a single group.
23 '''
24 ''' The focus is clearly set on getting and setting the values displayed by the controls of the form,
25 ''' not on their formatting. The latter is easily accessible via the XControlModel and XControlView
26 ''' UNO objects.
27 ''' Essentially a single property "Value" maps many alternative UNO properties depending each on
28 ''' the control type.
29 '''
30 ''' Service invocations:
31 ''' Dim myForm As Object, myControl As Object
32 ''' Set myForm = ... (read the comments in the SF_Form module)
35 '''
36 ''' REM the control is the subject of an event
37 ''' Sub OnEvent(ByRef poEvent As Object)
38 ''' Dim myControl As Object
39 ''' Set myControl = CreateScriptService("SFDocuments.FormEvent", poEvent)
40 '''
41 ''' Detailed user documentation:
42 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_formcontrol.html?DbPAR=BASIC
43 '''
44 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
46 REM ================================================================== EXCEPTIONS
50 REM ============================================================= PRIVATE MEMBERS
52 Private [Me] As Object
53 Private [_Parent] As Object
54 Private ObjectType As String ' Must be FORMCONTROL
55 Private ServiceName As String
57 ' Control naming and context
58 Private _Name As String
59 Private _IndexOfNames As Long ' Index in ElementNames array. Used to access SF_Form._ControlCache
60 Private _FormName As String ' Parent form name
61 Private _ParentForm As Object ' Parent form or subform instance
62 Private _ParentIsTable As Boolean ' True when parent is a table control
64 ' Control UNO references
65 Private _ControlModel As Object ' com.sun.star.awt.XControlModel
66 Private _ControlView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
68 ' Control attributes
69 Private _ImplementationName As String
70 Private _ControlType As String ' One of the CTLxxx constants
71 Private _ClassId As Integer ' Numerical type of control
73 ' Cache storage for table controls
74 Private _ControlNames As Variant ' Array of control names
75 Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of XControlModel
77 REM ============================================================ MODULE CONSTANTS
79 ' ClassId
103 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
105 REM -----------------------------------------------------------------------------
106 Private Sub Class_Initialize()
107 Set [Me] = Nothing
108 Set [_Parent] = Nothing
111 _Name = ""
112 _IndexOfNames = -1
113 _FormName = ""
114 _ParentIsTable = False
115 Set _ParentForm = Nothing
116 Set _ControlModel = Nothing
117 Set _ControlView = Nothing
118 _ImplementationName = ""
119 _ControlType = ""
120 _ClassId = 0
121 _ControlNames = Array()
122 _ControlCache = Array()
123 End Sub ' SFDocuments.SF_FormControl Constructor
125 REM -----------------------------------------------------------------------------
126 Private Sub Class_Terminate()
127 Call Class_Initialize()
128 End Sub ' SFDocuments.SF_FormControl Destructor
130 REM -----------------------------------------------------------------------------
131 Public Function Dispose() As Variant
132 If Not IsNull([_Parent]) And _IndexOfNames >= 0 Then [_Parent]._ControlCache(_IndexOfNames) = Empty
133 Call Class_Terminate()
134 Set Dispose = Nothing
135 End Function ' SFDocuments.SF_FormControl Explicit Destructor
137 REM ================================================================== PROPERTIES
139 REM -----------------------------------------------------------------------------
140 Property Get Action() As Variant
141 ''' The Action property specifies the action triggered when the button is clicked
142 ''' Accepted values: none, submitForm, resetForm, refreshForm, moveToFirst, moveToLast,
143 ''' moveToNext, moveToPrev, saveRecord, moveToNew, deleteRecord, undoRecord
145 End Property ' SFDocuments.SF_FormControl.Action (get)
147 REM -----------------------------------------------------------------------------
148 Property Let Action(Optional ByVal pvAction As Variant)
149 ''' Set the updatable property Action
151 End Property ' SFDocuments.SF_FormControl.Action (let)
153 REM -----------------------------------------------------------------------------
154 Property Get Caption() As Variant
155 ''' The Caption property refers to the text associated with the control
157 End Property ' SFDocuments.SF_FormControl.Caption (get)
159 REM -----------------------------------------------------------------------------
160 Property Let Caption(Optional ByVal pvCaption As Variant)
161 ''' Set the updatable property Caption
163 End Property ' SFDocuments.SF_FormControl.Caption (let)
165 REM -----------------------------------------------------------------------------
166 Property Get ControlSource() As Variant
167 ''' The ControlSource property specifies the rowset field mapped onto the actual control
169 End Property ' SFDocuments.SF_FormControl.ControlSource (get)
171 REM -----------------------------------------------------------------------------
172 Property Get ControlType() As String
173 ''' Return the type of the actual control: "CheckBox", "TextField", "DateField", ...
175 End Property ' SFDocuments.SF_FormControl.ControlType
177 REM -----------------------------------------------------------------------------
178 Property Get Default() As Variant
179 ''' The Default property specifies whether a command button is the default (OK) button.
181 End Property ' SFDocuments.SF_FormControl.Default (get)
183 REM -----------------------------------------------------------------------------
184 Property Let Default(Optional ByVal pvDefault As Variant)
185 ''' Set the updatable property Default
187 End Property ' SFDocuments.SF_FormControl.Default (let)
189 REM -----------------------------------------------------------------------------
190 Property Get DefaultValue() As Variant
191 ''' The DefaultValue property specifies how the control is initialized in a new record
193 End Property ' SFDocuments.SF_FormControl.DefaultValue (get)
195 REM -----------------------------------------------------------------------------
196 Property Let DefaultValue(Optional ByVal pvDefaultValue As Variant)
197 ''' Set the updatable property DefaultValue
199 End Property ' SFDocuments.SF_FormControl.DefaultValue (let)
201 REM -----------------------------------------------------------------------------
202 Property Get Enabled() As Variant
203 ''' The Enabled property specifies if the control is accessible with the cursor.
205 End Property ' SFDocuments.SF_FormControl.Enabled (get)
207 REM -----------------------------------------------------------------------------
208 Property Let Enabled(Optional ByVal pvEnabled As Variant)
209 ''' Set the updatable property Enabled
211 End Property ' SFDocuments.SF_FormControl.Enabled (let)
213 REM -----------------------------------------------------------------------------
214 Property Get Format() As Variant
215 ''' The Format property specifies the format in which to display dates and times.
217 End Property ' SFDocuments.SF_FormControl.Format (get)
219 REM -----------------------------------------------------------------------------
220 Property Let Format(Optional ByVal pvFormat As Variant)
221 ''' Set the updatable property Format
222 ''' NB: Format is read-only for formatted field controls
224 End Property ' SFDocuments.SF_FormControl.Format (let)
226 REM -----------------------------------------------------------------------------
227 Property Get ListCount() As Long
228 ''' The ListCount property specifies the number of rows in a list box or a combo box
230 End Property ' SFDocuments.SF_FormControl.ListCount (get)
232 REM -----------------------------------------------------------------------------
233 Property Get ListIndex() As Variant
234 ''' The ListIndex property specifies which item is selected in a list box or combo box.
235 ''' In case of multiple selection, the index of the first one is returned or only one is set
237 End Property ' SFDocuments.SF_FormControl.ListIndex (get)
239 REM -----------------------------------------------------------------------------
240 Property Let ListIndex(Optional ByVal pvListIndex As Variant)
241 ''' Set the updatable property ListIndex
243 End Property ' SFDocuments.SF_FormControl.ListIndex (let)
245 REM -----------------------------------------------------------------------------
246 Property Get ListSource() As Variant
247 ''' The ListSource property specifies the data contained in a combobox or a listbox
248 ''' as a zero-based array of string values
250 End Property ' SFDocuments.SF_FormControl.ListSource (get)
252 REM -----------------------------------------------------------------------------
253 Property Let ListSource(Optional ByVal pvListSource As Variant)
254 ''' Set the updatable property ListSource
256 End Property ' SFDocuments.SF_FormControl.ListSource (let)
258 REM -----------------------------------------------------------------------------
259 Property Get ListSourceType() As Variant
260 ''' The ListSourceType property specifies the kind of data source used to fill the list data of a listbox or a combobox
262 End Property ' SFDocuments.SF_FormControl.ListSourceType (get)
264 REM -----------------------------------------------------------------------------
265 Property Let ListSourceType(Optional ByVal pvListSourceType As Variant)
266 ''' Set the updatable property ListSourceType
268 End Property ' SFDocuments.SF_FormControl.ListSourceType (let)
270 REM -----------------------------------------------------------------------------
271 Property Get Locked() As Variant
272 ''' The Locked property specifies if a control is read-only
274 End Property ' SFDocuments.SF_FormControl.Locked (get)
276 REM -----------------------------------------------------------------------------
277 Property Let Locked(Optional ByVal pvLocked As Variant)
278 ''' Set the updatable property Locked
280 End Property ' SFDocuments.SF_FormControl.Locked (let)
282 REM -----------------------------------------------------------------------------
283 Property Get MultiSelect() As Variant
284 ''' The MultiSelect property specifies whether a user can make multiple selections in a listbox
286 End Property ' SFDocuments.SF_FormControl.MultiSelect (get)
288 REM -----------------------------------------------------------------------------
289 Property Let MultiSelect(Optional ByVal pvMultiSelect As Variant)
290 ''' Set the updatable property MultiSelect
292 End Property ' SFDocuments.SF_FormControl.MultiSelect (let)
294 REM -----------------------------------------------------------------------------
295 Property Get Name() As String
296 ''' Return the name of the actual control
298 End Property ' SFDocuments.SF_FormControl.Name
300 REM -----------------------------------------------------------------------------
301 Property Get OnActionPerformed() As Variant
302 ''' Get the script associated with the OnActionPerformed event
304 End Property ' SFDocuments.SF_FormControl.OnActionPerformed (get)
306 REM -----------------------------------------------------------------------------
307 Property Let OnActionPerformed(Optional ByVal pvOnActionPerformed As Variant)
308 ''' Set the updatable property OnActionPerformed
310 End Property ' SFDocuments.SF_FormControl.OnActionPerformed (let)
312 REM -----------------------------------------------------------------------------
313 Property Get OnAdjustmentValueChanged() As Variant
314 ''' Get the script associated with the OnAdjustmentValueChanged event
316 End Property ' SFDocuments.SF_FormControl.OnAdjustmentValueChanged (get)
318 REM -----------------------------------------------------------------------------
319 Property Let OnAdjustmentValueChanged(Optional ByVal pvOnAdjustmentValueChanged As Variant)
320 ''' Set the updatable property OnAdjustmentValueChanged
322 End Property ' SFDocuments.SF_FormControl.OnAdjustmentValueChanged (let)
324 REM -----------------------------------------------------------------------------
325 Property Get OnApproveAction() As Variant
326 ''' Get the script associated with the OnApproveAction event
328 End Property ' SFDocuments.SF_FormControl.OnApproveAction (get)
330 REM -----------------------------------------------------------------------------
331 Property Let OnApproveAction(Optional ByVal pvOnApproveAction As Variant)
332 ''' Set the updatable property OnApproveAction
334 End Property ' SFDocuments.SF_FormControl.OnApproveAction (let)
336 REM -----------------------------------------------------------------------------
337 Property Get OnApproveReset() As Variant
338 ''' Get the script associated with the OnApproveReset event
340 End Property ' SFDocuments.SF_FormControl.OnApproveReset (get)
342 REM -----------------------------------------------------------------------------
343 Property Let OnApproveReset(Optional ByVal pvOnApproveReset As Variant)
344 ''' Set the updatable property OnApproveReset
346 End Property ' SFDocuments.SF_FormControl.OnApproveReset (let)
348 REM -----------------------------------------------------------------------------
349 Property Get OnApproveUpdate() As Variant
350 ''' Get the script associated with the OnApproveUpdate event
352 End Property ' SFDocuments.SF_FormControl.OnApproveUpdate (get)
354 REM -----------------------------------------------------------------------------
355 Property Let OnApproveUpdate(Optional ByVal pvOnApproveUpdate As Variant)
356 ''' Set the updatable property OnApproveUpdate
358 End Property ' SFDocuments.SF_FormControl.OnApproveUpdate (let)
360 REM -----------------------------------------------------------------------------
361 Property Get OnChanged() As Variant
362 ''' Get the script associated with the OnChanged event
364 End Property ' SFDocuments.SF_FormControl.OnChanged (get)
366 REM -----------------------------------------------------------------------------
367 Property Let OnChanged(Optional ByVal pvOnChanged As Variant)
368 ''' Set the updatable property OnChanged
370 End Property ' SFDocuments.SF_FormControl.OnChanged (let)
372 REM -----------------------------------------------------------------------------
373 Property Get OnErrorOccurred() As Variant
374 ''' Get the script associated with the OnErrorOccurred event
376 End Property ' SFDocuments.SF_FormControl.OnErrorOccurred (get)
378 REM -----------------------------------------------------------------------------
379 Property Let OnErrorOccurred(Optional ByVal pvOnErrorOccurred As Variant)
380 ''' Set the updatable property OnErrorOccurred
382 End Property ' SFDocuments.SF_FormControl.OnErrorOccurred (let)
384 REM -----------------------------------------------------------------------------
385 Property Get OnFocusGained() As Variant
386 ''' Get the script associated with the OnFocusGained event
388 End Property ' SFDocuments.SF_FormControl.OnFocusGained (get)
390 REM -----------------------------------------------------------------------------
391 Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant)
392 ''' Set the updatable property OnFocusGained
394 End Property ' SFDocuments.SF_FormControl.OnFocusGained (let)
396 REM -----------------------------------------------------------------------------
397 Property Get OnFocusLost() As Variant
398 ''' Get the script associated with the OnFocusLost event
400 End Property ' SFDocuments.SF_FormControl.OnFocusLost (get)
402 REM -----------------------------------------------------------------------------
403 Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant)
404 ''' Set the updatable property OnFocusLost
406 End Property ' SFDocuments.SF_FormControl.OnFocusLost (let)
408 REM -----------------------------------------------------------------------------
409 Property Get OnItemStateChanged() As Variant
410 ''' Get the script associated with the OnItemStateChanged event
412 End Property ' SFDocuments.SF_FormControl.OnItemStateChanged (get)
414 REM -----------------------------------------------------------------------------
415 Property Let OnItemStateChanged(Optional ByVal pvOnItemStateChanged As Variant)
416 ''' Set the updatable property OnItemStateChanged
418 End Property ' SFDocuments.SF_FormControl.OnItemStateChanged (let)
420 REM -----------------------------------------------------------------------------
421 Property Get OnKeyPressed() As Variant
422 ''' Get the script associated with the OnKeyPressed event
424 End Property ' SFDocuments.SF_FormControl.OnKeyPressed (get)
426 REM -----------------------------------------------------------------------------
427 Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant)
428 ''' Set the updatable property OnKeyPressed
430 End Property ' SFDocuments.SF_FormControl.OnKeyPressed (let)
432 REM -----------------------------------------------------------------------------
433 Property Get OnKeyReleased() As Variant
434 ''' Get the script associated with the OnKeyReleased event
436 End Property ' SFDocuments.SF_FormControl.OnKeyReleased (get)
438 REM -----------------------------------------------------------------------------
439 Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant)
440 ''' Set the updatable property OnKeyReleased
442 End Property ' SFDocuments.SF_FormControl.OnKeyReleased (let)
444 REM -----------------------------------------------------------------------------
445 Property Get OnMouseDragged() As Variant
446 ''' Get the script associated with the OnMouseDragged event
448 End Property ' SFDocuments.SF_FormControl.OnMouseDragged (get)
450 REM -----------------------------------------------------------------------------
451 Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant)
452 ''' Set the updatable property OnMouseDragged
454 End Property ' SFDocuments.SF_FormControl.OnMouseDragged (let)
456 REM -----------------------------------------------------------------------------
457 Property Get OnMouseEntered() As Variant
458 ''' Get the script associated with the OnMouseEntered event
460 End Property ' SFDocuments.SF_FormControl.OnMouseEntered (get)
462 REM -----------------------------------------------------------------------------
463 Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant)
464 ''' Set the updatable property OnMouseEntered
466 End Property ' SFDocuments.SF_FormControl.OnMouseEntered (let)
468 REM -----------------------------------------------------------------------------
469 Property Get OnMouseExited() As Variant
470 ''' Get the script associated with the OnMouseExited event
472 End Property ' SFDocuments.SF_FormControl.OnMouseExited (get)
474 REM -----------------------------------------------------------------------------
475 Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant)
476 ''' Set the updatable property OnMouseExited
478 End Property ' SFDocuments.SF_FormControl.OnMouseExited (let)
480 REM -----------------------------------------------------------------------------
481 Property Get OnMouseMoved() As Variant
482 ''' Get the script associated with the OnMouseMoved event
484 End Property ' SFDocuments.SF_FormControl.OnMouseMoved (get)
486 REM -----------------------------------------------------------------------------
487 Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant)
488 ''' Set the updatable property OnMouseMoved
490 End Property ' SFDocuments.SF_FormControl.OnMouseMoved (let)
492 REM -----------------------------------------------------------------------------
493 Property Get OnMousePressed() As Variant
494 ''' Get the script associated with the OnMousePressed event
496 End Property ' SFDocuments.SF_FormControl.OnMousePressed (get)
498 REM -----------------------------------------------------------------------------
499 Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant)
500 ''' Set the updatable property OnMousePressed
502 End Property ' SFDocuments.SF_FormControl.OnMousePressed (let)
504 REM -----------------------------------------------------------------------------
505 Property Get OnMouseReleased() As Variant
506 ''' Get the script associated with the OnMouseReleased event
508 End Property ' SFDocuments.SF_FormControl.OnMouseReleased (get)
510 REM -----------------------------------------------------------------------------
511 Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant)
512 ''' Set the updatable property OnMouseReleased
514 End Property ' SFDocuments.SF_FormControl.OnMouseReleased (let)
516 REM -----------------------------------------------------------------------------
517 Property Get OnResetted() As Variant
518 ''' Get the script associated with the OnResetted event
520 End Property ' SFDocuments.SF_FormControl.OnResetted (get)
522 REM -----------------------------------------------------------------------------
523 Property Let OnResetted(Optional ByVal pvOnResetted As Variant)
524 ''' Set the updatable property OnResetted
526 End Property ' SFDocuments.SF_FormControl.OnResetted (let)
528 REM -----------------------------------------------------------------------------
529 Property Get OnTextChanged() As Variant
530 ''' Get the script associated with the OnTextChanged event
532 End Property ' SFDocuments.SF_FormControl.OnTextChanged (get)
534 REM -----------------------------------------------------------------------------
535 Property Let OnTextChanged(Optional ByVal pvOnTextChanged As Variant)
536 ''' Set the updatable property OnTextChanged
538 End Property ' SFDocuments.SF_FormControl.OnTextChanged (let)
540 REM -----------------------------------------------------------------------------
541 Property Get OnUpdated() As Variant
542 ''' Get the script associated with the OnUpdated event
544 End Property ' SFDocuments.SF_FormControl.OnUpdated (get)
546 REM -----------------------------------------------------------------------------
547 Property Let OnUpdated(Optional ByVal pvOnUpdated As Variant)
548 ''' Set the updatable property OnUpdated
550 End Property ' SFDocuments.SF_FormControl.OnUpdated (let)
552 REM -----------------------------------------------------------------------------
553 Property Get Parent() As Object
554 ''' Return the Parent form or [table]control object of the actual control
556 End Property ' SFDocuments.SF_FormControl.Parent
558 REM -----------------------------------------------------------------------------
559 Property Get Picture() As Variant
560 ''' The Picture property specifies a bitmap or other type of graphic to be displayed on the specified control
562 End Property ' SFDocuments.SF_FormControl.Picture (get)
564 REM -----------------------------------------------------------------------------
565 Property Let Picture(Optional ByVal pvPicture As Variant)
566 ''' Set the updatable property Picture
568 End Property ' SFDocuments.SF_FormControl.Picture (let)
570 REM -----------------------------------------------------------------------------
571 Property Get Required() As Variant
572 ''' A control is said Required when it must not contain a null value
574 End Property ' SFDocuments.SF_FormControl.Required (get)
576 REM -----------------------------------------------------------------------------
577 Property Let Required(Optional ByVal pvRequired As Variant)
578 ''' Set the updatable property Required
580 End Property ' SFDocuments.SF_FormControl.Required (let)
582 REM -----------------------------------------------------------------------------
583 Property Get Text() As Variant
584 ''' The Text property specifies the actual content of the control like it is displayed on the screen
586 End Property ' SFDocuments.SF_FormControl.Text (get)
588 REM -----------------------------------------------------------------------------
589 Property Get TipText() As Variant
590 ''' The TipText property specifies the text that appears in a screentip when you hold the mouse pointer over a control
592 End Property ' SFDocuments.SF_FormControl.TipText (get)
594 REM -----------------------------------------------------------------------------
595 Property Let TipText(Optional ByVal pvTipText As Variant)
596 ''' Set the updatable property TipText
598 End Property ' SFDocuments.SF_FormControl.TipText (let)
600 REM -----------------------------------------------------------------------------
601 Property Get TripleState() As Variant
602 ''' The TripleState property specifies how a check box will display Null values
603 ''' 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.
604 ''' When False, the control will cycle through states for Yes and No values. Null values display as if they were No values.
606 End Property ' SFDocuments.SF_FormControl.TripleState (get)
608 REM -----------------------------------------------------------------------------
609 Property Let TripleState(Optional ByVal pvTripleState As Variant)
610 ''' Set the updatable property TripleState
612 End Property ' SFDocuments.SF_FormControl.TripleState (let)
614 REM -----------------------------------------------------------------------------
615 Property Get Value() As Variant
616 ''' The Value property specifies the data contained in the control
618 End Property ' SFDocuments.SF_FormControl.Value (get)
620 REM -----------------------------------------------------------------------------
621 Property Let Value(Optional ByVal pvValue As Variant)
622 ''' Set the updatable property Value
624 End Property ' SFDocuments.SF_FormControl.Value (let)
626 REM -----------------------------------------------------------------------------
627 Property Get Visible() As Variant
628 ''' The Visible property specifies if the control is accessible with the cursor.
630 End Property ' SFDocuments.SF_FormControl.Visible (get)
632 REM -----------------------------------------------------------------------------
633 Property Let Visible(Optional ByVal pvVisible As Variant)
634 ''' Set the updatable property Visible
636 End Property ' SFDocuments.SF_FormControl.Visible (let)
638 REM -----------------------------------------------------------------------------
639 Property Get XControlModel() As Object
640 ''' The XControlModel property returns the model UNO object of the control
642 End Property ' SFDocuments.SF_FormControl.XControlModel (get)
644 REM -----------------------------------------------------------------------------
645 Property Get XControlView() As Object
646 ''' The XControlView property returns the view UNO object of the control
648 End Property ' SFDocuments.SF_FormControl.XControlView (get)
650 REM ===================================================================== METHODS
652 REM -----------------------------------------------------------------------------
653 Public Function Controls(Optional ByVal ControlName As Variant) As Variant
654 ''' Return either
655 ''' - the list of the controls contained in the actual table control
656 ''' - a Form Control object based on its name
657 ''' Args:
658 ''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
659 ''' Returns:
660 ''' A zero-base array of strings if ControlName is absent
661 ''' An instance of the SF_FormControl class if ControlName exists
662 ''' Exceptions:
663 ''' ControlName is invalid
664 ''' Example:
665 ''' Dim myGrid As Object, myList As Variant, myControl As Object
667 ''' myList = myGrid.Controls()
670 Dim oControl As Object ' The new control class instance
671 Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache
672 Dim vControl As Variant ' Alias of _ControlCache entry
673 Dim oView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
674 Dim i As Long
678 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
679 Set Controls = Nothing
681 Check:
682 If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
683 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
684 If _ControlType <> CTLTABLECONTROL Then GoTo Catch
685 If Not [_Parent]._IsStillAlive() Then GoTo Finally
686 If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
687 End If
689 Try:
690 ' Collect all control names if not yet done
692 _ControlNames = _ControlModel.getElementNames()
694 ReDim _ControlCache(0 To UBound(_ControlNames))
695 End If
696 End If
698 ' Return the list of controls or a FormControl instance
699 If Len(ControlName) = 0 Then
700 Controls = _ControlNames
702 Else
704 If Not _ControlModel.hasByName(ControlName) Then GoTo CatchNotFound
705 lIndexOfNames = ScriptForge.SF_Array.IndexOf(_ControlNames, ControlName, CaseSensitive := True)
706 ' Reuse cache when relevant
707 vControl = _ControlCache(lIndexOfNames)
709 If IsEmpty(vControl) Then
711 Set oControl = New SF_FormControl
712 With oControl
713 ._Name = ControlName
714 Set .[Me] = oControl
715 Set .[_Parent] = [Me]
716 ._ParentIsTable = True
717 ._IndexOfNames = lIndexOfNames
718 ._FormName = _FormName
719 Set ._ParentForm = _ParentForm
720 ' Get model and view of the current control
721 Set ._ControlModel = _ControlModel.getByName(ControlName)
722 ._ImplementationName = ._ControlModel.ColumnServiceName ' getImplementationName aborts for subcontrols !?
723 ' Bypass to find the control view: cannot be done from the top component
724 If Not IsNull(_ControlView) Then ' Anticipate absence of ControlView in table controls when edit mode
726 Set oView = _ControlView.GetByIndex(i)
727 If Not IsNull(oView) Then
728 If oView.getModel.Name = ControlName Then
729 Set ._ControlView = oView
730 Exit For
731 End If
732 End If
733 Next i
734 End If
735 ._Initialize()
736 End With
737 Else
738 Set oControl = vControl
739 End If
741 Set Controls = oControl
742 End If
744 Finally:
745 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
746 Exit Function
747 Catch:
748 GoTo Finally
749 CatchNotFound:
750 ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _ControlModel.getElementNames(), True)
751 GoTo Finally
752 End Function ' SFDocuments.SF_FormControl.Controls
754 REM -----------------------------------------------------------------------------
755 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
756 ''' Return the actual value of the given property
757 ''' Args:
758 ''' PropertyName: the name of the property as a string
759 ''' Returns:
760 ''' The actual value of the property
761 ''' If the property does not exist, returns Null
762 ''' Exceptions:
763 ''' see the exceptions of the individual properties
764 ''' Examples:
767 Dim vDefault As Variant ' Default value when property not applicable on control type
769 Const cstSubArgs = ""
771 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
772 GetProperty = Null
774 Check:
775 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
776 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
777 End If
779 Try:
780 ' FormControl properties are far from applicable to all control types
781 ' Getting a property must never abort to not interfere with the Basic IDE watch function
782 ' Hence a default value must be provided
783 Select Case UCase(PropertyName)
798 Case Else : vDefault = ""
799 End Select
801 GetProperty = _PropertyGet(PropertyName, vDefault)
803 Finally:
804 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
805 Exit Function
806 Catch:
807 GoTo Finally
808 End Function ' SFDocuments.SF_FormControl.GetProperty
810 REM -----------------------------------------------------------------------------
811 Public Function Methods() As Variant
812 ''' Return the list of public methods of the FormControl service as an array
814 Methods = Array( _
821 )
823 End Function ' SFDocuments.SF_FormControl.Methods
825 REM -----------------------------------------------------------------------------
826 Public Function Properties() As Variant
827 ''' Return the list or properties of the FormControl class as an array
829 Properties = Array( _
877 )
879 End Function ' SFDocuments.SF_FormControl.Properties
881 REM -----------------------------------------------------------------------------
882 Public Function SetFocus() As Boolean
883 ''' Set the focus on the current Control instance
884 ''' Probably called from after an event occurrence
885 ''' Args:
886 ''' Returns:
887 ''' True if focusing is successful
888 ''' Example:
889 ''' Dim oDoc As Object, oForm As Object, oControl As Object
890 ''' Set oDoc = CreateScriptService("SFDocuments.Document", ThisComponent)
893 ''' oControl.SetFocus()
895 Dim bSetFocus As Boolean ' Return value
896 Dim iColPosition As Integer ' Position of control in table
897 Dim oTableModel As Object ' XControlModel of parent table
898 Dim oControl As Object ' com.sun.star.awt.XControlModel
899 Dim i As Integer, j As Integer
901 Const cstSubArgs = ""
903 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
904 bSetFocus = False
906 Check:
907 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
908 If Not _ParentForm._IsStillAlive() Then GoTo Finally
909 End If
911 Try:
912 If Not IsNull(_ControlView) Then
913 If _ParentIsTable Then ' setFocus() method does not work on controlviews in table control ?!?
914 ' Find the column position of the current instance in the parent table control
915 iColPosition = -1
916 Set oTableModel = [_Parent]._ControlModel
917 j = -1
919 Set oControl = oTableModel.getByIndex(i)
921 If oControl.Name = _Name Then
922 iColPosition = j
923 Exit For
924 End If
925 Next i
927 [_Parent]._ControlView.setFocus() 'Set first focus on table control itself
928 [_Parent]._ControlView.setCurrentColumnPosition(iColPosition) 'Deprecated but no alternative found
929 End If
930 Else
931 _ControlView.setFocus()
932 End If
933 bSetFocus = True
934 End If
935 bSetFocus = True
937 Finally:
938 SetFocus = bSetFocus
939 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
940 Exit Function
941 Catch:
942 GoTo Finally
943 End Function ' SFControls.SF_FormControl.SetFocus
945 REM -----------------------------------------------------------------------------
946 Public Function SetProperty(Optional ByVal PropertyName As Variant _
947 , Optional ByRef Value As Variant _
948 ) As Boolean
949 ''' Set a new value to the given property
950 ''' Args:
951 ''' PropertyName: the name of the property as a string
952 ''' Value: its new value
953 ''' Exceptions
954 ''' ARGUMENTERROR The property does not exist
959 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
960 SetProperty = False
962 Check:
963 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
964 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
965 End If
967 Try:
968 SetProperty = _PropertySet(PropertyName, Value)
970 Finally:
971 SF_Utils._ExitFunction(cstThisSub)
972 Exit Function
973 Catch:
974 GoTo Finally
975 End Function ' SFDocuments.SF_FormControl.SetProperty
977 REM =========================================================== PRIVATE FUNCTIONS
979 REM -----------------------------------------------------------------------------
980 Private Function _FormatsList() As Variant
981 ''' Return the allowed format entries as a zero-based array for Date and Time control types
983 Dim vFormats() As Variant ' Return value
985 Select Case _ControlType
986 Case CTLDATEFIELD
987 vFormats = Array( _
1000 )
1001 Case CTLTIMEFIELD
1002 vFormats = Array( _
1007 )
1008 Case Else
1009 vFormats = Array()
1010 End Select
1012 _FormatsList = vFormats
1014 End Function ' SFDocuments.SF_FormControl._FormatsList
1016 REM -----------------------------------------------------------------------------
1017 Public Function _GetEventName(ByVal psProperty As String) As String
1018 ''' Return the LO internal event name derived from the SF property name
1019 ''' The SF property name is not case sensitive, while the LO name is case-sensitive
1020 ' Corrects the typo on ErrorOccur(r?)ed, if necessary
1022 Dim vProperties As Variant ' Array of class properties
1023 Dim sProperty As String ' Correctly cased property name
1025 vProperties = Properties()
1026 sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
1030 End Function ' SFDocuments.SF_FormControl._GetEventName
1032 REM -----------------------------------------------------------------------------
1033 Private Function _GetListener(ByVal psEventName As String) As String
1034 ''' Getting/Setting macros triggered by events requires a Listener-EventName pair
1035 ''' Return the X...Listener corresponding with the event name in argument
1037 Select Case UCase(psEventName)
1060 Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased")
1064 End Select
1066 End Function ' SFDocuments.SF_FormControl._GetListener
1068 REM -----------------------------------------------------------------------------
1069 Public Sub _Initialize()
1070 ''' Complete the object creation process:
1071 ''' - Initialization of private members
1072 ''' - Collection of specific attributes
1073 ''' - Synchronization with parent form instance
1075 Dim vControlTypes As Variant ' Array of control types ordered by the ClassId property of XControlModel - 2
1078 vControlTypes = array( CTLBUTTON _
1079 , CTLRADIOBUTTON _
1080 , CTLIMAGEBUTTON _
1081 , CTLCHECKBOX _
1082 , CTLLISTBOX _
1083 , CTLCOMBOBOX _
1084 , CTLGROUPBOX _
1085 , CTLTEXTFIELD _
1086 , CTLFIXEDTEXT _
1087 , CTLTABLECONTROL _
1088 , CTLFILECONTROL _
1089 , CTLHIDDENCONTROL _
1090 , CTLIMAGECONTROL _
1091 , CTLDATEFIELD _
1092 , CTLTIMEFIELD _
1093 , CTLNUMERICFIELD _
1094 , CTLCURRENCYFIELD _
1095 , CTLPATTERNFIELD _
1096 , CTLSCROLLBAR _
1097 , CTLSPINBUTTON _
1098 , CTLNAVIGATIONBAR _
1099 )
1101 Try:
1102 ' _implementationName is set elsewhere for controls in table control
1103 If Len(_ImplementationName) = 0 Then _ImplementationName = ScriptForge.SF_Session.UnoObjectType(_ControlModel)
1104 _ClassId = _ControlModel.ClassId
1106 ' Identify the control type, ignore subforms and pay attention to formatted fields
1107 If ScriptForge.SF_Session.HasUnoproperty(_ControlModel, "ClassId") Then ' All control types have a ClassId property except subforms
1108 _ControlType = vControlTypes(_ClassId - 2)
1109 ' Formatted fields belong to the TextField family
1110 If _ControlType = CTLTEXTFIELD Then
1112 Or _ImplementationName = "com.sun.star.comp.forms.OFormattedFieldWrapper_ForcedFormatted" _
1113 Or _ImplementationName = "com.sun.star.form.component.FormattedField" Then ' When in table control
1114 _ControlType = CTLFORMATTEDFIELD
1115 End If
1116 End If
1117 Else
1118 Exit Sub ' Ignore subforms, should not happen
1119 End If
1121 With [_Parent]
1122 ' Set control view if not set yet
1123 If IsNull(_ControlView) Then
1124 If _ClassId > 0 And _ClassId <> acHiddenControl Then ' No view on hidden controls
1125 If IsNull(._FormDocument) Then ' Usual document
1126 Set _ControlView = ._Component.CurrentController.getControl(_ControlModel)
1127 Else ' Base form document
1128 Set _ControlView = ._FormDocument.Component.CurrentController.getControl(_ControlModel)
1129 End If
1130 End If
1131 End If
1132 End With
1134 ' Store the SF_FormControl object in the parent cache
1135 Set [_Parent]._ControlCache(_IndexOfNames) = [Me]
1137 Finally:
1138 Exit Sub
1139 End Sub ' SFDocuments.SF_FormControl._Initialize
1141 REM -----------------------------------------------------------------------------
1142 Private Function _ListboxBound() As Boolean
1143 ''' Return True if the actual control, which is a listbox, has a bound column
1144 ''' Called before setting the value of a listbox, i.e. the value to be rewritten in the underlying table data
1145 ''' The existence of a bound column is derived from the comparison between StringItemList and ValueItemList
1146 ''' String ... : the strings displayed in the list box
1147 ''' Value ... : the database values
1148 ''' If they are different, then there is a bound column
1150 Dim bListboxBound As Boolean ' Return value
1151 Dim vValue() As Variant ' Alias of the control model ValueItemList
1152 Dim vString() As Variant ' Alias of the control model StringItemList
1153 Dim i As Long
1155 bListboxBound = False
1157 With _ControlModel
1158 If Not IsNull(.ValueItemList) _
1159 And .DataField <> "" _
1160 And Not IsNull(.BoundField) _
1161 And ScriptForge.SF_Array.Contains(Array( _
1162 com.sun.star.form.ListSourceType.TABLE _
1163 , com.sun.star.form.ListSourceType.QUERY _
1164 , com.sun.star.form.ListSourceType.SQL _
1165 , com.sun.star.form.ListSourceType.SQLPASSTHROUGH _
1166 ), .ListSourceType) Then
1167 If IsArray(.ValueItemList) Then
1168 vValue = .ValueItemList
1169 vString = .StringItemList
1170 For i = 0 To UBound(vValue)
1171 If VarType(vValue(i)) <> VarType(vString(i)) Then
1172 bListboxBound = True
1173 ElseIf vValue(i) <> vString(i) Then
1174 bListboxBound = True
1175 End If
1176 If bListboxBound Then Exit For
1177 Next i
1178 End If
1179 End If
1180 End With
1182 _ListboxBound = bListboxBound
1186 REM -----------------------------------------------------------------------------
1187 Private Function _PropertyGet(Optional ByVal psProperty As String _
1188 , Optional ByVal pvDefault As Variant _
1189 ) As Variant
1190 ''' Return the value of the named property
1191 ''' Args:
1192 ''' psProperty: the name of the property
1193 ''' pvDefault: the value returned when the property is not applicable on the control's type
1194 ''' Getting a non-existing property for a specific control type should
1195 ''' not generate an error to not disrupt the Basic IDE debugger
1197 Dim vGet As Variant ' Return value
1198 Static oSession As Object ' Alias of SF_Session
1199 Dim vSelection As Variant ' Alias of Model.SelectedItems or Model.Selection
1200 Dim vList As Variant ' Alias of Model.StringItemList
1201 Dim lIndex As Long ' Index in StringItemList
1202 Dim sItem As String ' A single item
1203 Dim vDate As Variant ' Date after conversion from com.sun.star.util.Date or com.sun.star.util.Time
1204 Dim vValues As Variant ' Array of listbox values
1205 Dim oControlEvents As Object ' com.sun.star.container.XNameContainer
1206 Dim sEventName As String ' Internal event name
1208 Dim i As Long
1209 Dim cstThisSub As String
1210 Const cstSubArgs = ""
1213 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1215 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1216 If Not _ParentForm._IsStillAlive() Then GoTo Finally
1218 If IsMissing(pvDefault) Or IsEmpty(pvDefault) Then pvDefault = Null
1219 _PropertyGet = pvDefault
1221 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1222 Select Case UCase(psProperty)
1224 Select Case _ControlType
1225 Case CTLBUTTON
1227 Select Case _ControlModel.ButtonType
1231 Case com.sun.star.form.FormButtonType.URL
1233 If Left(_ControlModel.TargetURL, Len(cstUnoUrl)) = cstUnoUrl Then
1234 _PropertyGet = Mid(_ControlModel.TargetURL, Len(cstUnoUrl) + 1)
1239 End If
1240 End Select
1241 End If
1242 Case Else : GoTo CatchType
1243 End Select
1245 Select Case _ControlType
1246 Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
1247 If oSession.HasUNOProperty(_ControlModel, "Label") Then _PropertyGet = _ControlModel.Label
1248 Case Else : GoTo CatchType
1249 End Select
1251 Select Case _ControlType
1252 Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFORMATTEDFIELD, CTLIMAGECONTROL, CTLLISTBOX _
1253 , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLRADIOBUTTON, CTLTEXTFIELD, CTLTIMEFIELD
1254 If oSession.HasUNOProperty(_ControlModel, "DataField") Then _PropertyGet = _ControlModel.DataField
1255 Case Else : GoTo CatchType
1256 End Select
1258 _PropertyGet = _ControlType
1260 Select Case _ControlType
1261 Case CTLBUTTON
1262 If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _PropertyGet = _ControlModel.DefaultButton
1263 Case Else : GoTo CatchType
1264 End Select
1266 Select Case _ControlType
1267 Case CTLCHECKBOX, CTLRADIOBUTTON
1268 If oSession.HasUNOProperty(_ControlModel, "DefaultState") Then _PropertyGet = _ControlModel.DefaultState
1269 Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD
1270 If oSession.HasUNOProperty(_ControlModel, "DefaultText") Then _PropertyGet = _ControlModel.DefaultText
1271 Case CTLCURRENCYFIELD, CTLNUMERICFIELD
1272 If oSession.HasUNOProperty(_ControlModel, "DefaultValue") Then _PropertyGet = _ControlModel.DefaultValue
1273 Case CTLDATEFIELD
1275 If Not IsEmpty(_ControlModel.DefaultDate) Then
1276 With _ControlModel.DefaultDate
1277 vDate = DateSerial(.Year, .Month, .Day)
1278 End With
1279 _PropertyGet = vDate
1280 End If
1281 End If
1282 Case CTLFORMATTEDFIELD
1283 If oSession.HasUNOProperty(_ControlModel, "EffectiveDefault") Then _PropertyGet = _ControlModel.EffectiveDefault
1284 Case CTLLISTBOX
1285 If oSession.HasUNOProperty(_ControlModel, "DefaultSelection") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
1286 vList = _ControlModel.DefaultSelection
1287 If IsArray(vList) Then
1289 lIndex = UBound(_ControlModel.StringItemList)
1290 If vList(0) >= 0 And vList(0) <= lIndex Then _PropertyGet = _ControlModel.StringItemList(vList(0))
1291 ' Only first default value is considered
1292 End If
1293 End If
1294 End If
1295 Case CTLSPINBUTTON
1296 If oSession.HasUNOProperty(_ControlModel, "DefaultSpinValue") Then _PropertyGet = _ControlModel.DefaultSpinValue
1297 Case CTLTIMEFIELD
1299 If Not IsEmpty(_ControlModel.DefaultTime) Then
1300 With _ControlModel.DefaultTime
1301 vDate = TimeSerial(.Hours, .Minutes, .Seconds)
1302 End With
1303 _PropertyGet = vDate
1304 End If
1305 End If
1306 Case Else : GoTo CatchType
1307 End Select
1309 Select Case _ControlType
1310 Case CTLHIDDENCONTROL : GoTo CatchType
1311 Case Else
1312 If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _PropertyGet = _ControlModel.Enabled
1313 End Select
1315 Select Case _ControlType
1316 Case CTLDATEFIELD
1317 If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = _FormatsList()(_ControlModel.DateFormat)
1318 Case CTLTIMEFIELD
1319 If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = _FormatsList()(_ControlModel.TimeFormat)
1320 Case CTLFORMATTEDFIELD
1321 If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") And oSession.HasUNOProperty(_ControlModel, "FormatKey") Then
1322 _PropertyGet = _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString
1323 End If
1324 Case Else : GoTo CatchType
1325 End Select
1327 Select Case _ControlType
1328 Case CTLCOMBOBOX, CTLLISTBOX
1329 If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1
1330 Case Else : GoTo CatchType
1331 End Select
1333 Select Case _ControlType
1334 Case CTLCOMBOBOX
1336 If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
1337 _PropertyGet = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, _ControlModel.Text, CaseSensitive := True)
1338 End If
1339 Case CTLLISTBOX
1341 If oSession.HasUNOProperty(_ControlModel, "SelectedItems") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
1342 vSelection = _ControlModel.SelectedItems
1344 End If
1345 Case Else : GoTo CatchType
1346 End Select
1348 Select Case _ControlType
1349 Case CTLCOMBOBOX, CTLLISTBOX
1351 With com.sun.star.form.ListSourceType
1352 Select Case _ControlModel.ListSourceType
1353 Case .VALUELIST _
1354 , .TABLEFIELDS
1355 If IsArray(_ControlModel.StringItemList) Then vValues = _ControlModel.StringItemList Else vValues = Array(_ControlModel.StringItemList)
1356 Case .TABLE _
1357 , .QUERY _
1358 , .SQL _
1359 , .SQLPASSTHROUGH
1360 If IsArray(_ControlModel.ListSource) Then vValues = _ControlModel.ListSource Else vValues = Array(_ControlModel.ListSource)
1361 End Select
1362 End With
1364 End If
1365 Case Else : GoTo CatchType
1366 End Select
1368 Select Case _ControlType
1369 Case CTLCOMBOBOX, CTLLISTBOX
1370 If oSession.HasUnoProperty(_ControlModel, "ListSourceType") Then _PropertyGet = _ControlModel.ListSourceType
1371 Case Else : GoTo CatchType
1372 End Select
1374 Select Case _ControlType
1375 Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLIMAGECONTROL _
1376 , CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
1377 If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _PropertyGet = _ControlModel.ReadOnly
1378 Case Else : GoTo CatchType
1379 End Select
1381 Select Case _ControlType
1382 Case CTLLISTBOX
1384 _PropertyGet = _ControlModel.MultiSelection
1385 ElseIf oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then ' Not documented: gridcontrols only TBC ??
1386 _PropertyGet = _ControlModel.MultiSelectionSimpleMode
1387 End If
1388 Case Else : GoTo CatchType
1389 End Select
1391 _PropertyGet = _Name
1392 Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnApproveAction"), UCase("OnApproveReset"), UCase("OnApproveUpdate") _
1393 , UCase("OnChanged"), UCase("OnErrorOccurred"), UCase("OnFocusGained"), UCase("OnFocusLost") _
1394 , UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
1395 , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
1396 , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted") _
1398 If IsNull(_ControlModel) Then _PropertyGet = "" Else _PropertyGet = SF_Register._GetEventScriptCode(_ControlModel, psProperty, _Name)
1400 Set _PropertyGet = [_Parent]
1402 Select Case _ControlType
1403 Case CTLBUTTON, CTLIMAGEBUTTON, CTLIMAGECONTROL
1404 If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_ControlModel.ImageURL)
1405 Case Else : GoTo CatchType
1406 End Select
1408 Select Case _ControlType
1409 Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD _
1410 , CTLPATTERNFIELD, CTLRADIOBUTTON, CTLTEXTFIELD, CTLTIMEFIELD
1411 If oSession.HasUnoProperty(_ControlModel, "InputRequired") Then _PropertyGet = _ControlModel.InputRequired
1412 Case Else : GoTo CatchType
1413 End Select
1415 Select Case _ControlType
1416 Case CTLDATEFIELD
1420 If Not IsEmpty(_ControlModel.Date) Then
1421 With _ControlModel.Date
1422 vDate = DateSerial(.Year, .Month, .Day)
1423 End With
1424 _PropertyGet = Format(vDate, _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString)
1425 End If
1426 End If
1427 Case CTLTIMEFIELD
1429 If Not IsEmpty(_ControlModel.Time) Then
1430 With _ControlModel.Time
1431 vDate = TimeSerial(.Hours, .Minutes, .Seconds)
1432 End With
1434 End If
1435 End If
1436 Case CTLCOMBOBOX, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLPATTERNFIELD, CTLTEXTFIELD
1437 If oSession.HasUnoProperty(_ControlModel, "Text") Then _PropertyGet = _ControlModel.Text
1438 Case Else : GoTo CatchType
1439 End Select
1441 Select Case _ControlType
1442 Case CTLHIDDENCONTROL : GoTo CatchType
1443 Case Else
1444 If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _PropertyGet = _ControlModel.HelpText
1445 End Select
1447 Select Case _ControlType
1448 Case CTLCHECKBOX
1449 If oSession.HasUnoProperty(_ControlModel, "TriState") Then _PropertyGet = _ControlModel.TriState
1450 Case Else : GoTo CatchType
1451 End Select
1452 Case UCase("Value") ' Default values are set here by control type, not in the 2nd argument (pvDefault)
1453 vGet = pvDefault
1454 Select Case _ControlType
1455 Case CTLBUTTON 'Boolean, toggle buttons only
1456 vGet = False
1458 If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 )
1459 End If
1461 If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = _ControlModel.State Else vGet = 2
1462 Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String
1463 If oSession.HasUnoProperty(_ControlModel, "Text") Then vGet = _ControlModel.Text Else vGet = ""
1464 Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
1465 If oSession.HasUnoProperty(_ControlModel, "Value") Then vGet = _ControlModel.Value Else vGet = 0
1466 Case CTLDATEFIELD 'Date
1467 vGet = CDate(1)
1469 If VarType(_ControlModel.Date) = ScriptForge.V_OBJECT Then ' com.sun.star.util.Date
1470 With _ControlModel.Date
1471 vDate = DateSerial(.Year, .Month, .Day)
1472 End With
1473 vGet = vDate
1474 Else ' .Date = Empty
1475 End If
1476 End If
1477 Case CTLFORMATTEDFIELD 'String or numeric
1478 If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then vGet = _ControlModel.EffectiveValue Else vGet = ""
1479 Case CTLHIDDENCONTROL 'String
1480 If oSession.HasUnoProperty(_ControlModel, "HiddenValue") Then vGet = _ControlModel.HiddenValue Else vGet = ""
1481 Case CTLLISTBOX 'String or array of strings depending on MultiSelection
1482 ' StringItemList is the list of the items displayed in the box
1483 ' ValueItemList is the list of the values in the underlying database field
1484 ' SelectedItems is the list of the indexes in StringItemList of the selected items
1485 ' It can go beyond the limits of StringItemList
1486 ' It can contain multiple values even if the listbox is not multiselect
1487 If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _
1489 vSelection = _ControlModel.SelectedItems
1490 ' The list of allowed values depends on the existence of a bound column
1491 If _ListBoxBound() Then vList = _ControlModel.ValueItemList Else vList = _ControlModel.StringItemList
1492 If _ControlModel.MultiSelection Then vValues = Array()
1493 For i = 0 To UBound(vSelection)
1494 lIndex = vSelection(i)
1496 If Not _ControlModel.MultiSelection Then
1497 vValues = vList(lIndex)
1498 Exit For
1499 End If
1500 vValues = ScriptForge.SF_Array.Append(vValues, vList(lIndex))
1501 End If
1502 Next i
1503 vGet = vValues
1504 Else
1505 vGet = ""
1506 End If
1507 Case CTLRADIOBUTTON 'Boolean
1508 If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 ) Else vGet = False
1509 Case CTLSCROLLBAR 'Numeric
1510 vGet = 0
1512 If Not IsEmpty(_ControlModel.ScrollValue) Then vGet = _ControlModel.ScrollValue
1513 End If
1514 Case CTLSPINBUTTON
1515 If oSession.HasUnoProperty(_ControlModel, "SpinValue") Then vGet = _ControlModel.SpinValue Else vGet = 0
1516 Case CTLTIMEFIELD
1517 vGet = CDate(0)
1519 If VarType(_ControlModel.Time) = ScriptForge.V_OBJECT Then ' com.sun.star.Util.Time
1520 With _ControlModel.Time
1521 vDate = TimeSerial(.Hours, .Minutes, .Seconds)
1522 End With
1523 vGet = vDate
1524 Else ' .Time = Empty
1525 End If
1526 End If
1527 Case Else : GoTo CatchType
1528 End Select
1529 _PropertyGet = vGet
1531 If oSession.HasUnoMethod(_ControlView, "isVisible") Then _PropertyGet = CBool(_ControlView.isVisible())
1533 Set _PropertyGet = _ControlModel
1535 Set _PropertyGet = _ControlView
1536 Case Else
1537 _PropertyGet = Null
1538 End Select
1540 Finally:
1541 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1542 Exit Function
1543 Catch:
1544 GoTo Finally
1545 CatchType:
1546 GoTo Finally
1547 End Function ' SFDocuments.SF_FormControl._PropertyGet
1549 REM -----------------------------------------------------------------------------
1550 Private Function _PropertySet(Optional ByVal psProperty As String _
1551 , Optional ByVal pvValue As Variant _
1552 ) As Boolean
1553 ''' Set the new value of the named property
1554 ''' Args:
1555 ''' psProperty: the name of the property
1556 ''' pvValue: the new value of the given property
1558 Dim bSet As Boolean ' Return value
1559 Static oSession As Object ' Alias of SF_Session
1560 Dim sFormName As String ' Full form identification for error messages
1561 Dim vSet As Variant ' Value to set in UNO model or view property
1562 Dim vActions As Variant ' Action property: list of available actions
1563 Dim sAction As String ' A single action
1564 Dim vFormats As Variant ' Format property: output of _FormatsList()
1565 Dim iFormat As Integer ' Format property: index in vFormats
1566 Dim vSelection As Variant ' Alias of Model.SelectedItems
1567 Dim vList As Variant ' Alias of Model.StringItemList
1568 Dim lIndex As Long ' Index in StringItemList
1569 Dim sItem As String ' A single item
1570 Dim oDatabase As Object ' The database object related to the parent form of the control instance
1571 Dim i As Long
1572 Dim cstThisSub As String
1575 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1576 bSet = False
1579 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1580 If Not _ParentForm._IsStillAlive() Then GoTo Finally
1582 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1583 bSet = True
1584 Select Case UCase(psProperty)
1586 Select Case _ControlType
1587 Case CTLBUTTON
1588 vActions = Array("none", "submitForm", "resetForm", "refreshForm", "moveToFirst", "moveToLast", "moveToNext", "moveToPrev" _
1589 , "saveRecord", "moveToNew", "deleteRecord", "undoRecord")
1590 If Not ScriptForge.SF_Utils._Validate(pvValue, "Action", ScriptForge.V_STRING, vActions) Then GoTo Finally
1592 sAction = vActions(ScriptForge.SF_Array.IndexOf(vActions, pvValue, CaseSensitive := False))
1593 _ControlModel.TargetURL = ""
1594 Select Case sAction
1598 Case Else
1599 vSet = com.sun.star.form.FormButtonType.URL
1601 End Select
1602 _ControlModel.ButtonType = vSet
1603 End If
1604 Case Else : GoTo CatchType
1605 End Select
1607 Select Case _ControlType
1608 Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
1609 If Not ScriptForge.SF_Utils._Validate(pvValue, "Caption", V_STRING) Then GoTo Finally
1610 If oSession.HasUNOProperty(_ControlModel, "Label") Then _ControlModel.Label = pvValue
1611 Case Else : GoTo CatchType
1612 End Select
1614 Select Case _ControlType
1615 Case CTLBUTTON
1616 If Not ScriptForge.SF_Utils._Validate(pvValue, "Default", ScriptForge.V_BOOLEAN) Then GoTo Finally
1617 If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _ControlModel.DefaultButton = pvValue
1618 Case Else : GoTo CatchType
1619 End Select
1621 Select Case _ControlType
1622 Case CTLHIDDENCONTROL : GoTo CatchType
1623 Case Else
1624 If Not ScriptForge.SF_Utils._Validate(pvValue, "Enabled", ScriptForge.V_BOOLEAN) Then GoTo Finally
1625 If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _ControlModel.Enabled = pvValue
1626 End Select
1628 Select Case _ControlType
1629 Case CTLDATEFIELD, CTLTIMEFIELD
1630 vFormats = _FormatsList()
1631 If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING, vFormats) Then GoTo Finally
1632 iFormat = ScriptForge.SF_Array.IndexOf(vFormats, pvValue, CaseSensitive := False)
1634 _ControlModel.DateFormat = iFormat
1636 _ControlModel.TimeFormat = iFormat
1637 End If
1638 Case Else : GoTo CatchType
1639 End Select
1641 If Not ScriptForge.SF_Utils._Validate(pvValue, "ListIndex", ScriptForge.V_NUMERIC) Then GoTo Finally
1642 Select Case _ControlType
1643 Case CTLCOMBOBOX
1644 If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
1645 If pvValue >= 0 And pvValue <= UBound(_ControlModel.StringItemList) Then _ControlModel.Text = _ControlModel.StringItemList(CInt(pvValue))
1646 End If
1647 Case CTLLISTBOX
1648 If oSession.HasUNOProperty(_ControlModel, "SelectedItems") Then _ControlModel.SelectedItems = Array(CInt(pvValue))
1649 Case Else : GoTo CatchType
1650 End Select
1652 Select Case _ControlType
1653 Case CTLCOMBOBOX, CTLLISTBOX
1655 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
1656 With com.sun.star.form.ListSourceType
1657 Select Case _ControlModel.ListSourceType
1658 Case .QUERY _
1659 , .TABLE _
1660 , .TABLEFIELDS
1661 Set oDatabase = _ParentForm.GetDatabase()
1662 If _ControlModel.ListSourceType = .QUERY Then vList = oDatabase.Queries Else vList = oDatabase.Tables
1663 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING, vList, True) Then Goto Finally
1664 If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = pvValue Else _ControlModel.ListSource = Array(pvValue)
1665 _ControlModel.refresh()
1666 Case .SQL
1667 Set oDatabase = _ParentForm.GetDatabase()
1668 If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = oDatabase._ReplaceSquareBrackets(pvValue) Else _ControlModel.ListSource = Array(oDatabase._ReplaceSquareBrackets(pvValue))
1669 _ControlModel.refresh()
1670 Case .VALUELIST ' ListBox only !
1672 _ControlModel.StringItemList = _ControlModel.ListSource
1673 Case .SQLPASSTHROUGH
1674 If _ControlType = CTLCOMBOBOX Then _ControlModel.ListSource = pvValue Else _ControlModel.ListSource = Array(pvValue)
1675 _ControlModel.refresh()
1676 End Select
1677 End With
1678 End If
1679 Case Else : GoTo CatchType
1680 End Select
1682 With com.sun.star.form.ListSourceType
1683 Select Case _ControlType
1684 Case CTLCOMBOBOX
1685 If Not ScriptForge.SF_Utils._Validate(pvValue, "ListSourceType", ScriptForge.V_NUMERIC, Array( _
1686 .TABLE _
1687 , .QUERY _
1688 , .SQL _
1689 , .SQLPASSTHROUGH _
1690 , .TABLEFIELDS _
1691 )) Then GoTo Finally
1692 Case CTLLISTBOX
1693 If Not ScriptForge.SF_Utils._Validate(pvValue, "ListSourceType", ScriptForge.V_NUMERIC, Array( _
1694 .VALUELIST _
1695 , .TABLE _
1696 , .QUERY _
1697 , .SQL _
1698 , .SQLPASSTHROUGH _
1699 , .TABLEFIELDS _
1700 )) Then GoTo Finally
1701 Case Else : GoTo CatchType
1702 End Select
1703 End With
1704 If oSession.HasUnoProperty(_ControlModel, "ListSourceType") Then _ControlModel.ListSourceType = pvValue
1706 Select Case _ControlType
1707 Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLIMAGECONTROL _
1708 , CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
1709 If Not ScriptForge.SF_Utils._Validate(pvValue, "Locked", ScriptForge.V_BOOLEAN) Then GoTo Finally
1710 If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _ControlModel.ReadOnly = pvValue
1711 Case Else : GoTo CatchType
1712 End Select
1714 Select Case _ControlType
1715 Case CTLLISTBOX
1716 If Not ScriptForge.SF_Utils._Validate(pvValue, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
1717 If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then _ControlModel.MultiSelection = pvValue
1718 If oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then _ControlModel.MultiSelectionSimpleMode = pvValue
1720 ' Cancel selections when MultiSelect becomes False
1722 lIndex = _ControlModel.SelectedItems(0)
1723 _ControlModel.SelectedItems = Array(lIndex)
1724 End If
1725 End If
1726 Case Else : GoTo CatchType
1727 End Select
1728 Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnApproveAction"), UCase("OnApproveReset"), UCase("OnApproveUpdate") _
1729 , UCase("OnChanged"), UCase("OnErrorOccurred"), UCase("OnFocusGained"), UCase("OnFocusLost") _
1730 , UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
1731 , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
1732 , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted") _
1734 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
1735 If Not IsNull(_ControlModel) Then
1736 bSet = SF_Register._RegisterEventScript(_ControlModel _
1737 , psProperty _
1738 , _GetListener(psProperty) _
1739 , pvValue _
1740 , _Name _
1741 )
1742 End If
1744 Select Case _ControlType
1745 Case CTLBUTTON, CTLIMAGEBUTTON, CTLIMAGECONTROL
1747 If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _ControlModel.ImageURL = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue)
1748 Case Else : GoTo CatchType
1749 End Select
1751 Select Case _ControlType
1752 Case CTLHIDDENCONTROL : GoTo CatchType
1753 Case Else
1754 If Not ScriptForge.SF_Utils._Validate(pvValue, "TipText", V_STRING) Then GoTo Finally
1755 If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _ControlModel.HelpText = pvValue
1756 End Select
1758 Select Case _ControlType
1759 Case CTLCHECKBOX
1760 If Not ScriptForge.SF_Utils._Validate(pvValue, "TripleState", ScriptForge.V_BOOLEAN) Then GoTo Finally
1761 If oSession.HasUnoProperty(_ControlModel, "TriState") Then _ControlModel.TriState = pvValue
1762 Case Else : GoTo CatchType
1763 End Select
1765 Select Case _ControlType
1766 Case CTLBUTTON 'Boolean, toggle buttons only
1767 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
1768 If oSession.HasUnoProperty(_ControlModel, "Toggle") And oSession.HasUnoProperty(_ControlModel, "State") Then
1770 End If
1772 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(ScriptForge.V_BOOLEAN, ScriptForge.V_NUMERIC), Array(0, 1, 2, True, False)) Then GoTo Finally
1775 _ControlModel.State = pvValue
1776 End If
1777 Case CTLCOMBOBOX
1778 If oSession.HasUnoProperty(_ControlModel, "Text") And oSession.HasUnoProperty(_ControlModel, "StringItemList") Then
1779 If pvValue <> "" Then
1780 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING, _ControlModel.StringItemList, True) Then Goto Finally
1781 End If
1782 _ControlModel.Text = pvValue
1783 End If
1784 Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
1785 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
1786 If oSession.HasUnoProperty(_ControlModel, "Value") Then _ControlModel.Value = pvValue
1787 Case CTLDATEFIELD 'Date
1790 Set vSet = New com.sun.star.util.Date
1791 vSet.Year = Year(pvValue)
1792 vSet.Month = Month(pvValue)
1793 vSet.Day = Day(pvValue)
1794 _ControlModel.Date = vSet
1795 End If
1796 Case CTLFILECONTROL
1798 If oSession.HasUnoProperty(_ControlModel, "Text") Then _ControlModel.Text = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue)
1799 Case CTLFORMATTEDFIELD 'String or numeric
1800 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
1801 If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then _ControlModel.EffectiveValue = pvValue
1802 Case CTLHIDDENCONTROL 'String
1804 If oSession.HasUnoProperty(_ControlModel, "HiddenValue") Then _ControlModel.HiddenValue = pvValue
1805 Case CTLLISTBOX 'String or number - Only a single value may be set
1806 ' StringItemList is the list of the items displayed in the box
1807 ' ValueItemList is the list of the values in the underlying database field
1808 ' SelectedItems is the list of the indexes in StringItemList of the selected items
1809 If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") Then
1810 ' Setting the value on a listbox is allowed only if single value and value in the list
1811 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
1812 ' The list of allowed values depends on the existence of a bound column
1813 If _ListboxBound() Then vList = _ControlModel.ValueItemList Else vList = _ControlModel.StringItemList
1815 _ControlModel.SelectedItems = Array(ScriptForge.SF_Array.IndexOf(vList, pvValue, CaseSensitive := True))
1816 End If
1817 Case CTLPATTERNFIELD, CTLTEXTFIELD 'String
1820 Case CTLRADIOBUTTON 'Boolean
1821 ' A group of radio buttons is presumed sharing the same GroupName
1822 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
1823 If oSession.HasUnoProperty(_ControlModel, "State") Then _ControlModel.State = Iif(pvValue, 1, 0)
1824 Case CTLSCROLLBAR 'Numeric
1825 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
1827 If pvValue < _ControlModel.ScrollValueMin Then pvValue = _ControlModel.ScrollValueMin
1828 End If
1830 If pvValue > _ControlModel.ScrollValueMax Then pvValue = _ControlModel.ScrollValueMax
1831 End If
1832 If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then _ControlModel.ScrollValue = pvValue
1833 Case CTLSPINBUTTON 'Numeric
1834 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
1836 If pvValue < _ControlModel.SpinValueMin Then pvValue = _ControlModel.SpinValueMin
1837 End If
1839 If pvValue > _ControlModel.SpinValueMax Then pvValue = _ControlModel.SpinValueMax
1840 End If
1841 If oSession.HasUnoProperty(_ControlModel, "SpinValue") Then _ControlModel.SpinValue = pvValue
1842 Case CTLTIMEFIELD
1845 Set vSet = New com.sun.star.util.Time
1846 vSet.Hours = Hour(pvValue)
1847 vSet.Minutes = Minute(pvValue)
1848 vSet.Seconds = Second(pvValue)
1849 _ControlModel.Time = vSet
1850 End If
1851 Case Else : GoTo CatchType
1852 End Select
1853 ' FINAL COMMITMENT
1854 If oSession.HasUNOMethod(_ControlModel, "commit") Then _ControlModel.commit() ' f.i. checkboxes have no commit method ??
1856 If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Finally
1858 If pvValue Then _ControlModel.EnableVisible = True
1859 _ControlView.setVisible(pvValue)
1860 End If
1861 Case Else
1862 bSet = False
1863 End Select
1865 Finally:
1866 _PropertySet = bSet
1867 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1868 Exit Function
1869 Catch:
1870 bSet = False
1871 GoTo Finally
1872 CatchType:
1873 If Len(_ParentForm._FormDocumentName) > 0 Then sFormName = _ParentForm._FormDocumentName & "." Else sFormName = ""
1874 ScriptForge.SF_Exception.RaiseFatal(FORMCONTROLTYPEERROR, _Name, sFormName & _FormName, _ControlType, psProperty)
1875 GoTo Finally
1876 End Function ' SFDocuments.SF_FormControl._PropertySet
1878 REM -----------------------------------------------------------------------------
1879 Private Function _Repr() As String
1880 ''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
1881 ''' Args:
1882 ''' Return:
1883 ''' "[FORMCONTROL]: Name, Type (formname)
1884 _Repr = "[FORMCONTROL]: " & _Name & ", " & _ControlType & " (" & _FormName & ")"
1886 End Function ' SFDocuments.SF_FormControl._Repr
1888 REM ============================================ END OF SFDOCUMENTS.SF_FORMCONTROL
1889 </script:module>