| blob | cc7c2aecf34f087b2b57f1147b88fd1ac9a8045d |
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: BASE DOCUMENTS ONLY
27 ''' For usual documents, there is only 1 forms container. It is either the document itself or one of its sheets (Calc)
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 Document or 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 Document or FormDocument and its FormName or FormIndex
43 '''
44 ''' Service invocations:
45 '''
46 ''' REM the form is stored in a Writer document
47 ''' Dim oDoc As Object, myForm As Object
48 ''' Set oDoc = CreateScriptService("SFDocuments.Document", ThisComponent)
52 '''
53 ''' REM the form is stored in a Calc document
54 ''' Dim oCalc As Object, myForm As Object
55 ''' Set oCalc = CreateScriptService("SFDocuments.Document", ThisComponent)
59 '''
60 ''' REM the form is stored in one of the FormDocuments of a Base document
61 ''' Dim oBase As Object, myFormDoc As Object, myForm As Object, mySubForm As Object
62 ''' Set oBase = CreateScriptService("SFDocuments.Document", ThisDatabaseDocument)
67 ''' ' To access a subform: myForm and mySubForm become distinct instances of the current class
69 '''
70 ''' REM the form is the subject of an event
71 ''' Sub OnEvent(ByRef poEvent As Object)
72 ''' Dim myForm As Object
74 '''
75 ''' Detailed user documentation:
76 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_form.html?DbPAR=BASIC
77 '''
78 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
80 REM ================================================================== EXCEPTIONS
85 REM ============================================================= PRIVATE MEMBERS
87 Private [Me] As Object
88 Private [_Parent] As Object
89 Private ObjectType As String ' Must be Form
90 Private ServiceName As String
92 ' Form location
93 Private _Name As String ' Internal name of the form
94 Private _FormType As Integer ' One of the ISxxxFORM constants
95 Private _SheetName As String ' Name as the sheet containing the form (Calc only)
96 Private _FormDocumentName As String ' The hierarchical name of the containing form document (Base only)
97 Private _FormDocument As Object ' com.sun.star.comp.sdb.Content - the form document container
98 ' The form topmost containers
99 Private _Component As Object ' com.sun.star.lang.XComponent
100 Private _BaseComponent As Object ' com.sun.star.comp.dba.ODatabaseDocument
102 ' Events management
103 Private _CacheIndex As Long ' Index in central cache storage
105 ' Form UNO references
106 ' The entry to the interactions with the form. Validity checked by the _IsStillAlive() method
107 ' Each method or property requiring that the form is opened should first invoke that method
108 Private _Form As Object ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
110 ' Form attributes
111 Private _Database As Object ' Database class instance
113 ' Cache storage for controls
114 Private _ControlNames As Variant ' Array of control names
115 Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of XForm
117 REM ============================================================ MODULE CONSTANTS
125 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
127 REM -----------------------------------------------------------------------------
128 Private Sub Class_Initialize()
129 Set [Me] = Nothing
130 Set [_Parent] = Nothing
133 _Name = ""
134 _SheetName = ""
135 _FormDocumentName = ""
136 Set _FormDocument = Nothing
137 Set _Component = Nothing
138 Set _BaseComponent = Nothing
139 _FormType = ISUNDEFINED
140 _CacheIndex = -1
141 Set _Form = Nothing
142 Set _Database = Nothing
143 _ControlNames = Array()
144 _ControlCache = Array()
145 End Sub ' SFDocuments.SF_Form Constructor
147 REM -----------------------------------------------------------------------------
148 Private Sub Class_Terminate()
149 Call Class_Initialize()
150 End Sub ' SFDocuments.SF_Form Destructor
152 REM -----------------------------------------------------------------------------
153 Public Function Dispose() As Variant
154 If Not IsNull(_Database) And (_FormType = ISDOCFORM Or _FormType = ISCALCFORM) Then
155 Set _Database = _Database.Dispose()
156 End If
157 SF_Register._CleanCacheEntry(_CacheIndex)
158 Call Class_Terminate()
159 Set Dispose = Nothing
160 End Function ' SFDocuments.SF_Form Explicit Destructor
162 REM ================================================================== PROPERTIES
164 REM -----------------------------------------------------------------------------
165 Property Get AllowDeletes() As Variant
166 ''' The AllowDeletes property specifies if the form allows to delete records
168 End Property ' SFDocuments.SF_Form.AllowDeletes (get)
170 REM -----------------------------------------------------------------------------
171 Property Let AllowDeletes(Optional ByVal pvAllowDeletes As Variant)
172 ''' Set the updatable property AllowDeletes
174 End Property ' SFDocuments.SF_Form.AllowDeletes (let)
176 REM -----------------------------------------------------------------------------
177 Property Get AllowInserts() As Variant
178 ''' The AllowInserts property specifies if the form allows to add records
180 End Property ' SFDocuments.SF_Form.AllowInserts (get)
182 REM -----------------------------------------------------------------------------
183 Property Let AllowInserts(Optional ByVal pvAllowInserts As Variant)
184 ''' Set the updatable property AllowInserts
186 End Property ' SFDocuments.SF_Form.AllowInserts (let)
188 REM -----------------------------------------------------------------------------
189 Property Get AllowUpdates() As Variant
190 ''' The AllowUpdates property specifies if the form allows to update records
192 End Property ' SFDocuments.SF_Form.AllowUpdates (get)
194 REM -----------------------------------------------------------------------------
195 Property Let AllowUpdates(Optional ByVal pvAllowUpdates As Variant)
196 ''' Set the updatable property AllowUpdates
198 End Property ' SFDocuments.SF_Form.AllowUpdates (let)
200 REM -----------------------------------------------------------------------------
201 Property Get BaseForm() As String
202 ''' The BaseForm property specifies the hierarchical name of the Base form containing the actual form
204 End Property ' SFDocuments.SF_Form.BaseForm (get)
206 REM -----------------------------------------------------------------------------
207 Property Get Bookmark() As Variant
208 ''' The Bookmark property specifies uniquely the current record of the form's underlying table, query or SQL statement.
210 End Property ' SFDocuments.SF_Form.Bookmark (get)
212 REM -----------------------------------------------------------------------------
213 Property Let Bookmark(Optional ByVal pvBookmark As Variant)
214 ''' Set the updatable property Bookmark
216 End Property ' SFDocuments.SF_Form.Bookmark (let)
218 REM -----------------------------------------------------------------------------
219 Property Get CurrentRecord() As Variant
220 ''' The CurrentRecord property identifies the current record in the recordset being viewed on a form
222 End Property ' SFDocuments.SF_Form.CurrentRecord (get)
224 REM -----------------------------------------------------------------------------
225 Property Let CurrentRecord(Optional ByVal pvCurrentRecord As Variant)
226 ''' Set the updatable property CurrentRecord
227 ''' If the row number is positive, the cursor moves to the given row number with respect to the beginning of the result set.
229 ''' If the given row number is negative, the cursor moves to an absolute row position with respect to the end of the result set.
230 ''' For example, setting CurrentRecord = -1 positions the cursor on the last row, -2 indicates the next-to-last row, and so on
232 End Property ' SFDocuments.SF_Form.CurrentRecord (let)
234 REM -----------------------------------------------------------------------------
235 Property Get Filter() As Variant
236 ''' The Filter property specifies a subset of records to be displayed.
238 End Property ' SFDocuments.SF_Form.Filter (get)
240 REM -----------------------------------------------------------------------------
241 Property Let Filter(Optional ByVal pvFilter As Variant)
242 ''' Set the updatable property Filter
244 End Property ' SFDocuments.SF_Form.Filter (let)
246 REM -----------------------------------------------------------------------------
247 Property Get LinkChildFields() As Variant
248 ''' The LinkChildFields property specifies how records in a subform (child) are linked to records in its parent form
249 ''' It returns an array of strings
251 End Property ' SFDocuments.SF_Form.LinkChildFields (get)
253 REM -----------------------------------------------------------------------------
254 Property Get LinkParentFields() As Variant
255 ''' The LinkParentFields property specifies how records in a subform (Child) are linked to records in its parent form
256 ''' It returns an array of strings
258 End Property ' SFDocuments.SF_Form.LinkParentFields (get)
260 REM -----------------------------------------------------------------------------
261 Property Get Name() As String
262 ''' Return the name of the actual Form
264 End Property ' SFDocuments.SF_Form.Name
266 REM -----------------------------------------------------------------------------
267 Property Get OnApproveCursorMove() As Variant
268 ''' The OnApproveCursorMove property specifies the script to trigger when this event occurs
270 End Property ' SFDocuments.SF_Form.OnApproveCursorMove (get)
272 REM -----------------------------------------------------------------------------
273 Property Let OnApproveCursorMove(Optional ByVal pvOnApproveCursorMove As Variant)
274 ''' Set the updatable property OnApproveCursorMove
276 End Property ' SFDocuments.SF_Form.OnApproveCursorMove (let)
278 REM -----------------------------------------------------------------------------
279 Property Get OnApproveReset() As Variant
280 ''' The OnApproveReset property specifies the script to trigger when this event occurs
282 End Property ' SFDocuments.SF_Form.OnApproveReset (get)
284 REM -----------------------------------------------------------------------------
285 Property Let OnApproveReset(Optional ByVal pvOnApproveReset As Variant)
286 ''' Set the updatable property OnApproveReset
288 End Property ' SFDocuments.SF_Form.OnApproveReset (let)
290 REM -----------------------------------------------------------------------------
291 Property Get OnApproveRowChange() As Variant
292 ''' The OnApproveRowChange property specifies the script to trigger when this event occurs
294 End Property ' SFDocuments.SF_Form.OnApproveRowChange (get)
296 REM -----------------------------------------------------------------------------
297 Property Let OnApproveRowChange(Optional ByVal pvOnApproveRowChange As Variant)
298 ''' Set the updatable property OnApproveRowChange
300 End Property ' SFDocuments.SF_Form.OnApproveRowChange (let)
302 REM -----------------------------------------------------------------------------
303 Property Get OnApproveSubmit() As Variant
304 ''' The OnApproveSubmit property specifies the script to trigger when this event occurs
306 End Property ' SFDocuments.SF_Form.OnApproveSubmit (get)
308 REM -----------------------------------------------------------------------------
309 Property Let OnApproveSubmit(Optional ByVal pvOnApproveSubmit As Variant)
310 ''' Set the updatable property OnApproveSubmit
312 End Property ' SFDocuments.SF_Form.OnApproveSubmit (let)
314 REM -----------------------------------------------------------------------------
315 Property Get OnConfirmDelete() As Variant
316 ''' The OnConfirmDelete property specifies the script to trigger when this event occurs
318 End Property ' SFDocuments.SF_Form.OnConfirmDelete (get)
320 REM -----------------------------------------------------------------------------
321 Property Let OnConfirmDelete(Optional ByVal pvOnConfirmDelete As Variant)
322 ''' Set the updatable property OnConfirmDelete
324 End Property ' SFDocuments.SF_Form.OnConfirmDelete (let)
326 REM -----------------------------------------------------------------------------
327 Property Get OnCursorMoved() As Variant
328 ''' The OnCursorMoved property specifies the script to trigger when this event occurs
330 End Property ' SFDocuments.SF_Form.OnCursorMoved (get)
332 REM -----------------------------------------------------------------------------
333 Property Let OnCursorMoved(Optional ByVal pvOnCursorMoved As Variant)
334 ''' Set the updatable property OnCursorMoved
336 End Property ' SFDocuments.SF_Form.OnCursorMoved (let)
338 REM -----------------------------------------------------------------------------
339 Property Get OnErrorOccurred() As Variant
340 ''' The OnErrorOccurred property specifies the script to trigger when this event occurs
342 End Property ' SFDocuments.SF_Form.OnErrorOccurred (get)
344 REM -----------------------------------------------------------------------------
345 Property Let OnErrorOccurred(Optional ByVal pvOnErrorOccurred As Variant)
346 ''' Set the updatable property OnErrorOccurred
348 End Property ' SFDocuments.SF_Form.OnErrorOccurred (let)
350 REM -----------------------------------------------------------------------------
351 Property Get OnLoaded() As Variant
352 ''' The OnLoaded property specifies the script to trigger when this event occurs
354 End Property ' SFDocuments.SF_Form.OnLoaded (get)
356 REM -----------------------------------------------------------------------------
357 Property Let OnLoaded(Optional ByVal pvOnLoaded As Variant)
358 ''' Set the updatable property OnLoaded
360 End Property ' SFDocuments.SF_Form.OnLoaded (let)
362 REM -----------------------------------------------------------------------------
363 Property Get OnReloaded() As Variant
364 ''' The OnReloaded property specifies the script to trigger when this event occurs
366 End Property ' SFDocuments.SF_Form.OnReloaded (get)
368 REM -----------------------------------------------------------------------------
369 Property Let OnReloaded(Optional ByVal pvOnReloaded As Variant)
370 ''' Set the updatable property OnReloaded
372 End Property ' SFDocuments.SF_Form.OnReloaded (let)
374 REM -----------------------------------------------------------------------------
375 Property Get OnReloading() As Variant
376 ''' The OnReloading property specifies the script to trigger when this event occurs
378 End Property ' SFDocuments.SF_Form.OnReloading (get)
380 REM -----------------------------------------------------------------------------
381 Property Let OnReloading(Optional ByVal pvOnReloading As Variant)
382 ''' Set the updatable property OnReloading
384 End Property ' SFDocuments.SF_Form.OnReloading (let)
386 REM -----------------------------------------------------------------------------
387 Property Get OnResetted() As Variant
388 ''' The OnResetted property specifies the script to trigger when this event occurs
390 End Property ' SFDocuments.SF_Form.OnResetted (get)
392 REM -----------------------------------------------------------------------------
393 Property Let OnResetted(Optional ByVal pvOnResetted As Variant)
394 ''' Set the updatable property OnResetted
396 End Property ' SFDocuments.SF_Form.OnResetted (let)
398 REM -----------------------------------------------------------------------------
399 Property Get OnRowChanged() As Variant
400 ''' The OnRowChanged property specifies the script to trigger when this event occurs
402 End Property ' SFDocuments.SF_Form.OnRowChanged (get)
404 REM -----------------------------------------------------------------------------
405 Property Let OnRowChanged(Optional ByVal pvOnRowChanged As Variant)
406 ''' Set the updatable property OnRowChanged
408 End Property ' SFDocuments.SF_Form.OnRowChanged (let)
410 REM -----------------------------------------------------------------------------
411 Property Get OnUnloaded() As Variant
412 ''' The OnUnloaded property specifies the script to trigger when this event occurs
414 End Property ' SFDocuments.SF_Form.OnUnloaded (get)
416 REM -----------------------------------------------------------------------------
417 Property Let OnUnloaded(Optional ByVal pvOnUnloaded As Variant)
418 ''' Set the updatable property OnUnloaded
420 End Property ' SFDocuments.SF_Form.OnUnloaded (let)
422 REM -----------------------------------------------------------------------------
423 Property Get OnUnloading() As Variant
424 ''' The OnUnloading property specifies the script to trigger when this event occurs
426 End Property ' SFDocuments.SF_Form.OnUnloading (get)
428 REM -----------------------------------------------------------------------------
429 Property Let OnUnloading(Optional ByVal pvOnUnloading As Variant)
430 ''' Set the updatable property OnUnloading
432 End Property ' SFDocuments.SF_Form.OnUnloading (let)
434 REM -----------------------------------------------------------------------------
435 Property Get OrderBy() As Variant
436 ''' The OrderBy property specifies in which order the records should be displayed.
438 End Property ' SFDocuments.SF_Form.OrderBy (get)
440 REM -----------------------------------------------------------------------------
441 Property Let OrderBy(Optional ByVal pvOrderBy As Variant)
442 ''' Set the updatable property OrderBy
444 End Property ' SFDocuments.SF_Form.OrderBy (let)
446 REM -----------------------------------------------------------------------------
447 Property Get Parent() As Object
448 ''' Return the Parent of the actual Form
450 End Property ' SFDocuments.SF_Form.Parent
452 REM -----------------------------------------------------------------------------
453 Property Get RecordSource() As Variant
454 ''' The RecordSource property specifies the source of the data,
455 ''' a table name, a query name or a SQL statement
457 End Property ' SFDocuments.SF_Form.RecordSource (get)
459 REM -----------------------------------------------------------------------------
460 Property Let RecordSource(Optional ByVal pvRecordSource As Variant)
461 ''' Set the updatable property RecordSource
463 End Property ' SFDocuments.SF_Form.RecordSource (let)
465 REM -----------------------------------------------------------------------------
466 Property Get XForm() As Object
467 ''' The XForm property returns the XForm UNO object of the Form
469 End Property ' SFDocuments.SF_Form.XForm (get)
471 REM ===================================================================== METHODS
473 REM -----------------------------------------------------------------------------
474 Public Function Activate() As Boolean
475 ''' Set the focus on the current Form instance
476 ''' Probably called from after an event occurrence or to focus on an open Base form document
477 ''' If the parent document is ...
478 ''' Calc Activate the corresponding sheet
479 ''' Writer Activate the parent document
480 ''' Base Activate the parent form document
481 ''' Args:
482 ''' Returns:
483 ''' True if focusing is successful
484 ''' Example:
485 ''' myForm.Activate()
487 Dim bActivate As Boolean ' Return value
488 Dim oContainer As Object ' com.sun.star.awt.XWindow
490 Const cstSubArgs = ""
492 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
493 bActivate = False
495 Check:
496 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
497 If Not _IsStillAlive() Then GoTo Finally
498 End If
499 Try:
500 Select Case _FormType
501 Case ISDOCFORM : bActivate = [_Parent].Activate()
502 Case ISCALCFORM : bActivate = [_Parent].Activate(_SheetName)
503 Case ISBASEFORM
504 Set oContainer = _FormDocument.Component.CurrentController.Frame.ContainerWindow
505 With oContainer
506 If .isVisible() = False Then .setVisible(True)
507 .IsMinimized = False
508 .setFocus()
509 .toFront() ' Force window change in Linux
511 End With
512 bActivate = True
513 End Select
515 Finally:
516 Activate = bActivate
517 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
518 Exit Function
519 Catch:
520 GoTo Finally
521 End Function ' SFDocuments.SF_Form.Activate
523 REM -----------------------------------------------------------------------------
524 Public Function CloseFormDocument() As Boolean
525 ''' Close the form document containing the actual form instance
526 ''' The form instance is disposed
527 ''' The method does nothing if the actual form is not located in a Base form document
528 ''' Args:
529 ''' Returns:
530 ''' True if closure is successful
531 ''' Example:
532 ''' myForm.CloseFormDocument()
534 Dim bClose As Boolean ' Return value
535 Dim oContainer As Object ' com.sun.star.awt.XWindow
537 Const cstSubArgs = ""
539 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
540 bClose = False
542 Check:
543 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
544 If Not _IsStillAlive() Then GoTo Finally
545 End If
546 Try:
547 Select Case _FormType
548 Case ISDOCFORM, ISCALCFORM
549 Case ISBASEFORM, ISSUBFORM
550 If Not IsNull(_FormDocument) Then
551 _FormDocument.close()
552 Dispose()
553 bClose = True
554 End If
555 Case Else
556 End Select
558 Finally:
559 CloseFormDocument = bClose
560 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
561 Exit Function
562 Catch:
563 GoTo Finally
564 End Function ' SFDocuments.SF_Form.CloseFormDocument
566 REM -----------------------------------------------------------------------------
567 Public Function Controls(Optional ByVal ControlName As Variant) As Variant
568 ''' Return either
569 ''' - the list of the controls contained in the Form
570 ''' - a Form control object based on its name
571 ''' Args:
572 ''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
573 ''' Returns:
574 ''' A zero-base array of strings if ControlName is absent
575 ''' An instance of the SF_FormControl class if ControlName exists
576 ''' Exceptions:
577 ''' ControlName is invalid
578 ''' Example:
579 ''' Dim myForm As Object, myList As Variant, myControl As Object
581 ''' myList = myForm.Controls()
584 Dim oControl As Object ' The new control class instance
585 Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache
586 Dim vControl As Variant ' Alias of _ControlCache entry
587 Dim i As Long
591 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
593 Check:
594 If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
595 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
596 If Not _IsStillAlive() Then GoTo Finally
597 If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
598 End If
600 Try:
601 ' Collect all control names if not yet done
603 _ControlNames = _Form.getElementNames()
604 ' Remove all subforms from the list
605 For i = 0 To UBound(_ControlNames)
606 ' Subforms have no ClassId property
607 If Not ScriptForge.SF_Session.HasUnoProperty(_Form.getByName(_ControlNames(i)), "ClassId") Then _ControlNames(i) = ""
608 Next i
609 _ControlNames = ScriptForge.SF_Array.TrimArray(_ControlNames)
610 ' Size the cache accordingly
612 ReDim _ControlCache(0 To UBound(_ControlNames))
613 End If
614 End If
616 ' Return the list of controls or a FormControl instance
617 If Len(ControlName) = 0 Then
618 Controls = _ControlNames
620 Else
622 If Not _Form.hasByName(ControlName) Then GoTo CatchNotFound
623 lIndexOfNames = ScriptForge.SF_Array.IndexOf(_ControlNames, ControlName, CaseSensitive := True)
624 ' Reuse cache when relevant
625 vControl = _ControlCache(lIndexOfNames)
627 If IsEmpty(vControl) Then
628 ' Create the new form control class instance
629 Set oControl = New SF_FormControl
630 With oControl
631 ._Name = ControlName
632 Set .[Me] = oControl
633 Set .[_Parent] = [Me]
634 Set ._ParentForm = [Me]
635 ._IndexOfNames = lIndexOfNames
636 ._FormName = _Name
637 ' Get model and view of the current control
638 Set ._ControlModel = _Form.getByName(ControlName)
639 ._Initialize()
640 End With
641 Else
642 Set oControl = vControl
643 End If
645 Set Controls = oControl
646 End If
648 Finally:
649 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
650 Exit Function
651 Catch:
652 GoTo Finally
653 CatchNotFound:
654 ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _Form.getElementNames())
655 GoTo Finally
656 End Function ' SFDocuments.SF_Form.Controls
658 REM -----------------------------------------------------------------------------
659 Public Function GetDatabase(Optional ByVal User As Variant _
660 , Optional ByVal Password As Variant _
661 ) As Object
662 ''' Returns a Database instance (service = SFDatabases.Database) giving access
663 ''' to the execution of SQL commands on the database defined and/or stored in
664 ''' the actual Base document
665 ''' Each main form has its own database connection, except within Base documents where
666 ''' they all share the same connection
667 ''' Args:
669 ''' Returns:
670 ''' A SFDatabases.Database instance or Nothing
671 ''' Example:
672 ''' Dim myDb As Object
673 ''' Set myDb = oForm.GetDatabase()
675 Dim FSO As Object ' Alias for SF_FileSystem
676 Dim sDataSource As String ' Database file name in FileNaming format
677 Dim sUser As String ' Alias for User
678 Dim sPassword As String ' Alias for Password
680 Const cstSubArgs = "[User=""""], [Password=""""]"
682 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
683 Set GetDatabase = Nothing
685 Check:
686 If IsMissing(User) Or IsEmpty(User) Then User = ""
687 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
688 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
689 If Not [_Parent]._IsStillAlive(False) Then GoTo Finally
691 If Not ScriptForge.SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally
692 End If
694 Try:
695 ' Adjust connection arguments
696 If Len(User) = 0 Then
697 If ScriptForge.SF_Session.HasUnoProperty(_Form, "User") Then sUser = _Form.User Else sUser = ""
698 Else
699 sUser = User
700 End If
701 If Len(sUser) + Len(Password) = 0 Then
702 If ScriptForge.SF_Session.HasUnoProperty(_Form, "Password") Then sPassword = _Form.Password Else sPassword = Password
703 End If
705 ' Connect to database, avoiding multiple requests
707 If _FormType = ISBASEFORM And Not IsNull(_BaseComponent) Then
708 ' Fetch the shared connection
709 Set _Database = [_Parent].GetDatabase(User, Password)
710 ElseIf _FormType = ISSUBFORM Then
711 Set _Database = [_Parent].GetDatabase() ' Recursive call, climb the tree
713 ' Return Nothing
714 Else
715 ' Check if DataSourceName is a file or a registered name and create database instance accordingly
716 Set FSO = ScriptForge.SF_FileSystem
717 sDataSource = FSO._ConvertFromUrl(_Form.DataSourceName)
718 If FSO.FileExists(sDataSource) Then
720 , sDataSource, , , sUser, sPassword)
721 Else
723 , , _Form.DataSourceName, , sUser, sPassword)
724 End If
725 If IsNull(_Database) Then GoTo CatchConnect
726 End If
727 Else
728 EndIf
730 Finally:
731 Set GetDatabase = _Database
732 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
733 Exit Function
734 Catch:
735 GoTo Finally
736 CatchConnect:
737 ScriptForge.SF_Exception.RaiseFatal(DBCONNECTERROR, "User", User, "Password", Password, [_Super]._FileIdent())
738 GoTo Finally
739 End Function ' SFDocuments.SF_Form.GetDatabase
741 REM -----------------------------------------------------------------------------
742 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
743 ''' Return the actual value of the given property
744 ''' Args:
745 ''' PropertyName: the name of the property as a string
746 ''' Returns:
747 ''' The actual value of the property
748 ''' Exceptions:
749 ''' ARGUMENTERROR The property does not exist
750 ''' Examples:
754 Const cstSubArgs = ""
756 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
757 GetProperty = Null
759 Check:
760 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
761 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
762 End If
764 Try:
765 GetProperty = _PropertyGet(PropertyName)
767 Finally:
768 SF_Utils._ExitFunction(cstThisSub)
769 Exit Function
770 Catch:
771 GoTo Finally
772 End Function ' SFDocuments.SF_Form.GetProperty
774 REM -----------------------------------------------------------------------------
775 Public Function Methods() As Variant
776 ''' Return the list of public methods of the Form service as an array
778 Methods = Array( _
790 )
792 End Function ' SFDocuments.SF_Form.Methods
794 REM -----------------------------------------------------------------------------
795 Public Function MoveFirst() As Boolean
796 ''' The cursor is (re)positioned on the first row
797 ''' Args:
798 ''' Returns:
799 ''' True if cursor move is successful
800 ''' Example:
801 ''' myForm.MoveFirst()
803 Dim bMoveFirst As Boolean ' Return value
805 Const cstSubArgs = ""
807 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
808 bMoveFirst = False
810 Check:
811 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
812 If Not _IsStillAlive() Then GoTo Finally
813 End If
814 Try:
815 With _Form
816 bMoveFirst = .first()
817 End With
819 Finally:
820 MoveFirst = bMoveFirst
821 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
822 Exit Function
823 Catch:
824 GoTo Finally
825 End Function ' SFDocuments.SF_Form.MoveFirst
827 REM -----------------------------------------------------------------------------
828 Public Function MoveLast() As Boolean
829 ''' The cursor is (re)positioned on the last row
830 ''' Args:
831 ''' Returns:
832 ''' True if cursor move is successful
833 ''' Example:
834 ''' myForm.MoveLast()
836 Dim bMoveLast As Boolean ' Return value
838 Const cstSubArgs = ""
840 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
841 bMoveLast = False
843 Check:
844 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
845 If Not _IsStillAlive() Then GoTo Finally
846 End If
847 Try:
848 With _Form
849 bMoveLast = .last()
850 End With
852 Finally:
853 MoveLast = bMoveLast
854 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
855 Exit Function
856 Catch:
857 GoTo Finally
858 End Function ' SFDocuments.SF_Form.MoveLast
860 REM -----------------------------------------------------------------------------
861 Public Function MoveNew() As Boolean
862 ''' The cursor is (re)positioned in the new record area
863 ''' Args:
864 ''' Returns:
865 ''' True if cursor move is successful
866 ''' Example:
867 ''' myForm.MoveNew()
869 Dim bMoveNew As Boolean ' Return value
871 Const cstSubArgs = ""
873 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
874 bMoveNew = False
876 Check:
877 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
878 If Not _IsStillAlive() Then GoTo Finally
879 End If
880 Try:
881 With _Form
882 .last() ' To simulate the behaviour in the UI
883 .moveToInsertRow()
884 End With
885 bMoveNew = True
887 Finally:
888 MoveNew = bMoveNew
889 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
890 Exit Function
891 Catch:
892 GoTo Finally
893 End Function ' SFDocuments.SF_Form.MoveNew
895 REM -----------------------------------------------------------------------------
896 Public Function MoveNext(Optional ByVal Offset As Variant) As Boolean
897 ''' The cursor is (re)positioned on the next row
898 ''' Args:
900 ''' Returns:
901 ''' True if cursor move is successful
902 ''' Example:
903 ''' myForm.MoveNext()
905 Dim bMoveNext As Boolean ' Return value
906 Dim lOffset As Long ' Alias of Offset
908 Const cstSubArgs = ""
910 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
911 bMoveNext = False
913 Check:
914 If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
915 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
916 If Not _IsStillAlive() Then GoTo Finally
917 If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
918 End If
919 Try:
920 lOffset = CLng(Offset) ' To be sure to have the right argument type
921 With _Form
922 If lOffset = 1 Then bMoveNext = .next() Else bMoveNext = .relative(lOffset)
923 End With
925 Finally:
926 MoveNext = bMoveNext
927 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
928 Exit Function
929 Catch:
930 GoTo Finally
931 End Function ' SFDocuments.SF_Form.MoveNext
933 REM -----------------------------------------------------------------------------
934 Public Function MovePrevious(Optional ByVal Offset As Variant) As Boolean
935 ''' The cursor is (re)positioned on the previous row
936 ''' Args:
938 ''' Returns:
939 ''' True if cursor move is successful
940 ''' Example:
941 ''' myForm.MovePrevious()
943 Dim bMovePrevious As Boolean ' Return value
944 Dim lOffset As Long ' Alias of Offset
946 Const cstSubArgs = ""
948 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
949 bMovePrevious = False
951 Check:
952 If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
953 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
954 If Not _IsStillAlive() Then GoTo Finally
955 If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
956 End If
957 Try:
958 lOffset = CLng(Offset) ' To be sure to have the right argument type
959 With _Form
960 If lOffset = 1 Then bMovePrevious = .previous() Else bMovePrevious = .relative(-lOffset)
961 End With
963 Finally:
964 MovePrevious = bMovePrevious
965 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
966 Exit Function
967 Catch:
968 GoTo Finally
969 End Function ' SFDocuments.SF_Form.MovePrevious
971 REM -----------------------------------------------------------------------------
972 Public Function Properties() As Variant
973 ''' Return the list or properties of the Form class as an array
975 Properties = Array( _
1005 )
1007 End Function ' SFDocuments.SF_Form.Properties
1009 REM -----------------------------------------------------------------------------
1010 Public Function Requery() As Boolean
1011 ''' Reload from the database the actual data into the form
1012 ''' The cursor is (re)positioned on the first row
1013 ''' Args:
1014 ''' Returns:
1015 ''' True if requery is successful
1016 ''' Example:
1017 ''' myForm.Requery()
1019 Dim bRequery As Boolean ' Return value
1021 Const cstSubArgs = ""
1023 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1024 bRequery = False
1026 Check:
1027 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1028 If Not _IsStillAlive() Then GoTo Finally
1029 End If
1030 Try:
1031 With _Form
1032 If .isLoaded() Then .reload() Else .load()
1033 End With
1034 bRequery = True
1036 Finally:
1037 Requery = bRequery
1038 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1039 Exit Function
1040 Catch:
1041 GoTo Finally
1042 End Function ' SFDocuments.SF_Form.Requery
1044 REM -----------------------------------------------------------------------------
1045 Public Function SetProperty(Optional ByVal PropertyName As Variant _
1046 , Optional ByRef Value As Variant _
1047 ) As Boolean
1048 ''' Set a new value to the given property
1049 ''' Args:
1050 ''' PropertyName: the name of the property as a string
1051 ''' Value: its new value
1052 ''' Exceptions
1053 ''' ARGUMENTERROR The property does not exist
1058 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1059 SetProperty = False
1061 Check:
1062 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1063 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1064 End If
1066 Try:
1067 SetProperty = _PropertySet(PropertyName, Value)
1069 Finally:
1070 SF_Utils._ExitFunction(cstThisSub)
1071 Exit Function
1072 Catch:
1073 GoTo Finally
1074 End Function ' SFDocuments.SF_Form.SetProperty
1076 REM -----------------------------------------------------------------------------
1077 Public Function Subforms(Optional ByVal Subform As Variant) As Variant
1078 ''' Return either
1079 ''' - the list of the subforms contained in the actual form or subform instance
1080 ''' - a SFDocuments.Form object based on its name or its index in the alphabetic list of subforms
1081 ''' Args:
1082 ''' Subform: a subform stored in the parent form given by its name or its index
1083 ''' When absent, the list of available subforms is returned
1084 ''' To get the first (unique ?) subform stored in the parent form, set Subform = 0
1085 ''' Exceptions:
1086 ''' SUBFORMNOTFOUNDERROR Subform not found
1087 ''' Returns:
1088 ''' A zero-based array of strings if Subform is absent
1089 ''' An instance of the SF_Form class if Subform exists
1090 ''' Example:
1091 ''' Dim myForm As Object, myList As Variant, mySubform As Object
1092 ''' myList = myForm.Subforms()
1095 Dim oSubform As Object ' The new Form class instance
1096 Dim oXSubform As Object ' com.sun.star.form.XForm
1097 Dim vSubformNames As Variant ' Array of subform names
1098 Dim i As Long
1104 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1106 Check:
1107 If IsMissing(Subform) Or IsEmpty(Subform) Then Subform = ""
1108 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1109 If Not _IsStillAlive() Then GoTo Finally
1110 If Not ScriptForge.SF_Utils._Validate(Subform, "Subform", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
1111 End If
1113 Try:
1114 ' Collect all control names and retain only the subforms
1115 vSubformNames = _Form.getElementNames()
1116 For i = 0 To UBound(vSubformNames)
1117 Set oSubform = _Form.getByName(vSubformNames(i))
1118 ' Subforms are the only control types having no ClassId property
1119 If ScriptForge.SF_Session.HasUnoProperty(oSubform, "ClassId") Then vSubformNames(i) = ""
1120 Next i
1121 vSubformNames = ScriptForge.SF_Array.TrimArray(vSubformNames)
1124 Subforms = vSubformNames
1125 Else
1126 If VarType(Subform) = V_STRING Then ' Find the form by name
1127 If Not ScriptForge.SF_Array.Contains(vSubformNames, Subform, CaseSensitive := True) Then GoTo CatchNotFound
1128 Set oXSubform = _Form.getByName(Subform)
1129 Else ' Find the form by index
1131 Set oXSubform = _Form.getByName(vSubformNames(Subform))
1132 End If
1133 ' Create the new Form class instance
1134 Set oSubform = SF_Register._NewForm(oXSubform)
1135 With oSubform
1136 Set .[_Parent] = [Me]
1137 ._FormType = ISSUBFORM
1138 Set ._Component = _Component
1139 Set ._BaseComponent = _BaseComponent
1140 Set ._FormDocument = _FormDocument
1141 ._SheetName = _SheetName
1142 ._FormDocumentName = _FormDocumentName
1143 Set ._Database = _Database
1144 ._Initialize()
1145 End With
1146 Set Subforms = oSubform
1147 End If
1149 Finally:
1150 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1151 Exit Function
1152 Catch:
1153 GoTo Finally
1154 CatchNotFound:
1155 ScriptForge.SF_Exception.RaiseFatal(SUBFORMNOTFOUNDERROR, Subform, _Name)
1156 GoTo Finally
1157 End Function ' SFDocuments.SF_Form.Subforms
1159 REM =========================================================== PRIVATE FUNCTIONS
1161 REM -----------------------------------------------------------------------------
1162 Public Function _GetEventName(ByVal psProperty As String) As String
1163 ''' Return the LO internal event name derived from the SF property name
1164 ''' The SF property name is not case sensitive, while the LO name is case-sensitive
1165 ' Corrects the typo on ErrorOccur(r?)ed, if necessary
1167 Dim vProperties As Variant ' Array of class properties
1168 Dim sProperty As String ' Correctly cased property name
1170 vProperties = Properties()
1171 sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
1175 End Function ' SFDocuments.SF_Form._GetEventName
1177 REM -----------------------------------------------------------------------------
1178 Private Function _GetListener(ByVal psEventName As String) As String
1179 ''' Getting/Setting macros triggered by events requires a Listener-EventName pair
1180 ''' Return the X...Listener corresponding with the event name in argument
1182 Select Case UCase(psEventName)
1199 Case UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnUnloaded"), UCase("OnUnloading")
1201 End Select
1203 End Function ' SFDocuments.SF_Form._GetListener
1205 REM -----------------------------------------------------------------------------
1206 Private Sub _GetParents()
1207 ''' When the current instance is created top-down, the parents are completely defined
1208 ''' and nothing should be done in this method
1209 ''' When the a class instance is created in a (form/control) event, it is the opposite
1210 ''' The current method rebuilds the missing members in the instance from the bottom
1211 ''' Members potentially to collect are:
1212 ''' - _FormType
1213 ''' - [_Parent], the immediate parent: a form or a document instance
1214 ''' + Only when the _FormType is a main form
1215 ''' - _SheetName (Calc only)
1216 ''' - _FormDocumentName (Base only)
1217 ''' - _FormDocument, the topmost form collection
1218 ''' - _Component, the containing document
1219 ''' They must be identified only starting from the _Form UNO object
1220 '''
1221 ''' The method is called from the _Initialize() method at instance creation
1223 Dim oParent As Object ' Successive bottom-up parents
1224 Dim sType As String ' UNO object type
1226 Dim oBase As Object ' Empty Base instance
1227 Dim oSession As Object : Set oSession = ScriptForge.SF_Session
1229 On Local Error GoTo Finally ' Being probably called from events, this method should avoid failures
1230 ' When the form type is known, the upper part of the branch is not scanned
1231 If _FormType <> ISUNDEFINED Then GoTo Finally
1233 Try:
1234 ' The whole branch is scanned bottom-up
1235 If oSession.HasUnoProperty(_Form, "Parent") Then Set oParent = _Form.Parent Else Set oParent = Nothing
1236 _FormType = ISUNDEFINED
1237 iLevel = 1
1239 Do While Not IsNull(oParent)
1240 sType = SF_Session.UnoObjectType(oParent)
1241 Select Case sType
1242 ' Collect at each level the needed info
1244 If iLevel = 1 Then
1245 _FormType = ISSUBFORM
1246 Set [_Parent] = SF_Register._NewForm(oParent)
1247 ' Everything is in the parent, copy items and stop scan
1248 [_Parent]._Initialize() ' Current method is called recursively here
1249 With [_Parent]
1250 _SheetName = ._SheetName
1251 _FormDocumentName = ._FormDocumentName
1252 Set _FormDocument = ._FormDocument
1253 Set _Component = ._Component
1254 End With
1255 Exit Sub
1256 End If
1257 Case "com.sun.star.form.OFormsCollection" ' The collection of forms inside a drawpage
1258 Case "SwXTextDocument" ' The parent document: a Writer document or a Base form document
1260 _FormType = ISBASEFORM
1261 ' Make a new SF_FormDocument instance
1262 Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.FormDocument", oParent)
1263 Set _FormDocument = [_Parent]._FormDocument
1265 _FormType = ISDOCFORM
1266 Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
1267 End If
1268 Set _Component = oParent
1270 _FormType = ISCALCFORM
1271 Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
1272 Set _Component = oParent
1273 ' The triggered form event is presumed to be located in the (drawpage of the) active sheet
1276 Case Else
1277 End Select
1278 If oSession.HasUnoProperty(oParent, "Parent") Then Set oParent = oParent.Parent Else Set oParent = Nothing
1279 iLevel = iLevel + 1
1280 Loop
1282 Finally:
1283 Exit Sub
1284 End Sub ' SFDocuments.SF_Form._GetParents
1286 REM -----------------------------------------------------------------------------
1287 Public Sub _Initialize()
1288 ''' Achieve the creation of a SF_Form instance
1289 ''' - complete the missing private members
1290 ''' - store the new instance in the cache
1292 _GetParents()
1293 _CacheIndex = SF_Register._AddFormToCache(_Form, [Me])
1295 End Sub ' SFDocuments.SF_Form._Initialize
1297 REM -----------------------------------------------------------------------------
1298 Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
1299 ''' Return True if the Form is still open
1300 ''' If dead the actual instance is disposed
1301 ''' and the execution is cancelled when pbError = True (default)
1302 ''' Args:
1303 ''' pbError: if True (default), raise a fatal error
1305 Dim bAlive As Boolean ' Return value
1306 Dim sName As String ' Alias of _Name
1307 Dim sId As String ' Alias of FileIdent
1309 Check:
1310 On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
1311 If IsMissing(pbError) Then pbError = True
1313 Try:
1314 ' At main form termination, all database connections are lost
1315 bAlive = Not IsNull(_Form)
1316 If Not bAlive Then GoTo Catch
1318 Finally:
1319 _IsStillAlive = bAlive
1320 Exit Function
1321 Catch:
1322 bAlive = False
1323 On Error GoTo 0
1324 ' Keep error message elements before disposing the instance
1326 sName = Iif(Len(sName) > 0, "[" & sName & "].", "") & _Name
1327 If Not IsNull(_Component) Then sId = _Component.Location Else sId = ""
1328 ' Dispose the actual forms instance
1329 Dispose()
1330 ' Display error message
1331 If pbError Then ScriptForge.SF_Exception.RaiseFatal(FORMDEADERROR, sName, sId)
1332 GoTo Finally
1333 End Function ' SFDocuments.SF_Form._IsStillAlive
1335 REM -----------------------------------------------------------------------------
1336 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
1337 ''' Return the value of the named property
1338 ''' Args:
1339 ''' psProperty: the name of the property
1341 Static oSession As Object ' Alias of SF_Session
1342 Dim vBookmark As Variant ' Form bookmark
1343 Dim cstThisSub As String
1344 Const cstSubArgs = ""
1347 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1349 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1350 _PropertyGet = Empty
1351 If Not _IsStillAlive() Then GoTo Finally
1353 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1354 Select Case UCase(psProperty)
1356 If Not IsNull(_Form) Then _PropertyGet = _Form.AllowDeletes
1358 If Not IsNull(_Form) Then _PropertyGet = _Form.AllowInserts
1360 If Not IsNull(_Form) Then _PropertyGet = _Form.AllowUpdates
1362 _PropertyGet = _FormDocumentName
1364 If IsNull(_Form) Then
1365 _PropertyGet = 0
1366 Else
1367 On Local Error Resume Next ' Disable error handler because bookmarking does not always react well in events ...
1368 If _Form.IsBookmarkable Then vBookmark = _Form.getBookmark() Else vBookmark = Nothing
1369 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error Goto Catch Else On Local Error Goto 0
1370 If IsNull(vBookmark) Then Goto Catch
1371 _PropertyGet = vBookmark
1372 End If
1374 If IsNull(_Form) Then _PropertyGet = 0 Else _PropertyGet = _Form.Row
1376 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Filter
1378 If IsNull(_Form) Or _FormType <> ISSUBFORM Then _PropertyGet = Array() Else _PropertyGet = _Form.DetailFields
1380 If IsNull(_Form) Or _FormType <> ISSUBFORM Then _PropertyGet = Array() Else _PropertyGet = _Form.MasterFields
1382 _PropertyGet = _Name
1383 Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _
1384 , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
1385 , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
1387 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = SF_Register._GetEventScriptCode(_Form, psProperty, _Name)
1389 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Order
1391 _PropertyGet = [_Parent]
1393 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Command
1395 Set _PropertyGet = _Form
1396 Case Else
1397 _PropertyGet = Null
1398 End Select
1400 Finally:
1401 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1402 Exit Function
1403 Catch:
1404 GoTo Finally
1405 End Function ' SFDocuments.SF_Form._PropertyGet
1407 REM -----------------------------------------------------------------------------
1408 Private Function _PropertySet(Optional ByVal psProperty As String _
1409 , Optional ByVal pvValue As Variant _
1410 ) As Boolean
1411 ''' Set the new value of the named property
1412 ''' Args:
1413 ''' psProperty: the name of the property
1414 ''' pvValue: the new value of the given property
1415 ''' Returns:
1416 ''' True if successful
1418 Dim bSet As Boolean ' Return value
1419 Dim oDatabase As Object ' Database class instance
1421 Dim sCommand As String ' Record source
1422 Static oSession As Object ' Alias of SF_Session
1423 Dim cstThisSub As String
1426 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1427 bSet = False
1430 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1431 If Not _IsStillAlive() Then GoTo Finally
1433 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1434 bSet = True
1435 Select Case UCase(psProperty)
1437 If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowDeletes", ScriptForge.V_BOOLEAN) Then GoTo Finally
1438 If Not IsNull(_Form) Then
1439 _Form.AllowDeletes = pvValue
1440 _Form.reload()
1441 End If
1443 If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowInserts", ScriptForge.V_BOOLEAN) Then GoTo Finally
1444 If Not IsNull(_Form) Then
1445 _Form.AllowInserts = pvValue
1446 _Form.reload()
1447 End If
1449 If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowUpdates", ScriptForge.V_BOOLEAN) Then GoTo Finally
1450 If Not IsNull(_Form) Then
1451 _Form.AllowUpdates = pvValue
1452 _Form.reload()
1453 End If
1455 If Not ScriptForge.SF_Utils._Validate(pvValue, "Bookmark", Array(ScriptForge.V_NUMERIC, ScriptForge.V_OBJECT)) Then GoTo Finally
1456 If Not IsNull(pvValue) And Not IsNull(_Form) Then bSet = _Form.moveToBookmark(pvValue)
1458 If Not ScriptForge.SF_Utils._Validate(pvValue, "CurrentRecord", ScriptForge.V_NUMERIC) Then GoTo Finally
1459 If Not IsNull(_Form) Then bSet = _Form.absolute(pvValue)
1462 If Not IsNull(_Form) Then
1463 With _Form
1465 Set oDatabase = GetDatabase()
1466 If Not IsNull(oDatabase) Then .Filter = oDatabase._ReplaceSquareBrackets(pvValue) Else .Filter = pvValue
1467 Else
1468 .Filter = ""
1469 End If
1470 .ApplyFilter = True
1471 .reload()
1472 End With
1473 End If
1474 Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _
1475 , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
1476 , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
1478 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
1479 If Not IsNull(_Form) Then
1480 bSet = SF_Register._RegisterEventScript(_Form _
1481 , psProperty _
1482 , _GetListener(psProperty) _
1483 , pvValue _
1484 , _Name _
1485 )
1486 End If
1488 If Not ScriptForge.SF_Utils._Validate(pvValue, "OrderBy", V_STRING) Then GoTo Finally
1489 If Not IsNull(_Form) Then
1490 With _Form
1492 Set oDatabase = GetDatabase()
1493 If Not IsNull(oDatabase) Then .Order = oDatabase._ReplaceSquareBrackets(pvValue) Else .Order = pvValue
1494 Else
1495 .Order = ""
1496 End If
1497 .reload()
1498 End With
1499 End If
1501 If Not ScriptForge.SF_Utils._Validate(pvValue, "RecordSource", V_STRING) Then GoTo Finally
1503 Set oDatabase = GetDatabase()
1504 If Not IsNull(oDatabase) Then
1505 With oDatabase
1506 If ScriptForge.SF_Array.Contains(.Tables, pvValue, CaseSensitive := True) Then
1507 sCommand = pvValue
1508 lCommandType = com.sun.star.sdb.CommandType.TABLE
1509 ElseIf ScriptForge.SF_Array.Contains(.Queries, pvValue, CaseSensitive := True) Then
1510 sCommand = pvValue
1511 lCommandType = com.sun.star.sdb.CommandType.QUERY
1512 ElseIf ScriptForge.SF_String.StartsWith(pvValue, "SELECT", CaseSensitive := False) Then
1513 sCommand = .ReplaceSquareBrackets(pvValue)
1514 lCommandType = com.sun.star.sdb.CommandType.COMMAND
1515 End If
1516 _Form.Command = sCommand
1517 _Form.CommandType = lCommandType
1518 End With
1519 End If
1520 End If
1521 Case Else
1522 bSet = False
1523 End Select
1525 Finally:
1526 _PropertySet = bSet
1527 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1528 Exit Function
1529 Catch:
1530 GoTo Finally
1531 End Function ' SFDocuments.SF_Form._PropertySet
1533 REM -----------------------------------------------------------------------------
1534 Private Function _Repr() As String
1535 ''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
1536 ''' Args:
1537 ''' Return:
1540 Dim sParent As String ' To recognize the parent
1542 sParent = _SheetName & _FormDocumentName ' At least one of them is a zero-length string
1543 _Repr = "[Form]: " & Iif(Len(sParent) > 0, sParent & "...", "") & _Name
1545 End Function ' SFDocuments.SF_Form._Repr
1547 REM ============================================ END OF SFDOCUMENTS.SF_FORM
1548 </script:module>