| blob | ef5907a8d723b1b353e2dd9f1e8c7c7640b66193 |
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
86 REM ============================================================= PRIVATE MEMBERS
88 Private [Me] As Object
89 Private [_Parent] As Object
90 Private ObjectType As String ' Must be Form
91 Private ServiceName As String
93 ' Form location
94 Private _Name As String ' Internal name of the form
95 Private _FormType As Integer ' One of the ISxxxFORM constants
96 Private _SheetName As String ' Name as the sheet containing the form (Calc only)
97 Private _FormDocumentName As String ' The hierarchical name of the containing form document (Base only)
98 Private _FormDocument As Object ' com.sun.star.comp.sdb.Content - the form document container
99 ' The form topmost containers
100 Private _Component As Object ' com.sun.star.lang.XComponent
101 Private _BaseComponent As Object ' com.sun.star.comp.dba.ODatabaseDocument
103 ' Events management
104 Private _CacheIndex As Long ' Index in central cache storage
106 ' Form UNO references
107 ' The entry to the interactions with the form. Validity checked by the _IsStillAlive() method
108 ' Each method or property requiring that the form is opened should first invoke that method
109 Private _Form As Object ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
111 ' Form attributes
112 Private _Database As Object ' Database class instance
114 ' Cache storage for controls
115 Private _ControlNames As Variant ' Array of control names
116 Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of XForm
118 REM ============================================================ MODULE CONSTANTS
126 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
128 REM -----------------------------------------------------------------------------
129 Private Sub Class_Initialize()
130 Set [Me] = Nothing
131 Set [_Parent] = Nothing
134 _Name = ""
135 _SheetName = ""
136 _FormDocumentName = ""
137 Set _FormDocument = Nothing
138 Set _Component = Nothing
139 Set _BaseComponent = Nothing
140 _FormType = ISUNDEFINED
141 _CacheIndex = -1
142 Set _Form = Nothing
143 Set _Database = Nothing
144 _ControlNames = Array()
145 _ControlCache = Array()
146 End Sub ' SFDocuments.SF_Form Constructor
148 REM -----------------------------------------------------------------------------
149 Private Sub Class_Terminate()
150 Call Class_Initialize()
151 End Sub ' SFDocuments.SF_Form Destructor
153 REM -----------------------------------------------------------------------------
154 Public Function Dispose() As Variant
155 If Not IsNull(_Database) And (_FormType = ISDOCFORM Or _FormType = ISCALCFORM) Then
156 Set _Database = _Database.Dispose()
157 End If
158 SF_Register._CleanCacheEntry(_CacheIndex)
159 Call Class_Terminate()
160 Set Dispose = Nothing
161 End Function ' SFDocuments.SF_Form Explicit Destructor
163 REM ================================================================== PROPERTIES
165 REM -----------------------------------------------------------------------------
166 Property Get AllowDeletes() As Variant
167 ''' The AllowDeletes property specifies if the form allows to delete records
169 End Property ' SFDocuments.SF_Form.AllowDeletes (get)
171 REM -----------------------------------------------------------------------------
172 Property Let AllowDeletes(Optional ByVal pvAllowDeletes As Variant)
173 ''' Set the updatable property AllowDeletes
175 End Property ' SFDocuments.SF_Form.AllowDeletes (let)
177 REM -----------------------------------------------------------------------------
178 Property Get AllowInserts() As Variant
179 ''' The AllowInserts property specifies if the form allows to add records
181 End Property ' SFDocuments.SF_Form.AllowInserts (get)
183 REM -----------------------------------------------------------------------------
184 Property Let AllowInserts(Optional ByVal pvAllowInserts As Variant)
185 ''' Set the updatable property AllowInserts
187 End Property ' SFDocuments.SF_Form.AllowInserts (let)
189 REM -----------------------------------------------------------------------------
190 Property Get AllowUpdates() As Variant
191 ''' The AllowUpdates property specifies if the form allows to update records
193 End Property ' SFDocuments.SF_Form.AllowUpdates (get)
195 REM -----------------------------------------------------------------------------
196 Property Let AllowUpdates(Optional ByVal pvAllowUpdates As Variant)
197 ''' Set the updatable property AllowUpdates
199 End Property ' SFDocuments.SF_Form.AllowUpdates (let)
201 REM -----------------------------------------------------------------------------
202 Property Get BaseForm() As String
203 ''' The BaseForm property specifies the hierarchical name of the Base form containing the actual form
205 End Property ' SFDocuments.SF_Form.BaseForm (get)
207 REM -----------------------------------------------------------------------------
208 Property Get Bookmark() As Variant
209 ''' The Bookmark property specifies uniquely the current record of the form's underlying table, query or SQL statement.
211 End Property ' SFDocuments.SF_Form.Bookmark (get)
213 REM -----------------------------------------------------------------------------
214 Property Let Bookmark(Optional ByVal pvBookmark As Variant)
215 ''' Set the updatable property Bookmark
217 End Property ' SFDocuments.SF_Form.Bookmark (let)
219 REM -----------------------------------------------------------------------------
220 Property Get CurrentRecord() As Variant
221 ''' The CurrentRecord property identifies the current record in the recordset being viewed on a form
223 End Property ' SFDocuments.SF_Form.CurrentRecord (get)
225 REM -----------------------------------------------------------------------------
226 Property Let CurrentRecord(Optional ByVal pvCurrentRecord As Variant)
227 ''' Set the updatable property CurrentRecord
228 ''' If the row number is positive, the cursor moves to the given row number with respect to the beginning of the result set.
230 ''' If the given row number is negative, the cursor moves to an absolute row position with respect to the end of the result set.
231 ''' For example, setting CurrentRecord = -1 positions the cursor on the last row, -2 indicates the next-to-last row, and so on
233 End Property ' SFDocuments.SF_Form.CurrentRecord (let)
235 REM -----------------------------------------------------------------------------
236 Property Get Filter() As Variant
237 ''' The Filter property specifies a subset of records to be displayed.
239 End Property ' SFDocuments.SF_Form.Filter (get)
241 REM -----------------------------------------------------------------------------
242 Property Let Filter(Optional ByVal pvFilter As Variant)
243 ''' Set the updatable property Filter
245 End Property ' SFDocuments.SF_Form.Filter (let)
247 REM -----------------------------------------------------------------------------
248 Property Get LinkChildFields() As Variant
249 ''' The LinkChildFields property specifies how records in a subform (child) are linked to records in its parent form
250 ''' It returns an array of strings
252 End Property ' SFDocuments.SF_Form.LinkChildFields (get)
254 REM -----------------------------------------------------------------------------
255 Property Get LinkParentFields() As Variant
256 ''' The LinkParentFields property specifies how records in a subform (Child) are linked to records in its parent form
257 ''' It returns an array of strings
259 End Property ' SFDocuments.SF_Form.LinkParentFields (get)
261 REM -----------------------------------------------------------------------------
262 Property Get Name() As String
263 ''' Return the name of the actual Form
265 End Property ' SFDocuments.SF_Form.Name
267 REM -----------------------------------------------------------------------------
268 Property Get OnApproveCursorMove() As Variant
269 ''' The OnApproveCursorMove property specifies the script to trigger when this event occurs
271 End Property ' SFDocuments.SF_Form.OnApproveCursorMove (get)
273 REM -----------------------------------------------------------------------------
274 Property Let OnApproveCursorMove(Optional ByVal pvOnApproveCursorMove As Variant)
275 ''' Set the updatable property OnApproveCursorMove
277 End Property ' SFDocuments.SF_Form.OnApproveCursorMove (let)
279 REM -----------------------------------------------------------------------------
280 Property Get OnApproveReset() As Variant
281 ''' The OnApproveReset property specifies the script to trigger when this event occurs
283 End Property ' SFDocuments.SF_Form.OnApproveReset (get)
285 REM -----------------------------------------------------------------------------
286 Property Let OnApproveReset(Optional ByVal pvOnApproveReset As Variant)
287 ''' Set the updatable property OnApproveReset
289 End Property ' SFDocuments.SF_Form.OnApproveReset (let)
291 REM -----------------------------------------------------------------------------
292 Property Get OnApproveRowChange() As Variant
293 ''' The OnApproveRowChange property specifies the script to trigger when this event occurs
295 End Property ' SFDocuments.SF_Form.OnApproveRowChange (get)
297 REM -----------------------------------------------------------------------------
298 Property Let OnApproveRowChange(Optional ByVal pvOnApproveRowChange As Variant)
299 ''' Set the updatable property OnApproveRowChange
301 End Property ' SFDocuments.SF_Form.OnApproveRowChange (let)
303 REM -----------------------------------------------------------------------------
304 Property Get OnApproveSubmit() As Variant
305 ''' The OnApproveSubmit property specifies the script to trigger when this event occurs
307 End Property ' SFDocuments.SF_Form.OnApproveSubmit (get)
309 REM -----------------------------------------------------------------------------
310 Property Let OnApproveSubmit(Optional ByVal pvOnApproveSubmit As Variant)
311 ''' Set the updatable property OnApproveSubmit
313 End Property ' SFDocuments.SF_Form.OnApproveSubmit (let)
315 REM -----------------------------------------------------------------------------
316 Property Get OnConfirmDelete() As Variant
317 ''' The OnConfirmDelete property specifies the script to trigger when this event occurs
319 End Property ' SFDocuments.SF_Form.OnConfirmDelete (get)
321 REM -----------------------------------------------------------------------------
322 Property Let OnConfirmDelete(Optional ByVal pvOnConfirmDelete As Variant)
323 ''' Set the updatable property OnConfirmDelete
325 End Property ' SFDocuments.SF_Form.OnConfirmDelete (let)
327 REM -----------------------------------------------------------------------------
328 Property Get OnCursorMoved() As Variant
329 ''' The OnCursorMoved property specifies the script to trigger when this event occurs
331 End Property ' SFDocuments.SF_Form.OnCursorMoved (get)
333 REM -----------------------------------------------------------------------------
334 Property Let OnCursorMoved(Optional ByVal pvOnCursorMoved As Variant)
335 ''' Set the updatable property OnCursorMoved
337 End Property ' SFDocuments.SF_Form.OnCursorMoved (let)
339 REM -----------------------------------------------------------------------------
340 Property Get OnErrorOccurred() As Variant
341 ''' The OnErrorOccurred property specifies the script to trigger when this event occurs
343 End Property ' SFDocuments.SF_Form.OnErrorOccurred (get)
345 REM -----------------------------------------------------------------------------
346 Property Let OnErrorOccurred(Optional ByVal pvOnErrorOccurred As Variant)
347 ''' Set the updatable property OnErrorOccurred
349 End Property ' SFDocuments.SF_Form.OnErrorOccurred (let)
351 REM -----------------------------------------------------------------------------
352 Property Get OnLoaded() As Variant
353 ''' The OnLoaded property specifies the script to trigger when this event occurs
355 End Property ' SFDocuments.SF_Form.OnLoaded (get)
357 REM -----------------------------------------------------------------------------
358 Property Let OnLoaded(Optional ByVal pvOnLoaded As Variant)
359 ''' Set the updatable property OnLoaded
361 End Property ' SFDocuments.SF_Form.OnLoaded (let)
363 REM -----------------------------------------------------------------------------
364 Property Get OnReloaded() As Variant
365 ''' The OnReloaded property specifies the script to trigger when this event occurs
367 End Property ' SFDocuments.SF_Form.OnReloaded (get)
369 REM -----------------------------------------------------------------------------
370 Property Let OnReloaded(Optional ByVal pvOnReloaded As Variant)
371 ''' Set the updatable property OnReloaded
373 End Property ' SFDocuments.SF_Form.OnReloaded (let)
375 REM -----------------------------------------------------------------------------
376 Property Get OnReloading() As Variant
377 ''' The OnReloading property specifies the script to trigger when this event occurs
379 End Property ' SFDocuments.SF_Form.OnReloading (get)
381 REM -----------------------------------------------------------------------------
382 Property Let OnReloading(Optional ByVal pvOnReloading As Variant)
383 ''' Set the updatable property OnReloading
385 End Property ' SFDocuments.SF_Form.OnReloading (let)
387 REM -----------------------------------------------------------------------------
388 Property Get OnResetted() As Variant
389 ''' The OnResetted property specifies the script to trigger when this event occurs
391 End Property ' SFDocuments.SF_Form.OnResetted (get)
393 REM -----------------------------------------------------------------------------
394 Property Let OnResetted(Optional ByVal pvOnResetted As Variant)
395 ''' Set the updatable property OnResetted
397 End Property ' SFDocuments.SF_Form.OnResetted (let)
399 REM -----------------------------------------------------------------------------
400 Property Get OnRowChanged() As Variant
401 ''' The OnRowChanged property specifies the script to trigger when this event occurs
403 End Property ' SFDocuments.SF_Form.OnRowChanged (get)
405 REM -----------------------------------------------------------------------------
406 Property Let OnRowChanged(Optional ByVal pvOnRowChanged As Variant)
407 ''' Set the updatable property OnRowChanged
409 End Property ' SFDocuments.SF_Form.OnRowChanged (let)
411 REM -----------------------------------------------------------------------------
412 Property Get OnUnloaded() As Variant
413 ''' The OnUnloaded property specifies the script to trigger when this event occurs
415 End Property ' SFDocuments.SF_Form.OnUnloaded (get)
417 REM -----------------------------------------------------------------------------
418 Property Let OnUnloaded(Optional ByVal pvOnUnloaded As Variant)
419 ''' Set the updatable property OnUnloaded
421 End Property ' SFDocuments.SF_Form.OnUnloaded (let)
423 REM -----------------------------------------------------------------------------
424 Property Get OnUnloading() As Variant
425 ''' The OnUnloading property specifies the script to trigger when this event occurs
427 End Property ' SFDocuments.SF_Form.OnUnloading (get)
429 REM -----------------------------------------------------------------------------
430 Property Let OnUnloading(Optional ByVal pvOnUnloading As Variant)
431 ''' Set the updatable property OnUnloading
433 End Property ' SFDocuments.SF_Form.OnUnloading (let)
435 REM -----------------------------------------------------------------------------
436 Property Get OrderBy() As Variant
437 ''' The OrderBy property specifies in which order the records should be displayed.
439 End Property ' SFDocuments.SF_Form.OrderBy (get)
441 REM -----------------------------------------------------------------------------
442 Property Let OrderBy(Optional ByVal pvOrderBy As Variant)
443 ''' Set the updatable property OrderBy
445 End Property ' SFDocuments.SF_Form.OrderBy (let)
447 REM -----------------------------------------------------------------------------
448 Property Get Parent() As Object
449 ''' Return the Parent of the actual Form
451 End Property ' SFDocuments.SF_Form.Parent
453 REM -----------------------------------------------------------------------------
454 Property Get RecordSource() As Variant
455 ''' The RecordSource property specifies the source of the data,
456 ''' a table name, a query name or a SQL statement
458 End Property ' SFDocuments.SF_Form.RecordSource (get)
460 REM -----------------------------------------------------------------------------
461 Property Let RecordSource(Optional ByVal pvRecordSource As Variant)
462 ''' Set the updatable property RecordSource
464 End Property ' SFDocuments.SF_Form.RecordSource (let)
466 REM -----------------------------------------------------------------------------
467 Property Get XForm() As Object
468 ''' The XForm property returns the XForm UNO object of the Form
470 End Property ' SFDocuments.SF_Form.XForm (get)
472 REM ===================================================================== METHODS
474 REM -----------------------------------------------------------------------------
475 Public Function Activate() As Boolean
476 ''' Set the focus on the current Form instance
477 ''' Probably called from after an event occurrence or to focus on an open Base form document
478 ''' If the parent document is ...
479 ''' Calc Activate the corresponding sheet
480 ''' Writer Activate the parent document
481 ''' Base Activate the parent form document
482 ''' Args:
483 ''' Returns:
484 ''' True if focusing is successful
485 ''' Example:
486 ''' myForm.Activate()
488 Dim bActivate As Boolean ' Return value
489 Dim oContainer As Object ' com.sun.star.awt.XWindow
491 Const cstSubArgs = ""
493 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
494 bActivate = False
496 Check:
497 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
498 If Not _IsStillAlive() Then GoTo Finally
499 End If
500 Try:
501 Select Case _FormType
502 Case ISDOCFORM : bActivate = [_Parent].Activate()
503 Case ISCALCFORM : bActivate = [_Parent].Activate(_SheetName)
504 Case ISBASEFORM
505 Set oContainer = _FormDocument.Component.CurrentController.Frame.ContainerWindow
506 With oContainer
507 If .isVisible() = False Then .setVisible(True)
508 .IsMinimized = False
509 .setFocus()
510 .toFront() ' Force window change in Linux
512 End With
513 bActivate = True
514 End Select
516 Finally:
517 Activate = bActivate
518 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
519 Exit Function
520 Catch:
521 GoTo Finally
522 End Function ' SFDocuments.SF_Form.Activate
524 REM -----------------------------------------------------------------------------
525 Public Function CloseFormDocument() As Boolean
526 ''' Close the form document containing the actual form instance
527 ''' The form instance is disposed
528 ''' The method does nothing if the actual form is not located in a Base form document
529 ''' Args:
530 ''' Returns:
531 ''' True if closure is successful
532 ''' Example:
533 ''' myForm.CloseFormDocument()
535 Dim bClose As Boolean ' Return value
536 Dim oContainer As Object ' com.sun.star.awt.XWindow
538 Const cstSubArgs = ""
540 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
541 bClose = False
543 Check:
544 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
545 If Not _IsStillAlive() Then GoTo Finally
546 End If
547 Try:
548 Select Case _FormType
549 Case ISDOCFORM, ISCALCFORM
550 Case ISBASEFORM, ISSUBFORM
551 If Not IsNull(_FormDocument) Then
552 _FormDocument.close()
553 Dispose()
554 bClose = True
555 End If
556 Case Else
557 End Select
559 Finally:
560 CloseFormDocument = bClose
561 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
562 Exit Function
563 Catch:
564 GoTo Finally
565 End Function ' SFDocuments.SF_Form.CloseFormDocument
567 REM -----------------------------------------------------------------------------
568 Public Function Controls(Optional ByVal ControlName As Variant) As Variant
569 ''' Return either
570 ''' - the list of the controls contained in the Form
571 ''' - a Form control object based on its name
572 ''' Args:
573 ''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
574 ''' Returns:
575 ''' A zero-base array of strings if ControlName is absent
576 ''' An instance of the SF_FormControl class if ControlName exists
577 ''' Exceptions:
578 ''' ControlName is invalid
579 ''' Example:
580 ''' Dim myForm As Object, myList As Variant, myControl As Object
582 ''' myList = myForm.Controls()
585 Dim oControl As Object ' The new control class instance
586 Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache
587 Dim vControl As Variant ' Alias of _ControlCache entry
588 Dim i As Long
592 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
594 Check:
595 If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
596 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
597 If Not _IsStillAlive() Then GoTo Finally
598 If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
599 End If
601 Try:
602 ' Collect all control names if not yet done
604 _ControlNames = _Form.getElementNames()
605 ' Remove all subforms from the list
606 For i = 0 To UBound(_ControlNames)
607 ' Subforms have no ClassId property
608 If Not ScriptForge.SF_Session.HasUnoProperty(_Form.getByName(_ControlNames(i)), "ClassId") Then _ControlNames(i) = ""
609 Next i
610 _ControlNames = ScriptForge.SF_Array.TrimArray(_ControlNames)
611 ' Size the cache accordingly
613 ReDim _ControlCache(0 To UBound(_ControlNames))
614 End If
615 End If
617 ' Return the list of controls or a FormControl instance
618 If Len(ControlName) = 0 Then
619 Controls = _ControlNames
621 Else
623 If Not _Form.hasByName(ControlName) Then GoTo CatchNotFound
624 lIndexOfNames = ScriptForge.SF_Array.IndexOf(_ControlNames, ControlName, CaseSensitive := True)
625 ' Reuse cache when relevant
626 vControl = _ControlCache(lIndexOfNames)
628 If IsEmpty(vControl) Then
629 ' Create the new form control class instance
630 Set oControl = New SF_FormControl
631 With oControl
632 ._Name = ControlName
633 Set .[Me] = oControl
634 Set .[_Parent] = [Me]
635 Set ._ParentForm = [Me]
636 ._IndexOfNames = lIndexOfNames
637 ._FormName = _Name
638 ' Get model and view of the current control
639 Set ._ControlModel = _Form.getByName(ControlName)
640 ._Initialize()
641 End With
642 Else
643 Set oControl = vControl
644 End If
646 Set Controls = oControl
647 End If
649 Finally:
650 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
651 Exit Function
652 Catch:
653 GoTo Finally
654 CatchNotFound:
655 ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _Form.getElementNames(), True)
656 GoTo Finally
657 End Function ' SFDocuments.SF_Form.Controls
659 REM -----------------------------------------------------------------------------
660 Public Function GetDatabase(Optional ByVal User As Variant _
661 , Optional ByVal Password As Variant _
662 ) As Object
663 ''' Returns a Database instance (service = SFDatabases.Database) giving access
664 ''' to the execution of SQL commands on the database defined and/or stored in
665 ''' the actual Base document
666 ''' Each main form has its own database connection, except within Base documents where
667 ''' they all share the same connection
668 ''' Args:
670 ''' Returns:
671 ''' A SFDatabases.Database instance or Nothing
672 ''' Exceptions:
673 ''' DBCONNECTERROR The database could not be connected, credentials are probably wrong
674 ''' Example:
675 ''' Dim myDb As Object
676 ''' Set myDb = oForm.GetDatabase()
678 Dim FSO As Object ' Alias for SF_FileSystem
679 Dim sDataSource As String ' Database file name in FileNaming format
680 Dim sUser As String ' Alias for User
681 Dim sPassword As String ' Alias for Password
683 Const cstSubArgs = "[User=""""], [Password=""""]"
685 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
686 Set GetDatabase = Nothing
688 Check:
689 If IsMissing(User) Or IsEmpty(User) Then User = ""
690 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
691 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
692 If Not [_Parent]._IsStillAlive(False) Then GoTo Finally
694 If Not ScriptForge.SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally
695 End If
697 Try:
698 ' Adjust connection arguments
699 If Len(User) = 0 Then
700 If ScriptForge.SF_Session.HasUnoProperty(_Form, "User") Then sUser = _Form.User Else sUser = ""
701 Else
702 sUser = User
703 End If
704 If Len(sUser) + Len(Password) = 0 Then
705 If ScriptForge.SF_Session.HasUnoProperty(_Form, "Password") Then sPassword = _Form.Password Else sPassword = Password
706 End If
708 ' Connect to database, avoiding multiple requests
710 If _FormType = ISBASEFORM And Not IsNull(_BaseComponent) Then
711 ' Fetch the shared connection
712 Set _Database = [_Parent].GetDatabase(User, Password)
713 ElseIf _FormType = ISSUBFORM Then
714 Set _Database = [_Parent].GetDatabase() ' Recursive call, climb the tree
716 ' Return Nothing
717 Else
718 ' Check if DataSourceName is a file or a registered name and create database instance accordingly
719 Set FSO = ScriptForge.SF_FileSystem
720 sDataSource = FSO._ConvertFromUrl(_Form.DataSourceName)
721 If FSO.FileExists(sDataSource) Then
723 , sDataSource, , , sUser, sPassword)
724 Else
726 , , _Form.DataSourceName, , sUser, sPassword)
727 End If
728 If IsNull(_Database) Then GoTo CatchConnect
729 End If
730 Else
731 EndIf
733 Finally:
734 Set GetDatabase = _Database
735 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
736 Exit Function
737 Catch:
738 GoTo Finally
739 CatchConnect:
740 ScriptForge.SF_Exception.RaiseFatal(DBCONNECTERROR, "User", User, "Password", Password, [_Super]._FileIdent())
741 GoTo Finally
742 End Function ' SFDocuments.SF_Form.GetDatabase
744 REM -----------------------------------------------------------------------------
745 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
746 ''' Return the actual value of the given property
747 ''' Args:
748 ''' PropertyName: the name of the property as a string
749 ''' Returns:
750 ''' The actual value of the property
751 ''' Exceptions:
752 ''' ARGUMENTERROR The property does not exist
753 ''' Examples:
757 Const cstSubArgs = ""
759 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
760 GetProperty = Null
762 Check:
763 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
764 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
765 End If
767 Try:
768 GetProperty = _PropertyGet(PropertyName)
770 Finally:
771 SF_Utils._ExitFunction(cstThisSub)
772 Exit Function
773 Catch:
774 GoTo Finally
775 End Function ' SFDocuments.SF_Form.GetProperty
777 REM -----------------------------------------------------------------------------
778 Public Function Methods() As Variant
779 ''' Return the list of public methods of the Form service as an array
781 Methods = Array( _
793 )
795 End Function ' SFDocuments.SF_Form.Methods
797 REM -----------------------------------------------------------------------------
798 Public Function MoveFirst() As Boolean
799 ''' The cursor is (re)positioned on the first row
800 ''' Args:
801 ''' Returns:
802 ''' True if cursor move is successful
803 ''' Example:
804 ''' myForm.MoveFirst()
806 Dim bMoveFirst As Boolean ' Return value
808 Const cstSubArgs = ""
810 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
811 bMoveFirst = False
813 Check:
814 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
815 If Not _IsStillAlive() Then GoTo Finally
816 End If
817 Try:
818 With _Form
819 bMoveFirst = .first()
820 End With
822 Finally:
823 MoveFirst = bMoveFirst
824 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
825 Exit Function
826 Catch:
827 GoTo Finally
828 End Function ' SFDocuments.SF_Form.MoveFirst
830 REM -----------------------------------------------------------------------------
831 Public Function MoveLast() As Boolean
832 ''' The cursor is (re)positioned on the last row
833 ''' Args:
834 ''' Returns:
835 ''' True if cursor move is successful
836 ''' Example:
837 ''' myForm.MoveLast()
839 Dim bMoveLast As Boolean ' Return value
841 Const cstSubArgs = ""
843 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
844 bMoveLast = False
846 Check:
847 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
848 If Not _IsStillAlive() Then GoTo Finally
849 End If
850 Try:
851 With _Form
852 bMoveLast = .last()
853 End With
855 Finally:
856 MoveLast = bMoveLast
857 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
858 Exit Function
859 Catch:
860 GoTo Finally
861 End Function ' SFDocuments.SF_Form.MoveLast
863 REM -----------------------------------------------------------------------------
864 Public Function MoveNew() As Boolean
865 ''' The cursor is (re)positioned in the new record area
866 ''' Args:
867 ''' Returns:
868 ''' True if cursor move is successful
869 ''' Example:
870 ''' myForm.MoveNew()
872 Dim bMoveNew As Boolean ' Return value
874 Const cstSubArgs = ""
876 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
877 bMoveNew = False
879 Check:
880 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
881 If Not _IsStillAlive() Then GoTo Finally
882 End If
883 Try:
884 With _Form
885 .last() ' To simulate the behaviour in the UI
886 .moveToInsertRow()
887 End With
888 bMoveNew = True
890 Finally:
891 MoveNew = bMoveNew
892 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
893 Exit Function
894 Catch:
895 GoTo Finally
896 End Function ' SFDocuments.SF_Form.MoveNew
898 REM -----------------------------------------------------------------------------
899 Public Function MoveNext(Optional ByVal Offset As Variant) As Boolean
900 ''' The cursor is (re)positioned on the next row
901 ''' Args:
903 ''' Returns:
904 ''' True if cursor move is successful
905 ''' Example:
906 ''' myForm.MoveNext()
908 Dim bMoveNext As Boolean ' Return value
909 Dim lOffset As Long ' Alias of Offset
911 Const cstSubArgs = ""
913 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
914 bMoveNext = False
916 Check:
917 If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
918 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
919 If Not _IsStillAlive() Then GoTo Finally
920 If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
921 End If
922 Try:
923 lOffset = CLng(Offset) ' To be sure to have the right argument type
924 With _Form
925 If lOffset = 1 Then bMoveNext = .next() Else bMoveNext = .relative(lOffset)
926 End With
928 Finally:
929 MoveNext = bMoveNext
930 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
931 Exit Function
932 Catch:
933 GoTo Finally
934 End Function ' SFDocuments.SF_Form.MoveNext
936 REM -----------------------------------------------------------------------------
937 Public Function MovePrevious(Optional ByVal Offset As Variant) As Boolean
938 ''' The cursor is (re)positioned on the previous row
939 ''' Args:
941 ''' Returns:
942 ''' True if cursor move is successful
943 ''' Example:
944 ''' myForm.MovePrevious()
946 Dim bMovePrevious As Boolean ' Return value
947 Dim lOffset As Long ' Alias of Offset
949 Const cstSubArgs = ""
951 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
952 bMovePrevious = False
954 Check:
955 If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
956 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
957 If Not _IsStillAlive() Then GoTo Finally
958 If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
959 End If
960 Try:
961 lOffset = CLng(Offset) ' To be sure to have the right argument type
962 With _Form
963 If lOffset = 1 Then bMovePrevious = .previous() Else bMovePrevious = .relative(-lOffset)
964 End With
966 Finally:
967 MovePrevious = bMovePrevious
968 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
969 Exit Function
970 Catch:
971 GoTo Finally
972 End Function ' SFDocuments.SF_Form.MovePrevious
974 REM -----------------------------------------------------------------------------
975 Public Function Properties() As Variant
976 ''' Return the list or properties of the Form class as an array
978 Properties = Array( _
1008 )
1010 End Function ' SFDocuments.SF_Form.Properties
1012 REM -----------------------------------------------------------------------------
1013 Public Function Requery() As Boolean
1014 ''' Reload from the database the actual data into the form
1015 ''' The cursor is (re)positioned on the first row
1016 ''' Args:
1017 ''' Returns:
1018 ''' True if requery is successful
1019 ''' Example:
1020 ''' myForm.Requery()
1022 Dim bRequery As Boolean ' Return value
1024 Const cstSubArgs = ""
1026 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1027 bRequery = False
1029 Check:
1030 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1031 If Not _IsStillAlive() Then GoTo Finally
1032 End If
1033 Try:
1034 With _Form
1035 If .isLoaded() Then .reload() Else .load()
1036 End With
1037 bRequery = True
1039 Finally:
1040 Requery = bRequery
1041 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1042 Exit Function
1043 Catch:
1044 GoTo Finally
1045 End Function ' SFDocuments.SF_Form.Requery
1047 REM -----------------------------------------------------------------------------
1048 Public Function SetProperty(Optional ByVal PropertyName As Variant _
1049 , Optional ByRef Value As Variant _
1050 ) As Boolean
1051 ''' Set a new value to the given property
1052 ''' Args:
1053 ''' PropertyName: the name of the property as a string
1054 ''' Value: its new value
1055 ''' Exceptions
1056 ''' ARGUMENTERROR The property does not exist
1061 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1062 SetProperty = False
1064 Check:
1065 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1066 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1067 End If
1069 Try:
1070 SetProperty = _PropertySet(PropertyName, Value)
1072 Finally:
1073 SF_Utils._ExitFunction(cstThisSub)
1074 Exit Function
1075 Catch:
1076 GoTo Finally
1077 End Function ' SFDocuments.SF_Form.SetProperty
1079 REM -----------------------------------------------------------------------------
1080 Public Function Subforms(Optional ByVal Subform As Variant) As Variant
1081 ''' Return either
1082 ''' - the list of the subforms contained in the actual form or subform instance
1083 ''' - a SFDocuments.Form object based on its name or its index in the alphabetic list of subforms
1084 ''' Args:
1085 ''' Subform: a subform stored in the parent form given by its name or its index
1086 ''' When absent, the list of available subforms is returned
1087 ''' To get the first (unique ?) subform stored in the parent form, set Subform = 0
1088 ''' Exceptions:
1089 ''' SUBFORMNOTFOUNDERROR Subform not found
1090 ''' Returns:
1091 ''' A zero-based array of strings if Subform is absent
1092 ''' An instance of the SF_Form class if Subform exists
1093 ''' Example:
1094 ''' Dim myForm As Object, myList As Variant, mySubform As Object
1095 ''' myList = myForm.Subforms()
1098 Dim oSubform As Object ' The new Form class instance
1099 Dim oXSubform As Object ' com.sun.star.form.XForm
1100 Dim vSubformNames As Variant ' Array of subform names
1101 Dim i As Long
1107 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1109 Check:
1110 If IsMissing(Subform) Or IsEmpty(Subform) Then Subform = ""
1111 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1112 If Not _IsStillAlive() Then GoTo Finally
1113 If Not ScriptForge.SF_Utils._Validate(Subform, "Subform", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
1114 End If
1116 Try:
1117 ' Collect all control names and retain only the subforms
1118 vSubformNames = _Form.getElementNames()
1119 For i = 0 To UBound(vSubformNames)
1120 Set oSubform = _Form.getByName(vSubformNames(i))
1121 ' Subforms are the only control types having no ClassId property
1122 If ScriptForge.SF_Session.HasUnoProperty(oSubform, "ClassId") Then vSubformNames(i) = ""
1123 Next i
1124 vSubformNames = ScriptForge.SF_Array.TrimArray(vSubformNames)
1127 Subforms = vSubformNames
1128 Else
1129 If VarType(Subform) = V_STRING Then ' Find the form by name
1130 If Not ScriptForge.SF_Array.Contains(vSubformNames, Subform, CaseSensitive := True) Then GoTo CatchNotFound
1131 Set oXSubform = _Form.getByName(Subform)
1132 Else ' Find the form by index
1134 Set oXSubform = _Form.getByName(vSubformNames(Subform))
1135 End If
1136 ' Create the new Form class instance
1137 Set oSubform = SF_Register._NewForm(oXSubform)
1138 With oSubform
1139 Set .[_Parent] = [Me]
1140 ._FormType = ISSUBFORM
1141 Set ._Component = _Component
1142 Set ._BaseComponent = _BaseComponent
1143 Set ._FormDocument = _FormDocument
1144 ._SheetName = _SheetName
1145 ._FormDocumentName = _FormDocumentName
1146 Set ._Database = _Database
1147 ._Initialize()
1148 End With
1149 Set Subforms = oSubform
1150 End If
1152 Finally:
1153 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1154 Exit Function
1155 Catch:
1156 GoTo Finally
1157 CatchNotFound:
1158 ScriptForge.SF_Exception.RaiseFatal(SUBFORMNOTFOUNDERROR, Subform, _Name)
1159 GoTo Finally
1160 End Function ' SFDocuments.SF_Form.Subforms
1162 REM =========================================================== PRIVATE FUNCTIONS
1164 REM -----------------------------------------------------------------------------
1165 Public Function _GetEventName(ByVal psProperty As String) As String
1166 ''' Return the LO internal event name derived from the SF property name
1167 ''' The SF property name is not case sensitive, while the LO name is case-sensitive
1168 ' Corrects the typo on ErrorOccur(r?)ed, if necessary
1170 Dim vProperties As Variant ' Array of class properties
1171 Dim sProperty As String ' Correctly cased property name
1173 vProperties = Properties()
1174 sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
1178 End Function ' SFDocuments.SF_Form._GetEventName
1180 REM -----------------------------------------------------------------------------
1181 Private Function _GetListener(ByVal psEventName As String) As String
1182 ''' Getting/Setting macros triggered by events requires a Listener-EventName pair
1183 ''' Return the X...Listener corresponding with the event name in argument
1185 Select Case UCase(psEventName)
1202 Case UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnUnloaded"), UCase("OnUnloading")
1204 End Select
1206 End Function ' SFDocuments.SF_Form._GetListener
1208 REM -----------------------------------------------------------------------------
1209 Private Sub _GetParents()
1210 ''' When the current instance is created top-down, the parents are completely defined
1211 ''' and nothing should be done in this method
1212 ''' When the a class instance is created in a (form/control) event, it is the opposite
1213 ''' The current method rebuilds the missing members in the instance from the bottom
1214 ''' Members potentially to collect are:
1215 ''' - _FormType
1216 ''' - [_Parent], the immediate parent: a form or a document instance
1217 ''' + Only when the _FormType is a main form
1218 ''' - _SheetName (Calc only)
1219 ''' - _FormDocumentName (Base only)
1220 ''' - _FormDocument, the topmost form collection
1221 ''' - _Component, the containing document
1222 ''' They must be identified only starting from the _Form UNO object
1223 '''
1224 ''' The method is called from the _Initialize() method at instance creation
1226 Dim oParent As Object ' Successive bottom-up parents
1227 Dim sType As String ' UNO object type
1229 Dim oBase As Object ' Empty Base instance
1230 Dim oSession As Object : Set oSession = ScriptForge.SF_Session
1232 On Local Error GoTo Finally ' Being probably called from events, this method should avoid failures
1233 ' When the form type is known, the upper part of the branch is not scanned
1234 If _FormType <> ISUNDEFINED Then GoTo Finally
1236 Try:
1237 ' The whole branch is scanned bottom-up
1238 If oSession.HasUnoProperty(_Form, "Parent") Then Set oParent = _Form.Parent Else Set oParent = Nothing
1239 _FormType = ISUNDEFINED
1240 iLevel = 1
1242 Do While Not IsNull(oParent)
1243 sType = SF_Session.UnoObjectType(oParent)
1244 Select Case sType
1245 ' Collect at each level the needed info
1247 If iLevel = 1 Then
1248 _FormType = ISSUBFORM
1249 Set [_Parent] = SF_Register._NewForm(oParent)
1250 ' Everything is in the parent, copy items and stop scan
1251 [_Parent]._Initialize() ' Current method is called recursively here
1252 With [_Parent]
1253 _SheetName = ._SheetName
1254 _FormDocumentName = ._FormDocumentName
1255 Set _FormDocument = ._FormDocument
1256 Set _Component = ._Component
1257 End With
1258 Exit Sub
1259 End If
1260 Case "com.sun.star.form.OFormsCollection" ' The collection of forms inside a drawpage
1261 Case "SwXTextDocument" ' The parent document: a Writer document or a Base form document
1263 _FormType = ISBASEFORM
1264 ' Make a new SF_FormDocument instance
1265 Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.FormDocument", oParent)
1266 Set _FormDocument = [_Parent]._FormDocument
1268 _FormType = ISDOCFORM
1269 Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
1270 End If
1271 Set _Component = oParent
1273 _FormType = ISCALCFORM
1274 Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
1275 Set _Component = oParent
1276 ' The triggered form event is presumed to be located in the (drawpage of the) active sheet
1279 Case Else
1280 End Select
1281 If oSession.HasUnoProperty(oParent, "Parent") Then Set oParent = oParent.Parent Else Set oParent = Nothing
1282 iLevel = iLevel + 1
1283 Loop
1285 Finally:
1286 Exit Sub
1287 End Sub ' SFDocuments.SF_Form._GetParents
1289 REM -----------------------------------------------------------------------------
1290 Public Sub _Initialize()
1291 ''' Achieve the creation of a SF_Form instance
1292 ''' - complete the missing private members
1293 ''' - store the new instance in the cache
1295 _GetParents()
1296 _CacheIndex = SF_Register._AddFormToCache(_Form, [Me])
1298 End Sub ' SFDocuments.SF_Form._Initialize
1300 REM -----------------------------------------------------------------------------
1301 Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
1302 ''' Return True if the Form is still open
1303 ''' If dead the actual instance is disposed
1304 ''' and the execution is cancelled when pbError = True (default)
1305 ''' Args:
1306 ''' pbError: if True (default), raise a fatal error
1308 Dim bAlive As Boolean ' Return value
1309 Dim sName As String ' Alias of _Name
1310 Dim sId As String ' Alias of FileIdent
1312 Check:
1313 On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
1314 If IsMissing(pbError) Then pbError = True
1316 Try:
1317 ' At main form termination, all database connections are lost
1318 bAlive = Not IsNull(_Form)
1319 If Not bAlive Then GoTo Catch
1321 Finally:
1322 _IsStillAlive = bAlive
1323 Exit Function
1324 Catch:
1325 bAlive = False
1326 On Error GoTo 0
1327 ' Keep error message elements before disposing the instance
1329 sName = Iif(Len(sName) > 0, "[" & sName & "].", "") & _Name
1330 If Not IsNull(_Component) Then sId = _Component.Location Else sId = ""
1331 ' Dispose the actual forms instance
1332 Dispose()
1333 ' Display error message
1334 If pbError Then ScriptForge.SF_Exception.RaiseFatal(FORMDEADERROR, sName, sId)
1335 GoTo Finally
1336 End Function ' SFDocuments.SF_Form._IsStillAlive
1338 REM -----------------------------------------------------------------------------
1339 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
1340 ''' Return the value of the named property
1341 ''' Args:
1342 ''' psProperty: the name of the property
1344 Static oSession As Object ' Alias of SF_Session
1345 Dim vBookmark As Variant ' Form bookmark
1346 Dim cstThisSub As String
1347 Const cstSubArgs = ""
1350 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1352 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1353 _PropertyGet = Empty
1354 If Not _IsStillAlive() Then GoTo Finally
1356 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1357 Select Case UCase(psProperty)
1359 If Not IsNull(_Form) Then _PropertyGet = _Form.AllowDeletes
1361 If Not IsNull(_Form) Then _PropertyGet = _Form.AllowInserts
1363 If Not IsNull(_Form) Then _PropertyGet = _Form.AllowUpdates
1365 _PropertyGet = _FormDocumentName
1367 If IsNull(_Form) Then
1368 _PropertyGet = 0
1369 Else
1370 On Local Error Resume Next ' Disable error handler because bookmarking does not always react well in events ...
1371 If _Form.IsBookmarkable Then vBookmark = _Form.getBookmark() Else vBookmark = Nothing
1372 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error Goto Catch Else On Local Error Goto 0
1373 If IsNull(vBookmark) Then Goto Catch
1374 _PropertyGet = vBookmark
1375 End If
1377 If IsNull(_Form) Then _PropertyGet = 0 Else _PropertyGet = _Form.Row
1379 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Filter
1381 If IsNull(_Form) Or _FormType <> ISSUBFORM Then _PropertyGet = Array() Else _PropertyGet = _Form.DetailFields
1383 If IsNull(_Form) Or _FormType <> ISSUBFORM Then _PropertyGet = Array() Else _PropertyGet = _Form.MasterFields
1385 _PropertyGet = _Name
1386 Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _
1387 , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
1388 , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
1390 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = SF_Register._GetEventScriptCode(_Form, psProperty, _Name)
1392 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Order
1394 _PropertyGet = [_Parent]
1396 If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Command
1398 Set _PropertyGet = _Form
1399 Case Else
1400 _PropertyGet = Null
1401 End Select
1403 Finally:
1404 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1405 Exit Function
1406 Catch:
1407 GoTo Finally
1408 End Function ' SFDocuments.SF_Form._PropertyGet
1410 REM -----------------------------------------------------------------------------
1411 Private Function _PropertySet(Optional ByVal psProperty As String _
1412 , Optional ByVal pvValue As Variant _
1413 ) As Boolean
1414 ''' Set the new value of the named property
1415 ''' Args:
1416 ''' psProperty: the name of the property
1417 ''' pvValue: the new value of the given property
1418 ''' Returns:
1419 ''' True if successful
1421 Dim bSet As Boolean ' Return value
1422 Dim oDatabase As Object ' Database class instance
1424 Dim sCommand As String ' Record source
1425 Static oSession As Object ' Alias of SF_Session
1426 Dim cstThisSub As String
1429 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1430 bSet = False
1433 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1434 If Not _IsStillAlive() Then GoTo Finally
1436 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1437 bSet = True
1438 Select Case UCase(psProperty)
1440 If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowDeletes", ScriptForge.V_BOOLEAN) Then GoTo Finally
1441 If Not IsNull(_Form) Then
1442 _Form.AllowDeletes = pvValue
1443 _Form.reload()
1444 End If
1446 If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowInserts", ScriptForge.V_BOOLEAN) Then GoTo Finally
1447 If Not IsNull(_Form) Then
1448 _Form.AllowInserts = pvValue
1449 _Form.reload()
1450 End If
1452 If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowUpdates", ScriptForge.V_BOOLEAN) Then GoTo Finally
1453 If Not IsNull(_Form) Then
1454 _Form.AllowUpdates = pvValue
1455 _Form.reload()
1456 End If
1458 If Not ScriptForge.SF_Utils._Validate(pvValue, "Bookmark", Array(ScriptForge.V_NUMERIC, ScriptForge.V_OBJECT)) Then GoTo Finally
1459 If Not IsNull(pvValue) And Not IsNull(_Form) Then bSet = _Form.moveToBookmark(pvValue)
1461 If Not ScriptForge.SF_Utils._Validate(pvValue, "CurrentRecord", ScriptForge.V_NUMERIC) Then GoTo Finally
1462 If Not IsNull(_Form) Then bSet = _Form.absolute(pvValue)
1465 If Not IsNull(_Form) Then
1466 With _Form
1468 Set oDatabase = GetDatabase()
1469 If Not IsNull(oDatabase) Then .Filter = oDatabase._ReplaceSquareBrackets(pvValue) Else .Filter = pvValue
1470 Else
1471 .Filter = ""
1472 End If
1473 .ApplyFilter = True
1474 .reload()
1475 End With
1476 End If
1477 Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _
1478 , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
1479 , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
1481 If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
1482 If Not IsNull(_Form) Then
1483 bSet = SF_Register._RegisterEventScript(_Form _
1484 , psProperty _
1485 , _GetListener(psProperty) _
1486 , pvValue _
1487 , _Name _
1488 )
1489 End If
1491 If Not ScriptForge.SF_Utils._Validate(pvValue, "OrderBy", V_STRING) Then GoTo Finally
1492 If Not IsNull(_Form) Then
1493 With _Form
1495 Set oDatabase = GetDatabase()
1496 If Not IsNull(oDatabase) Then .Order = oDatabase._ReplaceSquareBrackets(pvValue) Else .Order = pvValue
1497 Else
1498 .Order = ""
1499 End If
1500 .reload()
1501 End With
1502 End If
1504 If Not ScriptForge.SF_Utils._Validate(pvValue, "RecordSource", V_STRING) Then GoTo Finally
1506 Set oDatabase = GetDatabase()
1507 If Not IsNull(oDatabase) Then
1508 With oDatabase
1509 If ScriptForge.SF_Array.Contains(.Tables, pvValue, CaseSensitive := True) Then
1510 sCommand = pvValue
1511 lCommandType = com.sun.star.sdb.CommandType.TABLE
1512 ElseIf ScriptForge.SF_Array.Contains(.Queries, pvValue, CaseSensitive := True) Then
1513 sCommand = pvValue
1514 lCommandType = com.sun.star.sdb.CommandType.QUERY
1515 ElseIf ScriptForge.SF_String.StartsWith(pvValue, "SELECT", CaseSensitive := False) Then
1516 sCommand = .ReplaceSquareBrackets(pvValue)
1517 lCommandType = com.sun.star.sdb.CommandType.COMMAND
1518 End If
1519 _Form.Command = sCommand
1520 _Form.CommandType = lCommandType
1521 End With
1522 End If
1523 End If
1524 Case Else
1525 bSet = False
1526 End Select
1528 Finally:
1529 _PropertySet = bSet
1530 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1531 Exit Function
1532 Catch:
1533 GoTo Finally
1534 End Function ' SFDocuments.SF_Form._PropertySet
1536 REM -----------------------------------------------------------------------------
1537 Private Function _Repr() As String
1538 ''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
1539 ''' Args:
1540 ''' Return:
1543 Dim sParent As String ' To recognize the parent
1545 sParent = _SheetName & _FormDocumentName ' At least one of them is a zero-length string
1546 _Repr = "[Form]: " & Iif(Len(sParent) > 0, sParent & "...", "") & _Name
1548 End Function ' SFDocuments.SF_Form._Repr
1550 REM ============================================ END OF SFDOCUMENTS.SF_FORM
1551 </script:module>