| blob | a82a18e2e1242cc838e1441a4fff5a03b7a1872a |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_DialogControl" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === The SFDialogs library is one of the associated libraries. ===
6 REM === Full documentation is available on https://help.libreoffice.org/ ===
7 REM =======================================================================================================================
9 Option Compatible
10 Option ClassModule
12 Option Explicit
14 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
15 ''' SF_DialogControl
16 ''' ================
17 ''' Manage the controls belonging to a dialog defined with the Basic IDE
18 ''' Each instance of the current class represents a single control within a dialog box
19 '''
20 ''' The focus is clearly set on getting and setting the values displayed by the controls of the dialog box,
21 ''' not on their formatting. The latter is easily accessible via the XControlModel and XControlView
22 ''' UNO objects.
23 ''' Essentially a single property "Value" maps many alternative UNO properties depending each on
24 ''' the control type.
25 '''
26 ''' A special attention is given to controls with types TreeControl and TableControl
27 ''' It is easy with the API proposed in the current class to populate a tree, either
28 ''' - branch by branch (CreateRoot and AddSubNode), or
29 ''' - with a set of branches at once (AddSubtree)
30 ''' Additionally populating a TreeControl can be done statically or dynamically
31 '''
32 ''' With the method SetTableData(), feed a tablecontrol with a sortable and selectable
33 ''' array of data. Columns and rows may receive a header. Column widths are adjusted manually by the user or
34 ''' with the same method. Alignments can be set as well by script.
35 '''
36 ''' Service invocation:
37 ''' Dim myDialog As Object, myControl As Object
38 ''' Set myDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", myLibrary, DialogName)
41 ''' myDialog.Execute()
42 ''' ' ... process the controls actual values
43 ''' myDialog.Terminate()
44 '''
45 ''' Detailed user documentation:
46 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_dialogcontrol.html?DbPAR=BASIC
47 '''
48 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
50 REM ================================================================== EXCEPTIONS
55 REM ============================================================= PRIVATE MEMBERS
57 Private [Me] As Object
58 Private [_Parent] As Object
59 Private ObjectType As String ' Must be DIALOGCONTROL
60 Private ServiceName As String
62 ' Control naming
63 Private _Name As String
64 Private _IndexOfNames As Long ' Index in ElementNames array. Used to access SF_Dialog._ControlCache
65 Private _DialogName As String ' Parent dialog name
67 ' Control UNO references
68 Private _ControlModel As Object ' com.sun.star.awt.XControlModel
69 Private _ControlView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
70 Private _TreeDataModel As Object ' com.sun.star.awt.tree.MutableTreeDataModel
71 Private _GridColumnModel As Object ' com.sun.star.awt.grid.XGridColumnModel
72 Private _GridDataModel As Object ' com.sun.star.awt.grid.XGridDataModel
74 ' Control attributes
75 Private _ImplementationName As String
76 Private _ControlType As String ' One of the CTLxxx constants
78 ' Control initial position and dimensions in APPFONT units
79 Private _Left As Long
80 Private _Top As Long
81 Private _Width As Long
82 Private _Height As Long
84 ' Tree control on-select and on-expand attributes
85 ' Tree controls may be associated with events not defined in the Basic IDE
86 Private _OnNodeSelected As String ' Script to invoke when a node is selected
87 Private _OnNodeExpanded As String ' Script to invoke when a node is expanded
88 Private _SelectListener As Object ' com.sun.star.view.XSelectionChangeListener
89 Private _ExpandListener As Object ' com.sun.star.awt.tree.XTreeExpansionListener
91 ' Updatable events
92 Private _ActionListener As Object ' com.sun.star.awt.XActionListener
93 Private _OnActionPerformed As String ' Script to invoke when action triggered
94 Private _ActionCounter As Integer ' Counts the number of events set on the listener
95 ' ---
96 Private _AdjustmentListener As Object ' com.sun.star.awt.XAdjustmentListener
97 Private _OnAdjustmentValueChanged As String ' Script to invoke when scrollbar value has changed
98 Private _AdjustmentCounter As Integer ' Counts the number of events set on the listener
99 ' ---
100 Private _FocusListener As Object ' com.sun.star.awt.XFocusListener
101 Private _OnFocusGained As String ' Script to invoke when control gets focus
102 Private _OnFocusLost As String ' Script to invoke when control loses focus
103 Private _FocusCounter As Integer ' Counts the number of events set on the listener
104 ' ---
105 Private _ItemListener As Object ' com.sun.star.awt.XItemListener
106 Private _OnItemStateChanged As String ' Script to invoke when status of item changes
107 Private _ItemCounter As Integer ' Counts the number of events set on the listener
108 ' ---
109 Private _KeyListener As Object ' com.sun.star.awt.XKeyListener
110 Private _OnKeyPressed As String ' Script to invoke when Key clicked in control
111 Private _OnKeyReleased As String ' Script to invoke when Key released in control
112 Private _KeyCounter As Integer ' Counts the number of events set on the listener
113 ' ---
114 Private _MouseListener As Object ' com.sun.star.awt.XMouseListener
115 Private _OnMouseEntered As String ' Script to invoke when mouse enters control
116 Private _OnMouseExited As String ' Script to invoke when mouse leaves control
117 Private _OnMousePressed As String ' Script to invoke when mouse clicked in control
118 Private _OnMouseReleased As String ' Script to invoke when mouse released in control
119 Private _MouseCounter As Integer ' Counts the number of events set on the listener
120 ' ---
121 Private _MouseMotionListener As Object ' com.sun.star.awt.XMouseMotionListener
122 Private _OnMouseDragged As String ' Script to invoke when mouse is dragged from the control
123 Private _OnMouseMoved As String ' Script to invoke when mouse is moved across the control
124 Private _MouseMotionCounter As Integer ' Counts the number of events set on the listener
125 ' ---
126 Private _TextListener As Object ' com.sun.star.awt.XTextListener
127 Private _OnTextChanged As String ' Script to invoke when textual content has changed
128 Private _TextCounter As Integer ' Counts the number of events set on the listener
130 ' Table control attributes
131 Private _ColumnWidths As Variant ' Array of column widths
133 REM ============================================================ MODULE CONSTANTS
158 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
160 REM -----------------------------------------------------------------------------
161 Private Sub Class_Initialize()
162 Set [Me] = Nothing
163 Set [_Parent] = Nothing
166 _Name = ""
167 _IndexOfNames = -1
168 _DialogName = ""
169 Set _ControlModel = Nothing
170 Set _ControlView = Nothing
171 Set _TreeDataModel = Nothing
172 Set _GridColumnModel = Nothing
173 Set _GridDataModel = Nothing
174 _ImplementationName = ""
175 _ControlType = ""
177 _Left = SF_DialogUtils.MINPOSITION
178 _Top = SF_DialogUtils.MINPOSITION
179 _Width = -1
180 _Height = -1
182 _OnNodeSelected = ""
183 _OnNodeExpanded = ""
184 Set _SelectListener = Nothing
185 Set _ExpandListener = Nothing
187 Set _ActionListener = Nothing
188 _OnActionPerformed = ""
189 _ActionCounter = 0
190 Set _AdjustmentListener = Nothing
191 _OnAdjustmentValueChanged = ""
192 _AdjustmentCounter = 0
193 Set _FocusListener = Nothing
194 _OnFocusGained = ""
195 _OnFocusLost = ""
196 _FocusCounter = 0
197 Set _KeyListener = Nothing
198 _OnKeyPressed = ""
199 _OnKeyReleased = ""
200 _KeyCounter = 0
201 Set _MouseListener = Nothing
202 _OnMouseEntered = ""
203 _OnMouseExited = ""
204 _OnMousePressed = ""
205 _OnMouseReleased = ""
206 _MouseCounter = 0
207 Set _MouseMotionListener = Nothing
208 _OnMouseDragged = ""
209 _OnMouseMoved = ""
210 _MouseMotionCounter = 0
211 Set _ItemListener = Nothing
212 _OnItemStateChanged = ""
213 _ItemCounter = 0
214 Set _TextListener = Nothing
215 _OnTextChanged = ""
216 _TextCounter = 0
218 _ColumnWidths = Array()
219 End Sub ' SFDialogs.SF_DialogControl Constructor
221 REM -----------------------------------------------------------------------------
222 Private Sub Class_Terminate()
223 Call Class_Initialize()
224 End Sub ' SFDialogs.SF_DialogControl Destructor
226 REM -----------------------------------------------------------------------------
227 Public Function Dispose() As Variant
228 Call Class_Terminate()
229 Set Dispose = Nothing
230 End Function ' SFDialogs.SF_DialogControl Explicit Destructor
232 REM ================================================================== PROPERTIES
234 REM -----------------------------------------------------------------------------
235 Property Get Border() As Variant
236 ''' The Border property refers to the surrounding of the control: 3D, FLAT or NONE
238 End Property ' SFDialogs.SF_DialogControl.Border (get)
240 REM -----------------------------------------------------------------------------
241 Property Let Border(Optional ByVal pvBorder As Variant)
242 ''' Set the updatable property Border
244 End Property ' SFDialogs.SF_DialogControl.Border (let)
246 REM -----------------------------------------------------------------------------
247 Property Get Cancel() As Variant
248 ''' The Cancel property specifies if a command button has or not the behaviour of a Cancel button.
250 End Property ' SFDialogs.SF_DialogControl.Cancel (get)
252 REM -----------------------------------------------------------------------------
253 Property Let Cancel(Optional ByVal pvCancel As Variant)
254 ''' Set the updatable property Cancel
256 End Property ' SFDialogs.SF_DialogControl.Cancel (let)
258 REM -----------------------------------------------------------------------------
259 Property Get Caption() As Variant
260 ''' The Caption property refers to the text associated with the control
262 End Property ' SFDialogs.SF_DialogControl.Caption (get)
264 REM -----------------------------------------------------------------------------
265 Property Let Caption(Optional ByVal pvCaption As Variant)
266 ''' Set the updatable property Caption
268 End Property ' SFDialogs.SF_DialogControl.Caption (let)
270 REM -----------------------------------------------------------------------------
271 Property Get ControlType() As String
272 ''' Return the type of the actual control: "CheckBox", "TextField", "DateField", ...
274 End Property ' SFDialogs.SF_DialogControl.ControlType
276 REM -----------------------------------------------------------------------------
277 Property Get CurrentNode() As Variant
278 ''' The CurrentNode property returns the currently selected node
279 ''' It returns Empty when there is no node selected
280 ''' When there are several selections, it returns the topmost node among the selected ones
282 End Property ' SFDialogs.SF_DialogControl.CurrentNode (get)
284 REM -----------------------------------------------------------------------------
285 Property Let CurrentNode(Optional ByVal pvCurrentNode As Variant)
286 ''' Set a single selection in a tree control
288 End Property ' SFDialogs.SF_DialogControl.CurrentNode (let)
290 REM -----------------------------------------------------------------------------
291 Property Get Default() As Variant
292 ''' The Default property specifies whether a command button is the default (OK) button.
294 End Property ' SFDialogs.SF_DialogControl.Default (get)
296 REM -----------------------------------------------------------------------------
297 Property Let Default(Optional ByVal pvDefault As Variant)
298 ''' Set the updatable property Default
300 End Property ' SFDialogs.SF_DialogControl.Default (let)
302 REM -----------------------------------------------------------------------------
303 Property Get Enabled() As Variant
304 ''' The Enabled property specifies if the control is accessible with the cursor.
306 End Property ' SFDialogs.SF_DialogControl.Enabled (get)
308 REM -----------------------------------------------------------------------------
309 Property Let Enabled(Optional ByVal pvEnabled As Variant)
310 ''' Set the updatable property Enabled
312 End Property ' SFDialogs.SF_DialogControl.Enabled (let)
314 REM -----------------------------------------------------------------------------
315 Property Get Format() As Variant
316 ''' The Format property specifies the format in which to display dates and times.
318 End Property ' SFDialogs.SF_DialogControl.Format (get)
320 REM -----------------------------------------------------------------------------
321 Property Let Format(Optional ByVal pvFormat As Variant)
322 ''' Set the updatable property Format
324 End Property ' SFDialogs.SF_DialogControl.Format (let)
326 REM -----------------------------------------------------------------------------
327 Property Get Height() As Variant
328 ''' The Height property refers to the height of the control
330 End Property ' SFDialogs.SF_DialogControl.Height (get)
332 REM -----------------------------------------------------------------------------
333 Property Let Height(Optional ByVal pvHeight As Variant)
334 ''' Set the updatable property Height
336 End Property ' SFDialogs.SF_DialogControl.Height (let)
338 REM -----------------------------------------------------------------------------
339 Property Get ListCount() As Long
340 ''' The ListCount property specifies the number of rows in a list box or a combo box
342 End Property ' SFDialogs.SF_DialogControl.ListCount (get)
344 REM -----------------------------------------------------------------------------
345 Property Get ListIndex() As Variant
346 ''' The ListIndex property specifies which item is selected in a list box or combo box.
347 ''' In case of multiple selection, the index of the first one is returned or only one is set
349 End Property ' SFDialogs.SF_DialogControl.ListIndex (get)
351 REM -----------------------------------------------------------------------------
352 Property Let ListIndex(Optional ByVal pvListIndex As Variant)
353 ''' Set the updatable property ListIndex
355 End Property ' SFDialogs.SF_DialogControl.ListIndex (let)
357 REM -----------------------------------------------------------------------------
358 Property Get Locked() As Variant
359 ''' The Locked property specifies if a control is read-only
361 End Property ' SFDialogs.SF_DialogControl.Locked (get)
363 REM -----------------------------------------------------------------------------
364 Property Let Locked(Optional ByVal pvLocked As Variant)
365 ''' Set the updatable property Locked
367 End Property ' SFDialogs.SF_DialogControl.Locked (let)
369 REM -----------------------------------------------------------------------------
370 Property Get MultiSelect() As Variant
371 ''' The MultiSelect property specifies whether a user can make multiple selections in a listbox
373 End Property ' SFDialogs.SF_DialogControl.MultiSelect (get)
375 REM -----------------------------------------------------------------------------
376 Property Let MultiSelect(Optional ByVal pvMultiSelect As Variant)
377 ''' Set the updatable property MultiSelect
379 End Property ' SFDialogs.SF_DialogControl.MultiSelect (let)
381 REM -----------------------------------------------------------------------------
382 Property Get Name() As String
383 ''' Return the name of the actual control
385 End Property ' SFDialogs.SF_DialogControl.Name
387 REM -----------------------------------------------------------------------------
388 Property Get OnActionPerformed() As Variant
389 ''' Get the script associated with the OnActionPerformed event
391 End Property ' SFDialogs.SF_DialogControl.OnActionPerformed (get)
393 REM -----------------------------------------------------------------------------
394 Property Let OnActionPerformed(Optional ByVal pvActionPerformed As Variant)
395 ''' Set the updatable property OnActionPerformed
397 End Property ' SFDialogs.SF_DialogControl.OnActionPerformed (let)
399 REM -----------------------------------------------------------------------------
400 Property Get OnAdjustmentValueChanged() As Variant
401 ''' Get the script associated with the OnAdjustmentValueChanged event
403 End Property ' SFDialogs.SF_DialogControl.OnAdjustmentValueChanged (get)
405 REM -----------------------------------------------------------------------------
406 Property Let OnAdjustmentValueChanged(Optional ByVal pvAdjustmentValueChanged As Variant)
407 ''' Set the updatable property OnAdjustmentValueChanged
409 End Property ' SFDialogs.SF_DialogControl.OnAdjustmentValueChanged (let)
411 REM -----------------------------------------------------------------------------
412 Property Get OnFocusGained() As Variant
413 ''' Get the script associated with the OnFocusGained event
415 End Property ' SFDialogs.SF_DialogControl.OnFocusGained (get)
417 REM -----------------------------------------------------------------------------
418 Property Let OnFocusGained(Optional ByVal pvOnFocusGained As Variant)
419 ''' Set the updatable property OnFocusGained
421 End Property ' SFDialogs.SF_DialogControl.OnFocusGained (let)
423 REM -----------------------------------------------------------------------------
424 Property Get OnFocusLost() As Variant
425 ''' Get the script associated with the OnFocusLost event
427 End Property ' SFDialogs.SF_DialogControl.OnFocusLost (get)
429 REM -----------------------------------------------------------------------------
430 Property Let OnFocusLost(Optional ByVal pvOnFocusLost As Variant)
431 ''' Set the updatable property OnFocusLost
433 End Property ' SFDialogs.SF_DialogControl.OnFocusLost (let)
435 REM -----------------------------------------------------------------------------
436 Property Get OnItemStateChanged() As Variant
437 ''' Get the script associated with the OnItemStateChanged event
439 End Property ' SFDialogs.SF_DialogControl.OnItemStateChanged (get)
441 REM -----------------------------------------------------------------------------
442 Property Let OnItemStateChanged(Optional ByVal pvItemStateChanged As Variant)
443 ''' Set the updatable property OnItemStateChanged
445 End Property ' SFDialogs.SF_DialogControl.OnItemStateChanged (let)
447 REM -----------------------------------------------------------------------------
448 Property Get OnKeyPressed() As Variant
449 ''' Get the script associated with the OnKeyPressed event
451 End Property ' SFDialogs.SF_DialogControl.OnKeyPressed (get)
453 REM -----------------------------------------------------------------------------
454 Property Let OnKeyPressed(Optional ByVal pvOnKeyPressed As Variant)
455 ''' Set the updatable property OnKeyPressed
457 End Property ' SFDialogs.SF_DialogControl.OnKeyPressed (let)
459 REM -----------------------------------------------------------------------------
460 Property Get OnKeyReleased() As Variant
461 ''' Get the script associated with the OnKeyReleased event
463 End Property ' SFDialogs.SF_DialogControl.OnKeyReleased (get)
465 REM -----------------------------------------------------------------------------
466 Property Let OnKeyReleased(Optional ByVal pvOnKeyReleased As Variant)
467 ''' Set the updatable property OnKeyReleased
469 End Property ' SFDialogs.SF_DialogControl.OnKeyReleased (let)
471 REM -----------------------------------------------------------------------------
472 Property Get OnMouseDragged() As Variant
473 ''' Get the script associated with the OnMouseDragged event
475 End Property ' SFDialogs.SF_DialogControl.OnMouseDragged (get)
477 REM -----------------------------------------------------------------------------
478 Property Let OnMouseDragged(Optional ByVal pvOnMouseDragged As Variant)
479 ''' Set the updatable property OnMouseDragged
481 End Property ' SFDialogs.SF_DialogControl.OnMouseDragged (let)
483 REM -----------------------------------------------------------------------------
484 Property Get OnMouseEntered() As Variant
485 ''' Get the script associated with the OnMouseEntered event
487 End Property ' SFDialogs.SF_DialogControl.OnMouseEntered (get)
489 REM -----------------------------------------------------------------------------
490 Property Let OnMouseEntered(Optional ByVal pvOnMouseEntered As Variant)
491 ''' Set the updatable property OnMouseEntered
493 End Property ' SFDialogs.SF_DialogControl.OnMouseEntered (let)
495 REM -----------------------------------------------------------------------------
496 Property Get OnMouseExited() As Variant
497 ''' Get the script associated with the OnMouseExited event
499 End Property ' SFDialogs.SF_DialogControl.OnMouseExited (get)
501 REM -----------------------------------------------------------------------------
502 Property Let OnMouseExited(Optional ByVal pvOnMouseExited As Variant)
503 ''' Set the updatable property OnMouseExited
505 End Property ' SFDialogs.SF_DialogControl.OnMouseExited (let)
507 REM -----------------------------------------------------------------------------
508 Property Get OnMouseMoved() As Variant
509 ''' Get the script associated with the OnMouseMoved event
511 End Property ' SFDialogs.SF_DialogControl.OnMouseMoved (get)
513 REM -----------------------------------------------------------------------------
514 Property Let OnMouseMoved(Optional ByVal pvOnMouseMoved As Variant)
515 ''' Set the updatable property OnMouseMoved
517 End Property ' SFDialogs.SF_DialogControl.OnMouseMoved (let)
519 REM -----------------------------------------------------------------------------
520 Property Get OnMousePressed() As Variant
521 ''' Get the script associated with the OnMousePressed event
523 End Property ' SFDialogs.SF_DialogControl.OnMousePressed (get)
525 REM -----------------------------------------------------------------------------
526 Property Let OnMousePressed(Optional ByVal pvOnMousePressed As Variant)
527 ''' Set the updatable property OnMousePressed
529 End Property ' SFDialogs.SF_DialogControl.OnMousePressed (let)
531 REM -----------------------------------------------------------------------------
532 Property Get OnMouseReleased() As Variant
533 ''' Get the script associated with the OnMouseReleased event
535 End Property ' SFDialogs.SF_DialogControl.OnMouseReleased (get)
537 REM -----------------------------------------------------------------------------
538 Property Let OnMouseReleased(Optional ByVal pvOnMouseReleased As Variant)
539 ''' Set the updatable property OnMouseReleased
541 End Property ' SFDialogs.SF_DialogControl.OnMouseReleased (let)
543 REM -----------------------------------------------------------------------------
544 Property Get OnNodeExpanded() As Variant
545 ''' Get the script associated with the OnNodeExpanded event
547 End Property ' SFDialogs.SF_DialogControl.OnNodeExpanded (get)
549 REM -----------------------------------------------------------------------------
550 Property Let OnNodeExpanded(Optional ByVal pvOnNodeExpanded As Variant)
551 ''' Set the updatable property OnNodeExpanded
553 End Property ' SFDialogs.SF_DialogControl.OnNodeExpanded (let)
555 REM -----------------------------------------------------------------------------
556 Property Get OnNodeSelected() As Variant
557 ''' Get the script associated with the OnNodeSelected event
559 End Property ' SFDialogs.SF_DialogControl.OnNodeSelected (get)
561 REM -----------------------------------------------------------------------------
562 Property Let OnNodeSelected(Optional ByVal pvOnNodeSelected As Variant)
563 ''' Set the updatable property OnNodeSelected
565 End Property ' SFDialogs.SF_DialogControl.OnNodeSelected (let)
567 REM -----------------------------------------------------------------------------
568 Property Get OnTextChanged() As Variant
569 ''' Get the script associated with the OnTextChanged event
571 End Property ' SFDialogs.SF_DialogControl.OnTextChanged (get)
573 REM -----------------------------------------------------------------------------
574 Property Let OnTextChanged(Optional ByVal pvTextChanged As Variant)
575 ''' Set the updatable property OnTextChanged
577 End Property ' SFDialogs.SF_DialogControl.OnTextChanged (let)
579 REM -----------------------------------------------------------------------------
580 Property Get Page() As Variant
581 ''' A dialog may have several pages that can be traversed by the user step by step. The Page property of the Dialog object defines which page of the dialog is active.
582 ''' The Page property of a control defines the page of the dialog on which the control is visible.
583 ''' For example, if a control has a page value of 1, it is only visible on page 1 of the dialog.
584 ''' If the page value of the dialog is increased from 1 to 2, then all controls with a page value of 1 disappear and all controls with a page value of 2 become visible.
586 End Property ' SFDialogs.SF_DialogControl.Page (get)
588 REM -----------------------------------------------------------------------------
589 Property Let Page(Optional ByVal pvPage As Variant)
590 ''' Set the updatable property Page
592 End Property ' SFDialogs.SF_DialogControl.Page (let)
594 REM -----------------------------------------------------------------------------
595 Property Get Parent() As Object
596 ''' Return the Parent dialog object of the actual control
598 End Property ' SFDialogs.SF_DialogControl.Parent
600 REM -----------------------------------------------------------------------------
601 Property Get Picture() As Variant
602 ''' The Picture property specifies a bitmap or other type of graphic to be displayed on the specified control
604 End Property ' SFDialogs.SF_DialogControl.Picture (get)
606 REM -----------------------------------------------------------------------------
607 Property Let Picture(Optional ByVal pvPicture As Variant)
608 ''' Set the updatable property Picture
610 End Property ' SFDialogs.SF_DialogControl.Picture (let)
612 REM -----------------------------------------------------------------------------
613 Property Get RootNode() As Variant
614 ''' The RootNode property returns the last root node of a tree control
616 End Property ' SFDialogs.SF_DialogControl.RootNode (get)
618 REM -----------------------------------------------------------------------------
619 Property Get RowSource() As Variant
620 ''' The RowSource property specifies the data contained in a combobox or a listbox
621 ''' as a zero-based array of string values
623 End Property ' SFDialogs.SF_DialogControl.RowSource (get)
625 REM -----------------------------------------------------------------------------
626 Property Let RowSource(Optional ByVal pvRowSource As Variant)
627 ''' Set the updatable property RowSource
629 End Property ' SFDialogs.SF_DialogControl.RowSource (let)
631 REM -----------------------------------------------------------------------------
632 Property Get TabIndex() As Variant
633 ''' The TabIndex property specifies a control's place in the tab order in the dialog
634 ''' Zero or negative means no tab set in the control
636 End Property ' SFDialogs.SF_DialogControl.TabIndex (get)
638 REM -----------------------------------------------------------------------------
639 Property Let TabIndex(Optional ByVal pvTabIndex As Variant)
640 ''' Set the updatable property TabIndex
642 End Property ' SFDialogs.SF_DialogControl.TabIndex (let)
644 REM -----------------------------------------------------------------------------
645 Property Get Text() As Variant
646 ''' The Text property specifies the actual content of the control like it is displayed on the screen
648 End Property ' SFDialogs.SF_DialogControl.Text (get)
650 REM -----------------------------------------------------------------------------
651 Property Get TipText() As Variant
652 ''' The TipText property specifies the text that appears in a screentip when you hold the mouse pointer over a control
654 End Property ' SFDialogs.SF_DialogControl.TipText (get)
656 REM -----------------------------------------------------------------------------
657 Property Let TipText(Optional ByVal pvTipText As Variant)
658 ''' Set the updatable property TipText
660 End Property ' SFDialogs.SF_DialogControl.TipText (let)
662 REM -----------------------------------------------------------------------------
663 Property Get TripleState() As Variant
664 ''' The TripleState property specifies how a check box will display Null values
665 ''' When True, the control will cycle through states for Yes, No, and Null values. The control appears dimmed (grayed) when its Value property is set to Null.
666 ''' When False, the control will cycle through states for Yes and No values. Null values display as if they were No values.
668 End Property ' SFDialogs.SF_DialogControl.TripleState (get)
670 REM -----------------------------------------------------------------------------
671 Property Let TripleState(Optional ByVal pvTripleState As Variant)
672 ''' Set the updatable property TripleState
674 End Property ' SFDialogs.SF_DialogControl.TripleState (let)
676 REM -----------------------------------------------------------------------------
677 Property Get URL() As Variant
678 ''' The URL property refers to the URL to open when the control is clicked
680 End Property ' SFDialogs.SF_DialogControl.URL (get)
682 REM -----------------------------------------------------------------------------
683 Property Let URL(Optional ByVal pvURL As Variant)
684 ''' Set the updatable property URL
686 End Property ' SFDialogs.SF_DialogControl.URL (let)
688 REM -----------------------------------------------------------------------------
689 Property Get Value() As Variant
690 ''' The Value property specifies the data contained in the control
692 End Property ' SFDialogs.SF_DialogControl.Value (get)
694 REM -----------------------------------------------------------------------------
695 Property Let Value(Optional ByVal pvValue As Variant)
696 ''' Set the updatable property Value
698 End Property ' SFDialogs.SF_DialogControl.Value (let)
700 REM -----------------------------------------------------------------------------
701 Property Get Visible() As Variant
702 ''' The Visible property specifies if the control is accessible with the cursor.
704 End Property ' SFDialogs.SF_DialogControl.Visible (get)
706 REM -----------------------------------------------------------------------------
707 Property Let Visible(Optional ByVal pvVisible As Variant)
708 ''' Set the updatable property Visible
710 End Property ' SFDialogs.SF_DialogControl.Visible (let)
712 REM -----------------------------------------------------------------------------
713 Property Get Width() As Variant
714 ''' The Width property refers to the Width of the control
716 End Property ' SFDialogs.SF_DialogControl.Width (get)
718 REM -----------------------------------------------------------------------------
719 Property Let Width(Optional ByVal pvWidth As Variant)
720 ''' Set the updatable property Width
722 End Property ' SFDialogs.SF_DialogControl.Width (let)
724 REM -----------------------------------------------------------------------------
725 Property Get X() As Variant
726 ''' The X property refers to the X coordinate of the top-left corner of the control
728 End Property ' SFDialogs.SF_DialogControl.X (get)
730 REM -----------------------------------------------------------------------------
731 Property Let X(Optional ByVal pvX As Variant)
732 ''' Set the updatable property X
734 End Property ' SFDialogs.SF_DialogControl.X (let)
736 REM -----------------------------------------------------------------------------
737 Property Get Y() As Variant
738 ''' The Y property refers to the Y coordinate of the top-left corner of the control
740 End Property ' SFDialogs.SF_DialogControl.Y (get)
742 REM -----------------------------------------------------------------------------
743 Property Let Y(Optional ByVal pvY As Variant)
744 ''' Set the updatable property Y
746 End Property ' SFDialogs.SF_DialogControl.Y (let)
748 REM -----------------------------------------------------------------------------
749 Property Get XControlModel() As Object
750 ''' The XControlModel property returns the model UNO object of the control
752 End Property ' SFDialogs.SF_DialogControl.XControlModel (get)
754 REM -----------------------------------------------------------------------------
755 Property Get XControlView() As Object
756 ''' The XControlView property returns the view UNO object of the control
758 End Property ' SFDialogs.SF_DialogControl.XControlView (get)
760 REM -----------------------------------------------------------------------------
761 Property Get XGridColumnModel() As Object
762 ''' The XGridColumnModel property returns the mutable data model UNO object of the tree control
764 End Property ' SFDialogs.SF_DialogControl.XGridColumnModel (get)
766 REM -----------------------------------------------------------------------------
767 Property Get XGridDataModel() As Object
768 ''' The XGridDataModel property returns the mutable data model UNO object of the tree control
770 End Property ' SFDialogs.SF_DialogControl.XGridDataModel (get)
772 REM -----------------------------------------------------------------------------
773 Property Get XTreeDataModel() As Object
774 ''' The XTreeDataModel property returns the mutable data model UNO object of the tree control
776 End Property ' SFDialogs.SF_DialogControl.XTreeDataModel (get)
778 REM ===================================================================== METHODS
780 REM -----------------------------------------------------------------------------
781 Public Function AddSubNode(Optional ByRef ParentNode As Variant _
782 , Optional ByVal DisplayValue As Variant _
783 , Optional ByRef DataValue As Variant _
784 ) As Variant
785 ''' Return a new node of the tree control subordinate to a parent node
786 ''' Args:
787 ''' ParentNode: A node UNO object, of type com.sun.star.awt.tree.XMutableTreeNode
788 ''' DisplayValue: the text appearing in the control box
789 ''' DataValue: any value associated with the new node. Default = Empty
790 ''' Returns:
791 ''' The new node UNO object: com.sun.star.awt.tree.XMutableTreeNode
792 ''' Examples:
793 ''' Dim myTree As Object, myNode As Object, theRoot As Object
798 Dim oNode As Object ' Return value
802 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
803 Set oNode = Nothing
805 Check:
806 If IsMissing(DataValue) Then DataValue = Empty
807 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
808 If _ControlType <> CTLTREECONTROL Then GoTo CatchType
809 If Not ScriptForge.SF_Utils._Validate(ParentNode, "ParentNode", V_OBJECT) Then GoTo Catch
810 If ScriptForge.SF_Session.UnoObjectType(ParentNode) <> "toolkit.MutableTreeNode" Then GoTo Catch
811 If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch
812 End If
814 Try:
815 With _TreeDataModel
816 Set oNode = .createNode(DisplayValue, True)
817 oNode.DataValue = DataValue
818 ParentNode.appendChild(oNode)
819 End With
821 Finally:
822 Set AddSubNode = oNode
823 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
824 Exit Function
825 Catch:
826 GoTo Finally
827 CatchType:
828 ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "AddSubNode")
829 GoTo Finally
830 End Function ' SFDialogs.SF_DialogControl.AddSubNode
832 REM -----------------------------------------------------------------------------
833 Public Function AddSubTree(Optional ByRef ParentNode As Variant _
834 , Optional ByRef FlatTree As Variant _
835 , Optional ByVal WithDataValue As Variant _
836 ) As Boolean
837 ''' Return True when a subtree, subordinate to a parent node, could be inserted successfully in a tree control
838 ''' If the parent node had already child nodes before calling this method, the child nodes are erased
839 ''' Args:
840 ''' ParentNode: A node UNO object, of type com.sun.star.awt.tree.XMutableTreeNode
843 ''' A1 B1 C1 |__ A1
844 ''' A1 B1 C2 |__ B1
845 ''' A1 B2 C3 |__ C1
846 ''' A2 B3 C4 |__ C2
847 ''' A2 B3 C5 |__ B2
848 ''' A3 B4 C6 |__ C3
849 ''' |__ A2
850 ''' |__ B3
851 ''' |__ C4
852 ''' |__ C5
853 ''' |__ A3
854 ''' |__ B4
855 ''' |__ C6
856 ''' Typically, such an array can be issued by the GetRows method applied on the SFDatabases.Database service
857 ''' when an array item containing the text to be displayed is = "" or is empty/null,
858 ''' no new subnode is created and the remainder of the row is skipped
859 ''' When AddSubTree() is called from a Python script, FlatTree may be an array of arrays
860 ''' WithDataValue:
861 ''' When False (default), every column of FlatTree contains the text to be displayed in the tree control
862 ''' When True, the texts to be displayed (DisplayValue) are in columns 0, 2, 4, ...
864 ''' Returns:
865 ''' True when successful
866 ''' Examples:
867 ''' Dim myTree As Object, theRoot As Object, oDb As Object, vData As Variant
870 ''' Set oDb = CreateScriptService("SFDatabases.Database", "/home/.../mydatabase.odb")
871 ''' vData = oDb.GetRows("SELECT [Category].[Name], [Category].[ID], [Product].[Name], [Product].[ID] " _
872 ''' & "FROM [Category], [Product] WHERE [Product].[CategoryID] = [Category].[ID] " _
874 ''' myTree.AddSubTree(theRoot, vData, WithDataValue := True)
876 Dim bSubTree As Boolean ' Return value
877 Dim oNode As Object ' com.sun.star.awt.tree.XMutableTreeNode
878 Dim oNewNode As Object ' com.sun.star.awt.tree.XMutableTreeNode
879 Dim lChildCount As Long ' Number of children nodes of a parent node
881 Dim iDims As Integer ' Number of dimensions of FlatTree
882 Dim lMin1 As Long ' Lower bound (rows)
883 Dim lMin2 As Long ' Lower bounds (cols)
884 Dim lMax1 As Long ' Upper bound (rows)
885 Dim lMax2 As Long ' Upper bounds (cols)
886 Dim vFlatItem As Variant ' A single FlatTree item: FlatTree(i, j)
887 Dim vFlatItem2 As Variant ' A single FlatTree item
888 Dim bChange As Boolean ' When True, the item in FlatTree is different from the item above
889 Dim sValue As String ' Alias for display values
890 Dim i As Long, j As Long
894 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
895 bSubTree = False
897 Check:
898 If IsMissing(WithDataValue) Or IsEmpty(WithDataValue) Then WithDataValue = False
899 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
900 If _ControlType <> CTLTREECONTROL Then GoTo CatchType
901 If Not ScriptForge.SF_Utils._Validate(ParentNode, "ParentNode", V_OBJECT) Then GoTo Catch
902 If ScriptForge.SF_Session.UnoObjectType(ParentNode) <> "toolkit.MutableTreeNode" Then GoTo Catch
903 If Not ScriptForge.SF_Utils._ValidateArray(FlatTree, "FlatTree") Then GoTo Catch ' Dimensions checked below
904 If Not ScriptForge.SF_Utils._Validate(WithDataValue, "WithDataValue", V_BOOLEAN) Then GoTo Catch
905 End If
907 Try:
908 With _TreeDataModel
909 ' Clean subtree
910 lChildCount = ParentNode.getChildCount()
911 For i = 1 To lChildCount
913 Next i
915 ' Determine bounds
916 iDims = ScriptForge.SF_Array.CountDims(FlatTree)
917 Select Case iDims
921 If Not IsArray(FlatTree(0)) Then GoTo Catch
924 Case 2
927 Case Else : GoTo Catch
928 End Select
930 ' Build a new subtree
932 For i = lMin1 To lMax1
933 bChange = ( i = 0 )
934 ' Restart from the parent node at each i-iteration
935 Set oNode = ParentNode
936 For j = lMin2 To lMax2 Step iStep ' Array columns
937 If iDims = 1 Then vFlatItem = FlatTree(i)(j) Else vFlatItem = FlatTree(i, j)
938 If vFlatItem = "" Or IsNull(vFlatItem) Or IsEmpty(vFlatItem) Then
939 Set oNode = Nothing
940 Exit For ' Exit j-loop
941 End If
942 If Not bChange Then
944 bChange = ( vFlatItem <> vFlatItem2 )
945 End If
946 If bChange Then ' Create new subnode at tree depth = j
947 If VarType(vFlatItem) = V_STRING Then sValue = vFlatItem Else sValue = ScriptForge.SF_String.Represent(vFlatItem)
948 Set oNewNode = .createNode(sValue, True)
949 If WithDataValue Then
951 oNewNode.DataValue = vFlatItem2
952 End If
953 oNode.appendChild(oNewNode)
954 Set oNode = oNewNode
955 Else
956 ' Position next current node on last child of actual current node
957 lChildCount = oNode.getChildCount()
958 If lChildCount > 0 Then Set oNode = oNode.getChildAt(lChildCount - 1) Else Set oNode = Nothing
959 End If
960 Next j
961 Next i
962 bSubTree = True
963 End With
965 Finally:
966 AddSubTree = bSubTree
967 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
968 Exit Function
969 Catch:
970 GoTo Finally
971 CatchType:
972 ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "AddSubTree")
973 GoTo Finally
974 End Function ' SFDialogs.SF_DialogControl.AddSubTree
976 REM -----------------------------------------------------------------------------
977 Public Function CreateRoot(Optional ByVal DisplayValue As Variant _
978 , Optional ByRef DataValue As Variant _
979 ) As Variant
980 ''' Return a new root node of the tree control. The new tree root is inserted below pre-existing root nodes
981 ''' Args:
982 ''' DisplayValue: the text appearing in the control box
983 ''' DataValue: any value associated with the root node. Default = Empty
984 ''' Returns:
985 ''' The new root node as a UNO object of type com.sun.star.awt.tree.XMutableTreeNode
986 ''' Examples:
987 ''' Dim myTree As Object, myNode As Object
991 Dim oRoot As Object ' Return value
995 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
996 Set oRoot = Nothing
998 Check:
999 If IsMissing(DataValue) Then DataValue = Empty
1000 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1001 If _ControlType <> CTLTREECONTROL Then GoTo CatchType
1002 If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch
1003 End If
1005 Try:
1006 With _TreeDataModel
1007 Set oRoot = .createNode(DisplayValue, True)
1008 oRoot.DataValue = DataValue
1009 .setRoot(oRoot)
1010 ' To be visible, a root must have contained at least 1 child. Create a fictive one and erase it.
1011 ' This behaviour does not seem related to the RootDisplayed property ??
1013 oRoot.removeChildByIndex(0)
1014 End With
1016 Finally:
1017 Set CreateRoot = oRoot
1018 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1019 Exit Function
1020 Catch:
1021 GoTo Finally
1022 CatchType:
1023 ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "CreateRoot")
1024 GoTo Finally
1025 End Function ' SFDialogs.SF_DialogControl.CreateRoot
1027 REM -----------------------------------------------------------------------------
1028 Public Function FindNode(Optional ByVal DisplayValue As String _
1029 , Optional ByRef DataValue As Variant _
1030 , Optional ByVal CaseSensitive As Boolean _
1031 ) As Object
1032 ''' Traverses the tree and find recursively, starting from the root, a node meeting some criteria
1034 ''' having its DisplayValue like DisplayValue
1035 ''' having its DataValue = DataValue
1036 ''' Comparisons may be or not case-sensitive
1037 ''' The first matching occurrence is returned
1038 ''' Args:
1039 ''' DisplayValue: the pattern to be matched
1040 ''' DataValue: a string, a numeric value or a date or Empty (if not applicable)
1041 ''' CaseSensitive: applicable on both criteria. Default = False
1042 ''' Returns:
1043 ''' The found node of type com.sun.star.awt.tree.XMutableTreeNode or Nothing if not found
1044 ''' Examples:
1045 ''' Dim myTree As Object, myNode As Object
1050 Dim oNode As Object ' Return value
1052 Const cstSubArgs = "[DisplayValue=""""], [DataValue=Empty], [CaseSensitive=False]"
1054 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1055 Set oNode = Nothing
1057 Check:
1058 If IsMissing(DisplayValue) Or IsEmpty(DisplayValue) Then DisplayValue = ""
1059 If IsMissing(DataValue) Then DataValue = Empty
1060 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
1061 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1062 If _ControlType <> CTLTREECONTROL Then GoTo CatchType
1063 If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch
1064 If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", ScriptForge.V_BOOLEAN) Then GoTo Catch
1065 End If
1067 Try:
1068 Set oNode = _FindNode(_TreeDataModel.getRoot(), DisplayValue, DataValue, CaseSensitive)
1070 Finally:
1071 Set FindNode = oNode
1072 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1073 Exit Function
1074 Catch:
1075 GoTo Finally
1076 CatchType:
1077 ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "FindNode")
1078 GoTo Finally
1079 End Function ' SFDialogs.SF_DialogControl.FindNode
1081 REM -----------------------------------------------------------------------------
1082 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
1083 ''' Return the actual value of the given property
1084 ''' Args:
1085 ''' PropertyName: the name of the property as a string
1086 ''' Returns:
1087 ''' The actual value of the property
1088 ''' If the property does not exist, returns Null
1089 ''' Exceptions:
1090 ''' see the exceptions of the individual properties
1091 ''' Examples:
1095 Const cstSubArgs = ""
1097 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1098 GetProperty = Null
1100 Check:
1101 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1102 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1103 End If
1105 Try:
1106 GetProperty = _PropertyGet(PropertyName)
1108 Finally:
1109 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1110 Exit Function
1111 Catch:
1112 GoTo Finally
1113 End Function ' SFDialogs.SF_DialogControl.GetProperty
1115 REM -----------------------------------------------------------------------------
1116 Public Function Methods() As Variant
1117 ''' Return the list of public methods of the Model service as an array
1119 Methods = Array( _
1126 )
1128 End Function ' SFDialogs.SF_DialogControl.Methods
1130 REM -----------------------------------------------------------------------------
1131 Public Function Properties() As Variant
1132 ''' Return the list or properties of the Timer class as an array
1134 Properties = Array( _
1185 )
1187 End Function ' SFDialogs.SF_DialogControl.Properties
1189 REM -----------------------------------------------------------------------------
1190 Public Function Resize(Optional ByVal Left As Variant _
1191 , Optional ByVal Top As Variant _
1192 , Optional ByVal Width As Variant _
1193 , Optional ByVal Height As Variant _
1194 ) As Boolean
1195 ''' Move the top-left corner of the control to new coordinates and/or modify its dimensions
1196 ''' Without arguments, the method resets the initial dimensions and position
1197 ''' Attributes denoting the position and size of a control are expressed in "Map AppFont" units.
1198 ''' Map AppFont units are device and resolution independent.
1199 ''' One Map AppFont unit is equal to one eighth of the average character (Systemfont) height and one quarter of the average character width.
1200 ''' The dialog editor (= the Basic IDE) also uses Map AppFont units.
1201 ''' Args:
1202 ''' Left : the horizontal distance from the top-left corner. It may be negative.
1203 ''' Top : the vertical distance from the top-left corner. It may be negative.
1204 ''' Width : the horizontal width of the rectangle containing the Dialog. It must be positive.
1205 ''' Height : the vertical height of the rectangle containing the Dialog. It must be positive.
1206 ''' Missing arguments are left unchanged.
1207 ''' Returns:
1208 ''' True when successful
1209 ''' Examples:
1212 Try:
1213 Resize = SF_DialogUtils._Resize([Me], Left, Top, Width, Height)
1215 End Function ' SFDialogss.SF_Dialog.Resize
1217 REM -----------------------------------------------------------------------------
1218 Public Function SetFocus() As Boolean
1219 ''' Set the focus on the current Control instance
1220 ''' Probably called from after an event occurrence
1221 ''' Args:
1222 ''' Returns:
1223 ''' True if focusing is successful
1224 ''' Example:
1225 ''' Dim oDlg As Object, oControl As Object
1226 ''' Set oDlg = CreateScriptService(,, "myControl") ' Control stored in current document's standard library
1228 ''' oControl.SetFocus()
1230 Dim bSetFocus As Boolean ' Return value
1232 Const cstSubArgs = ""
1234 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1235 bSetFocus = False
1237 Check:
1238 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1239 If Not [_Parent]._IsStillAlive() Then GoTo Finally
1240 End If
1242 Try:
1243 If Not IsNull(_ControlView) Then
1244 _ControlView.setFocus()
1245 bSetFocus = True
1246 End If
1248 Finally:
1249 SetFocus = bSetFocus
1250 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1251 Exit Function
1252 Catch:
1253 GoTo Finally
1254 End Function ' SFControls.SF_DialogControl.SetFocus
1256 REM -----------------------------------------------------------------------------
1257 Public Function SetProperty(Optional ByVal PropertyName As Variant _
1258 , Optional ByRef Value As Variant _
1259 ) As Boolean
1260 ''' Set a new value to the given property
1261 ''' Args:
1262 ''' PropertyName: the name of the property as a string
1263 ''' Value: its new value
1264 ''' Exceptions
1265 ''' ARGUMENTERROR The property does not exist
1270 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1271 SetProperty = False
1273 Check:
1274 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1275 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1276 End If
1278 Try:
1279 SetProperty = _PropertySet(PropertyName, Value)
1281 Finally:
1282 SF_Utils._ExitFunction(cstThisSub)
1283 Exit Function
1284 Catch:
1285 GoTo Finally
1286 End Function ' SFDialogs.SF_DialogControl.SetProperty
1288 REM -----------------------------------------------------------------------------
1289 Public Function SetTableData(Optional ByRef DataArray As Variant _
1290 , Optional ByRef Widths As Variant _
1291 , Optional ByRef Alignments As Variant _
1292 , Optional ByVal RowHeaderWidth As Variant _
1293 ) As Boolean
1294 ''' Fill a table control with the given data. Preexisting data is erased
1295 ''' The Basic IDE allows to define if the control has a row and/or a column header
1296 ''' When it is the case, the array in argument should contain those headers resp. in the first
1297 ''' column and/or in the first row
1298 ''' A column in the control shall be sortable when the data (headers excluded) in that column
1299 ''' is homogeneously filled either with numbers or with strings
1300 ''' Columns containing strings will be left-aligned, those with numbers will be right-aligned
1301 ''' Args:
1302 ''' DataArray: the set of data to display in the table control, including optional column/row headers
1304 ''' Widths: the column's relative widths as a 1D array, each element corresponding with one data column
1305 ''' If the array is shorter than the number of columns, the last value is kept for the next columns.
1306 ''' Example:
1308 ''' means that the first column is half as wide as all the other columns
1309 ''' When the argument is absent, the columns are evenly spread over the available space in the control
1310 ''' Alignments: the column's horizontal alignment as a string with length = number of columns.
1311 ''' Possible characters are:
1312 ''' L(EFT), C(ENTER), R(IGHT) or space (default behaviour)
1313 ''' RowGeaderWidth: width of the row header column expressed in AppFont units. Default = 10.
1314 ''' The argument is ignored when the TableControl has no row header.
1315 ''' Returns:
1316 ''' True when successful
1317 ''' Examples:
1318 ''' Dim myTable As Object, bSet As Boolean, vData As Variant
1319 ''' Set myTable = myDialog.Controls("myTableControl") ' This control has only column headers
1326 Dim bData As Boolean ' Return value
1327 Dim iDims As Integer ' Number of dimensions of DataArray
1328 Dim lMin1 As Long ' LBound1 of input array
1329 Dim lMax1 As Long ' UBound1 of input array
1330 Dim lMin2 As Long ' LBound2 of input array
1331 Dim lMax2 As Long ' UBound2 of input array
1332 Dim lControlWidth As Long ' Width of the table control
1333 Dim lMinW As Long ' lBound of Widths
1334 Dim lMaxW As Long ' UBound of vWidths
1335 Dim lMinRow As Long ' Row index of effective data subarray
1336 Dim lMinCol As Long ' Column index of effective data subarray
1337 Dim vRowHeaders As Variant ' Array of row headers
1338 Dim sRowHeader As String ' A single row header
1339 Dim vColHeaders As Variant ' Array of column headers
1340 Dim oColumn As Object ' com.sun.star.awt.grid.XGridColumn
1341 Dim dWidth As Double ' A single item of Widths
1342 Dim dRelativeWidth As Double ' Sum of Widths up to the number of columns
1343 Dim dWidthFactor As Double ' Factor to apply to relative widths to get absolute column widths
1345 Dim lAverageWidth As Long ' Width to apply when columns spread evenly across table
1346 Dim vDataRow As Variant ' A single row content in the tablecontrol
1347 Dim vDataItem As Variant ' A single DataArray item
1349 Dim lAlign As Long ' com.sun.star.style.HorizontalAlignment.XXX
1350 Dim i As Long, j As Long, k As Long
1353 Const cstSubArgs = "DataArray, [Widths=Array(1)], [Alignments=""""], [RowHeaderWidth=10]"
1355 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1356 bData = False
1358 Check:
1359 If IsMissing(Widths) Or IsEmpty(Widths) Then Widths = Array()
1360 If IsMissing(Alignments) Or IsEmpty(Alignments) Then Alignments = ""
1361 If IsMissing(RowHeaderWidth) Or IsEmpty(RowHeaderWidth) Then RowHeaderWidth = 10
1362 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1363 If _ControlType <> CTLTABLECONTROL Then GoTo CatchType
1364 If Not ScriptForge.SF_Utils._ValidateArray(DataArray, "DataArray") Then GoTo Catch ' Dimensions are checked below
1365 If Not ScriptForge.SF_Utils._ValidateArray(Widths, "Widths", 1, ScriptForge.V_NUMERIC, True) Then GoTo Catch
1366 If Not ScriptForge.SF_Utils._Validate(Alignments, "Alignments", V_STRING) Then GoTo Catch
1367 If Not ScriptForge.SF_Utils._Validate(RowHeaderWidth, "RowHeaderWidth", ScriptForge.V_NUMERIC) Then GoTo Catch
1368 End If
1370 Try:
1371 ' Erase any pre-existing data and columns
1372 _GridDataModel.removeAllRows()
1374 _GridColumnModel.removeColumn(i)
1375 Next i
1377 ' LBounds, UBounds - Basic or Python
1378 iDims = ScriptForge.SF_Array.CountDims(DataArray)
1379 Select Case iDims
1383 If Not IsArray(DataArray(0)) Then GoTo Catch
1386 Case 2
1389 Case Else : GoTo Catch
1390 End Select
1392 ' Extract headers from data array
1393 lMinW = LBound(Widths) : lMaxW = UBound(Widths)
1394 With _ControlModel
1395 If .ShowColumnHeader Then
1396 lMinRow = lMin1 + 1
1397 If iDims = 1 Then
1398 vColHeaders = DataArray(lMin1)
1399 Else
1400 vColHeaders = ScriptForge.SF_Array.ExtractRow(DataArray, lMin1)
1401 End If
1402 Else
1403 lMinRow = lMin1
1404 vColHeaders = Array()
1405 End If
1406 If .ShowRowHeader Then
1407 lMinCol = lMin2 + 1
1408 If iDims = 1 Then
1409 vRowHeaders = Array()
1410 ReDim vRowHeaders(lMin1 To lMax1)
1411 For i = lMin1 To lMax1
1412 vRowHeaders(i) = DataArray(i)(lMin2)
1413 Next i
1414 Else
1415 vRowHeaders = ScriptForge.SF_Array.ExtractColumn(DataArray, lMin2)
1416 End If
1417 Else
1418 lMinCol = lMin2
1419 vRowHeaders = Array()
1420 End If
1421 End With
1423 ' Create the columns
1424 For j = lMinCol To lMax2
1425 Set oColumn = _GridColumnModel.createColumn()
1426 If _ControlModel.ShowColumnHeader Then oColumn.Title = vColHeaders(j)
1427 _GridColumnModel.addColumn(oColumn)
1428 Next j
1430 ' Manage row headers width
1431 If _ControlModel.ShowRowHeader Then
1432 lHeaderWidth = RowHeaderWidth
1433 _ControlModel.RowHeaderWidth = lHeaderWidth
1434 Else
1435 lHeaderWidth = 0
1436 End If
1438 ' Size the columns. Column sizing cannot be done before all the columns are added
1440 ' Size the columns proportionally with their relative widths
1441 dRelativeWidth = 0.0
1442 i = lMinW - 1
1443 ' Compute the sum of the relative widths
1444 For j = 0 To lMax2 - lMinCol
1445 i = i + 1
1446 If i >= lMinW And i <= lMaxW Then dRelativeWidth = dRelativeWidth + Widths(i) Else dRelativeWidth = dRelativeWidth + Widths(lMaxW)
1447 Next j
1449 ' Set absolute column widths
1450 If dRelativeWidth > 0.0 Then dWidthFactor = CDbl(_ControlModel.Width - lHeaderWidth) / dRelativeWidth Else dWidthFactor = 1.0
1451 i = lMinW - 1
1452 For j = 0 To lMax2 - lMinCol
1453 i = i + 1
1454 If i >= lMinW And i <= lMaxW Then dWidth = CDbl(Widths(i)) Else dWidth = CDbl(Widths(lMaxW))
1455 _GridColumnModel.Columns(j).ColumnWidth = CLng(dWidthFactor * dWidth)
1456 Next j
1457 Else
1458 ' Size header and columns evenly
1459 lAverageWidth = (_ControlModel.Width - lHeaderWidth) / (lMax2 - lMin2 + 1)
1460 For j = 0 To lMax2 - lMinCol
1461 _GridColumnModel.Columns(j).ColumnWidth = lAverageWidth
1462 Next j
1463 End If
1465 ' Initialize the column alignment
1466 If Len(Alignments) >= lMax2 - lMinCol + 1 Then sAlign = Alignments Else sAlign = Alignments & Space(lMax2 - lMinCol + 1 - Len(Alignments))
1468 ' Feed the table with data and define/confirm the column alignment
1469 vDataRow = Array()
1470 For i = lMinRow To lMax1
1471 ReDim vDataRow(0 To lMax2 - lMinCol)
1472 For j = lMinCol To lMax2
1473 If iDims = 1 Then vDataItem = DataArray(i)(j) Else vDataItem = DataArray(i, j)
1474 If VarType(vDataItem) = V_STRING Then
1475 ElseIf ScriptForge.SF_Utils._VarTypeExt(vDataItem) = ScriptForge.V_NUMERIC Then
1476 Else
1477 vDataItem = ScriptForge.SF_String.Represent(vDataItem)
1478 End If
1479 vDataRow(j - lMinCol) = vDataItem
1480 ' Store alignment while processing the first row of the array
1481 If i = lMinRow Then
1482 k = j - lMinCol + 1
1483 If Mid(sAlign, k, 1) = " " Then Mid(sAlign, k, 1) = Iif(VarType(vDataItem) = V_STRING, "L", "R")
1484 End If
1485 Next j
1486 If _ControlModel.ShowRowHeader Then sRowHeader = vRowHeaders(i) Else sRowHeader = ""
1487 _GridDataModel.addRow(sRowHeader, vDataRow)
1488 Next i
1490 ' Determine alignments of each column
1491 For j = 0 To lMax2 - lMinCol
1496 Case Else
1497 End Select
1498 _GridColumnModel.Columns(j).HorizontalAlign = lAlign
1499 Next j
1501 bData = True
1503 Finally:
1504 SetTableData = bData
1505 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1506 Exit Function
1507 Catch:
1508 GoTo Finally
1509 CatchType:
1510 ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "SetTableData")
1511 GoTo Finally
1512 End Function ' SFDialogs.SF_DialogControl.SetTableData
1514 REM -----------------------------------------------------------------------------
1515 Public Function WriteLine(Optional ByVal Line As Variant) As Boolean
1516 ''' Add a new line to a multiline TextField control
1517 ''' Args:
1518 ''' Line: (default = "") the line to insert at the end of the text box
1519 ''' a newline character will be inserted before the line, if relevant
1520 ''' Returns:
1521 ''' True if insertion is successful
1522 ''' Exceptions
1523 ''' TEXTFIELDERROR Method applicable on multiline text fields only
1524 ''' Example:
1525 ''' Dim oDlg As Object, oControl As Object
1526 ''' Set oDlg = CreateScriptService(,, "myControl") ' Control stored in current document's standard library
1530 Dim bWriteLine As Boolean ' Return value
1531 Dim lTextLength As Long ' Actual length of text in box
1532 Dim oSelection As New com.sun.star.awt.Selection
1533 Dim sNewLine As String ' Newline character(s)
1537 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1538 bWriteLine = False
1540 Check:
1541 If IsMissing(Line) Or IsEmpty(Line) Then Line = ""
1542 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1543 If Not [_Parent]._IsStillAlive() Then GoTo Finally
1545 End If
1546 If ControlType <> CTLTEXTFIELD Then GoTo CatchField
1547 If _ControlModel.MultiLine = False Then GoTo CatchField
1549 Try:
1550 _ControlModel.HardLineBreaks = True
1551 sNewLine = ScriptForge.SF_String.sfNEWLINE
1552 With _ControlView
1553 lTextLength = Len(.getText())
1556 .setText(Line)
1557 Else ' Put cursor at the end of the actual text
1558 oSelection.Min = lTextLength : oSelection.Max = lTextLength
1559 .insertText(oSelection, sNewLine & Line)
1560 End If
1561 ' Put the cursor at the end of the inserted text
1562 oSelection.Max = oSelection.Max + Len(sNewLine) + Len(Line)
1563 oSelection.Min = oSelection.Max
1564 .setSelection(oSelection)
1565 End With
1566 bWriteLine = True
1568 Finally:
1569 WriteLine = bWriteLine
1570 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1571 Exit Function
1572 Catch:
1573 GoTo Finally
1574 CatchField:
1575 ScriptForge.SF_Exception.RaiseFatal(TEXTFIELDERROR, _Name, _DialogName)
1576 GoTo Finally
1577 End Function ' SFControls.SF_DialogControl.WriteLine
1579 REM =========================================================== PRIVATE FUNCTIONS
1581 REM -----------------------------------------------------------------------------
1582 Private Function _FindNode(ByRef poNode As Object _
1583 , ByVal psDisplayValue As String _
1584 , ByRef pvDataValue As Variant _
1585 , ByVal pbCaseSensitive As Boolean _
1586 ) As Object
1587 ''' Traverses the tree and find recursively, starting from the root, a node meeting some criteria
1589 ''' having its DisplayValue like psDisplayValue
1590 ''' having its DataValue = pvDataValue
1591 ''' Comparisons may be or not case-sensitive
1592 ''' The first matching occurrence is returned
1593 ''' Args:
1595 ''' psDisplayValue: the pattern to be matched
1596 ''' pvDataValue: a string, a numeric value or a date or Empty (if not applicable)
1597 ''' pbCaseSensitive: applicable on both criteria
1598 ''' Returns:
1599 ''' The found node of type com.sun.star.awt.tree.XMutableTreeNode
1601 Dim oChild As Object ' Child node com.sun.star.awt.tree.XMutableTreeNode
1602 Dim oFind As Object ' Found node com.sun.star.awt.tree.XMutableTreeNode
1603 Dim lChildCount As Long ' Number of children of a node
1604 Dim bFound As Boolean ' True when node found
1605 Dim i As Long
1607 Set _FindNode = Nothing
1608 On Local Error GoTo Finally ' Better not found than raise an error
1610 Check:
1611 ' Does the actual node match the criteria ?
1612 bFound = False
1614 bFound = ScriptForge.SF_String.IsLike(poNode.DisplayValue, psDisplayValue, pbCaseSensitive)
1615 End If
1616 If Not bFound And Not IsEmpty(poNode.DataValue) Then
1617 If Not IsEmpty(pvdataValue) Then bFound = ( ScriptForge.SF_Array._ValCompare(poNode.DataValue, pvDataB-Value, pbCaseSensitive) = 0 )
1618 End If
1619 If bFound Then
1620 Set _FindNode = poNode
1621 Exit Function
1622 End If
1624 Try:
1625 ' Explore sub-branches
1626 lChildCount = poNode.getChildCount
1629 Set oChild = poNode.getChildAt(i)
1630 Set oFind = _FindNode(oChild, psDisplayValue, pvDataValue, pbCaseSensitive) ' Recursive call
1631 If Not IsNull(oFind) Then
1632 Set _FindNode = oFind
1633 Exit For
1634 End If
1635 Next i
1636 End If
1638 Finally:
1639 Exit Function
1640 End Function ' SFDialogs.SF_DialogControl._FindNode
1642 REM -----------------------------------------------------------------------------
1643 Public Function _GetEventName(ByVal psProperty As String) As String
1644 ''' Return the LO internal event name derived from the SF property name
1645 ''' The SF property name is not case sensitive, while the LO name is case-sensitive
1646 ' Corrects the typo on ErrorOccur(r?)ed, if necessary
1648 Dim vProperties As Variant ' Array of class properties
1649 Dim sProperty As String ' Correctly cased property name
1651 vProperties = Properties()
1652 sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
1656 End Function ' SFDialogs.SF_DialogControl._GetEventName
1658 REM -----------------------------------------------------------------------------
1659 Private Function _GetListener(ByVal psEventName As String) As String
1660 ''' Getting/Setting macros triggered by events requires a Listener-EventName pair
1661 ''' Return the X...Listener corresponding with the event name in argument
1663 Select Case UCase(psEventName)
1676 Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased")
1680 Case Else
1681 _GetListener = ""
1682 End Select
1684 End Function ' SFDialogs.SF_DialogControl._GetListener
1686 REM -----------------------------------------------------------------------------
1687 Public Sub _Initialize()
1688 ''' Complete the object creation process:
1689 ''' - Initialization of private members
1690 ''' - Collection of specific attributes
1691 ''' - synchronization with parent dialog instance
1693 Dim vServiceName As Variant ' Split service name
1694 Dim sType As String ' Last component of service name
1696 Try:
1697 _ImplementationName = _ControlModel.getImplementationName()
1699 ' Identify the control type
1701 sType = vServiceName(UBound(vServiceName))
1702 Select Case sType
1704 _ControlType = "" ' Not supported
1707 _ControlType = CTLHYPERLINK
1709 ' Initialize the data model
1710 _ControlType = CTLTREECONTROL
1711 Set _ControlModel.DataModel = CreateUnoService("com.sun.star.awt.tree.MutableTreeDataModel")
1712 Set _TreeDataModel = _ControlModel.DataModel
1714 _ControlType = CTLTABLECONTROL
1715 Set _GridColumnModel = _ControlModel.ColumnModel
1716 Set _GridDataModel = _ControlModel.GridDataModel
1717 Case Else : _ControlType = sType
1718 End Select
1720 ' Store initial position and dimensions
1721 With _ControlModel
1722 _Left = .PositionX
1723 _Top = .PositionY
1724 _Width = .Width
1725 _Height = .Height
1726 End With
1728 ' Store the SF_DialogControl object in the parent cache
1729 Set _Parent._ControlCache(_IndexOfNames) = [Me]
1731 Finally:
1732 Exit Sub
1733 End Sub ' SFDialogs.SF_DialogControl._Initialize
1735 REM -----------------------------------------------------------------------------
1736 Private Function _PropertyGet(Optional ByVal psProperty As String _
1737 , Optional ByVal pvDefault As Variant _
1738 ) As Variant
1739 ''' Return the value of the named property
1740 ''' Args:
1741 ''' psProperty: the name of the property
1742 ''' pvDefault: the value returned when the property is not applicable on the control's type
1743 ''' Getting a non-existing property for a specific control type should
1744 ''' not generate an error to not disrupt the Basic IDE debugger
1746 Dim vGet As Variant ' Return value
1747 Static oSession As Object ' Alias of SF_Session
1748 Dim vSelection As Variant ' Alias of Model.SelectedItems or Model.Selection
1749 Dim vList As Variant ' Alias of Model.StringItemList
1750 Dim lIndex As Long ' Index in StringItemList
1751 Dim sItem As String ' A single item
1752 Dim vDate As Variant ' com.sun.star.util.Date or com.sun.star.util.Time
1753 Dim vValues As Variant ' Array of listbox values
1754 Dim oPosSize As Object ' com.sun.star.awt.Rectangle
1755 Dim oControlEvents As Object ' com.sun.star.container.XNameContainer
1756 Dim sEventName As String ' Internal event name
1757 Dim i As Long
1758 Dim cstThisSub As String
1759 Const cstSubArgs = ""
1762 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1764 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1765 If Not [_Parent]._IsStillAlive() Then GoTo Finally
1767 If IsMissing(pvDefault) Then pvDefault = Null
1768 _PropertyGet = pvDefault
1770 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1771 Select Case UCase(psProperty)
1773 Select Case _ControlType
1774 Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT, CTLFORMATTEDFIELD _
1775 , CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLPROGRESSBAR _
1776 , CTLSCROLLBAR , CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL
1777 If oSession.HasUNOProperty(_ControlModel, "Border") Then _PropertyGet = Array("NONE", "3D", "FLAT")(_ControlModel.Border)
1778 Case CTLCHECKBOX, CTLRADIOBUTTON
1779 If oSession.HasUNOProperty(_ControlModel, "VisualEffect") Then _PropertyGet = Array("NONE", "3D", "FLAT")(_ControlModel.VisualEffect)
1780 Case Else : GoTo CatchType
1781 End Select
1783 Select Case _ControlType
1784 Case CTLBUTTON
1785 If oSession.HasUNOProperty(_ControlModel, "PushButtonType") Then _PropertyGet = ( _ControlModel.PushButtonType = com.sun.star.awt.PushButtonType.CANCEL )
1786 Case Else : GoTo CatchType
1787 End Select
1789 Select Case _ControlType
1790 Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDLINE, CTLFIXEDTEXT, CTLGROUPBOX, CTLHYPERLINK, CTLRADIOBUTTON
1791 If oSession.HasUNOProperty(_ControlModel, "Label") Then _PropertyGet = _ControlModel.Label
1792 Case Else : GoTo CatchType
1793 End Select
1795 _PropertyGet = _ControlType
1797 Select Case _ControlType
1798 Case CTLTREECONTROL
1800 _PropertyGet = Empty
1801 If _ControlModel.SelectionType <> com.sun.star.view.SelectionType.NONE Then
1802 vSelection = _ControlView.getSelection()
1803 If IsArray(vSelection) Then
1805 Else
1806 Set _PropertyGet = vSelection
1807 End If
1808 End If
1809 End If
1810 Case Else : GoTo CatchType
1811 End Select
1813 Select Case _ControlType
1814 Case CTLBUTTON
1815 If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _PropertyGet = _ControlModel.DefaultButton
1816 Case Else : GoTo CatchType
1817 End Select
1819 If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _PropertyGet = _ControlModel.Enabled
1821 Select Case _ControlType
1822 Case CTLDATEFIELD
1823 If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = SF_DialogUtils._FormatsList(_ControlType)(_ControlModel.DateFormat)
1824 Case CTLTIMEFIELD
1825 If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = SF_DialogUtils._FormatsList(_ControlType)(_ControlModel.TimeFormat)
1826 Case CTLFORMATTEDFIELD
1827 If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") And oSession.HasUNOProperty(_ControlModel, "FormatKey") Then
1828 _PropertyGet = _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString
1829 End If
1830 Case Else : GoTo CatchType
1831 End Select
1833 If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units
1834 _PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, False).Height
1835 Else
1836 If oSession.HasUNOProperty(_ControlModel, "Height") Then _PropertyGet = _ControlModel.Height
1837 End If
1839 Select Case _ControlType
1840 Case CTLCOMBOBOX, CTLLISTBOX
1841 If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1
1842 Case CTLTABLECONTROL ' Returns zero when no table data yet
1843 If oSession.HasUNOProperty(_GridDataModel, "RowCount") Then _PropertyGet = _GridDataModel.RowCount
1844 Case Else : GoTo CatchType
1845 End Select
1847 Select Case _ControlType
1848 Case CTLCOMBOBOX
1850 If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
1851 _PropertyGet = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, _ControlModel.Text, CaseSensitive := True)
1852 End If
1853 Case CTLLISTBOX
1855 If oSession.HasUNOProperty(_ControlModel, "SelectedItems") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
1856 vSelection = _ControlModel.SelectedItems
1858 End If
1859 Case CTLTABLECONTROL
1863 ' Other selection types (multi, range) not supported
1864 If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE Then
1865 lIndex = _ControlView.CurrentRow
1868 End If
1869 _PropertyGet = lIndex
1870 End If
1871 End If
1872 Case Else : GoTo CatchType
1873 End Select
1875 Select Case _ControlType
1876 Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLLISTBOX _
1877 , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
1878 If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _PropertyGet = _ControlModel.ReadOnly
1879 Case Else : GoTo CatchType
1880 End Select
1882 Select Case _ControlType
1883 Case CTLLISTBOX
1885 _PropertyGet = _ControlModel.MultiSelection
1886 ElseIf oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then ' Not documented: gridcontrols only TBC ??
1887 _PropertyGet = _ControlModel.MultiSelectionSimpleMode
1888 End If
1889 Case Else : GoTo CatchType
1890 End Select
1892 _PropertyGet = _Name
1893 Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnFocusGained"), UCase("OnFocusLost") _
1894 , UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
1895 , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
1896 , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnTextChanged")
1897 Set oControlEvents = _ControlModel.getEvents()
1898 sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & _GetEventName(psProperty)
1899 If oControlEvents.hasByName(sEventName) Then
1900 _PropertyGet = oControlEvents.getByName(sEventName).ScriptCode
1901 Else
1902 ' Check OnEvents set dynamically by code
1903 Select Case UCase(psProperty)
1918 Case Else : _PropertyGet = ""
1919 End Select
1920 End If
1922 Select Case _ControlType
1923 Case CTLTREECONTROL
1924 _PropertyGet = _OnNodeExpanded
1925 Case Else : GoTo CatchType
1926 End Select
1928 Select Case _ControlType
1929 Case CTLTREECONTROL
1930 _PropertyGet = _OnNodeSelected
1931 Case Else : GoTo CatchType
1932 End Select
1934 If oSession.HasUnoProperty(_ControlModel, "Step") Then _PropertyGet = _ControlModel.Step
1936 Set _PropertyGet = [_Parent]
1938 Select Case _ControlType
1939 Case CTLBUTTON, CTLIMAGECONTROL
1940 If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_ControlModel.ImageURL)
1941 Case Else : GoTo CatchType
1942 End Select
1944 Select Case _ControlType
1945 Case CTLTREECONTROL
1946 _PropertyGet = _TreeDataModel.getRoot()
1947 Case Else : GoTo CatchType
1948 End Select
1950 Select Case _ControlType
1951 Case CTLCOMBOBOX, CTLLISTBOX
1953 If IsArray(_ControlModel.StringItemList) Then _PropertyGet = _ControlModel.StringItemList Else _PropertyGet = Array(_ControlModel.StringItemList)
1954 End If
1955 Case Else : GoTo CatchType
1956 End Select
1958 Select Case _ControlType
1959 Case CTLBUTTON, CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT _
1960 , CTLFORMATTEDFIELD, CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD _
1961 , CTLRADIOBUTTON, CTLSCROLLBAR, CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL
1963 If CBool(_ControlModel.TabStop) Or IsEmpty(_ControlModel.TabStop) Then _PropertyGet = _ControlModel.TabIndex Else _PropertyGet = -1
1964 End If
1965 Case Else : GoTo CatchType
1966 End Select
1968 Select Case _ControlType
1969 Case CTLCOMBOBOX, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLPATTERNFIELD, CTLTEXTFIELD
1970 If oSession.HasUnoProperty(_ControlModel, "Text") Then _PropertyGet = _ControlModel.Text
1971 Case Else : GoTo CatchType
1972 End Select
1974 If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _PropertyGet = _ControlModel.HelpText
1976 Select Case _ControlType
1977 Case CTLCHECKBOX
1978 If oSession.HasUnoProperty(_ControlModel, "TriState") Then _PropertyGet = _ControlModel.TriState
1979 Case Else : GoTo CatchType
1980 End Select
1982 Select Case _ControlType
1983 Case CTLHYPERLINK
1984 If oSession.HasUnoProperty(_ControlModel, "URL") Then _PropertyGet = _ControlModel.URL
1985 Case Else : GoTo CatchType
1986 End Select
1987 Case UCase("Value") ' Default values are set here by control type, not in the 2nd argument
1988 vGet = pvDefault
1989 Select Case _ControlType
1990 Case CTLBUTTON 'Boolean, toggle buttons only
1991 vGet = False
1993 If oSession.HasUnoProperty(_ControlModel, "State") And _ControlMOdel.Toggle Then vGet = ( _ControlModel.State = 1 )
1994 End If
1996 If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = _ControlModel.State Else vGet = 2
1997 Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String
1998 If oSession.HasUnoProperty(_ControlModel, "Text") Then vGet = _ControlModel.Text Else vGet = ""
1999 Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
2000 If oSession.HasUnoProperty(_ControlModel, "Value") Then vGet = _ControlModel.Value Else vGet = 0
2001 Case CTLDATEFIELD 'Date
2002 vGet = CDate(1)
2004 If VarType(_ControlModel.Date) = ScriptForge.V_OBJECT Then ' com.sun.star.util.Date
2005 Set vDate = _ControlModel.Date
2006 vGet = DateSerial(vDate.Year, vDate.Month, vDate.Day)
2007 End If
2008 End If
2009 Case CTLFORMATTEDFIELD 'String or numeric
2010 If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then vGet = _ControlModel.EffectiveValue Else vGet = ""
2011 Case CTLLISTBOX 'String or array of strings depending on MultiSelection
2012 ' StringItemList is the list of the items displayed in the box
2013 ' SelectedItems is the list of the indexes in StringItemList of the selected items
2014 ' It can go beyond the limits of StringItemList
2015 ' It can contain multiple values even if the listbox is not multiselect
2016 If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _
2018 vSelection = _ControlModel.SelectedItems
2019 vList = _ControlModel.StringItemList
2020 If _ControlModel.MultiSelection Then vValues = Array()
2021 For i = 0 To UBound(vSelection)
2022 lIndex = vSelection(i)
2024 If Not _ControlModel.MultiSelection Then
2025 vValues = vList(lIndex)
2026 Exit For
2027 End If
2028 vValues = ScriptForge.SF_Array.Append(vValues, vList(lIndex))
2029 End If
2030 Next i
2031 vGet = vValues
2032 Else
2033 vGet = ""
2034 End If
2035 Case CTLPROGRESSBAR 'Numeric
2036 If oSession.HasUnoProperty(_ControlModel, "ProgressValue") Then vGet = _ControlModel.ProgressValue Else vGet = 0
2037 Case CTLRADIOBUTTON 'Boolean
2038 If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 ) Else vGet = False
2039 Case CTLSCROLLBAR 'Numeric
2040 If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then vGet = _ControlModel.ScrollValue Else vGet = 0
2041 Case CTLTABLECONTROL
2042 vGet = Array() ' Default value when no row selected, no data, multiselection
2045 ' Other selection types (multi, range) not supported
2046 If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE Then
2047 lIndex = _ControlView.CurrentRow
2050 End If
2052 End If
2053 End If
2054 Case CTLTIMEFIELD
2055 vGet = CDate(0)
2057 If VarType(_ControlModel.Time) = ScriptForge.V_OBJECT Then ' com.sun.star.Util.Time
2058 Set vDate = _ControlModel.Time
2059 vGet = TimeSerial(vDate.Hours, vDate.Minutes, vDate.Seconds)
2060 End If
2061 End If
2062 Case Else : GoTo CatchType
2063 End Select
2064 _PropertyGet = vGet
2066 If oSession.HasUnoMethod(_ControlView, "isVisible") Then _PropertyGet = CBool(_ControlView.isVisible())
2068 If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units
2069 _PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, False).Width
2070 Else
2071 If oSession.HasUNOProperty(_ControlModel, "Width") Then _PropertyGet = _ControlModel.Width
2072 End If
2074 If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units
2075 _PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, True).X
2076 Else
2077 If oSession.HasUNOProperty(_ControlModel, "PositionX") Then _PropertyGet = _ControlModel.PositionX
2078 End If
2080 If [_parent]._Displayed Then ' Convert PosSize view property from pixels to APPFONT units
2081 _PropertyGet = SF_DialogUtils._ConvertToAppFont(_ControlView, True).Y
2082 Else
2083 If oSession.HasUNOProperty(_ControlModel, "PositionY") Then _PropertyGet = _ControlModel.PositionY
2084 End If
2086 Set _PropertyGet = _ControlModel
2088 Set _PropertyGet = _ControlView
2090 Set _PropertyGet = _GridColumnModel
2092 Set _PropertyGet = _GridDataModel
2094 Set _PropertyGet = _TreeDataModel
2095 Case Else
2096 _PropertyGet = Null
2097 End Select
2099 Finally:
2100 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2101 Exit Function
2102 Catch:
2103 GoTo Finally
2104 CatchType:
2105 GoTo Finally
2106 End Function ' SFDialogs.SF_DialogControl._PropertyGet
2108 REM -----------------------------------------------------------------------------
2109 Private Function _PropertySet(Optional ByVal psProperty As String _
2110 , Optional ByVal pvValue As Variant _
2111 ) As Boolean
2112 ''' Set the new value of the named property
2113 ''' Args:
2114 ''' psProperty: the name of the property
2115 ''' pvValue: the new value of the given property
2117 Dim bSet As Boolean ' Return value
2118 Static oSession As Object ' Alias of SF_Session
2119 Dim vSet As Variant ' Value to set in UNO model or view property
2120 Dim vBorders As Variant ' Array of allowed Border values
2121 Dim vFormats As Variant ' Format property: output of _FormatsList()
2122 Dim iFormat As Integer ' Format property: index in vFormats
2123 Dim oNumberFormats As Object ' com.sun.star.util.XNumberFormats
2124 Dim lFormatKey As Long ' Format index for formatted fields
2125 Dim oLocale As Object ' com.sun.star.lang.Locale
2126 Dim vSelection As Variant ' Alias of Model.SelectedItems
2127 Dim vList As Variant ' Alias of Model.StringItemList
2128 Dim lIndex As Long ' Index in StringItemList
2129 Dim sItem As String ' A single item
2130 Dim vCtlTypes As Variant ' Array of allowed control types
2131 Dim i As Long
2132 Dim cstThisSub As String
2135 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2136 bSet = False
2139 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
2140 If Not [_Parent]._IsStillAlive() Then GoTo Finally
2142 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
2143 bSet = True
2144 Select Case UCase(psProperty)
2146 Select Case _ControlType
2147 Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT, CTLFORMATTEDFIELD _
2148 , CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLPROGRESSBAR _
2149 , CTLRADIOBUTTON, CTLSCROLLBAR , CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL
2151 If Not ScriptForge.SF_Utils._Validate(pvValue, "Border", V_STRING, vBorders) Then GoTo Finally
2152 vSet = ScriptForge.SF_Array.IndexOf(vBorders, pvValue)
2154 _ControlModel.Border = vSet
2155 ElseIf oSession.HasUNOProperty(_ControlModel, "VisualEffect") Then ' Checkbox case
2156 _ControlModel.VisualEffect = vSet
2157 End If
2158 Case Else : GoTo CatchType
2159 End Select
2161 Select Case _ControlType
2162 Case CTLBUTTON
2163 If Not ScriptForge.SF_Utils._Validate(pvValue, "Cancel", ScriptForge.V_BOOLEAN) Then GoTo Finally
2165 If pvValue Then vSet = com.sun.star.awt.PushButtonType.CANCEL Else vSet = com.sun.star.awt.PushButtonType.STANDARD
2166 _ControlModel.PushButtonType = vSet
2167 End If
2168 Case Else : GoTo CatchType
2169 End Select
2171 Select Case _ControlType
2172 Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDLINE, CTLFIXEDTEXT, CTLGROUPBOX, CTLHYPERLINK, CTLRADIOBUTTON
2173 If Not ScriptForge.SF_Utils._Validate(pvValue, "Caption", V_STRING) Then GoTo Finally
2174 If oSession.HasUNOProperty(_ControlModel, "Label") Then _ControlModel.Label = pvValue
2175 Case Else : GoTo CatchType
2176 End Select
2178 Select Case _ControlType
2179 Case CTLTREECONTROL
2180 If Not ScriptForge.SF_Utils._Validate(pvValue, "Selection", ScriptForge.V_OBJECT) Then GoTo Finally
2181 If oSession.UnoObjectType(pvValue) <> "toolkit.MutableTreeNode" Then GoTo CatchType
2182 With _ControlView
2183 .clearSelection()
2184 If Not IsNull(pvValue) Then
2185 .addSelection(pvValue)
2186 ' Suspending temporarily the expansion listener avoids conflicts
2188 .makeNodeVisible(pvValue) ' Expand parent nodes and put node in the display area
2190 End If
2191 End With
2192 Case Else : GoTo CatchType
2193 End Select
2195 Select Case _ControlType
2196 Case CTLBUTTON
2197 If Not ScriptForge.SF_Utils._Validate(pvValue, "Default", ScriptForge.V_BOOLEAN) Then GoTo Finally
2198 If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _ControlModel.DefaultButton = pvValue
2199 Case Else : GoTo CatchType
2200 End Select
2202 If Not ScriptForge.SF_Utils._Validate(pvValue, "Enabled", ScriptForge.V_BOOLEAN) Then GoTo Finally
2203 If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _ControlModel.Enabled = pvValue
2205 Select Case _ControlType
2206 Case CTLDATEFIELD, CTLTIMEFIELD
2207 vFormats = SF_DialogUtils._FormatsList(_ControlType)
2208 If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING, vFormats) Then GoTo Finally
2209 iFormat = ScriptForge.SF_Array.IndexOf(vFormats, pvValue, CaseSensitive := False)
2211 _ControlModel.DateFormat = iFormat
2213 _ControlModel.TimeFormat = iFormat
2214 End If
2215 Case CTLFORMATTEDFIELD ' The format may exist already or not yet
2218 If Not IsNull(_ControlModel.FormatsSupplier) Then
2220 Set oNumberFormats = _ControlModel.FormatsSupplier.getNumberFormats()
2221 lFormatKey = oNumberFormats.queryKey(pvValue, oLocale, True)
2223 _ControlModel.FormatKey = oNumberFormats.addNew(pvValue, oLocale)
2224 Else
2225 _ControlModel.FormatKey = lFormatKey
2226 End If
2227 End If
2228 End If
2229 Case Else : GoTo CatchType
2230 End Select
2232 If Not ScriptForge.SF_Utils._Validate(pvValue, "Height", ScriptForge.V_NUMERIC) Then GoTo Catch
2233 bSet = Resize(Height := pvValue)
2235 If Not ScriptForge.SF_Utils._Validate(pvValue, "ListIndex", ScriptForge.V_NUMERIC) Then GoTo Finally
2236 Select Case _ControlType
2237 Case CTLCOMBOBOX
2238 If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
2239 _ControlModel.Text = _ControlModel.StringItemList(CInt(pvValue))
2240 End If
2241 Case CTLLISTBOX
2242 If oSession.HasUNOProperty(_ControlModel, "SelectedItems") Then _ControlModel.SelectedItems = Array(CInt(pvValue))
2243 Case CTLTABLECONTROL
2246 ' Other selection types (multi, range) not supported
2247 If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE _
2249 _ControlView.selectRow(pvValue)
2250 End If
2251 End If
2252 Case Else : GoTo CatchType
2253 End Select
2255 Select Case _ControlType
2256 Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLLISTBOX _
2257 , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
2258 If Not ScriptForge.SF_Utils._Validate(pvValue, "Locked", ScriptForge.V_BOOLEAN) Then GoTo Finally
2259 If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _ControlModel.ReadOnly = pvValue
2260 Case Else : GoTo CatchType
2261 End Select
2263 Select Case _ControlType
2264 Case CTLLISTBOX
2265 If Not ScriptForge.SF_Utils._Validate(pvValue, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
2266 If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then _ControlModel.MultiSelection = pvValue
2267 If oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then _ControlModel.MultiSelectionSimpleMode = pvValue
2269 If Not pvValue And UBound(_ControlModel.SelectedItems) > 0 Then ' Cancel selections when MultiSelect becomes False
2270 lIndex = _ControlModel.SelectedItems(0)
2271 _ControlModel.SelectedItems = Array(lIndex)
2272 End If
2273 End If
2274 Case Else : GoTo CatchType
2275 End Select
2276 Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnFocusGained"), UCase("OnFocusLost") _
2277 , UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
2278 , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
2279 , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnTextChanged")
2280 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Catch
2281 ' Check control type for not universal event types
2282 Select Case UCase(psProperty)
2284 Select Case _ControlType
2285 Case CTLBUTTON, CTLCHECKBOX, CTLCOMBOBOX, CTLHYPERLINK, CTLLISTBOX, CTLRADIOBUTTON
2286 Case Else : GoTo CatchType
2287 End Select
2289 If _ControlType <> CTLSCROLLBAR Then GoTo CatchType
2291 Select Case _ControlType
2292 Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD _
2293 , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL
2294 Case Else : GoTo CatchType
2295 End Select
2296 Case Else
2297 End Select
2298 bSet = SF_DialogListener._SetOnProperty([Me], psProperty, pvValue)
2300 Select Case _ControlType
2301 Case CTLTREECONTROL
2302 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Finally
2303 ' If the listener was already set, then stop it
2305 _ControlView.removeTreeExpansionListener(_ExpandListener)
2306 Set _ExpandListener = Nothing
2307 _OnNodeExpanded = ""
2308 End If
2309 ' Setup a new fresh listener
2311 Set _ExpandListener = CreateUnoListener("_SFEXP_", "com.sun.star.awt.tree.XTreeExpansionListener")
2312 _ControlView.addTreeExpansionListener(_ExpandListener)
2313 _OnNodeExpanded = pvValue
2314 End If
2315 Case Else : GoTo CatchType
2316 End Select
2318 Select Case _ControlType
2319 Case CTLTREECONTROL
2320 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Finally
2321 ' If the listener was already set, then stop it
2323 _ControlView.removeSelectionChangeListener(_SelectListener)
2324 Set _SelectListener = Nothing
2325 _OnNodeSelected = ""
2326 End If
2327 ' Setup a new fresh listener
2329 Set _SelectListener = CreateUnoListener("_SFSEL_", "com.sun.star.view.XSelectionChangeListener")
2330 _ControlView.addSelectionChangeListener(_SelectListener)
2331 _OnNodeSelected = pvValue
2332 End If
2333 Case Else : GoTo CatchType
2334 End Select
2336 If Not ScriptForge.SF_Utils._Validate(pvValue, "Page", ScriptForge.V_NUMERIC) Then GoTo Finally
2337 If oSession.HasUnoProperty(_ControlModel, "Step") Then _ControlModel.Step = CLng(pvValue)
2339 Select Case _ControlType
2340 Case CTLBUTTON, CTLIMAGECONTROL
2342 If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _ControlModel.ImageURL = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue)
2343 Case Else : GoTo CatchType
2344 End Select
2346 Select Case _ControlType
2347 Case CTLCOMBOBOX, CTLLISTBOX
2348 If Not IsArray(pvValue) Then
2349 If Not ScriptForge.SF_Utils._Validate(pvValue, "RowSource", V_STRING) Then GoTo Finally
2350 pvArray = Array(pvArray)
2351 ElseIf Not ScriptForge.SF_Utils._ValidateArray(pvValue, "RowSource", 1, V_STRING, True) Then
2352 GoTo Finally
2353 End If
2354 If oSession.HasUnoProperty(_ControlModel, "StringItemList") Then _ControlModel.StringItemList = pvValue
2355 Case Else : GoTo CatchType
2356 End Select
2358 Select Case _ControlType
2359 Case CTLBUTTON, CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT _
2360 , CTLFORMATTEDFIELD, CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD _
2361 , CTLRADIOBUTTON, CTLSCROLLBAR, CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL
2362 If Not ScriptForge.SF_Utils._Validate(pvValue, "TabIndex", ScriptForge.V_NUMERIC) Then GoTo Finally
2366 End If
2367 Case Else : GoTo CatchType
2368 End Select
2370 If Not ScriptForge.SF_Utils._Validate(pvValue, "TipText", V_STRING) Then GoTo Finally
2371 If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _ControlModel.HelpText = pvValue
2373 Select Case _ControlType
2374 Case CTLCHECKBOX
2375 If Not ScriptForge.SF_Utils._Validate(pvValue, "TripleState", ScriptForge.V_BOOLEAN) Then GoTo Finally
2376 If oSession.HasUnoProperty(_ControlModel, "TriState") Then _ControlModel.TriState = pvValue
2377 Case Else : GoTo CatchType
2378 End Select
2380 Select Case _ControlType
2381 Case CTLHYPERLINK
2384 Case Else : GoTo CatchType
2385 End Select
2387 Select Case _ControlType
2388 Case CTLBUTTON 'Boolean, toggle buttons only
2389 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
2390 If oSession.HasUnoProperty(_ControlModel, "Toggle") And oSession.HasUnoProperty(_ControlModel, "State") Then
2391 If _ControlModel.Toggle Then _ControlModel.State = Iif(pvValue, 1, 0) Else _ControlModel.State = 2
2392 End If
2394 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(ScriptForge.V_BOOLEAN, ScriptForge.V_NUMERIC), Array(0, 1, 2, True, False)) Then GoTo Finally
2397 _ControlModel.State = pvValue
2398 End If
2399 Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String
2402 Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
2403 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
2404 If oSession.HasUnoProperty(_ControlModel, "Value") Then _ControlModel.Value = pvValue
2405 Case CTLDATEFIELD 'Date
2408 Set vSet = New com.sun.star.util.Date
2409 vSet.Year = Year(pvValue)
2410 vSet.Month = Month(pvValue)
2411 vSet.Day = Day(pvValue)
2412 _ControlModel.Date = vSet
2413 End If
2414 Case CTLFORMATTEDFIELD 'String or numeric
2415 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
2416 If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then _ControlModel.EffectiveValue = pvValue
2417 Case CTLLISTBOX 'String or array of strings depending on MultiSelection
2418 ' StringItemList is the list of the items displayed in the box
2419 ' SelectedItems is the list of the indexes in StringItemList of the selected items
2420 ' It can go beyond the limits of StringItemList
2421 ' It can contain multiple values even if the listbox is not multiselect
2422 If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _
2424 vSelection = Array()
2425 If _ControlModel.MultiSelection Then
2426 If Not ScriptForge.SF_Utils._ValidateArray(pvValue, "Value", 1, V_STRING, True) Then GoTo Finally
2427 vList = _ControlModel.StringItemList
2428 For i = LBound(pvValue) To UBound(pvValue)
2429 sItem = pvValue(i)
2430 lIndex = ScriptForge.SF_Array.IndexOf(vList, sItem)
2432 Next i
2433 Else
2435 lIndex = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, pvValue)
2437 End If
2438 _ControlModel.SelectedItems = vSelection
2439 End If
2440 Case CTLPROGRESSBAR 'Numeric
2441 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
2443 If pvValue < _ControlModel.ProgressValueMin Then pvValue = _ControlModel.ProgressValueMin
2444 End If
2446 If pvValue > _ControlModel.ProgressValueMax Then pvValue = _ControlModel.ProgressValueMax
2447 End If
2448 If oSession.HasUnoProperty(_ControlModel, "ProgressValue") Then _ControlModel.ProgressValue = pvValue
2449 Case CTLRADIOBUTTON 'Boolean
2450 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
2451 If oSession.HasUnoProperty(_ControlModel, "State") Then _ControlModel.State = Iif(pvValue, 1, 0)
2452 Case CTLSCROLLBAR 'Numeric
2453 If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
2455 If pvValue < _ControlModel.ScrollValueMin Then pvValue = _ControlModel.ScrollValueMin
2456 End If
2458 If pvValue > _ControlModel.ScrollValueMax Then pvValue = _ControlModel.ScrollValueMax
2459 End If
2460 If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then _ControlModel.ScrollValue = pvValue
2461 Case CTLTIMEFIELD
2464 Set vSet = New com.sun.star.util.Time
2465 vSet.Hours = Hour(pvValue)
2466 vSet.Minutes = Minute(pvValue)
2467 vSet.Seconds = Second(pvValue)
2468 _ControlModel.Time = vSet
2469 End If
2470 Case Else : GoTo CatchType
2471 End Select
2473 If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Finally
2475 If pvValue Then
2476 If oSession.HasUnoProperty(_ControlModel, "EnableVisible") Then _ControlModel.EnableVisible = True
2477 End If
2478 _ControlView.setVisible(pvValue)
2479 End If
2481 If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch
2482 bSet = Resize(Width := pvValue)
2484 If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch
2485 bSet = Resize(Left := pvValue)
2487 If Not ScriptForge.SF_Utils._Validate(pvValue, "Width", ScriptForge.V_NUMERIC) Then GoTo Catch
2488 bSet = Resize(Top := pvValue)
2489 Case Else
2490 bSet = False
2491 End Select
2492 Finally:
2493 _PropertySet = bSet
2494 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2495 Exit Function
2496 Catch:
2497 GoTo Finally
2498 CatchType:
2499 ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, psProperty)
2500 GoTo Finally
2501 End Function ' SFDialogs.SF_DialogControl._PropertySet
2503 REM -----------------------------------------------------------------------------
2504 Private Function _Repr() As String
2505 ''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
2506 ''' Args:
2507 ''' Return:
2508 ''' "[DIALOGCONTROL]: Name, Type (dialogname)
2509 _Repr = "[DIALOGCONTROL]: " & _Name & ", " & _ControlType & " (" & _DialogName & ")"
2511 End Function ' SFDialogs.SF_DialogControl._Repr
2513 REM ============================================ END OF SFDIALOGS.SF_DIALOGCONTROL
2514 </script:module>