?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
bump product version to 5.0.4.1
[LibreOffice.git] / wizards / source / access2base / Control.xba
blobd150c879ab4c649dc518bb49ffc067bdefc41122
1 <?xml version="1.0" encoding="UTF-8"?>
2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Control" script:language="StarBasic">REM =======================================================================================================================
4 REM === The Access2Base library is a part of the LibreOffice project. ===
5 REM === Full documentation is available on http://www.access2base.com ===
6 REM =======================================================================================================================
7
8 Option Compatible
9 Option ClassModule
10
11 Option Explicit
12
13 REM -----------------------------------------------------------------------------------------------------------------------
14 REM --- CLASS ROOT FIELDS ---
15 REM -----------------------------------------------------------------------------------------------------------------------
16
17 Private _Type As String &apos; Must be CONTROL
18 Private _ImplementationName As String
19 Private _ClassId As Integer
20 Private _ParentType As String &apos; One of CTLPARENTISxxxx constants
21 Private _Shortcut As String
22 Private _Name As String
23 Private _FormComponent As Object &apos; com.sun.star.text.TextDocument
24 Private _DocEntry As Integer &apos; Doc- and DbContainer entries in Root structure
25 Private _DbEntry As Integer
26 Private _ControlType As Integer
27 Private _SubType As String
28 Private ControlModel As Object &apos; com.sun.star.comp.forms.XXXModel
29 Private ControlView As Object &apos; com.sun.star.comp.forms.XXXControl
30 Private BoundField As Object &apos; com.sun.star.sdb.ODataColumn
31 Private LabelControl As Object &apos; com.sun.star.form.component.FixedText or com.sun.star.form.component.GroupBox
32
33 REM -----------------------------------------------------------------------------------------------------------------------
34 REM --- CONSTRUCTORS / DESTRUCTORS ---
35 REM -----------------------------------------------------------------------------------------------------------------------
36 Private Sub Class_Initialize()
37 _Type = OBJCONTROL
38 _ClassId = -1
39 _ParentType = &quot;&quot;
40 _Shortcut = &quot;&quot;
41 _Name = &quot;&quot;
42 Set _FormComponent = Nothing
43 _DocEntry = -1
44 _DbEntry = -1
45 _SubType = &quot;&quot;
46 Set ControlModel = Nothing
47 Set ControlView = Nothing
48 Set BoundField = Nothing
49 Set LabelControl = Nothing
50
51 End Sub &apos; Constructor
52
53 REM -----------------------------------------------------------------------------------------------------------------------
54 Private Sub Class_Terminate()
55 On Local Error Resume Next
56 Call Class_Initialize()
57 End Sub &apos; Destructor
58
59 REM -----------------------------------------------------------------------------------------------------------------------
60 Public Sub Dispose()
61 Call Class_Terminate()
62 End Sub &apos; Explicit destructor
63
64 REM -----------------------------------------------------------------------------------------------------------------------
65 REM --- CLASS GET/LET/SET PROPERTIES ---
66 REM -----------------------------------------------------------------------------------------------------------------------
67
68 Property Get BackColor() As Variant
69 BackColor = _PropertyGet(&quot;BackColor&quot;)
70 End Property &apos; BackColor (get)
71
72 Property Let BackColor(ByVal pvValue As Variant)
73 Call _PropertySet(&quot;BackColor&quot;, pvValue)
74 End Property &apos; BackColor (set)
75
76 REM -----------------------------------------------------------------------------------------------------------------------
77 Property Get BorderColor() As Variant
78 BorderColor = _PropertyGet(&quot;BorderColor&quot;)
79 End Property &apos; BorderColor (get)
80
81 Property Let BorderColor(ByVal pvValue As Variant)
82 Call _PropertySet(&quot;BorderColor&quot;, pvValue)
83 End Property &apos; BorderColor (set)
84
85 REM -----------------------------------------------------------------------------------------------------------------------
86 Property Get BorderStyle() As Variant
87 BorderStyle = _PropertyGet(&quot;BorderStyle&quot;)
88 End Property &apos; BorderStyle (get)
89
90 Property Let BorderStyle(ByVal pvValue As Variant)
91 Call _PropertySet(&quot;BorderStyle&quot;, pvValue)
92 End Property &apos; BorderStyle (set)
93
94 REM -----------------------------------------------------------------------------------------------------------------------
95 Property Get Cancel() As Variant
96 Cancel = _PropertyGet(&quot;Cancel&quot;)
97 End Property &apos; Cancel (get)
98
99 Property Let Cancel(ByVal pvValue As Variant)
100 Call _PropertySet(&quot;Cancel&quot;, pvValue)
101 End Property &apos; Cancel (set)
102
103 REM -----------------------------------------------------------------------------------------------------------------------
104 Property Get Caption() As Variant
105 Caption = _PropertyGet(&quot;Caption&quot;)
106 End Property &apos; Caption (get)
107
108 Property Let Caption(ByVal pvValue As Variant)
109 Call _PropertySet(&quot;Caption&quot;, pvValue)
110 End Property &apos; Caption (set)
111
112 REM -----------------------------------------------------------------------------------------------------------------------
113 Property Get ControlSource() As Variant
114 ControlSource = _PropertyGet(&quot;ControlSource&quot;)
115 End Property &apos; ControlSource (get)
116
117 REM -----------------------------------------------------------------------------------------------------------------------
118 Property Get ControlTipText() As Variant
119 ControlTipText = _PropertyGet(&quot;ControlTipText&quot;)
120 End Property &apos; ControlTipText (get)
121
122 Property Let ControlTipText(ByVal pvValue As Variant)
123 Call _PropertySet(&quot;ControlTipText&quot;, pvValue)
124 End Property &apos; ControlTipText (set)
125
126 REM -----------------------------------------------------------------------------------------------------------------------
127 Property Get ControlType() As Variant
128 ControlType = _PropertyGet(&quot;ControlType&quot;)
129 End Property &apos; ControlType (get)
130
131 REM -----------------------------------------------------------------------------------------------------------------------
132 Property Get Default() As Variant
133 Default = _PropertyGet(&quot;Default&quot;)
134 End Property &apos; Default (get)
135
136 Property Let Default(ByVal pvValue As Variant)
137 Call _PropertySet(&quot;Default&quot;, pvValue)
138 End Property &apos; Default (set)
139
140 REM -----------------------------------------------------------------------------------------------------------------------
141 Property Get DefaultValue() As Variant
142 DefaultValue = _PropertyGet(&quot;DefaultValue&quot;)
143 End Property &apos; DefaultValue (get)
144
145 Property Let DefaultValue(ByVal pvValue As Variant)
146 Call _PropertySet(&quot;DefaultValue&quot;, pvValue)
147 End Property &apos; DefaultValue (set)
148
149 REM -----------------------------------------------------------------------------------------------------------------------
150 Property Get Enabled() As Variant
151 Enabled = _PropertyGet(&quot;Enabled&quot;)
152 End Property &apos; Enabled (get)
153
154 Property Let Enabled(ByVal pvValue As Variant)
155 Call _PropertySet(&quot;Enabled&quot;, pvValue)
156 End Property &apos; Enabled (set)
157
158 REM -----------------------------------------------------------------------------------------------------------------------
159 Property Get FontBold() As Variant
160 FontBold = _PropertyGet(&quot;FontBold&quot;)
161 End Property &apos; FontBold (get)
162
163 Property Let FontBold(ByVal pvValue As Variant)
164 Call _PropertySet(&quot;FontBold&quot;, pvValue)
165 End Property &apos; FontBold (set)
166
167 REM -----------------------------------------------------------------------------------------------------------------------
168 Property Get FontItalic() As Variant
169 FontItalic = _PropertyGet(&quot;FontItalic&quot;)
170 End Property &apos; FontItalic (get)
171
172 Property Let FontItalic(ByVal pvValue As Variant)
173 Call _PropertySet(&quot;FontItalic&quot;, pvValue)
174 End Property &apos; FontItalic (set)
175
176 REM -----------------------------------------------------------------------------------------------------------------------
177 Property Get FontName() As Variant
178 FontName = _PropertyGet(&quot;FontName&quot;)
179 End Property &apos; FontName (get)
180
181 Property Let FontName(ByVal pvValue As Variant)
182 Call _PropertySet(&quot;FontName&quot;, pvValue)
183 End Property &apos; FontName (set)
184
185 REM -----------------------------------------------------------------------------------------------------------------------
186 Property Get FontSize() As Variant
187 FontSize = _PropertyGet(&quot;FontSize&quot;)
188 End Property &apos; FontSize (get)
189
190 Property Let FontSize(ByVal pvValue As Variant)
191 Call _PropertySet(&quot;FontSize&quot;, pvValue)
192 End Property &apos; FontSize (set)
193
194 REM -----------------------------------------------------------------------------------------------------------------------
195 Property Get FontUnderline() As Variant
196 FontUnderline = _PropertyGet(&quot;FontUnderline&quot;)
197 End Property &apos; FontUnderline (get)
198
199 Property Let FontUnderline(ByVal pvValue As Variant)
200 Call _PropertySet(&quot;FontUnderline&quot;, pvValue)
201 End Property &apos; FontUnderline (set)
202
203 REM -----------------------------------------------------------------------------------------------------------------------
204 Property Get FontWeight() As Variant
205 FontWeight = _PropertyGet(&quot;FontWeight&quot;)
206 End Property &apos; FontWeight (get)
207
208 Property Let FontWeight(ByVal pvValue As Variant)
209 Call _PropertySet(&quot;FontWeight&quot;, pvValue)
210 End Property &apos; FontWeight (set)
211
212 REM -----------------------------------------------------------------------------------------------------------------------
213 Property Get ForeColor() As Variant
214 ForeColor = _PropertyGet(&quot;ForeColor&quot;)
215 End Property &apos; ForeColor (get)
216
217 Property Let ForeColor(ByVal pvValue As Variant)
218 Call _PropertySet(&quot;ForeColor&quot;, pvValue)
219 End Property &apos; ForeColor (set)
220
221 REM -----------------------------------------------------------------------------------------------------------------------
222 Property Get Form() As Variant
223 Form = _PropertyGet(&quot;Form&quot;)
224 End Property &apos; Form (get)
225
226 REM -----------------------------------------------------------------------------------------------------------------------
227 Property Get Format() As Variant
228 Format = _PropertyGet(&quot;Format&quot;)
229 End Property &apos; Format (get)
230
231 Property Let Format(ByVal pvValue As Variant)
232 Call _PropertySet(&quot;Format&quot;, pvValue)
233 End Property &apos; Format (set)
234
235 REM -----------------------------------------------------------------------------------------------------------------------
236 Property Get ItemData(ByVal Optional pvIndex As Variant) As Variant
237 If IsMissing(pvIndex) Then ItemData = _PropertyGet(&quot;ItemData&quot;) Else ItemData = _PropertyGet(&quot;ItemData&quot;, pvIndex)
238 End Property &apos; ItemData (get)
239
240 REM -----------------------------------------------------------------------------------------------------------------------
241 Property Get ListCount() As Variant
242 ListCount = _PropertyGet(&quot;ListCount&quot;)
243 End Property &apos; ListCount (get)
244
245 REM -----------------------------------------------------------------------------------------------------------------------
246 Property Get ListIndex() As Variant
247 ListIndex = _PropertyGet(&quot;ListIndex&quot;)
248 End Property &apos; ListIndex (get)
249
250 Property Let ListIndex(ByVal pvValue As Variant)
251 Call _PropertySet(&quot;ListIndex&quot;, pvValue)
252 End Property &apos; ListIndex (set)
253
254 REM -----------------------------------------------------------------------------------------------------------------------
255 Property Get Locked() As Variant
256 Locked = _PropertyGet(&quot;Locked&quot;)
257 End Property &apos; Locked (get)
258
259 Property Let Locked(ByVal pvValue As Variant)
260 Call _PropertySet(&quot;Locked&quot;, pvValue)
261 End Property &apos; Locked (set)
262
263 REM -----------------------------------------------------------------------------------------------------------------------
264 Property Get MultiSelect() As Variant
265 MultiSelect = _PropertyGet(&quot;MultiSelect&quot;)
266 End Property &apos; MultiSelect (get)
267
268 Property Let MultiSelect(ByVal pvValue As Variant)
269 Call _PropertySet(&quot;MultiSelect&quot;, pvValue)
270 End Property &apos; MultiSelect (set)
271
272 REM -----------------------------------------------------------------------------------------------------------------------
273 Property Get Name() As String
274 Name = _PropertyGet(&quot;Name&quot;)
275 End Property &apos; Name (get)
276
277 Public Function pName() As String &apos; For compatibility with &lt; V0.9.0
278 pName = _PropertyGet(&quot;Name&quot;)
279 End Function &apos; pName (get)
280
281 REM -----------------------------------------------------------------------------------------------------------------------
282 Property Get ObjectType() As String
283 ObjectType = _PropertyGet(&quot;ObjectType&quot;)
284 End Property &apos; ObjectType (get)
285
286 REM -----------------------------------------------------------------------------------------------------------------------
287 Property Get OptionValue() As Variant
288 OptionValue = _PropertyGet(&quot;OptionValue&quot;)
289 End Property &apos; OptionValue (get)
290
291 Property Let OptionValue(ByVal pvValue As Variant)
292 Call _PropertySet(&quot;OptionValue&quot;, pvValue)
293 End Property &apos; OptionValue (set)
294
295 REM -----------------------------------------------------------------------------------------------------------------------
296 Property Get Page() As Variant
297 Page = _PropertyGet(&quot;Page&quot;)
298 End Property &apos; Page (get)
299
300 Property Let Page(ByVal pvValue As Variant)
301 Call _PropertySet(&quot;Page&quot;, pvValue)
302 End Property &apos; Page (set)
303
304 REM -----------------------------------------------------------------------------------------------------------------------
305 Public Function Parent() As Object
306 Parent = _PropertyGet(&quot;Parent&quot;)
307 End Function &apos; Parent (get) V0.9.1
308
309 REM -----------------------------------------------------------------------------------------------------------------------
310 Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
311 &apos; Return
312 &apos; a Collection object if pvIndex absent
313 &apos; a Property object otherwise
314
315 Utils._SetCalledSub(&quot;Control.Properties&quot;)
316 Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
317 vPropertiesList = _PropertiesList()
318 sObject = Utils._PCase(_Type)
319 If IsMissing(pvIndex) Then
320 vProperty = PropertiesGet._Properties(sObject, _Shortcut, vPropertiesList)
321 Else
322 vProperty = PropertiesGet._Properties(sObject, _Shortcut, vPropertiesList, pvIndex)
323 vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
324 End If
325
326 Exit_Function:
327 Set Properties = vProperty
328 Utils._ResetCalledSub(&quot;Control.Properties&quot;)
329 Exit Function
330 End Function &apos; Properties
331
332 REM -----------------------------------------------------------------------------------------------------------------------
333 Property Get Required() As Variant
334 Required = _PropertyGet(&quot;Required&quot;)
335 End Property &apos; Required (get)
336
337 Property Let Required(ByVal pvValue As Variant)
338 Call _PropertySet(&quot;Required&quot;, pvValue)
339 End Property &apos; Required (set)
340
341 REM -----------------------------------------------------------------------------------------------------------------------
342 Property Get RowSource() As Variant
343 RowSource = _PropertyGet(&quot;RowSource&quot;)
344 End Property &apos; RowSource (get)
345
346 Property Let RowSource(ByVal pvValue As Variant)
347 Call _PropertySet(&quot;RowSource&quot;, pvValue)
348 End Property &apos; RowSource (set)
349
350 REM -----------------------------------------------------------------------------------------------------------------------
351 Property Get RowSourceType() As Variant
352 RowSourceType = _PropertyGet(&quot;RowSourceType&quot;)
353 End Property &apos; RowSourceType (get)
354
355 Property Let RowSourceType(ByVal pvValue As Variant)
356 Call _PropertySet(&quot;RowSourceType&quot;, pvValue)
357 End Property &apos; RowSourceType (set)
358
359 REM -----------------------------------------------------------------------------------------------------------------------
360 Property Get Selected(ByVal Optional pvIndex As Variant) As Variant
361 If IsMissing(pvIndex) Then Selected = _PropertyGet(&quot;Selected&quot;) Else Selected = _PropertyGet(&quot;Selected&quot;, pvIndex)
362 End Property &apos; Selected (get)
363
364 Property Let Selected(ByVal pvValue As Variant) &apos; , ByVal Optional pvIndex As Variant)
365 &apos; If IsMissing(pvIndex) Then Call _PropertySet(&quot;Selected&quot;, pvValue) Else Call _PropertySet(&quot;Selected&quot;, pvValue, pvIndex)
366 Call _PropertySet(&quot;Selected&quot;, pvValue)
367 End Property &apos; Selected (set)
368
369 Public Function SelectedI(ByVal pvValue As variant, ByVal pvIndex As Variant)
370 Call _PropertySet(&quot;Selected&quot;, pvValue, pvIndex)
371 End Function
372
373 REM -----------------------------------------------------------------------------------------------------------------------
374 Property Get SelLength() As Variant
375 SelLength = _PropertyGet(&quot;SelLength&quot;)
376 End Property &apos; SelLength (get)
377
378 Property Let SelLength(ByVal pvValue As Variant)
379 Call _PropertySet(&quot;SelLength&quot;, pvValue)
380 End Property &apos; SelLength (set)
381
382 REM -----------------------------------------------------------------------------------------------------------------------
383 Property Get SelStart() As Variant
384 SelStart = _PropertyGet(&quot;SelStart&quot;)
385 End Property &apos; SelStart (get)
386
387 Property Let SelStart(ByVal pvValue As Variant)
388 Call _PropertySet(&quot;SelStart&quot;, pvValue)
389 End Property &apos; SelStart (set)
390
391 REM -----------------------------------------------------------------------------------------------------------------------
392 Property Get SelText() As Variant
393 SelText = _PropertyGet(&quot;SelText&quot;)
394 End Property &apos; SelText (get)
395
396 Property Let SelText(ByVal pvValue As Variant)
397 Call _PropertySet(&quot;SelText&quot;, pvValue)
398 End Property &apos; SelText (set)
399
400 REM -----------------------------------------------------------------------------------------------------------------------
401 Property Get SpecialEffect() As Variant
402 SpecialEffect = _PropertyGet(&quot;SpecialEffect&quot;)
403 End Property &apos; SpecialEffect (get)
404
405 Property Let SpecialEffect(ByVal pvValue As Variant)
406 Call _PropertySet(&quot;SpecialEffect&quot;, pvValue)
407 End Property &apos; SpecialEffect (set)
408
409 REM -----------------------------------------------------------------------------------------------------------------------
410 Property Get SubType() As Variant
411 SubType = _PropertyGet(&quot;SubType&quot;)
412 End Property &apos; SubType (get)
413
414 REM -----------------------------------------------------------------------------------------------------------------------
415 Property Get TabIndex() As Variant
416 TabIndex = _PropertyGet(&quot;TabIndex&quot;)
417 End Property &apos; TabIndex (get)
418
419 Property Let TabIndex(ByVal pvValue As Variant)
420 Call _PropertySet(&quot;TabIndex&quot;, pvValue)
421 End Property &apos; TabIndex (set)
422
423 REM -----------------------------------------------------------------------------------------------------------------------
424 Property Get TabStop() As Variant
425 TabStop = _PropertyGet(&quot;TabStop&quot;)
426 End Property &apos; TabStop (get)
427
428 Property Let TabStop(ByVal pvValue As Variant)
429 Call _PropertySet(&quot;TabStop&quot;, pvValue)
430 End Property &apos; TabStop (set)
431
432 REM -----------------------------------------------------------------------------------------------------------------------
433 Property Get Tag() As Variant
434 Tag = _PropertyGet(&quot;Tag&quot;)
435 End Property &apos; Tag (get)
436
437 Property Let Tag(ByVal pvValue As Variant)
438 Call _PropertySet(&quot;Tag&quot;, pvValue)
439 End Property &apos; Tag (set)
440
441 REM -----------------------------------------------------------------------------------------------------------------------
442 Property Get Text() As Variant
443 Text = _PropertyGet(&quot;Text&quot;)
444 End Property &apos; Text (get)
445
446 Public Function pText() As variant
447 pText = _PropertyGet(&quot;Text&quot;)
448 End Function &apos; pText (get)
449
450 REM -----------------------------------------------------------------------------------------------------------------------
451 Property Get TextAlign() As Variant
452 TextAlign = _PropertyGet(&quot;TextAlign&quot;)
453 End Property &apos; TextAlign (get)
454
455 Property Let TextAlign(ByVal pvValue As Variant)
456 Call _PropertySet(&quot;TextAlign&quot;, pvValue)
457 End Property &apos; TextAlign (set)
458
459 REM -----------------------------------------------------------------------------------------------------------------------
460 Property Get TripleState() As Variant
461 TripleState = _PropertyGet(&quot;TripleState&quot;)
462 End Property &apos; TripleState (get)
463
464 Property Let TripleState(ByVal pvValue As Variant)
465 Call _PropertySet(&quot;TripleState&quot;, pvValue)
466 End Property &apos; TripleState (set)
467
468 REM -----------------------------------------------------------------------------------------------------------------------
469 Property Get Value() As Variant
470 Value = _PropertyGet(&quot;Value&quot;)
471 End Property &apos; Value (get)
472
473 Property Let Value(ByVal pvValue As Variant)
474 Call _PropertySet(&quot;Value&quot;, pvValue)
475 End Property &apos; Value (set)
476
477 REM -----------------------------------------------------------------------------------------------------------------------
478 Property Get Visible() As Variant
479 Visible = _PropertyGet(&quot;Visible&quot;)
480 End Property &apos; Visible (get)
481
482 Property Let Visible(ByVal pvValue As Variant)
483 Call _PropertySet(&quot;Visible&quot;, pvValue)
484 End Property &apos; Visible (set)
485
486 REM -----------------------------------------------------------------------------------------------------------------------
487 REM --- CLASS METHODS ---
488 REM -----------------------------------------------------------------------------------------------------------------------
489
490 Public Function AddItem(ByVal Optional pvItem As Variant, ByVal Optional pvIndex) As Boolean
491 &apos; Add an item in a Listbox
492
493 Utils._SetCalledSub(&quot;Control.AddItem&quot;)
494 AddItem = False
495 If _ErrorHandler() Then On Local Error Goto Error_Function
496
497 If IsMissing(pvItem) Then Call _TraceArguments()
498 If IsMissing(pvIndex) Then pvIndex = -1
499
500 Dim iArgNr As Integer
501 Select Case UCase(_A2B_.CalledSub)
502 Case UCase(&quot;AddItem&quot;) : iArgNr = 1
503 Case UCase(&quot;Control.AddItem&quot;) : iArgNr = 0
504 End Select
505
506 If Not Utils._CheckArgument(pvItem, iArgNr + 1, vbString) Then Goto Exit_Function
507 If Not Utils._CheckArgument(pvIndex, iArgNr + 2, Utils._AddNumeric()) Then Goto Exit_Function
508 If _SubType &lt;&gt; CTLLISTBOX Then Goto Error_Control
509 If _ParentType &lt;&gt; CTLPARENTISDIALOG Then
510 If ControlModel.ListSourceType &lt;&gt; com.sun.star.form.ListSourceType.VALUELIST Then Goto Error_Control
511 End If
512
513 Dim vRowSource() As Variant, iCount As Integer, i As Integer
514 If IsArray(ControlModel.StringItemList) Then vRowSource = ControlModel.StringItemList Else vRowSource = Array(ControlModel.StringItemList)
515 iCount = UBound(vRowSource)
516 If pvIndex &lt; -1 Or pvIndex &gt; iCount + 1 Then Goto Error_Index
517 ReDim Preserve vRowSource(0 To iCount + 1)
518 If pvIndex = -1 Then pvIndex = iCount + 1
519 For i = iCount + 1 To pvIndex + 1 Step -1
520 vRowSource(i) = vRowSource(i - 1)
521 Next i
522 vRowSource(pvIndex) = pvItem
523
524 If _ParentType &lt;&gt; CTLPARENTISDIALOG Then
525 ControlModel.ListSource = vRowSource()
526 End If
527 ControlModel.StringItemList = vRowSource()
528 AddItem = True
529
530 Exit_Function:
531 Utils._ResetCalledSub(&quot;Control.AddItem&quot;)
532 Exit Function
533 Error_Function:
534 TraceError(TRACEABORT, Err, &quot;Control.AddItem&quot;, Erl)
535 AddItem = False
536 GoTo Exit_Function
537 Error_Control:
538 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , &quot;Control.AddItem&quot;)
539 AddItem = False
540 Goto Exit_Function
541 Error_Index:
542 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(iArgNr + 2,pvIndex))
543 AddItem = False
544 Goto Exit_Function
545 End Function &apos; AddItem V0.9.1
546
547 REM -----------------------------------------------------------------------------------------------------------------------
548 Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
549 &apos; Return a Control object with name or index = pvIndex
550
551 If _ErrorHandler() Then On Local Error Goto Error_Function
552 Utils._SetCalledSub(&quot;Grid.Controls&quot;)
553
554 Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer
555 Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String
556 Dim j As Integer, oView As Object
557
558 If _SubType &lt;&gt; CTLGRIDCONTROL Then Goto Trace_Error_Context
559 Set ocControl = Nothing
560 iControlCount = ControlModel.getCount()
561
562 If IsMissing(pvIndex) Then &apos; No argument, return Collection pseudo-object
563 Set oCounter = New Collect
564 oCounter._CollType = COLLCONTROLS
565 oCounter._ParentType = OBJCONTROL
566 oCounter._ParentName = _Shortcut
567 oCounter._Count = iControlCount
568 Set Controls = oCounter
569 Goto Exit_Function
570 End If
571
572 If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
573
574 &apos; Start building the ocControl object
575 &apos; Determine exact name
576 Set ocControl = New Control
577 ocControl._ParentType = CTLPARENTISGRID
578 sParentShortcut = _Shortcut
579 sControls() = ControlModel.getElementNames()
580
581 Select Case VarType(pvIndex)
582 Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
583 If pvIndex &lt; 0 Or pvIndex &gt; iControlCount - 1 Then Goto Trace_Error_Index
584 ocControl._Name = sControls(pvIndex)
585 Case vbString &apos; Check control name validity (non case sensitive)
586 bFound = False
587 sIndex = UCase(Utils._Trim(pvIndex))
588 For i = 0 To iControlCount - 1
589 If UCase(sControls(i)) = sIndex Then
590 bFound = True
591 Exit For
592 End If
593 Next i
594 If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound
595 End Select
596
597 ocControl._Shortcut = sParentShortcut &amp; &quot;!&quot; &amp; Utils._Surround(ocControl._Name)
598 Set ocControl.ControlModel = ControlModel.getByName(ocControl._Name)
599 ocControl._ImplementationName = ocControl.ControlModel.ColumnServiceName &apos; getImplementationName aborts for subcontrols !?
600 ocControl._FormComponent = ParentComponent
601 If Utils._hasUNOProperty(ocControl.ControlModel, &quot;ClassId&quot;) Then ocControl._ClassId = ocControl.ControlModel.ClassId
602 &apos; Complex bypass to find View of grid subcontrols !
603 For i = 0 to ControlView.getCount() - 1
604 Set oView = ControlView.GetByIndex(i)
605 If oView.getModel.Name = ocControl._Name Then
606 Set ocControl.ControlView = oView
607 Exit For
608 End If
609 Next i
610
611 ocControl._Initialize()
612 ocControl._DocEntry = _DocEntry
613 ocControl._DbEntry = _DbEntry
614 Set Controls = ocControl
615
616 Exit_Function:
617 Utils._ResetCalledSub(&quot;Grid.Controls&quot;)
618 Exit Function
619 Trace_Error_Index:
620 TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
621 Set Controls = Nothing
622 Goto Exit_Function
623 Trace_NotFound:
624 TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, _Name))
625 Set Controls = Nothing
626 Goto Exit_Function
627 Trace_Error_Context:
628 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , &quot;Grid.Controls&quot;)
629 Set Controls = Nothing
630 Goto Exit_Function
631 Error_Function:
632 TraceError(TRACEABORT, Err, &quot;Grid.Controls&quot;, Erl)
633 Set Controls = Nothing
634 GoTo Exit_Function
635 End Function &apos; Controls
636
637 REM -----------------------------------------------------------------------------------------------------------------------
638 Public Function getProperty(Optional ByVal pvProperty As Variant, ByVal Optional pvIndex As Variant) As Variant
639 &apos; Return property value of psProperty property name
640
641 Utils._SetCalledSub(&quot;Control.getProperty&quot;)
642 If IsMissing(pvProperty) Then Call _TraceArguments()
643 If IsMissing(pvIndex) Then
644 getProperty = _PropertyGet(pvProperty)
645 Else
646 getProperty = _PropertyGet(pvProperty, pvIndex)
647 End If
648 Utils._ResetCalledSub(&quot;Control.getProperty&quot;)
649
650 End Function &apos; getProperty
651
652 REM -----------------------------------------------------------------------------------------------------------------------
653 Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
654 &apos; Return True if object has a valid property called pvProperty (case-insensitive comparison !)
655
656 If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
657 Exit Function
658
659 End Function &apos; hasProperty
660
661 REM -----------------------------------------------------------------------------------------------------------------------
662 Public Function RemoveItem(ByVal Optional pvIndex) As Boolean
663 &apos; Remove an item from a Listbox
664 &apos; Index may be a string value or an index-position
665
666 Utils._SetCalledSub(&quot;Control.RemoveItem&quot;)
667 If _ErrorHandler() Then On Local Error Goto Error_Function
668
669 If IsMissing(pvIndex) Then Call _TraceArguments()
670 Dim iArgNr As Integer
671 Select Case UCase(_A2B_.CalledSub)
672 Case UCase(&quot;RemoveItem&quot;) : iArgNr = 1
673 Case UCase(&quot;Control.RemoveItem&quot;) : iArgNr = 0
674 End Select
675 If Not Utils._CheckArgument(pvIndex, iArgNr + 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
676 If _SubType &lt;&gt; CTLLISTBOX Then Goto Error_Control
677 If _ParentType &lt;&gt; CTLPARENTISDIALOG Then
678 If ControlModel.ListSourceType &lt;&gt; com.sun.star.form.ListSourceType.VALUELIST Then Goto Error_Control
679 End If
680
681 Dim vRowSource() As Variant, iCount As Integer, i As Integer, j As integer, bFound As Boolean
682 If IsArray(ControlModel.StringItemList) Then vRowSource = ControlModel.StringItemList Else vRowSource = Array(ControlModel.StringItemList)
683 iCount = UBound(vRowSource)
684
685 Select Case VarType(pvIndex)
686 Case vbString
687 bFound = False
688 For i = 0 To iCount
689 If vRowSource(i) = pvIndex Then
690 For j = i To iCount - 1
691 vRowSource(j) = vRowSource(j + 1)
692 Next j
693 bFound = True
694 Exit For &apos; Remove only 1st occurrence of string
695 End If
696 Next i
697 Case Else
698 If pvIndex &lt; 0 Or pvIndex &gt; iCount Then Goto Error_Index
699 For i = pvIndex To iCount - 1
700 vRowSource(i) = vRowSource(i + 1)
701 Next i
702 bFound = True
703 End Select
704
705 If bFound Then
706 If iCount &gt; 0 Then &apos; https://forum.openoffice.org/en/forum/viewtopic.php?f=47&amp;t=75008
707 ReDim Preserve vRowSource(0 To iCount - 1)
708 Else
709 vRowSource = Array()
710 End If
711 If _ParentType &lt;&gt; CTLPARENTISDIALOG Then
712 ControlModel.ListSource = vRowSource()
713 End If
714 ControlModel.StringItemList = vRowSource()
715 RemoveItem = True
716 Else
717 RemoveItem = False
718 End If
719
720 Exit_Function:
721 Utils._ResetCalledSub(&quot;Control.RemoveItem&quot;)
722 Exit Function
723 Error_Function:
724 TraceError(TRACEABORT, Err, &quot;Control.RemoveItem&quot;, Erl)
725 RemoveItem = False
726 GoTo Exit_Function
727 Error_Control:
728 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, &quot;Control.RemoveItem&quot;)
729 RemoveItem = False
730 Goto Exit_Function
731 Error_Index:
732 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(2, pvIndex))
733 RemoveItem = False
734 Goto Exit_Function
735 End Function &apos; RemoveItem V0.9.1
736
737 REM -----------------------------------------------------------------------------------------------------------------------
738 Public Function Requery() As Boolean
739 &apos; Refresh data displayed in a form, subform, combobox or listbox
740 Utils._SetCalledSub(&quot;Control.Requery&quot;)
741 If _ErrorHandler() Then On Local Error Goto Error_Function
742 Requery = False
743
744 Select Case _SubType
745 Case CTLCOMBOBOX, CTLLISTBOX
746 If Utils._InList(ControlModel.ListSourceType, Array( _
747 com.sun.star.form.ListSourceType.QUERY _
748 , com.sun.star.form.ListSourceType.TABLE _
749 , com.sun.star.form.ListSourceType.TABLEFIELDS _
750 , com.sun.star.form.ListSourceType.SQL _
751 , com.sun.star.form.ListSourceType.SQLPASSTHROUGH _
752 )) Then
753 ControlModel.refresh()
754 End If
755 Case Else
756 Goto Error_Control
757 End Select
758 Requery = True
759
760 Exit_Function:
761 Utils._ResetCalledSub(&quot;Control.Requery&quot;)
762 Exit Function
763 Error_Control:
764 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, &quot;Control.Requery&quot;)
765 Requery = False
766 Goto Exit_Function
767 Error_Function:
768 TraceError(TRACEABORT, Err, &quot;Control.Requery&quot;, Erl)
769 GoTo Exit_Function
770 End Function &apos; Requery
771
772 REM -----------------------------------------------------------------------------------------------------------------------
773 Public Function setFocus() As Boolean
774 &apos; Execute setFocus method
775 Utils._SetCalledSub(&quot;Control.setFocus&quot;)
776 If _ErrorHandler() Then On Local Error Goto Error_Function
777 setFocus = False
778
779 Dim i As Integer, j As Integer, iColPosition As Integer
780 Dim ocControl As Object, ocGrid As Variant, oGridModel As Object
781 If _ParentType = CTLPARENTISGRID Then &apos;setFocus method does not work on controlviews in grid ?!?
782 &apos; Find column position of control
783 iColPosition = -1
784 ocGrid = getObject(_getUpperShortcut(_Shortcut, _Name)) &apos; return containing grid
785 Set oGridModel = ocGrid.ControlModel
786 j = -1
787 For i = 0 To oGridModel.Count - 1
788 Set ocControl = oGridModel.GetByIndex(i)
789 If Not ocControl.Hidden Then j = j + 1 &apos; Skip if hidden
790 If oGridModel.GetByIndex(i).Name = _Name Then
791 iColPosition = j
792 Exit For
793 End If
794 Next i
795 If iColPosition &gt;= 0 Then
796 ocGrid.ControlView.setFocus() &apos;Set first focus on grid itself
797 ocGrid.ControlView.setCurrentColumnPosition(iColPosition) &apos;Deprecated but no alternative found
798 Else
799 Goto Error_Grid
800 End If
801 Else
802 ControlView.setFocus()
803 End If
804 setFocus = True
805
806 Exit_Function:
807 Utils._ResetCalledSub(&quot;Control.setFocus&quot;)
808 Exit Function
809 Error_Function:
810 TraceError(TRACEABORT, Err, &quot;Control.setFocus&quot;, Erl)
811 Goto Exit_Function
812 Error_Grid:
813 TraceError(TRACEFATAL, ERRFOCUSINGRID, Utils._CalledSub(), 0, 1, Array(_Name, ocGrid._Name))
814 Goto Exit_Function
815 End Function &apos; setFocus V0.9.0
816
817 REM -----------------------------------------------------------------------------------------------------------------------
818 Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean
819 &apos; Return True if property setting OK
820 Utils._SetCalledSub(&quot;Control.setProperty&quot;)
821 If IsMissing(pvIndex) Then
822 setProperty = _PropertySet(psProperty, pvValue)
823 Else
824 setProperty = _PropertySet(psProperty, pvValue, pvIndex)
825 End If
826 Utils._ResetCalledSub(&quot;Control.setProperty&quot;)
827 End Function &apos; setProperty
828
829 REM -----------------------------------------------------------------------------------------------------------------------
830 REM --- PRIVATE FUNCTIONS ---
831 REM -----------------------------------------------------------------------------------------------------------------------
832 Private Function _Formats(ByVal psControlType As String) As Variant
833 &apos; Return allowed format entries for Date and Time control types
834
835 Dim vFormats() As Variant
836 Select Case psControlType
837 Case CTLDATEFIELD
838 vFormats = Array( _
839 &quot;Standard (short)&quot; _
840 , &quot;Standard (short YY)&quot; _
841 , &quot;Standard (short YYYY)&quot; _
842 , &quot;Standard (long)&quot; _
843 , &quot;DD/MM/YY&quot; _
844 , &quot;MM/DD/YY&quot; _
845 , &quot;YY/MM/DD&quot; _
846 , &quot;DD/MM/YYYY&quot; _
847 , &quot;MM/DD/YYYY&quot; _
848 , &quot;YYYY/MM/DD&quot; _
849 , &quot;YY-MM-DD&quot; _
850 , &quot;YYYY-MM-DD&quot; _
851 )
852 Case CTLTIMEFIELD
853 vFormats = Array( _
854 &quot;24h short&quot; _
855 , &quot;24h long&quot; _
856 , &quot;12h short&quot; _
857 , &quot;12h long&quot; _
858 )
859 Case Else
860 vFormats = Array()
861 End Select
862
863 _Formats = vFormats
864
865 End Function &apos; _Formats V0.9.1
866
867 REM -----------------------------------------------------------------------------------------------------------------------
868 Public Sub _Initialize()
869 &apos; Initialize new Control
870 &apos; ControlModel, ParentType, Name, Shortcut, ControlView, ImplementationName, ClassId (if parent &lt;&gt; dialog)
871 &apos; are presumed preexisting
872
873 &apos; Identify SubType and ControlView
874 Dim sControlTypes() As Variant, i As Integer, vSplit() As Variant, sTrailer As String
875 sControlTypes = array( CTLCONTROL _
876 , CTLCOMMANDBUTTON _
877 , CTLRADIOBUTTON _
878 , CTLIMAGEBUTTON _
879 , CTLCHECKBOX _
880 , CTLLISTBOX _
881 , CTLCOMBOBOX _
882 , CTLGROUPBOX _
883 , CTLTEXTFIELD _
884 , CTLFIXEDTEXT _
885 , CTLGRIDCONTROL _
886 , CTLFILECONTROL _
887 , CTLHIDDENCONTROL _
888 , CTLIMAGECONTROL _
889 , CTLDATEFIELD _
890 , CTLTIMEFIELD _
891 , CTLNUMERICFIELD _
892 , CTLCURRENCYFIELD _
893 , CTLPATTERNFIELD _
894 , CTLSCROLLBAR _
895 , CTLSPINBUTTON _
896 , CTLNAVIGATIONBAR _
897 , CTLPROGRESSBAR _
898 , CTLFIXEDLINE _
899 )
900
901 Select Case _ParentType
902 Case CTLPARENTISDIALOG
903 vSplit = Split(ControlModel.getServiceName(), &quot;.&quot;)
904 sTrailer = UCase(vSplit(UBound(vSplit)))
905 &apos; Manage homonyms
906 Select Case sTrailer
907 Case &quot;BUTTON&quot; : sTrailer = CTLCOMMANDBUTTON
908 Case &quot;EDIT&quot; : sTrailer = CTLTEXTFIELD
909 Case Else
910 End Select
911 If sTrailer &lt;&gt; CTLFORMATTEDFIELD Then
912 For i = 0 To UBound(sControlTypes)
913 If sControlTypes(i) = sTrailer Then
914 _ClassId = i + 1
915 _SubType = sTrailer
916 _ControlType = _ClassId
917 Exit For
918 End If
919 Next i
920 Else
921 _ClassId = acFormattedField
922 _SubType = CTLFORMATTEDFIELD
923 _ControlType = _ClassId
924 End If
925 Case Else
926 &apos;Is ClassId one of the properties ?
927 If _ClassId &gt; 0 Then &apos; All control types have a ClassId except subforms
928 _SubType = sControlTypes(_ClassId - 1)
929 _ControlType = _ClassId
930 If _SubType = CTLTEXTFIELD Then &apos; Formatted fields belong to the TextField family
931 If _ImplementationName = &quot;com.sun.star.comp.forms.OFormattedFieldWrapper&quot; _
932 Or _ImplementationName = &quot;com.sun.star.form.component.FormattedField&quot; Then &apos; When in datagrid
933 _SubType = CTLFORMATTEDFIELD
934 _ControlType = acFormattedField
935 End If
936 End If
937 Else &apos; Initialize subform Control
938 If ControlModel.ImplementationName = &quot;com.sun.star.comp.forms.ODatabaseForm&quot; Then
939 _SubType = CTLSUBFORM
940 _ControlType = acSubform
941 End If
942 End If
943 End Select
944
945 End Sub &apos; _Initialize
946
947 REM -----------------------------------------------------------------------------------------------------------------------
948 Public Function _ListboxBound() As Boolean
949 &apos; Return True if listbox has a bound column
950
951 Dim bListboxBound As Boolean, j As Integer
952 Dim vValue() As variant, vString As Variant
953
954 bListboxBound = False
955
956 If Not IsNull(ControlModel.ValueItemList) _
957 And ControlModel.DataField &lt;&gt; &quot;&quot; _
958 And Not IsNull(ControlModel.BoundField) _
959 And Utils._InList(ControlModel.ListSourceType, Array( _
960 com.sun.star.form.ListSourceType.TABLE _
961 , com.sun.star.form.ListSourceType.QUERY _
962 , com.sun.star.form.ListSourceType.SQL _
963 , com.sun.star.form.ListSourceType.SQLPASSTHROUGH _
964 )) Then &apos; MultiSelect behaviour changed in OpenOffice &gt;= 3.3
965 If IsArray(ControlModel.ValueItemList) Then
966 vValue = ControlModel.ValueItemList
967 vString = ControlModel.StringItemList
968 For j = 0 To UBound(vValue)
969 If VarType(vValue(j)) &lt;&gt; VarType(vString(j)) Then
970 bListboxBound = True
971 ElseIf vValue(j) &lt;&gt; vString(j) Then
972 bListboxBound = True
973 End If
974 If bListboxBound Then Exit For
975 Next j
976 End If
977 End If
978
979 _ListboxBound = bListboxBound
980
981 End Function &apos; _ListboxBound V0.9.0
982
983 REM -----------------------------------------------------------------------------------------------------------------------
984 Private Function _PropertiesList() As Variant
985 &apos; Based on ControlProperties.ods analysis
986
987 Dim vFullPropertiesList() As Variant
988 vFullPropertiesList = Array( _
989 &quot;BackColor&quot; _
990 , &quot;BorderColor&quot; _
991 , &quot;BorderStyle&quot; _
992 , &quot;Cancel&quot; _
993 , &quot;Caption&quot; _
994 , &quot;ControlSource&quot; _
995 , &quot;ControlTipText&quot; _
996 , &quot;ControlType&quot; _
997 , &quot;Default&quot; _
998 , &quot;DefaultValue&quot; _
999 , &quot;Enabled&quot; _
1000 , &quot;FontBold&quot; _
1001 , &quot;FontItalic&quot; _
1002 , &quot;FontName&quot; _
1003 , &quot;FontSize&quot; _
1004 , &quot;FontUnderline&quot; _
1005 , &quot;FontWeight&quot; _
1006 , &quot;ForeColor&quot; _
1007 , &quot;Form&quot; _
1008 , &quot;Format&quot; _
1009 , &quot;ItemData&quot; _
1010 , &quot;LinkChildFields&quot; _
1011 , &quot;LinkMasterFields&quot; _
1012 , &quot;ListCount&quot; _
1013 , &quot;ListIndex&quot; _
1014 , &quot;Locked&quot; _
1015 , &quot;MultiSelect&quot; _
1016 , &quot;Name&quot; _
1017 , &quot;ObjectType&quot; _
1018 , &quot;OptionValue&quot; _
1019 , &quot;Page&quot; _
1020 , &quot;Parent&quot; _
1021 , &quot;Required&quot; _
1022 , &quot;RowSource&quot; _
1023 , &quot;RowSourceType&quot; _
1024 , &quot;Selected&quot; _
1025 , &quot;SelLength&quot; _
1026 , &quot;SelStart&quot; _
1027 , &quot;Seltext&quot; _
1028 , &quot;SpecialEffect&quot; _
1029 , &quot;SubType&quot; _
1030 , &quot;TabIndex&quot; _
1031 , &quot;TabStop&quot; _
1032 , &quot;Tag&quot; _
1033 , &quot;Text&quot; _
1034 , &quot;TextAlign&quot; _
1035 , &quot;TripleState&quot; _
1036 , &quot;Value&quot; _
1037 , &quot;Visible&quot; _
1038 )
1039 Dim vPropertiesMatrix(25) As Variant
1040 Select Case _ParentType
1041 Case CTLPARENTISFORM, CTLPARENTISSUBFORM
1042 vPropertiesMatrix(acCheckBox) = Array(0,4,5,6,7,9,10,11,12,13,14,15,16,17,27,28,31,32,39,40,41,42,43,45,46,47,48)
1043 vPropertiesMatrix(acComboBox) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,20,23,24,25,27,28,31,32,33,34,40,41,42,43,44,45,47,48)
1044 vPropertiesMatrix(acCommandButton) = Array(0,3,4,6,7,8,10,11,12,13,14,15,16,17,27,28,31,40,41,42,43,45,47,48)
1045 vPropertiesMatrix(acCurrencyField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,31,32,40,41,42,43,45,47,48)
1046 vPropertiesMatrix(acDateField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,19,25,27,28,31,32,40,41,42,43,44,45,47,48)
1047 vPropertiesMatrix(acFileControl) = Array(0,1,2,6,7,9,10,11,12,13,14,15,16,17,25,27,28,31,40,41,42,43,44,47,48)
1048 vPropertiesMatrix(acFixedLine) = Array()
1049 vPropertiesMatrix(acFixedText) = Array(0,1,2,4,6,7,10,11,12,13,14,15,16,17,27,28,31,40,43,45,48)
1050 vPropertiesMatrix(acFormattedField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,19,25,27,28,31,32,40,41,42,43,44,45,47,48)
1051 vPropertiesMatrix(acGridControl) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,27,28,31,40,41,42,43,48)
1052 vPropertiesMatrix(acGroupBox) = Array(4,6,7,10,11,12,13,14,15,16,17,27,28,31,40,43,48)
1053 vPropertiesMatrix(acHiddenControl) = Array(7,27,28,31,40,43,47,48)
1054 vPropertiesMatrix(acImageButton) = Array(0,1,2,6,7,10,27,28,31,40,41,42,43,48)
1055 vPropertiesMatrix(acImageControl) = Array(0,1,2,5,6,7,10,25,27,28,31,32,40,41,42,43,48)
1056 vPropertiesMatrix(acListBox) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,20,23,24,25,26,27,28,31,32,33,34,35,40,41,42,43,45,47,48)
1057 vPropertiesMatrix(acNavigationBar) = Array(0,2,6,7,10,11,12,13,14,15,16,17,27,28,31,40,41,42,43,48)
1058 vPropertiesMatrix(acNumericField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,31,32,40,41,42,43,45,47,48)
1059 vPropertiesMatrix(acPatternField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,31,32,36,37,38,40,41,42,43,44,45,47,48)
1060 vPropertiesMatrix(acProgressBar) = Array()
1061 vPropertiesMatrix(acRadioButton) = Array(0,4,5,6,7,9,10,11,12,13,14,15,16,17,27,28,29,31,32,39,40,41,42,43,45,47,48)
1062 vPropertiesMatrix(acScrollBar) = Array(0,1,2,6,7,10,27,28,31,40,41,42,43,47,48)
1063 vPropertiesMatrix(acSpinButton) = Array(0,1,2,6,7,9,10,27,28,31,40,41,42,43,47,48)
1064 vPropertiesMatrix(0) = Array(7,18,21,22,27,28,31,40)
1065 vPropertiesMatrix(acTextField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,31,32,36,37,38,40,41,42,43,44,45,47,48)
1066 vPropertiesMatrix(acTimeField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,19,25,27,28,31,32,40,41,42,43,44,45,47,48)
1067 Case CTLPARENTISGROUP
1068 &apos; To be duplicated from above !!!
1069 vPropertiesMatrix(acRadioButton) = Array(0,4,5,6,7,9,10,11,12,13,14,15,16,17,27,28,29,31,32,39,40,41,42,43,45,47,48)
1070 Case CTLPARENTISGRID
1071 vPropertiesMatrix(acCheckBox) = Array(4,5,6,7,9,10,27,28,31,32,39,40,43,45,46,47)
1072 vPropertiesMatrix(acComboBox) = Array(4,5,6,7,9,10,20,23,24,25,27,28,31,32,33,34,40,43,44,45,47)
1073 vPropertiesMatrix(acCurrencyField) = Array(4,5,6,7,9,10,25,27,28,31,32,40,43,45,47)
1074 vPropertiesMatrix(acDateField) = Array(4,5,6,7,9,10,19,25,27,28,31,32,40,43,44,45,47)
1075 vPropertiesMatrix(acFormattedField) = Array(4,5,6,7,9,10,19,25,27,28,31,32,40,43,44,45,47)
1076 vPropertiesMatrix(acListBox) = Array(4,5,6,7,9,10,20,23,24,25,26,27,28,31,32,33,34,35,40,43,45,47)
1077 vPropertiesMatrix(acNumericField) = Array(4,5,6,7,9,10,25,27,28,31,32,40,43,45,47)
1078 vPropertiesMatrix(acPatternField) = Array(4,5,6,7,9,10,25,27,28,31,32,36,37,38,40,43,44,45,47)
1079 vPropertiesMatrix(acTextField) = Array(4,5,6,7,9,10,25,27,28,31,32,36,37,38,40,43,44,45,47)
1080 vPropertiesMatrix(acTimeField) = Array(4,5,6,7,9,10,19,25,27,28,31,32,40,43,44,45,47)
1081 Case CTLPARENTISDIALOG
1082 vPropertiesMatrix(acCheckBox) = Array(0,4,6,7,10,11,12,13,14,15,16,17,27,28,30,31,39,40,41,42,43,45,46,47,48)
1083 vPropertiesMatrix(acComboBox) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,20,23,24,25,27,28,30,31,33,40,41,42,43,44,45,47,48)
1084 vPropertiesMatrix(acCommandButton) = Array(0,3,4,6,7,8,10,11,12,13,14,15,16,17,27,28,30,31,40,41,42,43,45,48)
1085 vPropertiesMatrix(acCurrencyField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,30,31,40,41,42,43,45,47,48)
1086 vPropertiesMatrix(acDateField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,19,25,27,28,30,31,40,41,42,43,44,45,47,48)
1087 vPropertiesMatrix(acFileControl) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,30,31,40,41,42,43,44,45,47,48)
1088 vPropertiesMatrix(acFixedLine) = Array(0,4,6,7,10,11,12,13,14,15,16,17,27,28,30,31,40,41,43,48)
1089 vPropertiesMatrix(acFixedText) = Array(0,1,2,4,6,7,10,11,12,13,14,15,16,17,27,28,30,31,40,41,42,43,45,48)
1090 vPropertiesMatrix(acFormattedField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,19,25,27,28,30,31,40,41,42,43,44,45,47,48)
1091 vPropertiesMatrix(acGroupBox) = Array(4,6,7,10,11,12,13,14,15,16,17,27,28,30,31,40,41,43,48)
1092 vPropertiesMatrix(acImageControl) = Array(0,1,2,6,7,10,27,28,30,31,40,41,42,43,48)
1093 vPropertiesMatrix(acListBox) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,20,23,24,25,26,27,28,30,31,33,35,40,41,42,43,45,47,48)
1094 vPropertiesMatrix(acNumericField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,30,31,40,41,42,43,45,47,48)
1095 vPropertiesMatrix(acPatternField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,30,31,36,37,38,40,41,42,43,44,45,47,48)
1096 vPropertiesMatrix(acProgressBar) = Array(0,1,2,6,7,10,27,28,30,31,40,41,43,47,48)
1097 vPropertiesMatrix(acRadioButton) = Array(0,4,6,7,10,11,12,13,14,15,16,17,27,28,29,30,31,39,40,41,42,43,45,47,48)
1098 vPropertiesMatrix(acScrollBar) = Array(0,1,2,6,7,10,27,28,30,31,40,41,42,43,47,48)
1099 vPropertiesMatrix(acTextField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,30,31,36,37,38,40,41,42,43,44,45,47,48)
1100 vPropertiesMatrix(acTimeField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,19,25,27,28,30,31,40,41,42,43,44,45,47,48)
1101 End Select
1102
1103 Dim vProperties() As Variant, i As Integer, iIndex As Integer
1104 If _ControlType = acSubForm Then iIndex = 0 Else iIndex = _ControlType
1105 If IsEmpty(vPropertiesMatrix(iIndex)) Then
1106 vProperties = Array()
1107 Else
1108 ReDim vProperties(0 To UBound(vPropertiesMatrix(iIndex)))
1109 For i = 0 To UBound(vProperties)
1110 vProperties(i) = vFullPropertiesList(vPropertiesMatrix(iIndex)(i))
1111 Next i
1112 End If
1113
1114 _PropertiesList = vProperties()
1115
1116 End Function &apos; _PropertiesList
1117
1118 REM -----------------------------------------------------------------------------------------------------------------------
1119 Private Function _PropertyGet(ByVal psProperty As String, ByVal Optional pvIndex As Variant) As Variant
1120 &apos; Return property value of the psProperty property name
1121
1122 Dim vEMPTY As Variant, iArg As Integer
1123 If _ErrorHandler() Then On Local Error Goto Error_Function
1124 Utils._SetCalledSub(&quot;Control.get&quot; &amp; psProperty)
1125 _PropertyGet = vEMPTY
1126
1127 &apos;Check Index argument
1128 Dim iArgNr As Integer
1129 If Not IsMissing(pvIndex) Then
1130 Select Case UCase(_A2B_.CalledSub)
1131 Case UCase(&quot;getProperty&quot;) : iArgNr = 3
1132 Case UCase(&quot;Control.getProperty&quot;) : iArgNr = 2
1133 Case UCase(&quot;Control.get&quot; &amp; psProperty) : iArgNr = 1
1134 End Select
1135 If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function
1136 End If
1137
1138 Dim vDefaultValue As Variant, oDefaultValue As Object, vValue As Variant, oValue As Object, iIndex As Integer
1139 Dim lListIndex As Long, i As Integer, j As Integer, vCurrentValue As Variant, lListCount As Long
1140 Dim vListboxValue As Variant, vListSource, bSelected() As Boolean, bListboxBound As Boolean
1141 Dim vGet As Variant, vDate As Variant
1142 Dim ofSubForm As Object
1143 Dim vFormats() As Variant
1144 Dim vSelection As Variant, sSelectedText As String
1145
1146 If Not hasProperty(psProperty) Then Goto Trace_Error
1147
1148 Select Case UCase(psProperty)
1149 Case UCase(&quot;BackColor&quot;)
1150 If Utils._hasUNOProperty(ControlModel, &quot;BackgroundColor&quot;) Then _PropertyGet = ControlModel.BackgroundColor
1151 Case UCase(&quot;BorderColor&quot;)
1152 If Utils._hasUNOProperty(ControlModel, &quot;BorderColor&quot;) Then _PropertyGet = ControlModel.BorderColor
1153 Case UCase(&quot;BorderStyle&quot;)
1154 If Utils._hasUNOProperty(ControlModel, &quot;Border&quot;) Then _PropertyGet = ControlModel.Border
1155 Case UCase(&quot;Cancel&quot;)
1156 If Utils._hasUNOProperty(ControlModel, &quot;PushButtonType&quot;) Then _PropertyGet = ( ControlModel.PushButtonType = com.sun.star.awt.PushButtonType.CANCEL )
1157 Case UCase(&quot;Caption&quot;)
1158 If Utils._hasUNOProperty(ControlModel, &quot;Label&quot;) Then _PropertyGet = ControlModel.Label
1159 Case UCase(&quot;ControlSource&quot;)
1160 If Utils._hasUNOProperty(ControlModel, &quot;DataField&quot;) Then _PropertyGet = ControlModel.DataField
1161 Case UCase(&quot;ControlTipText&quot;)
1162 If Utils._hasUNOProperty(ControlModel, &quot;HelpText&quot;) Then _PropertyGet = ControlModel.HelpText
1163 Case UCase(&quot;ControlType&quot;)
1164 _PropertyGet = _ControlType
1165 Case UCase(&quot;Default&quot;)
1166 If Utils._hasUNOProperty(ControlModel, &quot;DefaultButton&quot;) Then _PropertyGet = ControlModel.DefaultButton
1167 Case UCase(&quot;DefaultValue&quot;)
1168 Select Case _SubType
1169 Case CTLCHECKBOX, CTLRADIOBUTTON
1170 If Utils._hasUNOProperty(ControlModel, &quot;DefaultState&quot;) Then _PropertyGet = ControlModel.DefaultState
1171 Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD
1172 If Utils._hasUNOProperty(ControlModel, &quot;DefaultText&quot;) Then _PropertyGet = ControlModel.DefaultText
1173 Case CTLCURRENCYFIELD, CTLNUMERICFIELD
1174 If Utils._hasUNOProperty(ControlModel, &quot;DefaultValue&quot;) Then _PropertyGet = ControlModel.DefaultValue
1175 Case CTLDATEFIELD
1176 If Utils._hasUNOProperty(ControlModel, &quot;DefaultDate&quot;) Then
1177 Select Case VarType(ControlModel.DefaultDate)
1178 Case vbLong &apos; AOO and LO &lt;= 4.1
1179 vDefaultValue = ControlModel.DefaultDate
1180 vGet = DateSerial(Left(vDefaultValue, 4), Mid(vDefaultValue, 5, 2), Right(vDefaultValue, 2))
1181 Case vbObject &apos; LO &gt;= 4.2 com.sun.star.Util.Date
1182 Set oDefaultValue = ControlModel.DefaultDate
1183 vGet = DateSerial(oDefaultValue.Year,oDefaultValue.Month, oDefaultValue.Day)
1184 Case vbEmpty
1185 End Select
1186 End If
1187 Case CTLFORMATTEDFIELD
1188 If Utils._hasUNOProperty(ControlModel, &quot;EffectiveDefault&quot;) Then _PropertyGet = ControlModel.EffectiveDefault
1189 Case CTLLISTBOX
1190 If Utils._hasUNOProperty(ControlModel, &quot;DefaultSelection&quot;) And Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) Then
1191 vDefaultValue = ControlModel.DefaultSelection
1192 If IsArray(vDefaultValue) Then
1193 If UBound(vDefaultValue) &gt;= LBound(vDefaultValue) Then &apos; Is array initialized ?
1194 iIndex = UBound(ControlModel.StringItemList)
1195 If vDefaultValue(0) &gt;= 0 And vDefaultValue(0) &lt;= iIndex Then _PropertyGet = ControlModel.StringItemList(vDefaultValue(0))
1196 &apos; Only first default value is considered
1197 End If
1198 End If
1199 End If
1200 Case CTLSPINBUTTON
1201 If Utils._hasUNOProperty(ControlModel, &quot;DefaultSpinValue&quot;) Then _PropertyGet = ControlModel.DefaultSpinValue
1202 Case CTLTIMEFIELD
1203 If Utils._hasUNOProperty(ControlModel, &quot;DefaultTime&quot;) Then
1204 Select Case VarType(ControlModel.DefaultTime)
1205 Case vbLong &apos; AOO and LO &lt;= 4.1
1206 _PropertyGet = ControlModel.DefaultTime
1207 Case vbObject &apos; LO &gt;= 4.2 com.sun.star.Util.Time
1208 Set oDefaultValue = ControlModel.DefaultTime
1209 _PropertyGet = TimeSerial(oDefaultValue.Hours, oDefaultValue.Minutes, oDefaultValue.Seconds)
1210 Case vbEmpty
1211 End Select
1212 End If
1213 Case Else
1214 Goto Trace_Error
1215 End Select
1216 Case UCase(&quot;Enabled&quot;)
1217 If Utils._hasUNOProperty(ControlModel, &quot;Enabled&quot;) Then _PropertyGet = ControlModel.Enabled
1218 Case UCase(&quot;FontBold&quot;)
1219 If Utils._hasUNOProperty(ControlModel, &quot;FontWeight&quot;) Then _PropertyGet = ( ControlModel.FontWeight &gt;= com.sun.star.awt.FontWeight.BOLD )
1220 Case UCase(&quot;FontItalic&quot;)
1221 If Utils._hasUNOProperty(ControlModel, &quot;FontSlant&quot;) Then _PropertyGet = ( ControlModel.FontSlant = com.sun.star.awt.FontSlant.ITALIC )
1222 Case UCase(&quot;FontName&quot;)
1223 If Utils._hasUNOProperty(ControlModel, &quot;FontName&quot;) Then _PropertyGet = ControlModel.FontName
1224 Case UCase(&quot;FontSize&quot;)
1225 If Utils._hasUNOProperty(ControlModel, &quot;FontHeight&quot;) Then _PropertyGet = ControlModel.FontHeight
1226 Case UCase(&quot;FontUnderline&quot;)
1227 If Utils._hasUNOProperty(ControlModel, &quot;FontUnderline&quot;) Then _PropertyGet = _
1228 Not ( ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.NONE _
1229 Or ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.DONTKNOW )
1230 Case UCase(&quot;FontWeight&quot;)
1231 If Utils._hasUNOProperty(ControlModel, &quot;FontWeight&quot;) Then _PropertyGet = ControlModel.FontWeight
1232 Case UCase(&quot;ForeColor&quot;)
1233 If Utils._hasUNOProperty(ControlModel, &quot;TextColor&quot;) Then _PropertyGet = ControlModel.TextColor
1234 Case UCase(&quot;Form&quot;)
1235 Set ofSubForm = New SubForm &apos; Start building the SUBFORM object
1236 With ofSubForm
1237 Set .DatabaseForm = ControlModel
1238 ._Name = _Name
1239 ._Shortcut = _Shortcut &amp; &quot;.Form&quot;
1240 .ParentComponent = _FormComponent
1241 ._DocEntry = _DocEntry
1242 ._DbEntry = _DbEntry
1243 ._OrderBy = ControlModel.Order
1244 End With
1245 set _PropertyGet = ofSubForm
1246 Case UCase(&quot;Format&quot;)
1247 vFormats = _Formats(_Subtype)
1248 Select Case _SubType
1249 Case CTLDATEFIELD
1250 If Utils._hasUNOProperty(ControlModel, &quot;DateFormat&quot;) Then
1251 If ControlModel.DateFormat &lt;= UBound(vFormats) Then _PropertyGet = vFormats(ControlModel.DateFormat)
1252 End If
1253 Case CTLTIMEFIELD
1254 If Utils._hasUNOProperty(ControlModel, &quot;TimeFormat&quot;) Then
1255 If ControlModel.TimeFormat &lt;= UBound(vFormats) Then _PropertyGet = vFormats(ControlModel.TimeFormat)
1256 End If
1257 Case Else
1258 If Utils._hasUNOProperty(ControlModel, &quot;FormatKey&quot;) Then
1259 If Utils._hasUNOProperty(ControlModel, &quot;FormatsSupplier&quot;) Then
1260 _PropertyGet = ControlModel.FormatsSupplier.getNumberFormats.getByKey(ControlModel.FormatKey).FormatString
1261 End If
1262 End If
1263 End Select
1264 Case UCase(&quot;ItemData&quot;)
1265 If Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) Then
1266 If IsMissing(pvIndex) Then
1267 _PropertyGet = ControlModel.StringItemList
1268 Else
1269 If pvIndex &lt; 0 Or pvIndex &gt; UBound(ControlModel.StringItemList) Then Goto Trace_Error_Index
1270 _PropertyGet = ControlModel.StringItemList(pvIndex)
1271 End If
1272 End If
1273 Case UCase(&quot;ListCount&quot;)
1274 If Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) Then _PropertyGet = UBound(ControlModel.StringItemList) + 1
1275 Case UCase(&quot;ListIndex&quot;)
1276 If Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) Then
1277 lListIndex = -1 &apos; Either Multiple selections or no selection at all
1278 Select Case _SubType
1279 Case CTLCOMBOBOX
1280 If Not Utils._hasUNOProperty(ControlModel, &quot;Text&quot;) Then Goto Trace_Error
1281 iIndex = 0
1282 If ControlModel.Text &lt;&gt; &quot;&quot; Then
1283 For j = 0 To UBound(ControlModel.StringItemList)
1284 If ControlModel.StringItemList(j) = ControlModel.Text Then
1285 lListIndex = j
1286 iIndex = iIndex + 1
1287 End If
1288 Next j
1289 If iIndex &lt;&gt; 1 Then lListIndex = -1 &apos; Multiselection or synonyms rejected
1290 End If
1291 Case CTLLISTBOX &apos; No mean found to access bound column !! See mail Lionel 10/5/2013 for improvement
1292 If Not Utils._hasUNOProperty(ControlModel, &quot;SelectedItems&quot;) Then Goto Trace_Error
1293 If UBound(ControlModel.SelectedItems) &gt; 0 Then &apos; Several items selected
1294 Else &apos; Mono selection
1295 If _ParentType &lt;&gt; CTLPARENTISDIALOG Then &apos; getCurrentValue not found in dialog listboxes ??
1296 vCurrentValue = ControlModel.getCurrentValue() &apos; Space or uninitialized array if no selection at all
1297 If IsArray(vCurrentValue) Then &apos; Is an array if MultiSelect
1298 vListboxValue = &quot;&quot;
1299 If UBound(vCurrentValue) = 0 Then vListboxValue = vCurrentValue(0)
1300 Else
1301 vListboxValue = vCurrentValue
1302 End If
1303 If vListboxValue &lt;&gt; &quot;&quot; Then &apos; Speed up search PM Pastim 12/02/2013
1304 If Ubound(ControlModel.SelectedItems) &gt;= 0 Then lListIndex = Controlmodel.Selecteditems(0)
1305 End If
1306 Else
1307 If Ubound(ControlModel.SelectedItems) &gt;= 0 Then lListIndex = Controlmodel.Selecteditems(0)
1308 End If
1309 End If
1310 End Select
1311 _PropertyGet = lListIndex
1312 End If
1313 Case UCase(&quot;Locked&quot;)
1314 If Utils._hasUNOProperty(ControlModel, &quot;ReadOnly&quot;) Then _PropertyGet = ControlModel.ReadOnly
1315 Case UCase(&quot;MultiSelect&quot;)
1316 If Utils._hasUNOProperty(ControlModel, &quot;MultiSelection&quot;) Then
1317 _PropertyGet = ControlModel.MultiSelection &apos; Boolean in OO, Integer (0, 1 or 2) in VBA
1318 ElseIf Utils._hasUNOProperty(ControlModel, &quot;MultiSelectionSimpleMode&quot;) Then &apos; Not documented: only for GridControls !? Changed in OO &gt;= 3,3 !?
1319 _PropertyGet = ControlModel.MultiSelectionSimpleMode
1320 Else
1321 _PropertyGet = False
1322 End If
1323 Case UCase(&quot;Name&quot;)
1324 _PropertyGet = _Name
1325 Case UCase(&quot;OptionValue&quot;)
1326 If Utils._hasUNOProperty(ControlModel, &quot;RefValue&quot;) Then
1327 If ControlModel.RefValue &lt;&gt; &quot;&quot; Then
1328 _PropertyGet = ControlModel.RefValue
1329 ElseIf Utils._hasUNOProperty(ControlModel, &quot;Label&quot;) Then
1330 _PropertyGet = ControlModel.Label
1331 End If
1332 End If
1333 Case UCase(&quot;ObjectType&quot;)
1334 _PropertyGet = _Type
1335 Case UCase(&quot;Page&quot;)
1336 If Utils._hasUNOProperty(ControlModel, &quot;Step&quot;) Then _PropertyGet = ControlModel.Step
1337 Case UCase(&quot;Parent&quot;)
1338 Set _PropertyGet = PropertiesGet._ParentObject(_Shortcut)
1339 Case UCase(&quot;Required&quot;)
1340 If Utils._hasUNOProperty(ControlModel, &quot;InputRequired&quot;) Then _PropertyGet = ControlModel.InputRequired
1341 Case UCase(&quot;RowSource&quot;)
1342 Select Case _ParentType
1343 Case CTLPARENTISDIALOG
1344 If Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) Then
1345 If IsArray(ControlModel.StringItemList) Then vListSource = ControlModel.StringItemList Else vListSource = Array(ControlModel.StringItemList)
1346 _PropertyGet = Join(vListSource, &quot;;&quot;)
1347 End If
1348 Case Else
1349 If Utils._hasUNOProperty(ControlModel, &quot;ListSource&quot;) Then
1350 Select Case ControlModel.ListSourceType
1351 Case com.sun.star.form.ListSourceType.VALUELIST _
1352 , com.sun.star.form.ListSourceType.TABLEFIELDS
1353 If IsArray(ControlModel.StringItemList) Then vListSource = ControlModel.StringItemList Else vListSource = Array(ControlModel.StringItemList)
1354 Case com.sun.star.form.ListSourceType.TABLE _
1355 , com.sun.star.form.ListSourceType.QUERY _
1356 , com.sun.star.form.ListSourceType.SQL _
1357 , com.sun.star.form.ListSourceType.SQLPASSTHROUGH
1358 If IsArray(ControlModel.ListSource) Then vListSource = ControlModel.ListSource Else vListSource = Array(ControlModel.ListSource)
1359 End Select
1360 _PropertyGet = Join(vListSource, &quot;;&quot;)
1361 End If
1362 End Select
1363 Case UCase(&quot;RowSourceType&quot;)
1364 If Utils._hasUNOProperty(ControlModel, &quot;ListSourceType&quot;) Then _PropertyGet = ControlModel.ListSourceType
1365 Case UCase(&quot;Selected&quot;)
1366 If Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) Then
1367 lListIndex = UBound(ControlModel.StringItemList)
1368 If Not IsMissing(pvIndex) Then
1369 If pvIndex &lt; 0 Or pvIndex &gt; lListIndex Then Goto Trace_Error_Index
1370 End If
1371 If lListIndex &lt; 0 Then &apos; Do nothing if listbox empty
1372 _PropertyGet = Array()
1373 Else
1374 Redim bSelected(0 To lListIndex)
1375 For j = 0 To lListIndex
1376 bSelected(j) = False
1377 Next j
1378 For j = 0 To UBound(ControlModel.SelectedItems)
1379 iIndex = ControlModel.SelectedItems(j)
1380 If iIndex &gt;= 0 And iIndex &lt;= lListIndex Then bSelected(iIndex) = True
1381 Next j
1382 If IsMissing(pvIndex) Then _PropertyGet = bSelected Else _PropertyGet = bSelected(pvIndex)
1383 End If
1384 End If
1385 Case UCase(&quot;SelLength&quot;)
1386 If Utils._hasUNOProperty(ControlView, &quot;Selection&quot;) Then
1387 vSelection = ControlView.getSelection()
1388 If vSelection.Max &gt;= vSelection.Min Then
1389 _PropertyGet = vSelection.Max - vSelection.Min
1390 Else
1391 _PropertyGet = 0 &apos; probably control does not have focus
1392 End If
1393 Else
1394 _PropertyGet = 0
1395 End If
1396 Case UCase(&quot;SelStart&quot;)
1397 If Utils._hasUNOProperty(ControlView, &quot;Selection&quot;) Then
1398 vSelection = ControlView.getSelection()
1399 If vSelection.Max &gt;= vSelection.Min Then
1400 _PropertyGet = vSelection.Min + 1
1401 Else
1402 _PropertyGet = 1 &apos; probably control does not have focus
1403 End If
1404 Else
1405 _PropertyGet = 1
1406 End If
1407 Case UCase(&quot;SelText&quot;)
1408 If Utils._hasUNOProperty(ControlView, &quot;SelectedText&quot;) Then
1409 _PropertyGet = ControlView.getSelectedText()
1410 Else
1411 _PropertyGet = &quot;&quot;
1412 End If
1413 Case UCase(&quot;SpecialEffect&quot;)
1414 If Utils._hasUNOProperty(ControlModel, &quot;VisualEffect&quot;) Then _PropertyGet = ControlModel.VisualEffect
1415 Case UCase(&quot;SubType&quot;)
1416 _PropertyGet = _SubType
1417 Case UCase(&quot;TabIndex&quot;)
1418 If Utils._hasUNOProperty(ControlModel, &quot;TabIndex&quot;) Then _PropertyGet = ControlModel.TabIndex
1419 Case UCase(&quot;TabStop&quot;)
1420 If Utils._hasUNOProperty(ControlModel, &quot;TabStop&quot;) Then _PropertyGet = ControlModel.TabStop
1421 Case UCase(&quot;Tag&quot;)
1422 If Utils._hasUNOProperty(ControlModel, &quot;Tag&quot;) Then _PropertyGet = ControlModel.Tag
1423 Case UCase(&quot;Text&quot;)
1424 Select Case _SubType
1425 Case CTLDATEFIELD
1426 If Utils._hasUNOProperty(ControlModel, &quot;Date&quot;) Then
1427 If Utils._hasUNOProperty(ControlModel, &quot;FormatKey&quot;) Then
1428 If Utils._hasUNOProperty(ControlModel, &quot;FormatsSupplier&quot;) Then
1429 Select Case VarType(ControlModel.Date)
1430 Case vbLong &apos; AOO and LO &lt;= 4.1
1431 vDate = DateSerial(Left(ControlModel.Date, 4), Mid(ControlModel.Date, 5, 2), Right(ControlModel.Date, 2))
1432 Case vbObject &apos; LO &gt;= 4.2
1433 vDate = DateSerial(ControlModel.Date.Year, ControlModel.Date.Month, ControlModel.Date.Day)
1434 Case vbEmpty
1435 End Select
1436 _PropertyGet = Format(vDate, ControlModel.FormatsSupplier.getNumberFormats.getByKey(ControlModel.FormatKey).FormatString)
1437 End If
1438 End If
1439 End If
1440 Case CTLTIMEFIELD
1441 If Utils._hasUNOProperty(ControlModel, &quot;Text&quot;) Then
1442 Select Case VarType(ControlModel.Time)
1443 Case vbLong &apos; AOO and LO &lt;= 4.1
1444 _PropertyGet = Format(ControlModel.Time, &quot;HH:MM:SS&quot;)
1445 Case vbObject &apos; LO &gt;= 4.2 com.sun.star.Util.Time
1446 Set oValue = ControlModel.Time
1447 _PropertyGet = Format(TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds), &quot;HH:MM:SS&quot;)
1448 Case vbEmpty
1449 End Select
1450 End If
1451 Case Else
1452 If Utils._hasUNOProperty(ControlModel, &quot;Text&quot;) Then _PropertyGet = ControlModel.Text
1453 End Select
1454 Case UCase(&quot;TextAlign&quot;)
1455 If Utils._hasUNOProperty(ControlModel, &quot;Tag&quot;) Then _PropertyGet = ControlModel.Tag
1456 Case UCase(&quot;TripleState&quot;)
1457 If Utils._hasUNOProperty(ControlModel, &quot;TriState&quot;) Then _PropertyGet = ControlModel.TriState
1458 Case UCase(&quot;Value&quot;)
1459 Select Case _SubType
1460 Case CTLCHECKBOX
1461 If Utils._hasUNOProperty(ControlModel, &quot;State&quot;) Then vGet = ControlModel.State
1462 Case CTLCOMMANDBUTTON
1463 vGet = False
1464 If Utils._hasUNOProperty(ControlModel, &quot;Toggle&quot;) Then
1465 If Utils._hasUNOProperty(ControlModel, &quot;State&quot;) Then vGet = ( ControlModel.State = 1 )
1466 End If
1467 Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD
1468 If Utils._hasUNOProperty(ControlModel, &quot;Text&quot;) Then vGet = ControlModel.Text
1469 Case CTLCURRENCYFIELD
1470 If Utils._hasUNOProperty(ControlModel, &quot;Value&quot;) Then vGet = ControlModel.Value
1471 Case CTLDATEFIELD
1472 If Utils._hasUNOProperty(ControlModel, &quot;Date&quot;) Then
1473 Select Case VarType(ControlModel.Date)
1474 Case vbLong &apos; AOO and LO &lt;= 4.1
1475 vValue = ControlModel.Date
1476 vGet = DateSerial(Left(vValue, 4), Mid(vValue, 5, 2), Right(vValue, 2))
1477 Case vbObject &apos; LO &gt;= 4.2 com.sun.star.Util.Date
1478 Set oValue = ControlModel.Date
1479 vGet = DateSerial(oValue.Year, oValue.Month, oValue.Day)
1480 Case vbEmpty
1481 End Select
1482 End If
1483 Case CTLFORMATTEDFIELD
1484 If Utils._hasUNOProperty(ControlModel, &quot;EffectiveValue&quot;) Then vGet = ControlModel.EffectiveValue
1485 Case CTLHIDDENCONTROL
1486 If Utils._hasUNOProperty(ControlModel, &quot;HiddenValue&quot;) Then vGet = ControlModel.HiddenValue
1487 Case CTLLISTBOX
1488 If Not Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) Then Goto Trace_Error
1489 If Not Utils._hasUNOProperty(ControlModel, &quot;SelectedItems&quot;) Then Goto Trace_Error
1490 If UBound(ControlModel.SelectedItems) &gt; 0 Then &apos; Several items selected
1491 vGet = vEMPTY &apos; Listbox has no value, only an array of Selected flags to identify values
1492 Else &apos; Mono selection
1493 Select Case _ParentType
1494 Case CTLPARENTISDIALOG
1495 If Ubound(ControlModel.SelectedItems) &gt;= 0 Then
1496 lListIndex = Controlmodel.Selecteditems(0)
1497 If lListIndex &gt; -1 And lListIndex &lt;= UBound(ControlModel.StringItemList) Then
1498 vGet = ControlModel.StringItemList(lListIndex)
1499 Else
1500 vGet = vEMPTY
1501 End If
1502 End If
1503 Case Else
1504 vCurrentValue = ControlModel.getCurrentValue() &apos; Space or uninitialized array if no selection at all
1505 If IsArray(vCurrentValue) Then &apos; Is an array if MultiSelect
1506 If UBound(vCurrentValue) &gt;= LBound(vCurrentValue) Then
1507 vListboxValue = vCurrentValue(0)
1508 Else
1509 vListboxValue = &quot;&quot;
1510 End If
1511 Else
1512 vListboxValue = vCurrentValue
1513 End If
1514 lListIndex = -1 &apos; Speed up getting value PM PASTIM 12/02/2013
1515 If vListboxValue &lt;&gt; &quot;&quot; Then
1516 If Ubound(ControlModel.SelectedItems) &gt;= 0 Then lListIndex = Controlmodel.Selecteditems(0)
1517 End If
1518 &apos; If listbox has hidden column = real bound field, then explore ValueItemList
1519 bListboxBound = _ListboxBound()
1520 If bListboxBound Then
1521 If lListIndex &gt; -1 Then vGet = ControlModel.ValueItemList(lListIndex) &apos; PASTIM
1522 Else
1523 vGet = vListboxValue
1524 End If
1525 End Select
1526 End If
1527 Case CTLNUMERICFIELD
1528 If Utils._hasUNOProperty(ControlModel, &quot;Value&quot;) Then vGet = ControlModel.Value
1529 Case CTLPROGRESSBAR
1530 If Utils._hasUNOProperty(ControlModel, &quot;ProgressValue&quot;) Then vGet = ControlModel.ProgressValue
1531 Case CTLSCROLLBAR
1532 If Utils._hasUNOProperty(ControlModel, &quot;ScrollValue&quot;) Then vGet = ControlModel.ScrollValue
1533 Case CTLSPINBUTTON
1534 If Utils._hasUNOProperty(ControlModel, &quot;SpinValue&quot;) Then vGet = ControlModel.SpinValue
1535 Case CTLTIMEFIELD
1536 If Utils._hasUNOProperty(ControlModel, &quot;Time&quot;) Then
1537 Select Case VarType(ControlModel.Time)
1538 Case vbLong &apos; AOO and LO &lt;= 4.1
1539 vGet = ControlModel.Time
1540 Case vbObject &apos; LO &gt;= 4.2 com.sun.star.Util.Time
1541 Set oValue = ControlModel.Time
1542 vGet = TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds)
1543 Case vbEmpty
1544 End Select
1545 End If
1546 Case Else
1547 End Select
1548 If _SubType &lt;&gt; CTLLISTBOX Then &apos; Give getCurrentValue an additional try
1549 If IsEmpty(vGet) And Utils._hasUNOMethod(ControlModel, &quot;getCurrentValue&quot;) Then vGet = ControlModel.getCurrentValue()
1550 End If
1551 _PropertyGet = vGet
1552 Case UCase(&quot;Visible&quot;)
1553 Select Case _SubType
1554 Case CTLHIDDENCONTROL
1555 _PropertyGet = False
1556 Case Else
1557 If Utils._hasUNOMethod(ControlView, &quot;isVisible&quot;) Then _PropertyGet = CBool(ControlView.isVisible())
1558 End Select
1559 Case Else
1560 Goto Trace_Error
1561 End Select
1562
1563 If IsEmpty(_PropertyGet) Then TraceError(TRACEINFO, ERRPROPERTYINIT, Utils._CalledSub(), 0, , psProperty)
1564
1565 Exit_Function:
1566 Utils._ResetCalledSub(&quot;Control.get&quot; &amp; psProperty)
1567 Exit Function
1568 Trace_Error:
1569 TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
1570 _PropertyGet = vEMPTY
1571 Goto Exit_Function
1572 Trace_Error_Index:
1573 TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty)
1574 _PropertyGet = vEMPTY
1575 Goto Exit_Function
1576 Error_Function:
1577 TraceError(TRACEABORT, Err, &quot;Control._PropertyGet&quot;, Erl)
1578 _PropertyGet = vEMPTY
1579 GoTo Exit_Function
1580 End Function &apos; _PropertyGet V0.9.1
1581
1582 REM -----------------------------------------------------------------------------------------------------------------------
1583 Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean
1584 &apos; Return True if property setting OK
1585
1586 If _ErrorHandler() Then On Local Error Goto Error_Function
1587 Utils._SetCalledSub(&quot;Control.set&quot; &amp; psProperty)
1588 _PropertySet = True
1589
1590 &apos;Check Index argument
1591 If Not IsMissing(pvIndex) Then
1592 If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric()) Then Goto Exit_Function
1593 End If
1594 &apos;Execute
1595 Dim iArgNr As Integer, vButton As Variant, i As Integer
1596 Dim odbDatabase As Object, vNames() As Variant, bFound As Boolean, sName As String
1597 Dim bMultiSelect As Boolean, iCount As Integer, iSelectedItems() As Integer, lListCount As Long, bSelected() As Boolean
1598 Dim vItemList() As Variant, vFormats() As Variant
1599 Dim oStruct As Object, sValue As String
1600 Dim vSelection As Variant, sText As String, lStart As long
1601
1602 _PropertySet = True
1603 Select Case UCase(_A2B_.CalledSub)
1604 Case UCase(&quot;setProperty&quot;) : iArgNr = 3
1605 Case UCase(&quot;Control.setProperty&quot;) : iArgNr = 2
1606 Case UCase(&quot;Control.set&quot; &amp; psProperty) : iArgNr = 1
1607 End Select
1608
1609 If Not hasProperty(psProperty) Then Goto Trace_Error
1610
1611 Select Case UCase(psProperty)
1612 Case UCase(&quot;BackColor&quot;)
1613 If Not Utils._hasUNOProperty(ControlModel, &quot;BackgroundColor&quot;) Then Goto Trace_Error
1614 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1615 ControlModel.BackgroundColor = CLng(pvValue)
1616 Case UCase(&quot;BorderColor&quot;)
1617 If Not Utils._hasUNOProperty(ControlModel, &quot;BorderColor&quot;) Then Goto Trace_Error
1618 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1619 ControlModel.BorderColor = CLng(pvValue)
1620 Case UCase(&quot;BorderStyle&quot;)
1621 If Not Utils._hasUNOProperty(ControlModel, &quot;BorderColor&quot;) Then Goto Trace_Error
1622 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1623 If pvValue &lt; 0 Or pvValue &gt; 2 Then Goto Trace_Error_Value &apos; 0 = No border, 1 = 3D border, 2 = Normal border
1624 ControlModel.Border = CLng(pvValue)
1625 Case UCase(&quot;Cancel&quot;)
1626 If Not Utils._hasUNOProperty(ControlModel, &quot;PushButtonType&quot;) Then Goto Trace_Error
1627 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1628 If pvValue Then vButton = com.sun.star.awt.PushButtonType.CANCEL Else vButton = com.sun.star.awt.PushButtonType.STANDARD
1629 ControlModel.PushButtonType = vButton
1630 Case UCase(&quot;Caption&quot;)
1631 If Not Utils._hasUNOProperty(ControlModel, &quot;Label&quot;) Then Goto Trace_Error
1632 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
1633 ControlModel.Label = pvValue
1634 Case UCase(&quot;ControlTipText&quot;)
1635 If Not Utils._hasUNOProperty(ControlModel, &quot;HelpText&quot;) Then Goto Trace_Error
1636 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
1637 ControlModel.HelpText = pvValue
1638 Case UCase(&quot;Default&quot;)
1639 If Not Utils._hasUNOProperty(ControlModel, &quot;DefaultButton&quot;) Then Goto Trace_Error
1640 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1641 ControlModel.DefaultButton = pvValue
1642 Case UCase(&quot;DefaultValue&quot;)
1643 Select Case _SubType
1644 Case CTLDATEFIELD
1645 If Not Utils._hasUNOProperty(ControlModel, &quot;DefaultDate&quot;) Then Goto Trace_Error
1646 If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
1647 Select Case VarType(ControlModel.DefaultDate)
1648 Case vbEmpty, vbLong &apos; AOO and LO &lt;= 4.1
1649 ControlModel.DefaultDate = Year(pvValue) * 10000 + Month(pvValue) * 100 + Day(pvValue)
1650 Case vbObject &apos; LO &gt;= 4.2 com.sun.star.Util.Date
1651 ControlModel.DefaultDate.Year = Year(pvValue)
1652 ControlModel.DefaultDate.Month = Month(pvValue)
1653 ControlModel.DefaultDate.Day = Day(pvValue)
1654 End Select
1655 Case CTLLISTBOX
1656 If Not Utils._hasUNOProperty(ControlModel, &quot;DefaultSelection&quot;) Or Not Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) Then Goto Trace_Error
1657 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
1658 For i = 0 To UBound(ControlModel.StringItemList)
1659 If UCase(pvValue) = UCase(ControlModel.StringItemList(i)) Then
1660 ControlModel.DefaultSelection = Array(i)
1661 Exit For
1662 End If
1663 Next i
1664 Case CTLSPINBUTTON
1665 If Not Utils._hasUNOProperty(ControlModel, &quot;DefaultSpinValue&quot;) Then Goto Trace_Error
1666 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1667 ControlModel.DefaultSpinValue = pvValue
1668 Case CTLCHECKBOX
1669 If Not Utils._hasUNOProperty(ControlModel, &quot;DefaultState&quot;) Then Goto Trace_Error
1670 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1671 If pvValue &lt; 0 Or pvValue &gt; 2 Then Goto Trace_Error_Value &apos; 0 = Not checked 1 = Checked 2 = don&apos;t know
1672 ControlModel.DefaultState = pvValue
1673 Case CTLRADIOBUTTON
1674 If Not Utils._hasUNOProperty(ControlModel, &quot;DefaultState&quot;) Then Goto Trace_Error
1675 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1676 If pvValue &lt; 0 Or pvValue &gt; 1 Then Goto Trace_Error_Value &apos; 0 = Not checked 1 = Checked
1677 ControlModel.DefaultState = pvValue
1678 Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD
1679 If Not Utils._hasUNOProperty(ControlModel, &quot;DefaultText&quot;) Then Goto Trace_Error
1680 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
1681 ControlModel.DefaultText = pvValue
1682 Case CTLTIMEFIELD
1683 If Not Utils._hasUNOProperty(ControlModel, &quot;DefaultTime&quot;) Then Goto Trace_Error
1684 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1685 If pvValue &gt;= 0 And pvValue &lt;= 23595999 Then
1686 Select Case VarType(ControlModel.DefaultTime)
1687 Case vbEmpty, vbLong &apos; AOO and LO &lt;= 4.1
1688 ControlModel.DefaultTime = pvValue
1689 Case vbObject &apos; LO &gt;= 4.2 com.sun.star.Util.Time
1690 ControlModel.DefaultDate.Hours = Hour(pvValue)
1691 ControlModel.DefaultDate.Minutes = Minute(pvValue)
1692 ControlModel.DefaultDate.Seconds = Second(pvValue)
1693 End Select
1694 Else Goto Trace_Error_Value
1695 End If
1696 Case CTLCURRENCYFIELD, CTLNUMERICFIELD
1697 If Not Utils._hasUNOProperty(ControlModel, &quot;DefaultValue&quot;) Then Goto Trace_Error
1698 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1699 ControlModel.DefaultValue = pvValue
1700 Case CTLFORMATTEDFIELD
1701 If Not Utils._hasUNOProperty(ControlModel, &quot;EffectiveDefault&quot;) Then Goto Trace_Error
1702 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1703 ControlModel.EffectiveDefault = pvValue &apos; Thanks, PASTIM
1704 Case Else
1705 Goto Trace_Error
1706 End Select
1707 Case UCase(&quot;Enabled&quot;)
1708 If Not Utils._hasUNOProperty(ControlModel, &quot;Enabled&quot;) Then Goto Trace_Error
1709 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1710 ControlModel.Enabled = pvValue
1711 Case UCase(&quot;FontBold&quot;)
1712 If Not Utils._hasUNOProperty(ControlModel, &quot;FontWeight&quot;) Then Goto Trace_Error
1713 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1714 If pvValue Then &apos; Iif construction does not work !
1715 ControlModel.FontWeight = com.sun.star.awt.FontWeight.BOLD
1716 Else
1717 ControlModel.FontWeight = com.sun.star.awt.FontWeight.NORMAL
1718 End If
1719 Case UCase(&quot;FontItalic&quot;)
1720 If Not Utils._hasUNOProperty(ControlModel, &quot;FontSlant&quot;) Then Goto Trace_Error
1721 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1722 If pvValue Then &apos; Iif construction does not work !
1723 ControlModel.FontSlant = com.sun.star.awt.FontSlant.ITALIC
1724 Else
1725 ControlModel.FontSlant = com.sun.star.awt.FontSlant.NONE
1726 End If
1727 Case UCase(&quot;FontName&quot;)
1728 If Not Utils._hasUNOProperty(ControlModel, &quot;FontName&quot;) Then Goto Trace_Error
1729 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
1730 ControlModel.FontName = pvValue
1731 Case UCase(&quot;FontSize&quot;)
1732 If Not Utils._hasUNOProperty(ControlModel, &quot;FontHeight&quot;) Then Goto Trace_Error
1733 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1734 If pvValue &lt; 1 Or pvValue &gt; 127 Then Goto Trace_Error_Value
1735 ControlModel.FontHeight = pvValue
1736 Case UCase(&quot;FontUnderline&quot;)
1737 If Not Utils._hasUNOProperty(ControlModel, &quot;FontUnderline&quot;) Then Goto Trace_Error
1738 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1739 If pvValue Then &apos; Iif construction does not work !
1740 ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.SINGLE
1741 Else
1742 ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.NONE
1743 End If
1744 Case UCase(&quot;FontWeight&quot;)
1745 If Not Utils._hasUNOProperty(ControlModel, &quot;FontWeight&quot;) Then Goto Trace_Error
1746 If Not Utils._IsScalar(CSng(pvValue), vbSingle, Array( _
1747 com.sun.star.awt.FontWeight.THIN _
1748 , com.sun.star.awt.FontWeight.ULTRALIGHT _
1749 , com.sun.star.awt.FontWeight.LIGHT _
1750 , com.sun.star.awt.FontWeight.SEMILIGHT _
1751 , com.sun.star.awt.FontWeight.NORMAL _
1752 , com.sun.star.awt.FontWeight.SEMIBOLD _
1753 , com.sun.star.awt.FontWeight.BOLD _
1754 , com.sun.star.awt.FontWeight.ULTRABOLD _
1755 , com.sun.star.awt.FontWeight.BLACK _
1756 )) Then Goto Trace_Error_Value
1757 ControlModel.FontWeight = pvValue
1758 Case UCase(&quot;Format&quot;)
1759 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
1760 vFormats = _Formats(_SubType)
1761 Select Case _SubType
1762 Case CTLDATEFIELD, CTLTIMEFIELD
1763 bFound = False
1764 For i = 0 To UBound(vFormats)
1765 If UCase(pvValue) = UCase(vFormats(i)) Then
1766 If _SubType = CTLDATEFIELD Then
1767 If Utils._hasUNOProperty(ControlModel, &quot;DateFormat&quot;) Then ControlModel.DateFormat = i Else Goto Trace_Error
1768 Else
1769 If Utils._hasUNOProperty(ControlModel, &quot;TimeFormat&quot;) Then ControlModel.TimeFormat = i Else Goto Trace_Error
1770 End If
1771 bFound = True
1772 Exit For
1773 End If
1774 Next i
1775 If Not bFound Then Goto Trace_Error_Value
1776 Case Else
1777 Goto Trace_Error
1778 End Select
1779 Case UCase(&quot;ForeColor&quot;)
1780 If Not Utils._hasUNOProperty(ControlModel, &quot;TextColor&quot;) Then Goto Trace_Error
1781 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1782 ControlModel.TextColor = CLng(pvValue)
1783 Case UCase(&quot;ListIndex&quot;)
1784 If Not Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) Then Goto Trace_Error
1785 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1786 If pvValue &lt; 0 Or pvValue &gt; UBound(ControlModel.StringItemList) Then Goto Trace_Error_Value
1787 Select Case _SubType
1788 Case CTLCOMBOBOX
1789 ControlModel.Text = ControlModel.StringItemList(pvValue)
1790 Case CTLLISTBOX
1791 ControlModel.SelectedItems = Array(pvValue)
1792 End Select
1793 Case UCase(&quot;Locked&quot;)
1794 If Not Utils._hasUNOProperty(ControlModel, &quot;ReadOnly&quot;) Then Goto Trace_Error
1795 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1796 ControlModel.ReadOnly = pvValue
1797 Case UCase(&quot;MultiSelect&quot;)
1798 If Not Utils._hasUNOProperty(ControlModel, &quot;MultiSelection&quot;) And Not Utils._hasUNOProperty(ControlModel, &quot;MultiSelectionSimpleMode&quot;) Then Goto Trace_Error
1799 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1800 If Utils._hasUNOProperty(ControlModel, &quot;MultiSelection&quot;) Then
1801 ControlModel.MultiSelection = pvValue
1802 ElseIf Utils._hasUNOProperty(ControlModel, &quot;MultiSelectionSimpleMode&quot;) Then
1803 ControlModel.MultiSelectionSimpleMode = pvValue
1804 End If
1805 If Not pvValue Then ControlModel.SelectedItems = Array() &apos; Cancel selections when MultiSelect becomes False
1806 Case UCase(&quot;OptionValue&quot;)
1807 If Not Utils._hasUNOProperty(ControlModel, &quot;RefValue&quot;) Then Goto Trace_Error
1808 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
1809 If Not Utils._hasUNOProperty(ControlModel, &quot;Label&quot;) Then
1810 If pvValue = &quot;&quot; Then Goto Trace_Error_Value
1811 If ControlModel.RefValue &lt;&gt; &quot;&quot; Then ControlModel.RefValue = pvValue
1812 Else
1813 ControlModel.Label = pvValue
1814 End If
1815 Case UCase(&quot;Page&quot;)
1816 If Not Utils._hasUNOProperty(ControlModel, &quot;Step&quot;) Then Goto Trace_Error
1817 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1818 If pvValue &lt; 0 Then Goto Trace_Error_Value
1819 ControlModel.Step = pvValue
1820 Case UCase(&quot;Required&quot;)
1821 If Not Utils._hasUNOProperty(ControlModel, &quot;InputRequired&quot;) Then Goto Trace_Error
1822 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1823 ControlModel.InputRequired = pvValue
1824 Case UCase(&quot;RowSource&quot;)
1825 Select Case _ParentType
1826 Case CTLPARENTISDIALOG
1827 If Not Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) Then Goto Trace_Error
1828 ControlModel.StringItemList = Split(pvValue, &quot;;&quot;)
1829 Case Else
1830 If Not Utils._hasUNOProperty(ControlModel, &quot;ListSource&quot;) Then Goto Trace_Error
1831 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
1832 Select Case ControlModel.ListSourceType
1833 Case com.sun.star.form.ListSourceType.QUERY _
1834 , com.sun.star.form.ListSourceType.TABLE _
1835 , com.sun.star.form.ListSourceType.TABLEFIELDS
1836 Set odbDatabase = Application._CurrentDb(_DocEntry, _DbEntry)
1837 If ControlModel.ListSourceType = com.sun.star.form.ListSourceType.QUERY Then vNames = odbDatabase.Connection.getQueries.GetElementNames _
1838 Else vNames = odbDatabase.Connection.getTables.GetElementNames
1839 bFound = False &apos; Check existence of table or query and find its correct (case-sensitive) name
1840 For i = 0 To UBound(vNames)
1841 If UCase(vNames(i)) = UCase(pvValue) Then
1842 bFound = True
1843 sName = vNames(i)
1844 Exit For
1845 End If
1846 Next i
1847 If Not bFound Then Goto Trace_Error_Value
1848 If _SubType = CTLCOMBOBOX Then ControlModel.ListSource = sName Else ControlModel.ListSource = Array(sName)
1849 ControlModel.refresh()
1850 Case com.sun.star.form.ListSourceType.SQL
1851 Set odbDatabase = Application._CurrentDb(_DocEntry, _DbEntry)
1852 If _SubType = CTLCOMBOBOX Then ControlModel.ListSource = odbDatabase._ReplaceSquareBrackets(pvValue) Else ControlModel.ListSource = Array(odbDatabase._ReplaceSquareBrackets(pvValue))
1853 ControlModel.refresh()
1854 Case com.sun.star.form.ListSourceType.VALUELIST &apos; Forbidden for COMBOBOX !
1855 If _SubType = CTLCOMBOBOX Then Goto Trace_Error
1856 ControlModel.ListSource = Split(pvValue, &quot;;&quot;)
1857 ControlModel.StringItemList = ControlModel.ListSource
1858 Case com.sun.star.form.ListSourceType.SQLPASSTHROUGH
1859 If _SubType = CTLCOMBOBOX Then ControlModel.ListSource = pvValue Else ControlModel.ListSource = Array(pvValue)
1860 ControlModel.refresh()
1861 End Select
1862 End Select
1863 If _SubType = CTLLISTBOX Then ControlModel.SelectedItems = Array()
1864 Case UCase(&quot;RowSourceType&quot;) &apos; Refresh done when RowSource changes, not RowSourceType
1865 If Not Utils._hasUNOProperty(ControlModel, &quot;ListSourceType&quot;) Then Goto Trace_Error
1866 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1867 If Not Utils._IsScalar(pvValue, Utils._AddNumeric(), Array( _
1868 com.sun.star.form.ListSourceType.VALUELIST _
1869 , com.sun.star.form.ListSourceType.TABLE _
1870 , com.sun.star.form.ListSourceType.QUERY _
1871 , com.sun.star.form.ListSourceType.SQL _
1872 , com.sun.star.form.ListSourceType.SQLPASSTHROUGH _
1873 , com.sun.star.form.ListSourceType.TABLEFIELDS _
1874 )) Then Goto Trace_Error_Value
1875 ControlModel.ListSourceType = pvValue
1876 Case UCase(&quot;Selected&quot;)
1877 If Not Utils._hasUNOProperty(ControlModel, &quot;SelectedItems&quot;) Then Goto Trace_Error
1878 If Not Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) Then Goto Trace_Error
1879 If Utils._hasUNOProperty(ControlModel, &quot;MultiSelection&quot;) Then
1880 bMultiSelect = ControlModel.MultiSelection
1881 ElseIf Utils._hasUNOProperty(ControlModel, &quot;MultiSelectionSimpleMode&quot;) Then
1882 bMultiSelect = ControlModel.MultiSelectionSimpleMode
1883 Else: Goto Trace_Error
1884 End If
1885 lListCount = UBound(ControlModel.StringItemList) + 1
1886 If IsMissing(pvIndex) Then &apos; Full boolean array passed
1887 If Not IsArray(pvValue) Then Goto Trace_Error_Array
1888 If LBound(pvValue) &lt;&gt; 0 Or UBound(pvValue) &lt; 0 Then Goto Trace_Error_Array
1889 If Not Utils._CheckArgument(pvValue(0), iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1890 If UBound(pvValue) &lt;&gt; lListCount - 1 Then Goto Trace_Error_Index
1891 iCount = 0
1892 For i = 0 To UBound(pvValue) &apos; Count True values
1893 If pvValue(i) Then iCount = iCount + 1
1894 Next i
1895 If iCount &gt; 0 Then
1896 Redim iSelectedItems(0 To iCount - 1)
1897 iCount = 0
1898 For i = 0 To UBound(pvValue)
1899 If pvValue(i) Then
1900 iSelectedItems(iCount) = i
1901 iCount = iCount + 1
1902 End If
1903 Next i
1904 ControlModel.SelectedItems = iSelectedItems &apos; iSelectedItems maps OO internals (size = # of selected items)
1905 Else
1906 ControlModel.SelectedItems = Array()
1907 End If
1908 Else &apos; Single boolean value passed
1909 If Not Utils._CheckArgument(pvIndex, iArgNr + 1, Utils._AddNumeric()) Then Goto Exit_Function
1910 If pvIndex &lt; 0 Or pvIndex &gt;= lListCount Then Goto Trace_Error_Index
1911 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1912 ReDim bSelected(0 To lListCount - 1) &apos; bSelected maps VBA internals (size = # of displayed items)
1913 If Not bMultiSelect Then &apos; Set all other values to False
1914 For i = 0 To lListCount - 1
1915 If i = pvIndex Then
1916 bSelected(i) = pvValue &apos; All entries = False except one
1917 Else
1918 bSelected(i) = False
1919 End If
1920 Next i
1921 Else
1922 For i = 0 To lListCount - 1
1923 bSelected(i) = False
1924 Next i
1925 iSelectedItems = ControlModel.SelectedItems
1926 iCount = UBound(iSelectedItems)
1927 For i = 0 To iCount
1928 bSelected(iSelectedItems(i)) = True
1929 Next i
1930 bSelected(pvIndex) = pvValue
1931 End If
1932 iCount = 0 &apos; Rebuild SelectedItems
1933 For i = 0 To lListCount - 1
1934 If bSelected(i) Then iCount = iCount + 1
1935 Next i
1936 If iCount &gt; 0 Then
1937 Redim iSelectedItems(0 To iCount - 1)
1938 iCount = 0
1939 For i = 0 To lListCount - 1
1940 If bSelected(i) Then
1941 iSelectedItems(iCount) = i
1942 iCount = iCount + 1
1943 End If
1944 Next i
1945 ControlModel.SelectedItems = iSelectedItems
1946 Else
1947 ControlModel.SelectedItems = Array()
1948 End If
1949 End If
1950 Case UCase(&quot;SelLength&quot;)
1951 If Not Utils._hasUNOProperty(ControlView, &quot;Selection&quot;) Then Goto trace_Error
1952 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1953 If pvValue &lt; 0 Then Goto Trace_Error_Value
1954 vSelection = ControlView.getSelection()
1955 vSelection.Max = vSelection.Min + pvValue
1956 ControlView.setSelection(vSelection)
1957 Case UCase(&quot;SelStart&quot;)
1958 If Not Utils._hasUNOProperty(ControlView, &quot;Selection&quot;) Then Goto trace_Error
1959 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1960 If pvValue &lt; 1 Or pvValue &gt; Len(ControlModel.Text) + 1 Then Goto Trace_Error_Value
1961 vSelection = ControlView.getSelection()
1962 vSelection.Min = pvValue - 1
1963 vSelection.Max = pvValue - 1 &apos; Also reset length to 0
1964 ControlView.setSelection(vSelection)
1965 Case UCase(&quot;SelText&quot;)
1966 If Not Utils._hasUNOProperty(ControlView, &quot;Selection&quot;) Then Goto trace_Error
1967 If Not Utils._hasUNOProperty(ControlModel, &quot;Text&quot;) Then Goto trace_Error
1968 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
1969 If Len(pvValue) &gt; 0 Then
1970 vSelection = ControlView.getSelection()
1971 sText = ControlModel.Text
1972 lStart = InStr(1, sText, pvValue, 0) &apos; Case sensitive !
1973 If lStart &gt; 0 Then
1974 vSelection.Min = lStart - 1
1975 vSelection.Max = lStart + Len(pvValue) - 1
1976 ControlView.setSelection(vSelection)
1977 End If
1978 End If
1979 Case UCase(&quot;SpecialEffect&quot;)
1980 If Not Utils._hasUNOProperty(ControlModel, &quot;VisualEffect&quot;) Then Goto Trace_Error
1981 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1982 If pvValue &lt; 0 Or pvValue &gt; 2 Then Goto Trace_Error_Value &apos; 0 = None, 1 = Look3D, 2 = Flat
1983 ControlModel.VisualEffect = pvValue
1984 Case UCase(&quot;TabIndex&quot;)
1985 If Not Utils._hasUNOProperty(ControlModel, &quot;TabIndex&quot;) Then Goto Trace_Error
1986 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
1987 If pvValue &lt; -1 Then Goto Trace_Error_Value
1988 ControlModel.TabIndex = pvValue
1989 Case UCase(&quot;TabStop&quot;)
1990 If Not Utils._hasUNOProperty(ControlModel, &quot;Tabstop&quot;) Then Goto Trace_Error
1991 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
1992 ControlModel.Tabstop = pvValue
1993 Case UCase(&quot;Tag&quot;)
1994 If Not Utils._hasUNOProperty(ControlModel, &quot;Tag&quot;) Then Goto Trace_Error
1995 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
1996 ControlModel.Tag = pvValue
1997 Case UCase(&quot;TextAlign&quot;)
1998 If Not Utils._hasUNOProperty(ControlModel, &quot;Align&quot;) Then Goto Trace_Error
1999 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
2000 If pvValue &lt; 0 Or pvValue &gt; 2 Then Goto Trace_Error_Value &apos; 0 = Left, 1 = Center, 2 = Right
2001 ControlModel.Align = pvValue
2002 Case UCase(&quot;TripleState&quot;)
2003 If Not Utils._hasUNOProperty(ControlModel, &quot;TriState&quot;) Then Goto Trace_Error
2004 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
2005 ControlModel.TriState = pvValue
2006 Case UCase(&quot;Value&quot;)
2007 Select Case _SubType
2008 Case CTLCHECKBOX
2009 If Not Utils._hasUNOProperty(ControlModel, &quot;State&quot;) Then Goto Trace_Error
2010 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(vbBoolean), , False) Then Goto Trace_Error_Value
2011 If VarType(pvValue) = vbBoolean Then pvValue = Iif(pvValue, 1, 0)
2012 If pvValue &lt; 0 Or pvValue &gt; 2 Then Goto Trace_Error_Value &apos; 0 = Not checked 1 = Checked 2 = don&apos;t know
2013 ControlModel.State = pvValue
2014 Case CTLCOMMANDBUTTON
2015 If Not Utils._hasUNOProperty(ControlModel, &quot;State&quot;) Then Goto Trace_Error
2016 If Not Utils._hasUNOProperty(ControlModel, &quot;Toggle&quot;) Then Goto Trace_Error
2017 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
2018 If pvValue Then ControlModel.State = 1 Else ControlModel.State = 0
2019 Case CTLCOMBOBOX
2020 If Not Utils._hasUNOProperty(ControlModel, &quot;Text&quot;) Or Not Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) _
2021 Then Goto Trace_Error
2022 If pvValue &lt;&gt; &quot;&quot; Then
2023 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, ControlModel.StringItemList, False) Then Goto Trace_Error_Value
2024 End If
2025 ControlModel.Text = pvValue
2026 Case CTLCURRENCYFIELD, CTLNUMERICFIELD
2027 If Not Utils._hasUNOProperty(ControlModel, &quot;Value&quot;) Then Goto Trace_Error
2028 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
2029 ControlModel.Value = pvValue
2030 Case CTLDATEFIELD
2031 If Not Utils._hasUNOProperty(ControlModel, &quot;Date&quot;) Then Goto Trace_Error
2032 If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
2033 Select Case _InspectPropertyType(ControlModel, &quot;Date&quot;)
2034 Case &quot;long&quot; &apos; AOO and LO &lt;= 4.1
2035 &apos;ControlModel.Date = Year(pvValue) * 10000 + Month(pvValue) * 100 + Day(pvValue) &apos; Gives error in dialogs ?!?
2036 ControlModel.setPropertyValue(&quot;Date&quot;, Year(pvValue) * 10000 + Month(pvValue) * 100 + Day(pvValue))
2037 Case &quot;com.sun.star.util.Date&quot; &apos; LO &gt;= 4.2
2038 &apos;Direct assignment of ControlModel.Date.Xxx has no effect ?!?
2039 Set oStruct = CreateUnoStruct(&quot;com.sun.star.util.Date&quot;)
2040 oStruct.Year = Year(pvValue)
2041 oStruct.Month = Month(pvValue)
2042 oStruct.Day = Day(pvValue)
2043 Set ControlModel.Date = oStruct
2044 End Select
2045 Case CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD
2046 If Not Utils._hasUNOProperty(ControlModel, &quot;Text&quot;) Then Goto Trace_Error
2047 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
2048 ControlModel.Text = pvValue
2049 Case CTLFORMATTEDFIELD
2050 If Not Utils._hasUNOProperty(ControlModel, &quot;EffectiveValue&quot;) Then Goto Trace_Error
2051 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(vbString), , False) Then Goto Trace_Error_Value
2052 ControlModel.EffectiveValue = pvValue
2053 Case CTLHIDDENCONTROL
2054 If Not Utils._hasUNOProperty(ControlModel, &quot;HiddenValue&quot;) Then Goto Trace_Error
2055 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(Array(vbString, vbBoolean, vbDate)), , False) Then Goto Trace_Error_Value
2056 ControlModel.HiddenValue = pvValue
2057 Case CTLLISTBOX
2058 If Not Utils._hasUNOProperty(ControlModel, &quot;SelectedItems&quot;) Or Not Utils._hasUNOProperty(ControlModel, &quot;StringItemList&quot;) _
2059 Then Goto Trace_Error
2060 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(Array(vbString, vbDate)), , False) Then Goto Trace_Error_Value &apos; PASTIM
2061 If IsArray(pvValue) Then Goto Trace_Error_Value &apos; Setting the value on a listbox is allowed only if single value and value in the list
2062 &apos; Check ValueItemList
2063 bFound = False
2064 Select Case _ParentType
2065 Case CTLPARENTISDIALOG
2066 vItemList = ControlModel.StringItemList
2067 Case Else
2068 If _ListboxBound() Then &apos; Performance improvement (PASTIM PM 9 Feb 2013)
2069 If Not Utils._hasUNOProperty(ControlModel, &quot;ValueItemList&quot;) Then Goto Trace_Error
2070 vItemList = ControlModel.ValueItemList
2071 Else
2072 vItemList = ControlModel.StringItemList
2073 End If
2074 End Select
2075 For i = 0 To UBound(vItemList)
2076 If pvValue = vItemList(i) Then
2077 bFound = True
2078 Exit For
2079 End If
2080 Next i
2081 If bFound Then ControlModel.SelectedItems = Array(i) Else Goto Trace_Error_Value
2082 Case CTLPROGRESSBAR
2083 If Not Utils._hasUNOProperty(ControlModel, &quot;ProgressValue&quot;) Then Goto Trace_Error
2084 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
2085 If Utils._hasUNOProperty(ControlModel, &quot;ProgressValueMin&quot;) Then
2086 If pvValue &lt; ControlModel.ProgressValueMin Then Goto Trace_Error_Value
2087 End If
2088 If Utils._hasUNOProperty(ControlModel, &quot;ProgressValueMax&quot;) Then
2089 If pvValue &gt; ControlModel.ProgressValueMax Then Goto Trace_Error_Value
2090 End If
2091 ControlModel.ProgressValue = pvValue
2092 Case CTLSCROLLBAR
2093 If Not Utils._hasUNOProperty(ControlModel, &quot;ScrollValue&quot;) Then Goto Trace_Error
2094 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
2095 If Utils._hasUNOProperty(ControlModel, &quot;ScrollValueMin&quot;) Then
2096 If pvValue &lt; ControlModel.ScrollValueMin Then Goto Trace_Error_Value
2097 End If
2098 If Utils._hasUNOProperty(ControlModel, &quot;ScrollValueMax&quot;) Then
2099 If pvValue &gt; ControlModel.ScrollValueMax Then Goto Trace_Error_Value
2100 End If
2101 ControlModel.ScrollValue = pvValue
2102 Case CTLSPINBUTTON
2103 If Not Utils._hasUNOProperty(ControlModel, &quot;SpinValue&quot;) Then Goto Trace_Error
2104 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
2105 If Utils._hasUNOProperty(ControlModel, &quot;SpinValueMin&quot;) Then
2106 If pvValue &lt; ControlModel.SpinValueMin Then Goto Trace_Error_Value
2107 End If
2108 If Utils._hasUNOProperty(ControlModel, &quot;SpinValueMax&quot;) Then
2109 If pvValue &gt; ControlModel.SpinValueMax Then Goto Trace_Error_Value
2110 End If
2111 ControlModel.SpinValue = pvValue
2112 Case CTLTIMEFIELD
2113 If Not Utils._hasUNOProperty(ControlModel, &quot;Time&quot;) Then Goto Trace_Error
2114 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
2115 Select Case _InspectPropertyType(ControlModel, &quot;Time&quot;)
2116 Case &quot;long&quot; &apos; AOO and LO &lt;= 4.0
2117 ControlModel.Time = CLng(pvValue)
2118 Case &quot;com.sun.star.util.Time&quot; &apos; LO &gt;= 4.1
2119 &apos;Direct assignment of ControlModel.Time.Xxx gives error ?!?
2120 Set oStruct = CreateUnoStruct(&quot;com.sun.star.util.Time&quot;)
2121 sValue = Right(&quot;00000000&quot; &amp; Str(CLng(pvValue)), 8)
2122 oStruct.Hours = Val(Left(sValue, 2))
2123 oStruct.Minutes = Val(Mid(sValue, 3, 2))
2124 oStruct.Seconds = Val(Mid(sValue, 5, 2))
2125 Set ControlModel.Time = oStruct
2126 End Select
2127 Case Else
2128 Goto Trace_Error
2129 End Select
2130 &apos; FINAL COMMITMENT
2131 If Utils._hasUNOMethod(ControlModel, &quot;commit&quot;) Then ControlModel.commit() &apos; f.i. checkboxes have no commit method ?? [PASTIM]
2132 Case UCase(&quot;Visible&quot;)
2133 If _SubType = CTLHIDDENCONTROL Then Goto Trace_Error &apos; Hidden remains hidden !!
2134 If Not Utils._hasUNOMethod(ControlView, &quot;setVisible&quot;) Then Goto Trace_Error
2135 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
2136 If pvValue Then ControlModel.EnableVisible = True
2137 ControlView.setVisible(pvValue)
2138 Case Else
2139 Goto Trace_Error
2140 End Select
2141
2142 Exit_Function:
2143 Utils._ResetCalledSub(&quot;Control.set&quot; &amp; psProperty)
2144 Exit Function
2145 Trace_Error:
2146 TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
2147 _PropertySet = False
2148 Goto Exit_Function
2149 Trace_Error_Value:
2150 TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
2151 _PropertySet = False
2152 Goto Exit_Function
2153 Trace_Error_Index:
2154 TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty)
2155 _PropertySet = False
2156 Goto Exit_Function
2157 Trace_Error_Array:
2158 TraceError(TRACEFATAL, ERRPROPERTYNOTARRAY, Utils._CalledSub(), 0, 1, iArgNr)
2159 _PropertySet = False
2160 Goto Exit_Function
2161 Error_Function:
2162 TraceError(TRACEABORT, Err, &quot;Control._PropertySet&quot;, Erl)
2163 _PropertySet = False
2164 GoTo Exit_Function
2165 End Function &apos; _PropertySet V1.1.0
2166 </script:module>
FREE OFFICE SUITE