| blob | 2879536efb6f88f22b4c85a2b239864766f96112 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Form" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === The SFDocuments library is one of the associated libraries. ===
6 REM === Full documentation is available on https://help.libreoffice.org/ ===
7 REM =======================================================================================================================
9 Option Compatible
10 Option ClassModule
12 Option Explicit
14 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
15 ''' SF_Form
16 ''' =======
17 ''' Management of forms defined in LibreOffice documents. Supported types are Base, Calc and Writer documents.
18 ''' It includes the management of subforms
19 ''' Each instance of the current class represents a single form or a single subform
20 '''
21 ''' A form may optionally be (understand "is often") linked to a data source manageable with the SFDatabases.Database service
22 ''' The current service offers a rapid access to that service
23 '''
24 ''' Definitions:
25 '''
26 ''' FormDocument:
27 ''' For usual documents, there is only 1 form document. It is in fact the document itself.
28 ''' A Base document may contain an unlimited number of form documents.
29 ''' In the Base terminology they are called "forms" or "Base forms". This could create some confusion.
30 ''' They can be organized in folders. Their name is then always the full path of folders + form
32 ''' A FormDocument is a set of Forms. Form names are visible in the user interface thanks to the form navigator
33 ''' Often there is only 1 Form present in a FormDocument. Having more, however, might improve
34 ''' the user experience significantly
35 '''
37 ''' Is an abstract set of Controls in an OPEN FormDocument
38 ''' Each form is usually linked to one single dataset (table, query or Select statement),
39 ''' located in any database (provided the user may access it)
40 ''' A usual document may contain several forms. Each of which may have its own data source (database + dataset)
41 ''' A Base form document may contain several forms. Each of which may address its own dataset. The database however is unique
42 ''' A form is defined by its owning FormDocument and its FormName or FormIndex
43 '''
44 ''' Service invocations:
45 '''
46 ''' REM the form is stored in a not-Base document (Calc, Writer)
47 ''' Dim oDoc As Object, myForm As Object
48 ''' Set oDoc = CreateScriptService("SFDocuments.Document", ThisComponent)
52 '''
53 ''' REM the form is stored in one of the FormDocuments of a Base document
54 ''' Dim oDoc As Object, myForm As Object, mySubForm As Object
55 ''' Set oDoc = CreateScriptService("SFDocuments.Document", ThisDatabaseDocument)
60 ''' ' To access a subform: myForm and mySubForm become distinct instances of the current class
62 '''
63 ''' REM the form is the subject of an event
64 ''' Sub OnEvent(ByRef poEvent As Object)
65 ''' Dim myForm As Object
67 '''
68 ''' Detailed user documentation:
69 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_form.html?DbPAR=BASIC
70 '''
71 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
73 REM ================================================================== EXCEPTIONS
78 REM ============================================================= PRIVATE MEMBERS
80 Private [Me] As Object
81 Private [_Parent] As Object
82 Private ObjectType As String ' Must be Form
83 Private ServiceName As String
85 ' Form location
86 Private _Name As String ' Internal name of the form
87 Private _FormType As Integer ' One of the ISxxxFORM constants
88 Private _SheetName As String ' Name as the sheet containing the form (Calc only)
89 Private _FormDocumentName As String ' The hierarchical name of the containing form document (Base only)
90 Private _FormDocument As Object ' com.sun.star.comp.sdb.Content - the containing form document
91 ' The form topmost container
92 Private _Component As Object ' com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument
94 ' Events management
95 Private _CacheIndex As Long ' Index in central cache storage
97 ' Form UNO references
98 ' The entry to the interactions with the form. Validity checked by the _IsStillAlive() method
99 ' Each method or property requiring that the form is opened should first invoke that method
100 Private _Form As Object ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
101 Private _Database As Object ' Database class instance
103 ' Form attributes
105 ' Cache storage for controls
106 Private _ControlNames As Variant ' Array of control names
107 Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of XForm
109 REM ============================================================ MODULE CONSTANTS
117 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
119 REM -----------------------------------------------------------------------------
120 Private Sub Class_Initialize()
121 Set [Me] = Nothing
122 Set [_Parent] = Nothing
125 _Name = ""
126 _SheetName = ""
127 _FormDocumentName = ""
128 Set _FormDocument = Nothing
129 _FormType = ISUNDEFINED
130 _CacheIndex = -1
131 Set _Form = Nothing
132 Set _Database = Nothing
133 _ControlNames = Array()
134 _ControlCache = Array()
135 End Sub ' SFDocuments.SF_Form Constructor
137 REM -----------------------------------------------------------------------------
138 Private Sub Class_Terminate()
139 Call Class_Initialize()
140 End Sub ' SFDocuments.SF_Form Destructor
142 REM -----------------------------------------------------------------------------
143 Public Function Dispose() As Variant
144 If Not IsNull(_Database) And (_FormType = ISDOCFORM Or _FormType = ISCALCFORM) Then
145 Set _Database = _Database.Dispose()
146 End If
147 SF_Register._CleanCacheEntry(_CacheIndex)
148 Call Class_Terminate()
149 Set Dispose = Nothing
150 End Function ' SFDocuments.SF_Form Explicit Destructor
152 REM ================================================================== PROPERTIES
154 REM -----------------------------------------------------------------------------
155 Property Get AllowDeletes() As Variant
156 ''' The AllowDeletes property specifies if the form allows to delete records
158 End Property ' SFDocuments.SF_Form.AllowDeletes (get)
160 REM -----------------------------------------------------------------------------
161 Property Let AllowDeletes(Optional ByVal pvAllowDeletes As Variant)
162 ''' Set the updatable property AllowDeletes
164 End Property ' SFDocuments.SF_Form.AllowDeletes (let)
166 REM -----------------------------------------------------------------------------
167 Property Get AllowInserts() As Variant
168 ''' The AllowInserts property specifies if the form allows to add records
170 End Property ' SFDocuments.SF_Form.AllowInserts (get)
172 REM -----------------------------------------------------------------------------
173 Property Let AllowInserts(Optional ByVal pvAllowInserts As Variant)
174 ''' Set the updatable property AllowInserts
176 End Property ' SFDocuments.SF_Form.AllowInserts (let)
178 REM -----------------------------------------------------------------------------
179 Property Get AllowUpdates() As Variant
180 ''' The AllowUpdates property specifies if the form allows to update records
182 End Property ' SFDocuments.SF_Form.AllowUpdates (get)
184 REM -----------------------------------------------------------------------------
185 Property Let AllowUpdates(Optional ByVal pvAllowUpdates As Variant)
186 ''' Set the updatable property AllowUpdates
188 End Property ' SFDocuments.SF_Form.AllowUpdates (let)
190 REM -----------------------------------------------------------------------------
191 Property Get BaseForm() As String
192 ''' The BaseForm property specifies the hierarchical name of the Base form containing the actual form
194 End Property ' SFDocuments.SF_Form.BaseForm (get)
196 REM -----------------------------------------------------------------------------
197 Property Get Bookmark() As Variant
198 ''' The Bookmark property specifies uniquely the current record of the form's underlying table, query or SQL statement.
200 End Property ' SFDocuments.SF_Form.Bookmark (get)
202 REM -----------------------------------------------------------------------------
203 Property Let Bookmark(Optional ByVal pvBookmark As Variant)
204 ''' Set the updatable property Bookmark
206 End Property ' SFDocuments.SF_Form.Bookmark (let)
208 REM -----------------------------------------------------------------------------
209 Property Get CurrentRecord() As Variant
210 ''' The CurrentRecord property identifies the current record in the recordset being viewed on a form
212 End Property ' SFDocuments.SF_Form.CurrentRecord (get)
214 REM -----------------------------------------------------------------------------
215 Property Let CurrentRecord(Optional ByVal pvCurrentRecord As Variant)
216 ''' Set the updatable property CurrentRecord
217 ''' If the row number is positive, the cursor moves to the given row number with respect to the beginning of the result set.
219 ''' If the given row number is negative, the cursor moves to an absolute row position with respect to the end of the result set.
220 ''' For example, setting CurrentRecord = -1 positions the cursor on the last row, -2 indicates the next-to-last row, and so on
222 End Property ' SFDocuments.SF_Form.CurrentRecord (let)
224 REM -----------------------------------------------------------------------------
225 Property Get Filter() As Variant
226 ''' The Filter property specifies a subset of records to be displayed.
228 End Property ' SFDocuments.SF_Form.Filter (get)
230 REM -----------------------------------------------------------------------------
231 Property Let Filter(Optional ByVal pvFilter As Variant)
232 ''' Set the updatable property Filter
234 End Property ' SFDocuments.SF_Form.Filter (let)
236 REM -----------------------------------------------------------------------------
237 Property Get LinkChildFields() As Variant
238 ''' The LinkChildFields property specifies how records in a subform (child) are linked to records in its parent form
239 ''' It returns an array of strings
241 End Property ' SFDocuments.SF_Form.LinkChildFields (get)
243 REM -----------------------------------------------------------------------------
244 Property Get LinkParentFields() As Variant
245 ''' The LinkParentFields property specifies how records in a subform (Child) are linked to records in its parent form
246 ''' It returns an array of strings
248 End Property ' SFDocuments.SF_Form.LinkParentFields (get)
250 REM -----------------------------------------------------------------------------
251 Property Get Name() As String
252 ''' Return the name of the actual Form
254 End Property ' SFDocuments.SF_Form.Name
256 REM -----------------------------------------------------------------------------
257 Property Get OnApproveCursorMove() As Variant
258 ''' The OnApproveCursorMove property specifies the script to trigger when this event occurs
260 End Property ' SFDocuments.SF_Form.OnApproveCursorMove (get)
262 REM -----------------------------------------------------------------------------
263 Property Let OnApproveCursorMove(Optional ByVal pvOnApproveCursorMove As Variant)
264 ''' Set the updatable property OnApproveCursorMove
266 End Property ' SFDocuments.SF_Form.OnApproveCursorMove (let)
268 REM -----------------------------------------------------------------------------
269 Property Get OnApproveReset() As Variant
270 ''' The OnApproveReset property specifies the script to trigger when this event occurs
272 End Property ' SFDocuments.SF_Form.OnApproveReset (get)
274 REM -----------------------------------------------------------------------------
275 Property Let OnApproveReset(Optional ByVal pvOnApproveReset As Variant)
276 ''' Set the updatable property OnApproveReset
278 End Property ' SFDocuments.SF_Form.OnApproveReset (let)
280 REM -----------------------------------------------------------------------------
281 Property Get OnApproveRowChange() As Variant
282 ''' The OnApproveRowChange property specifies the script to trigger when this event occurs
284 End Property ' SFDocuments.SF_Form.OnApproveRowChange (get)
286 REM -----------------------------------------------------------------------------
287 Property Let OnApproveRowChange(Optional ByVal pvOnApproveRowChange As Variant)
288 ''' Set the updatable property OnApproveRowChange
290 End Property ' SFDocuments.SF_Form.OnApproveRowChange (let)
292 REM -----------------------------------------------------------------------------
293 Property Get OnApproveSubmit() As Variant
294 ''' The OnApproveSubmit property specifies the script to trigger when this event occurs
296 End Property ' SFDocuments.SF_Form.OnApproveSubmit (get)
298 REM -----------------------------------------------------------------------------
299 Property Let OnApproveSubmit(Optional ByVal pvOnApproveSubmit As Variant)
300 ''' Set the updatable property OnApproveSubmit
302 End Property ' SFDocuments.SF_Form.OnApproveSubmit (let)
304 REM -----------------------------------------------------------------------------
305 Property Get OnConfirmDelete() As Variant
306 ''' The OnConfirmDelete property specifies the script to trigger when this event occurs
308 End Property ' SFDocuments.SF_Form.OnConfirmDelete (get)
310 REM -----------------------------------------------------------------------------
311 Property Let OnConfirmDelete(Optional ByVal pvOnConfirmDelete As Variant)
312 ''' Set the updatable property OnConfirmDelete
314 End Property ' SFDocuments.SF_Form.OnConfirmDelete (let)
316 REM -----------------------------------------------------------------------------
317 Property Get OnCursorMoved() As Variant
318 ''' The OnCursorMoved property specifies the script to trigger when this event occurs
320 End Property ' SFDocuments.SF_Form.OnCursorMoved (get)
322 REM -----------------------------------------------------------------------------
323 Property Let OnCursorMoved(Optional ByVal pvOnCursorMoved As Variant)
324 ''' Set the updatable property OnCursorMoved
326 End Property ' SFDocuments.SF_Form.OnCursorMoved (let)
328 REM -----------------------------------------------------------------------------
329 Property Get OnErrorOccurred() As Variant
330 ''' The OnErrorOccurred property specifies the script to trigger when this event occurs
332 End Property ' SFDocuments.SF_Form.OnErrorOccurred (get)
334 REM -----------------------------------------------------------------------------
335 Property Let OnErrorOccurred(Optional ByVal pvOnErrorOccurred As Variant)
336 ''' Set the updatable property OnErrorOccurred
338 End Property ' SFDocuments.SF_Form.OnErrorOccurred (let)
340 REM -----------------------------------------------------------------------------
341 Property Get OnLoaded() As Variant
342 ''' The OnLoaded property specifies the script to trigger when this event occurs
344 End Property ' SFDocuments.SF_Form.OnLoaded (get)
346 REM -----------------------------------------------------------------------------
347 Property Let OnLoaded(Optional ByVal pvOnLoaded As Variant)
348 ''' Set the updatable property OnLoaded
350 End Property ' SFDocuments.SF_Form.OnLoaded (let)
352 REM -----------------------------------------------------------------------------
353 Property Get OnReloaded() As Variant
354 ''' The OnReloaded property specifies the script to trigger when this event occurs
356 End Property ' SFDocuments.SF_Form.OnReloaded (get)
358 REM -----------------------------------------------------------------------------
359 Property Let OnReloaded(Optional ByVal pvOnReloaded As Variant)
360 ''' Set the updatable property OnReloaded
362 End Property ' SFDocuments.SF_Form.OnReloaded (let)
364 REM -----------------------------------------------------------------------------
365 Property Get OnReloading() As Variant
366 ''' The OnReloading property specifies the script to trigger when this event occurs
368 End Property ' SFDocuments.SF_Form.OnReloading (get)
370 REM -----------------------------------------------------------------------------
371 Property Let OnReloading(Optional ByVal pvOnReloading As Variant)
372 ''' Set the updatable property OnReloading
374 End Property ' SFDocuments.SF_Form.OnReloading (let)
376 REM -----------------------------------------------------------------------------
377 Property Get OnResetted() As Variant
378 ''' The OnResetted property specifies the script to trigger when this event occurs
380 End Property ' SFDocuments.SF_Form.OnResetted (get)
382 REM -----------------------------------------------------------------------------
383 Property Let OnResetted(Optional ByVal pvOnResetted As Variant)
384 ''' Set the updatable property OnResetted
386 End Property ' SFDocuments.SF_Form.OnResetted (let)
388 REM -----------------------------------------------------------------------------
389 Property Get OnRowChanged() As Variant
390 ''' The OnRowChanged property specifies the script to trigger when this event occurs
392 End Property ' SFDocuments.SF_Form.OnRowChanged (get)
394 REM -----------------------------------------------------------------------------
395 Property Let OnRowChanged(Optional ByVal pvOnRowChanged As Variant)
396 ''' Set the updatable property OnRowChanged
398 End Property ' SFDocuments.SF_Form.OnRowChanged (let)
400 REM -----------------------------------------------------------------------------
401 Property Get OnUnloaded() As Variant
402 ''' The OnUnloaded property specifies the script to trigger when this event occurs
404 End Property ' SFDocuments.SF_Form.OnUnloaded (get)
406 REM -----------------------------------------------------------------------------
407 Property Let OnUnloaded(Optional ByVal pvOnUnloaded As Variant)
408 ''' Set the updatable property OnUnloaded
410 End Property ' SFDocuments.SF_Form.OnUnloaded (let)
412 REM -----------------------------------------------------------------------------
413 Property Get OnUnloading() As Variant
414 ''' The OnUnloading property specifies the script to trigger when this event occurs
416 End Property ' SFDocuments.SF_Form.OnUnloading (get)
418 REM -----------------------------------------------------------------------------
419 Property Let OnUnloading(Optional ByVal pvOnUnloading As Variant)
420 ''' Set the updatable property OnUnloading
422 End Property ' SFDocuments.SF_Form.OnUnloading (let)
424 REM -----------------------------------------------------------------------------
425 Property Get OrderBy() As Variant
426 ''' The OrderBy property specifies in which order the records should be displayed.
428 End Property ' SFDocuments.SF_Form.OrderBy (get)
430 REM -----------------------------------------------------------------------------
431 Property Let OrderBy(Optional ByVal pvOrderBy As Variant)
432 ''' Set the updatable property OrderBy
434 End Property ' SFDocuments.SF_Form.OrderBy (let)
436 REM -----------------------------------------------------------------------------
437 Property Get Parent() As Object
438 ''' Return the Parent of the actual Form
440 End Property ' SFDocuments.SF_Form.Parent
442 REM -----------------------------------------------------------------------------
443 Property Get RecordSource() As Variant
444 ''' The RecordSource property specifies the source of the data,
445 ''' a table name, a query name or a SQL statement
447 End Property ' SFDocuments.SF_Form.RecordSource (get)
449 REM -----------------------------------------------------------------------------
450 Property Let RecordSource(Optional ByVal pvRecordSource As Variant)
451 ''' Set the updatable property RecordSource
453 End Property ' SFDocuments.SF_Form.RecordSource (let)
455 REM -----------------------------------------------------------------------------
456 Property Get XForm() As Object
457 ''' The XForm property returns the XForm UNO object of the Form
459 End Property ' SFDocuments.SF_Form.XForm (get)
461 REM ===================================================================== METHODS
463 REM -----------------------------------------------------------------------------
464 Public Function Activate() As Boolean
465 ''' Set the focus on the current Form instance
466 ''' Probably called from after an event occurrence or to focus on an open Base form document
467 ''' If the parent document is ...
468 ''' Calc Activate the corresponding sheet
469 ''' Writer Activate the parent document
470 ''' Base Activate the parent form document
471 ''' Args:
472 ''' Returns:
473 ''' True if focusing is successful
474 ''' Example:
475 ''' myForm.Activate()
477 Dim bActivate As Boolean ' Return value
478 Dim oContainer As Object ' com.sun.star.awt.XWindow
480 Const cstSubArgs = ""
482 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
483 bActivate = False
485 Check:
486 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
487 If Not _IsStillAlive() Then GoTo Finally
488 End If
489 Try:
490 Select Case _FormType
491 Case ISDOCFORM : bActivate = [_Parent].Activate()
492 Case ISCALCFORM : bActivate = [_Parent].Activate(_SheetName)
493 Case ISBASEFORM
494 Set oContainer = _FormDocument.Component.CurrentController.Frame.ContainerWindow
495 With oContainer
496 If .isVisible() = False Then .setVisible(True)
497 .IsMinimized = False
498 .setFocus()
499 .toFront() ' Force window change in Linux
501 End With
502 bActivate = True
503 End Select
505 Finally:
506 Activate = bActivate
507 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
508 Exit Function
509 Catch:
510 GoTo Finally
511 End Function ' SFDocuments.SF_Form.Activate
513 REM -----------------------------------------------------------------------------
514 Public Function CloseFormDocument() As Boolean
515 ''' Close the form document containing the actual form instance
516 ''' The form instance is disposed
517 ''' The method does nothing if the actual form is not located in a Base form document
518 ''' Args:
519 ''' Returns:
520 ''' True if closure is successful
521 ''' Example:
522 ''' myForm.CloseFormDocument()
524 Dim bClose As Boolean ' Return value
525 Dim oContainer As Object ' com.sun.star.awt.XWindow
527 Const cstSubArgs = ""
529 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
530 bClose = False
532 Check:
533 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
534 If Not _IsStillAlive() Then GoTo Finally
535 End If
536 Try:
537 Select Case _FormType
538 Case ISDOCFORM, ISCALCFORM, ISSUBFORM
539 Case ISBASEFORM
540 _FormDocument.close()
541 Dispose()
542 bClose = True
543 End Select
545 Finally:
546 CloseFormDocument = bClose
547 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
548 Exit Function
549 Catch:
550 GoTo Finally
551 End Function ' SFDocuments.SF_Form.CloseFormDocument
553 REM -----------------------------------------------------------------------------
554 Public Function Controls(Optional ByVal ControlName As Variant) As Variant
555 ''' Return either
556 ''' - the list of the controls contained in the Form
557 ''' - a Form control object based on its name
558 ''' Args:
559 ''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
560 ''' Returns:
561 ''' A zero-base array of strings if ControlName is absent
562 ''' An instance of the SF_FormControl class if ControlName exists
563 ''' Exceptions:
564 ''' ControlName is invalid
565 ''' Example:
566 ''' Dim myForm As Object, myList As Variant, myControl As Object
568 ''' myList = myForm.Controls()
571 Dim oControl As Object ' The new control class instance
572 Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache
573 Dim vControl As Variant ' Alias of _ControlCache entry
574 Dim i As Long
578 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
580 Check:
581 If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
582 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
583 If Not _IsStillAlive() Then GoTo Finally
584 If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
585 End If
587 Try:
588 ' Collect all control names if not yet done
590 _ControlNames = _Form.getElementNames()
591 ' Remove all subforms from the list
592 For i = 0 To UBound(_ControlNames)
593 ' Subforms have no ClassId property
594 If Not ScriptForge.SF_Session.HasUnoProperty(_Form.getByName(_ControlNames(i)), "ClassId") Then _ControlNames(i) = ""
595 Next i
596 _ControlNames = ScriptForge.SF_Array.TrimArray(_ControlNames)
597 ' Size the cache accordingly
599 ReDim _ControlCache(0 To UBound(_ControlNames))
600 End If
601 End If
603 ' Return the list of controls or a FormControl instance
604 If Len(ControlName) = 0 Then
605 Controls = _ControlNames
607 Else
609 If Not _Form.hasByName(ControlName) Then GoTo CatchNotFound
610 lIndexOfNames = ScriptForge.SF_Array.IndexOf(_ControlNames, ControlName, CaseSensitive := True)
611 ' Reuse cache when relevant
612 vControl = _ControlCache(lIndexOfNames)
614 If IsEmpty(vControl) Then
615 ' Create the new form control class instance
616 Set oControl = New SF_FormControl
617 With oControl
618 ._Name = ControlName
619 Set .[Me] = oControl
620 Set .[_Parent] = [Me]
621 Set ._ParentForm = [Me]
622 ._IndexOfNames = lIndexOfNames
623 ._FormName = _Name
624 ' Get model and view of the current control
625 Set ._ControlModel = _Form.getByName(ControlName)
626 ._Initialize()
627 End With
628 Else
629 Set oControl = vControl
630 End If
632 Set Controls = oControl
633 End If
635 Finally:
636 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
637 Exit Function
638 Catch:
639 GoTo Finally
640 CatchNotFound:
641 ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _Form.getElementNames())
642 GoTo Finally
643 End Function ' SFDocuments.SF_Form.Controls
645 REM -----------------------------------------------------------------------------
646 Public Function GetDatabase(Optional ByVal User As Variant _
647 , Optional ByVal Password As Variant _
648 ) As Object
649 ''' Returns a Database instance (service = SFDatabases.Database) giving access
650 ''' to the execution of SQL commands on the database defined and/or stored in
651 ''' the actual Base document
652 ''' Each main form has its own database connection, except within Base documents where
653 ''' they all share the same connection
654 ''' Args:
656 ''' Returns:
657 ''' A SFDatabases.Database instance or Nothing
658 ''' Example:
659 ''' Dim myDb As Object
660 ''' Set myDb = oForm.GetDatabase()
662 Dim FSO As Object ' Alias for SF_FileSystem
663 Dim sDataSource As String ' Database file name in FileNaming format
664 Dim sUser As String ' Alias for User
665 Dim sPassword As String ' Alias for Password
667 Const cstSubArgs = "[User=""""], [Password=""""]"
669 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
670 Set GetDatabase = Nothing
672 Check:
673 If IsMissing(User) Or IsEmpty(User) Then User = ""
674 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
675 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
676 If Not [_Parent]._IsStillAlive(True) Then GoTo Finally
678 If Not ScriptForge.SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally
679 End If
681 Try:
682 ' Adjust connection arguments
683 If Len(User) = 0 Then
684 If ScriptForge.SF_Session.HasUnoProperty(_Form, "User") Then sUser = _Form.User Else sUser = ""
685 Else
686 sUser = User
687 End If
688 If Len(sUser) + Len(Password) = 0 Then
689 If ScriptForge.SF_Session.HasUnoProperty(_Form, "Password") Then sPassword = _Form.Password Else sPassword = Password
690 End If
692 ' Connect to database, avoiding multiple requests
694 If _FormType = ISBASEFORM Then
695 ' Fetch the shared connection
696 Set _Database = [_Parent].GetDatabase(User, Password)
697 ElseIf _FormType = ISSUBFORM Then
698 Set _Database = [_Parent].GetDatabase() ' Recursive call, climb the tree
700 ' Return Nothing
701 Else
702 ' Check if DataSourceName is a file or a registered name and create database instance accordingly
703 Set FSO = ScriptForge.SF_FileSystem
704 sDataSource = FSO._ConvertFromUrl(_Form.DataSourceName)
705 If FSO.FileExists(sDataSource) Then
707 , sDataSource, , , sUser, sPassword)
708 Else
710 , , _Form.DataSourceName, , sUser, sPassword)
711 End If
712 If IsNull(_Database) Then GoTo CatchConnect
713 End If
714 Else
715 EndIf
717 Finally:
718 Set GetDatabase = _Database
719 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
720 Exit Function
721 Catch:
722 GoTo Finally
723 CatchConnect:
724 ScriptForge.SF_Exception.RaiseFatal(DBCONNECTERROR, "User", User, "Password", Password, [_Super]._FileIdent())
725 GoTo Finally
726 End Function ' SFDocuments.SF_Form.GetDatabase
728 REM -----------------------------------------------------------------------------
729 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
730 ''' Return the actual value of the given property
731 ''' Args:
732 ''' PropertyName: the name of the property as a string
733 ''' Returns:
734 ''' The actual value of the property
735 ''' Exceptions:
736 ''' ARGUMENTERROR The property does not exist
737 ''' Examples:
741 Const cstSubArgs = ""
743 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
744 GetProperty = Null
746 Check:
747 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
748 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
749 End If
751 Try:
752 GetProperty = _PropertyGet(PropertyName)
754 Finally:
755 SF_Utils._ExitFunction(cstThisSub)
756 Exit Function
757 Catch:
758 GoTo Finally
759 End Function ' SFDocuments.SF_Form.GetProperty
761 REM -----------------------------------------------------------------------------
762 Public Function Methods() As Variant
763 ''' Return the list of public methods of the Form service as an array
765 Methods = Array( _
777 )
779 End Function ' SFDocuments.SF_Form.Methods
781 REM -----------------------------------------------------------------------------
782 Public Function MoveFirst() As Boolean
783 ''' The cursor is (re)positioned on the first row
784 ''' Args:
785 ''' Returns:
786 ''' True if cursor move is successful
787 ''' Example:
788 ''' myForm.MoveFirst()
790 Dim bMoveFirst As Boolean ' Return value
792 Const cstSubArgs = ""
794 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
795 bMoveFirst = False
797 Check:
798 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
799 If Not _IsStillAlive() Then GoTo Finally
800 End If
801 Try:
802 With _Form
803 bMoveFirst = .first()
804 End With
806 Finally:
807 MoveFirst = bMoveFirst
808 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
809 Exit Function
810 Catch:
811 GoTo Finally
812 End Function ' SFDocuments.SF_Form.MoveFirst
814 REM -----------------------------------------------------------------------------
815 Public Function MoveLast() As Boolean
816 ''' The cursor is (re)positioned on the last row
817 ''' Args:
818 ''' Returns:
819 ''' True if cursor move is successful
820 ''' Example:
821 ''' myForm.MoveLast()
823 Dim bMoveLast As Boolean ' Return value
825 Const cstSubArgs = ""
827 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
828 bMoveLast = False
830 Check:
831 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
832 If Not _IsStillAlive() Then GoTo Finally
833 End If
834 Try:
835 With _Form
836 bMoveLast = .last()
837 End With
839 Finally:
840 MoveLast = bMoveLast
841 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
842 Exit Function
843 Catch:
844 GoTo Finally
845 End Function ' SFDocuments.SF_Form.MoveLast
847 REM -----------------------------------------------------------------------------
848 Public Function MoveNew() As Boolean
849 ''' The cursor is (re)positioned in the new record area
850 ''' Args:
851 ''' Returns:
852 ''' True if cursor move is successful
853 ''' Example:
854 ''' myForm.MoveNew()
856 Dim bMoveNew As Boolean ' Return value
858 Const cstSubArgs = ""
860 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
861 bMoveNew = False
863 Check:
864 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
865 If Not _IsStillAlive() Then GoTo Finally
866 End If
867 Try:
868 With _Form
869 .last() ' To simulate the behaviour in the UI
870 .moveToInsertRow()
871 End With
872 bMoveNew = True
874 Finally:
875 MoveNew = bMoveNew
876 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
877 Exit Function
878 Catch:
879 GoTo Finally
880 End Function ' SFDocuments.SF_Form.MoveNew
882 REM -----------------------------------------------------------------------------
883 Public Function MoveNext(Optional ByVal Offset As Variant) As Boolean
884 ''' The cursor is (re)positioned on the next row
885 ''' Args:
887 ''' Returns:
888 ''' True if cursor move is successful
889 ''' Example:
890 ''' myForm.MoveNext()
892 Dim bMoveNext As Boolean ' Return value
893 Dim lOffset As Long ' Alias of Offset
895 Const cstSubArgs = ""
897 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
898 bMoveNext = False
900 Check:
901 If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
902 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
903 If Not _IsStillAlive() Then GoTo Finally
904 If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
905 End If
906 Try:
907 lOffset = CLng(Offset) ' To be sure to have the right argument type
908 With _Form
909 If lOffset = 1 Then bMoveNext = .next() Else bMoveNext = .relative(lOffset)
910 End With
912 Finally:
913 MoveNext = bMoveNext
914 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
915 Exit Function
916 Catch:
917 GoTo Finally
918 End Function ' SFDocuments.SF_Form.MoveNext
920 REM -----------------------------------------------------------------------------
921 Public Function MovePrevious(Optional ByVal Offset As Variant) As Boolean
922 ''' The cursor is (re)positioned on the previous row
923 ''' Args:
925 ''' Returns:
926 ''' True if cursor move is successful
927 ''' Example:
928 ''' myForm.MovePrevious()
930 Dim bMovePrevious As Boolean ' Return value
931 Dim lOffset As Long ' Alias of Offset
933 Const cstSubArgs = ""
935 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
936 bMovePrevious = False
938 Check:
939 If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
940 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
941 If Not _IsStillAlive() Then GoTo Finally
942 If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
943 End If
944 Try:
945 lOffset = CLng(Offset) ' To be sure to have the right argument type
946 With _Form
947 If lOffset = 1 Then bMovePrevious = .previous() Else bMovePrevious = .relative(-lOffset)
948 End With
950 Finally:
951 MovePrevious = bMovePrevious
952 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
953 Exit Function
954 Catch:
955 GoTo Finally
956 End Function ' SFDocuments.SF_Form.MovePrevious
958 REM -----------------------------------------------------------------------------
959 Public Function Properties() As Variant
960 ''' Return the list or properties of the Form class as an array
962 Properties = Array( _
992 )
994 End Function ' SFDocuments.SF_Form.Properties
996 REM -----------------------------------------------------------------------------
997 Public Function Requery() As Boolean
998 ''' Reload from the database the actual data into the form
999 ''' The cursor is (re)positioned on the first row
1000 ''' Args:
1001 ''' Returns:
1002 ''' True if requery is successful
1003 ''' Example:
1004 ''' myForm.Requery()
1006 Dim bRequery As Boolean ' Return value
1008 Const cstSubArgs = ""
1010 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1011 bRequery = False
1013 Check:
1014 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1015 If Not _IsStillAlive() Then GoTo Finally
1016 End If
1017 Try:
1018 With _Form
1019 If .isLoaded() Then .reload() Else .load()
1020 End With
1021 bRequery = True
1023 Finally:
1024 Requery = bRequery
1025 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1026 Exit Function
1027 Catch:
1028 GoTo Finally
1029 End Function ' SFDocuments.SF_Form.Requery
1031 REM -----------------------------------------------------------------------------
1032 Public Function SetProperty(Optional ByVal PropertyName As Variant _
1033 , Optional ByRef Value As Variant _
1034 ) As Boolean
1035 ''' Set a new value to the given property
1036 ''' Args:
1037 ''' PropertyName: the name of the property as a string
1038 ''' Value: its new value
1039 ''' Exceptions
1040 ''' ARGUMENTERROR The property does not exist
1045 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1046 SetProperty = False
1048 Check:
1049 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1050 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1051 End If
1053 Try:
1054 SetProperty = _PropertySet(PropertyName, Value)
1056 Finally:
1057 SF_Utils._ExitFunction(cstThisSub)
1058 Exit Function
1059 Catch:
1060 GoTo Finally
1061 End Function ' SFDocuments.SF_Form.SetProperty
1063 REM -----------------------------------------------------------------------------
1064 Public Function Subforms(Optional ByVal Subform As Variant) As Variant
1065 ''' Return either
1066 ''' - the list of the subforms contained in the actual form or subform instance
1067 ''' - a SFDocuments.Form object based on its name or its index in the alphabetic list of subforms
1068 ''' Args:
1069 ''' Subform: a subform stored in the parent form given by its name or its index
1070 ''' When absent, the list of available subforms is returned
1071 ''' To get the first (unique ?) subform stored in the parent form, set Subform = 0
1072 ''' Exceptions:
1073 ''' SUBFORMNOTFOUNDERROR Subform not found
1074 ''' Returns:
1075 ''' A zero-based array of strings if Subform is absent
1076 ''' An instance of the SF_Form class if Subform exists
1077 ''' Example:
1078 ''' Dim myForm As Object, myList As Variant, mySubform As Object
1079 ''' myList = myForm.Subforms()
1082 Dim oSubform As Object ' The new Form class instance
1083 Dim oXSubform As Object ' com.sun.star.form.XForm
1084 Dim vSubformNames As Variant ' Array of subform names
1085 Dim i As Long
1091 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1093 Check:
1094 If IsMissing(Subform) Or IsEmpty(Subform) Then Subform = ""
1095 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1096 If Not _IsStillAlive() Then GoTo Finally
1097 If Not ScriptForge.SF_Utils._Validate(Subform, "Subform", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
1098 End If
1100 Try:
1101 ' Collect all control names and retain only the subforms
1102 vSubformNames = _Form.getElementNames()
1103 For i = 0 To UBound(vSubformNames)
1104 Set oSubform = _Form.getByName(vSubformNames(i))
1105 ' Subforms are the only control types having no ClassId property
1106 If ScriptForge.SF_Session.HasUnoProperty(oSubform, "ClassId") Then vSubformNames(i) = ""
1107 Next i
1108 vSubformNames = ScriptForge.SF_Array.TrimArray(vSubformNames)
1111 Subforms = vSubformNames
1112 Else
1113 If VarType(Subform) = V_STRING Then ' Find the form by name
1114 If Not ScriptForge.SF_Array.Contains(vSubformNames, Subform, CaseSensitive := True) Then GoTo CatchNotFound
1115 Set oXSubform = _Form.getByName(Subform)
1116 Else ' Find the form by index
1118 Set oXSubform = _Form.getByName(vSubformNames(Subform))
1119 End If
1120 ' Create the new Form class instance
1121 Set oSubform = SF_Register._NewForm(oXSubform)
1122 With oSubform
1123 Set .[_Parent] = [Me]
1124 ._FormType = ISSUBFORM
1125 Set ._Component = _Component
1126 Set ._FormDocument = _FormDocument
1127 ._SheetName = _SheetName
1128 ._FormDocumentName = _FormDocumentName
1129 Set ._Database = _Database
1130 ._Initialize()
1131 End With
1132 Set Subforms = oSubform
1133 End If
1135 Finally:
1136 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1137 Exit Function
1138 Catch:
1139 GoTo Finally
1140 CatchNotFound:
1141 ScriptForge.SF_Exception.RaiseFatal(SUBFORMNOTFOUNDERROR, Subform, _Name)
1142 GoTo Finally
1143 End Function ' SFDocuments.SF_Form.Subforms
1145 REM =========================================================== PRIVATE FUNCTIONS
1147 REM -----------------------------------------------------------------------------
1148 Public Function _GetEventName(ByVal psProperty As String) As String
1149 ''' Return the LO internal event name derived from the SF property name
1150 ''' The SF property name is not case sensitive, while the LO name is case-sensitive
1151 ' Corrects the typo on ErrorOccur(r?)ed, if necessary
1153 Dim vProperties As Variant ' Array of class properties
1154 Dim sProperty As String ' Correctly cased property name
1156 vProperties = Properties()
1157 sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
1161 End Function ' SFDocuments.SF_Form._GetEventName
1163 REM -----------------------------------------------------------------------------
1164 Private Function _GetListener(ByVal psEventName As String) As String
1165 ''' Getting/Setting macros triggered by events requires a Listener-EventName pair
1166 ''' Return the X...Listener corresponding with the event name in argument
1168 Select Case UCase(psEventName)
1185 Case UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnUnloaded"), UCase("OnUnloading")
1187 End Select
1189 End Function ' SFDocuments.SF_Form._GetListener
1191 REM -----------------------------------------------------------------------------
1192 Private Sub _GetParents()
1193 ''' When the current instance is created top-down, the parents are completely defined
1194 ''' and nothing should be done in this method
1195 ''' When the a class instance is created in a (form/control) event, it is the opposite
1196 ''' The current method rebuilds the missing members in the instance from the bottom
1197 ''' Members potentially to collect are:
1198 ''' - _FormType
1199 ''' - [_Parent], the immediate parent: a form or a document instance
1200 ''' + Only when the _FormType is a main form
1201 ''' - _SheetName (Calc only)
1202 ''' - _FormDocumentName (Base only)
1203 ''' - _FormDocument, the topmost form collection
1204 ''' - _Component, the containing document
1205 ''' They must be identified only starting from the _Form UNO object
1206 '''
1207 ''' The method is called from the _Initialize() method at instance creation
1209 Dim oParent As Object ' Successive bottom-up parents
1210 Dim sType As String ' UNO object type
1211 Dim sPersistentName As String ' The Obj... name of a Base form
1213 Dim oSession As Object : Set oSession = ScriptForge.SF_Session
1215 On Local Error GoTo Finally ' Being probably called from events, this method should avoid failures
1216 ' When the form type is known, the upper part of the branch is not scanned
1217 If _FormType <> ISUNDEFINED Then GoTo Finally
1219 Try:
1220 ' The whole branch is scanned bottom-up
1221 If oSession.HasUnoProperty(_Form, "Parent") Then Set oParent = _Form.Parent Else Set oParent = Nothing
1222 _FormType = ISUNDEFINED
1223 iLevel = 1
1225 Do While Not IsNull(oParent)
1226 sType = SF_Session.UnoObjectType(oParent)
1227 Select Case sType
1228 ' Collect at each level the needed info
1230 If iLevel = 1 Then
1231 _FormType = ISSUBFORM
1232 Set [_Parent] = SF_Register._NewForm(oParent)
1233 ' Everything is in the parent, copy items and stop scan
1234 [_Parent]._Initialize() ' Current method is called recursively here
1235 With [_Parent]
1236 _SheetName = ._SheetName
1237 _FormDocumentName = ._FormDocumentName
1238 Set _FormDocument = ._FormDocument
1239 Set _Component = ._Component
1240 End With
1241 Exit Sub
1242 End If
1243 Case "com.sun.star.form.OFormsCollection" ' The collection of forms inside a drawpage
1244 Case "SwXTextDocument" ' The parent document: a Writer document or a Base form document
1246 sPersistentName = ScriptForge._GetPropertyValue(oParent.Args, "HierarchicalDocumentName")
1248 _FormType = ISDOCFORM
1249 Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
1250 Set _Component = [_Parent]._Component
1251 End If
1253 _FormType = ISCALCFORM
1254 Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
1255 Set _Component = oParent
1256 ' The triggered form event is presumed to be located in the (drawpage of the) active sheet
1259 _FormType = ISBASEFORM
1260 Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
1261 Set _Component = oParent
1262 If IsNull([_Parent]._FormDocuments) Then Set [_Parent]._FormDocuments = _Component.getFormDocuments()
1263 Set _FormDocument = [_Parent]._FindByPersistentName([_Parent]._FormDocuments, sPersistentName)
1264 _FormDocumentName = _FormDocument.HierarchicalName
1265 Case Else
1266 End Select
1267 If oSession.HasUnoProperty(oParent, "Parent") Then Set oParent = oParent.Parent Else Set oParent = Nothing
1268 iLevel = iLevel + 1
1269 Loop
1271 Finally:
1272 Exit Sub
1273 End Sub ' SFDocuments.SF_Form._GetParents
1275 REM -----------------------------------------------------------------------------
1276 Public Sub _Initialize()
1277 ''' Achieve the creation of a SF_Form instance
1278 ''' - complete the missing private members
1279 ''' - store the new instance in the cache
1281 _GetParents()
1282 _CacheIndex = SF_Register._AddFormToCache(_Form, [Me])
1284 End Sub ' SFDocuments.SF_Form._Initialize
1286 REM -----------------------------------------------------------------------------
1287 Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
1288 ''' Return True if the Form is still open
1289 ''' If dead the actual instance is disposed
1290 ''' and the execution is cancelled when pbError = True (default)
1291 ''' Args:
1292 ''' pbError: if True (default), raise a fatal error
1294 Dim bAlive As Boolean ' Return value
1295 Dim sName As String ' Alias of _Name
1296 Dim sId As String ' Alias of FileIdent
1298 Check:
1299 On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
1300 If IsMissing(pbError) Then pbError = True
1302 Try:
1303 ' At main form termination, all database connections are lost
1304 bAlive = Not IsNull(_Form)
1305 If Not bAlive Then GoTo Catch
1307 Finally:
1308 _IsStillAlive = bAlive
1309 Exit Function
1310 Catch:
1311 bAlive = False
1312 On Error GoTo 0
1313 ' Keep error message elements before disposing the instance
1315 sName = Iif(Len(sName) > 0, "[" & sName & "].", "") & _Name
1316 If Not IsNull(_Component) Then sId = _Component.Location Else sId = ""
1317 ' Dispose the actual forms instance
1318 Dispose()
1319 ' Display error message
1320 If pbError Then ScriptForge.SF_Exception.RaiseFatal(FORMDEADERROR, sName, sId)
1321 GoTo Finally
1322 End Function ' SFDocuments.SF_Form._IsStillAlive
1324 REM -----------------------------------------------------------------------------
1325 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
1326 ''' Return the value of the named property
1327 ''' Args:
1328 ''' psProperty: the name of the property
1330 Static oSession As Object ' Alias of SF_Session
1331 Dim vBookmark As Variant ' Form bookmark
1332 Dim cstThisSub As String
1333 Const cstSubArgs = ""
1336 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1338 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1339 _PropertyGet = Empty
1340 If Not _IsStillAlive() Then GoTo Finally
1342 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1343 Select Case UCase(psProperty)
1345 If Not IsNull(_Form) Then _PropertyGet = _Form.AllowDeletes
1347 If Not IsNull(_Form) Then _PropertyGet = _Form.AllowInserts
1349 If Not IsNull(_Form) Then _PropertyGet = _Form.AllowUpdates
1351 _PropertyGet = _FormDocumentName
1353 If IsNull(_Form) Then
1354 _PropertyGet = 0
1355 Else
1356 On Local Error Resume Next ' Disable error handler because bookmarking does not always react well in events ...
1357 If _Form.IsBookmarkable Then vBookmark = _Form.getBookmark() Else vBookmark = Nothing
1358 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error Goto Catch Else On Local Error Goto 0
1359 If IsNull(vBookmark) Then Goto Catch
1360 _PropertyGet = vBookmark
1361 End If
1363 If IsNull(_Form) Then _PropertyGet = 0 Else _PropertyGet = _Form.Row
1365 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Filter
1367 If IsNull(_Form) Or _FormType <> ISSUBFORM Then _PropertyGet = Array() Else _PropertyGet = _Form.DetailFields
1369 If IsNull(_Form) Or _FormType <> ISSUBFORM Then _PropertyGet = Array() Else _PropertyGet = _Form.MasterFields
1371 _PropertyGet = _Name
1372 Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _
1373 , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
1374 , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
1376 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = SF_Register._GetEventScriptCode(_Form, psProperty, _Name)
1378 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Order
1380 _PropertyGet = [_Parent]
1382 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Command
1384 Set _PropertyGet = _Form
1385 Case Else
1386 _PropertyGet = Null
1387 End Select
1389 Finally:
1390 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1391 Exit Function
1392 Catch:
1393 GoTo Finally
1394 End Function ' SFDocuments.SF_Form._PropertyGet
1396 REM -----------------------------------------------------------------------------
1397 Private Function _PropertySet(Optional ByVal psProperty As String _
1398 , Optional ByVal pvValue As Variant _
1399 ) As Boolean
1400 ''' Set the new value of the named property
1401 ''' Args:
1402 ''' psProperty: the name of the property
1403 ''' pvValue: the new value of the given property
1404 ''' Returns:
1405 ''' True if successful
1407 Dim bSet As Boolean ' Return value
1408 Dim oDatabase As Object ' Database class instance
1410 Dim sCommand As String ' Record source
1411 Static oSession As Object ' Alias of SF_Session
1412 Dim cstThisSub As String
1415 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1416 bSet = False
1419 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1420 If Not _IsStillAlive() Then GoTo Finally
1422 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1423 bSet = True
1424 Select Case UCase(psProperty)
1426 If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowDeletes", ScriptForge.V_BOOLEAN) Then GoTo Finally
1427 If Not IsNull(_Form) Then
1428 _Form.AllowDeletes = pvValue
1429 _Form.reload()
1430 End If
1432 If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowInserts", ScriptForge.V_BOOLEAN) Then GoTo Finally
1433 If Not IsNull(_Form) Then
1434 _Form.AllowInserts = pvValue
1435 _Form.reload()
1436 End If
1438 If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowUpdates", ScriptForge.V_BOOLEAN) Then GoTo Finally
1439 If Not IsNull(_Form) Then
1440 _Form.AllowUpdates = pvValue
1441 _Form.reload()
1442 End If
1444 If Not ScriptForge.SF_Utils._Validate(pvValue, "Bookmark", Array(ScriptForge.V_NUMERIC, ScriptForge.V_OBJECT)) Then GoTo Finally
1445 If Not IsNull(pvValue) And Not IsNull(_Form) Then bSet = _Form.moveToBookmark(pvValue)
1447 If Not ScriptForge.SF_Utils._Validate(pvValue, "CurrentRecord", ScriptForge.V_NUMERIC) Then GoTo Finally
1448 If Not IsNull(_Form) Then bSet = _Form.absolute(pvValue)
1451 If Not IsNull(_Form) Then
1452 With _Form
1454 Set oDatabase = GetDatabase()
1455 If Not IsNull(oDatabase) Then .Filter = oDatabase._ReplaceSquareBrackets(pvValue) Else .Filter = pvValue
1456 Else
1457 .Filter = ""
1458 End If
1459 .ApplyFilter = True
1460 .reload()
1461 End With
1462 End If
1463 Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _
1464 , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
1465 , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
1467 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
1468 If Not IsNull(_Form) Then
1469 bSet = SF_Register._RegisterEventScript(_Form _
1470 , psProperty _
1471 , _GetListener(psProperty) _
1472 , pvValue _
1473 , _Name _
1474 )
1475 End If
1477 If Not ScriptForge.SF_Utils._Validate(pvValue, "OrderBy", V_STRING) Then GoTo Finally
1478 If Not IsNull(_Form) Then
1479 With _Form
1481 Set oDatabase = GetDatabase()
1482 If Not IsNull(oDatabase) Then .Order = oDatabase._ReplaceSquareBrackets(pvValue) Else .Order = pvValue
1483 Else
1484 .Order = ""
1485 End If
1486 .reload()
1487 End With
1488 End If
1490 If Not ScriptForge.SF_Utils._Validate(pvValue, "RecordSource", V_STRING) Then GoTo Finally
1492 Set oDatabase = GetDatabase()
1493 If Not IsNull(oDatabase) Then
1494 With oDatabase
1495 If ScriptForge.SF_Array.Contains(.Tables, pvValue, CaseSensitive := True) Then
1496 sCommand = pvValue
1497 lCommandType = com.sun.star.sdb.CommandType.TABLE
1498 ElseIf ScriptForge.SF_Array.Contains(.Queries, pvValue, CaseSensitive := True) Then
1499 sCommand = pvValue
1500 lCommandType = com.sun.star.sdb.CommandType.QUERY
1501 ElseIf ScriptForge.SF_String.StartsWith(pvValue, "SELECT", CaseSensitive := False) Then
1502 sCommand = .ReplaceSquareBrackets(pvValue)
1503 lCommandType = com.sun.star.sdb.CommandType.COMMAND
1504 End If
1505 _Form.Command = sCommand
1506 _Form.CommandType = lCommandType
1507 End With
1508 End If
1509 End If
1510 Case Else
1511 bSet = False
1512 End Select
1514 Finally:
1515 _PropertySet = bSet
1516 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1517 Exit Function
1518 Catch:
1519 GoTo Finally
1520 End Function ' SFDocuments.SF_Form._PropertySet
1522 REM -----------------------------------------------------------------------------
1523 Private Function _Repr() As String
1524 ''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
1525 ''' Args:
1526 ''' Return:
1529 Dim sParent As String ' To recognize the parent
1531 sParent = _SheetName & _FormDocumentName ' At least one of them is a zero-length string
1532 _Repr = "[Form]: " & Iif(Len(sParent) > 0, sParent & "...", "") & _Name
1534 End Function ' SFDocuments.SF_Form._Repr
1536 REM ============================================ END OF SFDOCUMENTS.SF_FORM
1537 </script:module>