SSL SF_Form.xba   Sprache: unbekannt

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Form" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
REM ===   The ScriptForge library and its associated libraries are part of the LibreOffice project.    ===
REM ===      The SFDocuments library is one of the associated libraries.         ===
REM ===     Full documentation is available on https://help.libreoffice.org/        ===
REM =======================================================================================================================

Option Compatible
Option ClassModule

Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_Form
''' =======
'''  Management of forms defined in LibreOffice documents. Supported types are Base, Calc and Writer documents.
'''  It includes the management of subforms
'''  Each instance of the current class represents a single form or a single subform
'''
'''  A form may optionally be (understand "is often") linked to a data source manageable with the SFDatabases.Database service
'''  The current service offers a rapid access to that service
'''  
'''  Definitions:
'''
'''   FormDocument: BASE DOCUMENTS ONLY
'''    For usual documents, there is only 1 forms container. It is either the document itself or one of its sheets (Calc)
'''    A Base document may contain an unlimited number of form documents.
'''     In the Base terminology they are called "forms" or "Base forms". This could create some confusion.
'''     They can be organized in folders. Their name is then always the full path of folders + form
'''     with the slash ("/") as path separator
'''    A FormDocument is a set of Forms. Form names are visible in the user interface thanks to the form navigator
'''     Often there is only 1 Form present in a FormDocument. Having more, however, might improve
'''     the user experience significantly
'''
'''   Form: WHERE IT IS ABOUT IN THE CURRENT "Form" SERVICE
'''    Is an abstract set of Controls in an OPEN Document or FormDocument
'''    Each form is usually linked to one single dataset (table, query or Select statement),
'''    located in any database (provided the user may access it)
'''     A usual document may contain several forms. Each of which may have its own data source (database + dataset)
'''     A Base form document may contain several forms. Each of which may address its own dataset. The database however is unique
'''    A form is defined by its owning Document or FormDocument and its FormName or FormIndex
'''
'''  Service invocations:
'''
'''   REM the form is stored in a Writer document
'''   Dim oDoc As Object, myForm As Object
'''    Set oDoc = CreateScriptService("SFDocuments.Document", ThisComponent)
'''    Set myForm = oDoc.Forms("Form1")
'''    ' or, alternatively, when there is only 1 form
'''    Set myForm = oDoc.Forms(0) 
'''
'''   REM the form is stored in a Calc document
'''   Dim oCalc As Object, myForm As Object
'''    Set oCalc = CreateScriptService("SFDocuments.Document", ThisComponent)
'''    Set myForm = oCalc.Forms("Sheet1", "Form1")
'''    ' or, alternatively, when there is only 1 form
'''    Set myForm = oCalc.Forms("Sheet1", 0) 
'''
'''   REM the form is stored in one of the FormDocuments of a Base document
'''   Dim oBase As Object, myFormDoc As Object, myForm As Object, mySubForm As Object
'''    Set oBase = CreateScriptService("SFDocuments.Document", ThisDatabaseDocument)
'''    Set oFormDoc = oBase.OpenFormDocument("thisFormDocument")
'''    Set myForm = oFormDoc.Forms("MainForm")
'''    ' or, alternatively, when there is only 1 form
'''    Set myForm = oFormDoc.Forms(0)
'''    ' To access a subform: myForm and mySubForm become distinct instances of the current class
'''    Set mySubForm = myForm.SubForms("mySubForm")
'''
'''   REM the form is the subject of an event
'''   Sub OnEvent(ByRef poEvent As Object)
'''   Dim myForm As Object
'''    Set myForm = CreateScriptService("SFDocuments.FormEvent", poEvent)
'''
'''  Detailed user documentation:
'''   https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_form.html?DbPAR=BASIC
'''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

REM ================================================================== EXCEPTIONS

Private Const FORMDEADERROR   = "FORMDEADERROR"
Private Const SUBFORMNOTFOUNDERROR = "SUBFORMNOTFOUNDERROR"
Private Const DBCONNECTERROR  = "DBCONNECTERROR"

REM ============================================================= PRIVATE MEMBERS

Private [Me]    As Object
Private [_Parent]   As Object
Private ObjectType   As String  ' Must be Form
Private ServiceName   As String

' Form location
Private _Name    As String  ' Internal name of the form
Private _FormType   As Integer  ' One of the ISxxxFORM constants
Private _SheetName   As String  ' Name as the sheet containing the form (Calc only)
Private _FormDocumentName As String  ' The hierarchical name of the containing form document (Base only)
Private _FormDocument  As Object  ' com.sun.star.comp.sdb.Content - the form document container
' The form topmost containers
Private _Component   As Object  ' com.sun.star.lang.XComponent
Private _BaseComponent  As Object  ' com.sun.star.comp.dba.ODatabaseDocument

' Events management
Private _CacheIndex   As Long   ' Index in central cache storage

' Form UNO references
'  The entry to the interactions with the form. Validity checked by the _IsStillAlive() method
'  Each method or property requiring that the form is opened should first invoke that method
Private _Form    As Object  ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm

' Form attributes
Private _Database   As Object  ' Database class instance

' Cache storage for controls
Private _ControlNames  As Variant  ' Array of control names
Private _ControlCache  As Variant  ' Array of control objects sorted like ElementNames of XForm

REM ============================================================ MODULE CONSTANTS

Const ISDOCFORM    = 1   ' Form is stored in a Writer document
Const ISCALCFORM   = 2   ' Form is stored in a Calc document
Const ISBASEFORM   = 3   ' Form is stored in a Base form document
Const ISSUBFORM    = 4   ' Form is a subform of a form or of another subform
Const ISUNDEFINED   = -1   ' Undefined form type

REM ====================================================== CONSTRUCTOR/DESTRUCTOR

REM -----------------------------------------------------------------------------
Private Sub Class_Initialize()
 Set [Me] = Nothing
 Set [_Parent] = Nothing
 ObjectType = "FORM"
 ServiceName = "SFDocuments.Form"
 _Name = ""
 _SheetName = ""
 _FormDocumentName = ""
 Set _FormDocument = Nothing
 Set _Component = Nothing
 Set _BaseComponent = Nothing
 _FormType = ISUNDEFINED
 _CacheIndex = -1
 Set _Form = Nothing
 Set _Database = Nothing
 _ControlNames = Array()
 _ControlCache = Array()
End Sub  ' SFDocuments.SF_Form Constructor

REM -----------------------------------------------------------------------------
Private Sub Class_Terminate()
 Call Class_Initialize()
End Sub  ' SFDocuments.SF_Form Destructor

REM -----------------------------------------------------------------------------
Public Function Dispose() As Variant
 If Not IsNull(_Database) And (_FormType = ISDOCFORM Or _FormType = ISCALCFORM) Then
  Set _Database = _Database.Dispose()
 End If
 SF_Register._CleanCacheEntry(_CacheIndex)
 Call Class_Terminate()
 Set Dispose = Nothing
End Function ' SFDocuments.SF_Form Explicit Destructor

REM ================================================================== PROPERTIES

REM -----------------------------------------------------------------------------
Property Get AllowDeletes() As Variant
''' The AllowDeletes property specifies if the form allows to delete records
 AllowDeletes = _PropertyGet("AllowDeletes")
End Property ' SFDocuments.SF_Form.AllowDeletes (get)

REM -----------------------------------------------------------------------------
Property Let AllowDeletes(Optional ByVal pvAllowDeletes As Variant)
''' Set the updatable property AllowDeletes
 _PropertySet("AllowDeletes", pvAllowDeletes)
End Property ' SFDocuments.SF_Form.AllowDeletes (let)

REM -----------------------------------------------------------------------------
Property Get AllowInserts() As Variant
''' The AllowInserts property specifies if the form allows to add records
 AllowInserts = _PropertyGet("AllowInserts")
End Property ' SFDocuments.SF_Form.AllowInserts (get)

REM -----------------------------------------------------------------------------
Property Let AllowInserts(Optional ByVal pvAllowInserts As Variant)
''' Set the updatable property AllowInserts
 _PropertySet("AllowInserts", pvAllowInserts)
End Property ' SFDocuments.SF_Form.AllowInserts (let)

REM -----------------------------------------------------------------------------
Property Get AllowUpdates() As Variant
''' The AllowUpdates property specifies if the form allows to update records
 AllowUpdates = _PropertyGet("AllowUpdates")
End Property ' SFDocuments.SF_Form.AllowUpdates (get)

REM -----------------------------------------------------------------------------
Property Let AllowUpdates(Optional ByVal pvAllowUpdates As Variant)
''' Set the updatable property AllowUpdates
 _PropertySet("AllowUpdates", pvAllowUpdates)
End Property ' SFDocuments.SF_Form.AllowUpdates (let)

REM -----------------------------------------------------------------------------
Property Get BaseForm() As String
''' The BaseForm property specifies the hierarchical name of the Base form containing the actual form
 BaseForm = _PropertyGet("BaseForm")
End Property ' SFDocuments.SF_Form.BaseForm (get)

REM -----------------------------------------------------------------------------
Property Get Bookmark() As Variant
''' The Bookmark property specifies uniquely the current record of the form's underlying table, query or SQL statement.
 Bookmark = _PropertyGet("Bookmark")
End Property ' SFDocuments.SF_Form.Bookmark (get)

REM -----------------------------------------------------------------------------
Property Let Bookmark(Optional ByVal pvBookmark As Variant)
''' Set the updatable property Bookmark
 _PropertySet("Bookmark", pvBookmark)
End Property ' SFDocuments.SF_Form.Bookmark (let)

REM -----------------------------------------------------------------------------
Property Get CurrentRecord() As Variant
''' The CurrentRecord property identifies the current record in the recordset being viewed on a form
 CurrentRecord = _PropertyGet("CurrentRecord")
End Property ' SFDocuments.SF_Form.CurrentRecord (get)

REM -----------------------------------------------------------------------------
Property Let CurrentRecord(Optional ByVal pvCurrentRecord As Variant)
''' Set the updatable property CurrentRecord
''' If the row number is positive, the cursor moves to the given row number with respect to the beginning of the result set.
''' The first row is row 1, the second is row 2, and so on.
''' If the given row number is negative, the cursor moves to an absolute row position with respect to the end of the result set.
''' For example, setting CurrentRecord = -1 positions the cursor on the last row, -2 indicates the next-to-last row, and so on
 _PropertySet("CurrentRecord", pvCurrentRecord)
End Property ' SFDocuments.SF_Form.CurrentRecord (let)

REM -----------------------------------------------------------------------------
Property Get Filter() As Variant
''' The Filter property specifies a subset of records to be displayed.
 Filter = _PropertyGet("Filter")
End Property ' SFDocuments.SF_Form.Filter (get)

REM -----------------------------------------------------------------------------
Property Let Filter(Optional ByVal pvFilter As Variant)
''' Set the updatable property Filter
 _PropertySet("Filter", pvFilter)
End Property ' SFDocuments.SF_Form.Filter (let)

REM -----------------------------------------------------------------------------
Property Get LinkChildFields() As Variant
''' The LinkChildFields property specifies how records in a subform (child) are linked to records in its parent form
''' It returns an array of strings
 LinkChildFields = _PropertyGet("LinkChildFields")
End Property ' SFDocuments.SF_Form.LinkChildFields (get)

REM -----------------------------------------------------------------------------
Property Get LinkParentFields() As Variant
''' The LinkParentFields property specifies how records in a subform (Child) are linked to records in its parent form
''' It returns an array of strings
 LinkParentFields = _PropertyGet("LinkParentFields")
End Property ' SFDocuments.SF_Form.LinkParentFields (get)

REM -----------------------------------------------------------------------------
Property Get Name() As String
''' Return the name of the actual Form
 Name = _PropertyGet("Name")
End Property ' SFDocuments.SF_Form.Name

REM -----------------------------------------------------------------------------
Property Get OnApproveCursorMove() As Variant
''' The OnApproveCursorMove property specifies the script to trigger when this event occurs
 OnApproveCursorMove = _PropertyGet("OnApproveCursorMove")
End Property ' SFDocuments.SF_Form.OnApproveCursorMove (get)

REM -----------------------------------------------------------------------------
Property Let OnApproveCursorMove(Optional ByVal pvOnApproveCursorMove As Variant)
''' Set the updatable property OnApproveCursorMove
 _PropertySet("OnApproveCursorMove", pvOnApproveCursorMove)
End Property ' SFDocuments.SF_Form.OnApproveCursorMove (let)

REM -----------------------------------------------------------------------------
Property Get OnApproveReset() As Variant
''' The OnApproveReset property specifies the script to trigger when this event occurs
 OnApproveReset = _PropertyGet("OnApproveReset")
End Property ' SFDocuments.SF_Form.OnApproveReset (get)

REM -----------------------------------------------------------------------------
Property Let OnApproveReset(Optional ByVal pvOnApproveReset As Variant)
''' Set the updatable property OnApproveReset
 _PropertySet("OnApproveReset", pvOnApproveReset)
End Property ' SFDocuments.SF_Form.OnApproveReset (let)

REM -----------------------------------------------------------------------------
Property Get OnApproveRowChange() As Variant
''' The OnApproveRowChange property specifies the script to trigger when this event occurs
 OnApproveRowChange = _PropertyGet("OnApproveRowChange")
End Property ' SFDocuments.SF_Form.OnApproveRowChange (get)

REM -----------------------------------------------------------------------------
Property Let OnApproveRowChange(Optional ByVal pvOnApproveRowChange As Variant)
''' Set the updatable property OnApproveRowChange
 _PropertySet("OnApproveRowChange", pvOnApproveRowChange)
End Property ' SFDocuments.SF_Form.OnApproveRowChange (let)

REM -----------------------------------------------------------------------------
Property Get OnApproveSubmit() As Variant
''' The OnApproveSubmit property specifies the script to trigger when this event occurs
 OnApproveSubmit = _PropertyGet("OnApproveSubmit")
End Property ' SFDocuments.SF_Form.OnApproveSubmit (get)

REM -----------------------------------------------------------------------------
Property Let OnApproveSubmit(Optional ByVal pvOnApproveSubmit As Variant)
''' Set the updatable property OnApproveSubmit
 _PropertySet("OnApproveSubmit", pvOnApproveSubmit)
End Property ' SFDocuments.SF_Form.OnApproveSubmit (let)

REM -----------------------------------------------------------------------------
Property Get OnConfirmDelete() As Variant
''' The OnConfirmDelete property specifies the script to trigger when this event occurs
 OnConfirmDelete = _PropertyGet("OnConfirmDelete")
End Property ' SFDocuments.SF_Form.OnConfirmDelete (get)

REM -----------------------------------------------------------------------------
Property Let OnConfirmDelete(Optional ByVal pvOnConfirmDelete As Variant)
''' Set the updatable property OnConfirmDelete
 _PropertySet("OnConfirmDelete", pvOnConfirmDelete)
End Property ' SFDocuments.SF_Form.OnConfirmDelete (let)

REM -----------------------------------------------------------------------------
Property Get OnCursorMoved() As Variant
''' The OnCursorMoved property specifies the script to trigger when this event occurs
 OnCursorMoved = _PropertyGet("OnCursorMoved")
End Property ' SFDocuments.SF_Form.OnCursorMoved (get)

REM -----------------------------------------------------------------------------
Property Let OnCursorMoved(Optional ByVal pvOnCursorMoved As Variant)
''' Set the updatable property OnCursorMoved
 _PropertySet("OnCursorMoved", pvOnCursorMoved)
End Property ' SFDocuments.SF_Form.OnCursorMoved (let)

REM -----------------------------------------------------------------------------
Property Get OnErrorOccurred() As Variant
''' The OnErrorOccurred property specifies the script to trigger when this event occurs
 OnErrorOccurred = _PropertyGet("OnErrorOccurred")
End Property ' SFDocuments.SF_Form.OnErrorOccurred (get)

REM -----------------------------------------------------------------------------
Property Let OnErrorOccurred(Optional ByVal pvOnErrorOccurred As Variant)
''' Set the updatable property OnErrorOccurred
 _PropertySet("OnErrorOccurred", pvOnErrorOccurred)
End Property ' SFDocuments.SF_Form.OnErrorOccurred (let)

REM -----------------------------------------------------------------------------
Property Get OnLoaded() As Variant
''' The OnLoaded property specifies the script to trigger when this event occurs
 OnLoaded = _PropertyGet("OnLoaded")
End Property ' SFDocuments.SF_Form.OnLoaded (get)

REM -----------------------------------------------------------------------------
Property Let OnLoaded(Optional ByVal pvOnLoaded As Variant)
''' Set the updatable property OnLoaded
 _PropertySet("OnLoaded", pvOnLoaded)
End Property ' SFDocuments.SF_Form.OnLoaded (let)

REM -----------------------------------------------------------------------------
Property Get OnReloaded() As Variant
''' The OnReloaded property specifies the script to trigger when this event occurs
 OnReloaded = _PropertyGet("OnReloaded")
End Property ' SFDocuments.SF_Form.OnReloaded (get)

REM -----------------------------------------------------------------------------
Property Let OnReloaded(Optional ByVal pvOnReloaded As Variant)
''' Set the updatable property OnReloaded
 _PropertySet("OnReloaded", pvOnReloaded)
End Property ' SFDocuments.SF_Form.OnReloaded (let)

REM -----------------------------------------------------------------------------
Property Get OnReloading() As Variant
''' The OnReloading property specifies the script to trigger when this event occurs
 OnReloading = _PropertyGet("OnReloading")
End Property ' SFDocuments.SF_Form.OnReloading (get)

REM -----------------------------------------------------------------------------
Property Let OnReloading(Optional ByVal pvOnReloading As Variant)
''' Set the updatable property OnReloading
 _PropertySet("OnReloading", pvOnReloading)
End Property ' SFDocuments.SF_Form.OnReloading (let)

REM -----------------------------------------------------------------------------
Property Get OnResetted() As Variant
''' The OnResetted property specifies the script to trigger when this event occurs
 OnResetted = _PropertyGet("OnResetted")
End Property ' SFDocuments.SF_Form.OnResetted (get)

REM -----------------------------------------------------------------------------
Property Let OnResetted(Optional ByVal pvOnResetted As Variant)
''' Set the updatable property OnResetted
 _PropertySet("OnResetted", pvOnResetted)
End Property ' SFDocuments.SF_Form.OnResetted (let)

REM -----------------------------------------------------------------------------
Property Get OnRowChanged() As Variant
''' The OnRowChanged property specifies the script to trigger when this event occurs
 OnRowChanged = _PropertyGet("OnRowChanged")
End Property ' SFDocuments.SF_Form.OnRowChanged (get)

REM -----------------------------------------------------------------------------
Property Let OnRowChanged(Optional ByVal pvOnRowChanged As Variant)
''' Set the updatable property OnRowChanged
 _PropertySet("OnRowChanged", pvOnRowChanged)
End Property ' SFDocuments.SF_Form.OnRowChanged (let)

REM -----------------------------------------------------------------------------
Property Get OnUnloaded() As Variant
''' The OnUnloaded property specifies the script to trigger when this event occurs
 OnUnloaded = _PropertyGet("OnUnloaded")
End Property ' SFDocuments.SF_Form.OnUnloaded (get)

REM -----------------------------------------------------------------------------
Property Let OnUnloaded(Optional ByVal pvOnUnloaded As Variant)
''' Set the updatable property OnUnloaded
 _PropertySet("OnUnloaded", pvOnUnloaded)
End Property ' SFDocuments.SF_Form.OnUnloaded (let)

REM -----------------------------------------------------------------------------
Property Get OnUnloading() As Variant
''' The OnUnloading property specifies the script to trigger when this event occurs
 OnUnloading = _PropertyGet("OnUnloading")
End Property ' SFDocuments.SF_Form.OnUnloading (get)

REM -----------------------------------------------------------------------------
Property Let OnUnloading(Optional ByVal pvOnUnloading As Variant)
''' Set the updatable property OnUnloading
 _PropertySet("OnUnloading", pvOnUnloading)
End Property ' SFDocuments.SF_Form.OnUnloading (let)

REM -----------------------------------------------------------------------------
Property Get OrderBy() As Variant
''' The OrderBy property specifies in which order the records should be displayed.
 OrderBy = _PropertyGet("OrderBy")
End Property ' SFDocuments.SF_Form.OrderBy (get)

REM -----------------------------------------------------------------------------
Property Let OrderBy(Optional ByVal pvOrderBy As Variant)
''' Set the updatable property OrderBy
 _PropertySet("OrderBy", pvOrderBy)
End Property ' SFDocuments.SF_Form.OrderBy (let)

REM -----------------------------------------------------------------------------
Property Get Parent() As Object
''' Return the Parent of the actual Form
 Parent = _PropertyGet("Parent")
End Property ' SFDocuments.SF_Form.Parent

REM -----------------------------------------------------------------------------
Property Get RecordSource() As Variant
''' The RecordSource property specifies the source of the data,
''' a table name, a query name or a SQL statement
 RecordSource = _PropertyGet("RecordSource")
End Property ' SFDocuments.SF_Form.RecordSource (get)

REM -----------------------------------------------------------------------------
Property Let RecordSource(Optional ByVal pvRecordSource As Variant)
''' Set the updatable property RecordSource
 _PropertySet("RecordSource", pvRecordSource)
End Property ' SFDocuments.SF_Form.RecordSource (let)

REM -----------------------------------------------------------------------------
Property Get XForm() As Object
''' The XForm property returns the XForm UNO object of the Form
 XForm = _PropertyGet("XForm")
End Property ' SFDocuments.SF_Form.XForm (get)

REM ===================================================================== METHODS

REM -----------------------------------------------------------------------------
Public Function Activate() As Boolean
''' Set the focus on the current Form instance
''' Probably called from after an event occurrence or to focus on an open Base form document
''' If the parent document is ...
'''  Calc  Activate the corresponding sheet
'''  Writer  Activate the parent document
'''  Base  Activate the parent form document
''' Args:
''' Returns:
'''  True if focusing is successful
''' Example:
'''   myForm.Activate()

Dim bActivate As Boolean  ' Return value
Dim oContainer As Object  ' com.sun.star.awt.XWindow
Const cstThisSub = "SFDocuments.Form.Activate"
Const cstSubArgs = ""

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bActivate = False

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
 End If
Try:
 Select Case _FormType
  Case ISDOCFORM  : bActivate = [_Parent].Activate()
  Case ISCALCFORM  : bActivate = [_Parent].Activate(_SheetName)
  Case ISBASEFORM
   Set oContainer = _FormDocument.Component.CurrentController.Frame.ContainerWindow
   With oContainer
    If .isVisible() = False Then .setVisible(True)
    .IsMinimized = False
    .setFocus()
    .toFront()    ' Force window change in Linux
    Wait 1     ' Bypass desynchro issue in Linux
   End With
   bActivate = True
 End Select

Finally:
 Activate = bActivate
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_Form.Activate

REM -----------------------------------------------------------------------------
Public Function CloseFormDocument() As Boolean
''' Close the form document containing the actual form instance
''' The form instance is disposed
''' The method does nothing if the actual form is not located in a Base form document
''' Args:
''' Returns:
'''  True if closure is successful
''' Example:
'''   myForm.CloseFormDocument()

Dim bClose As Boolean   ' Return value
Dim oContainer As Object  ' com.sun.star.awt.XWindow
Const cstThisSub = "SFDocuments.Form.CloseFormDocument"
Const cstSubArgs = ""

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bClose = False

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
 End If
Try:
 Select Case _FormType
  Case ISDOCFORM, ISCALCFORM
  Case ISBASEFORM, ISSUBFORM
   If Not IsNull(_FormDocument) Then
    _FormDocument.close()
    Dispose()
    bClose = True
   End If
  Case Else
 End Select

Finally:
 CloseFormDocument = bClose
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_Form.CloseFormDocument

REM -----------------------------------------------------------------------------
Public Function Controls(Optional ByVal ControlName As Variant) As Variant
''' Return either
'''  - the list of the controls contained in the Form
'''  - a Form control object based on its name
''' Args:
'''  ControlName: a valid control name as a case-sensitive string. If absent the list is returned
''' Returns:
'''  A zero-base array of strings if ControlName is absent
'''  An instance of the SF_FormControl class if ControlName exists
''' Exceptions:
'''  ControlName is invalid
''' Example:
'''   Dim myForm As Object, myList As Variant, myControl As Object
'''    Set myForm = myDoc.Forms("myForm")
'''    myList = myForm.Controls()
'''    Set myControl = myForm.Controls("myTextBox")

Dim oControl As Object    ' The new control class instance
Dim lIndexOfNames As Long   ' Index in ElementNames array. Used to access _ControlCache
Dim vControl As Variant    ' Alias of _ControlCache entry
Dim i As Long
Const cstThisSub = "SFDocuments.Form.Controls"
Const cstSubArgs = "[ControlName]"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch

Check:
 If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
 End If

Try:
 ' Collect all control names if not yet done
 If UBound(_ControlNames) < 0 Then
  _ControlNames = _Form.getElementNames()
  ' Remove all subforms from the list
  For i = 0 To UBound(_ControlNames)
   ' Subforms have no ClassId property
   If Not ScriptForge.SF_Session.HasUnoProperty(_Form.getByName(_ControlNames(i)), "ClassId") Then _ControlNames(i) = ""
  Next i
  _ControlNames = ScriptForge.SF_Array.TrimArray(_ControlNames)
  ' Size the cache accordingly
  If UBound(_ControlNames) >= 0 Then
   ReDim _ControlCache(0 To UBound(_ControlNames))
  End If
 End If

 ' Return the list of controls or a FormControl instance
 If Len(ControlName) = 0 Then
  Controls = _ControlNames

 Else

  If Not _Form.hasByName(ControlName) Then GoTo CatchNotFound
  lIndexOfNames = ScriptForge.SF_Array.IndexOf(_ControlNames, ControlName, CaseSensitive := True)
  ' Reuse cache when relevant
  vControl = _ControlCache(lIndexOfNames)

  If IsEmpty(vControl) Then
   ' Create the new form control class instance
   Set oControl = New SF_FormControl
   With oControl
    ._Name = ControlName
    Set .[Me] = oControl
    Set .[_Parent] = [Me]
    Set ._ParentForm = [Me]
    ._IndexOfNames = lIndexOfNames
    ._FormName = _Name
    ' Get model and view of the current control
    Set ._ControlModel = _Form.getByName(ControlName)
    ._Initialize()
   End With
  Else
   Set oControl = vControl
  End If

  Set Controls = oControl
 End If

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
CatchNotFound:
 ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _Form.getElementNames(), True)
 GoTo Finally
End Function ' SFDocuments.SF_Form.Controls

REM -----------------------------------------------------------------------------
Public Function GetDatabase(Optional ByVal User As Variant _
        , Optional ByVal Password As Variant _
        ) As Object
''' Returns a Database instance (service = SFDatabases.Database) giving access
''' to the execution of SQL commands on the database defined and/or stored in
''' the actual Base document
''' Each main form has its own database connection, except within Base documents where
''' they all share the same connection
''' Args:
'''  User, Password: the login parameters as strings. Defaults = ""
''' Returns:
'''  A SFDatabases.Database instance or Nothing
''' Exceptions:
'''  DBCONNECTERROR    The database could not be connected, credentials are probably wrong
''' Example:
'''  Dim myDb As Object
'''   Set myDb = oForm.GetDatabase()

Dim FSO As Object    ' Alias for SF_FileSystem
Dim sDataSource As String  ' Database file name in FileNaming format
Dim sUser As String    ' Alias for User
Dim sPassword As String   ' Alias for Password
Const cstThisSub = "SFDocuments.Form.GetDatabase"
Const cstSubArgs = "[User=""""], [Password=""""]"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 Set GetDatabase = Nothing

Check:
 If IsMissing(User) Or IsEmpty(User) Then User = ""
 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not [_Parent]._IsStillAlive(False) Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(User, "User", V_STRING) Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally
 End If

Try:
 ' Adjust connection arguments
 If Len(User) = 0 Then
  If ScriptForge.SF_Session.HasUnoProperty(_Form, "User") Then sUser = _Form.User Else sUser = ""
 Else
  sUser = User
 End If
 If Len(sUser) + Len(Password) = 0 Then
  If ScriptForge.SF_Session.HasUnoProperty(_Form, "Password") Then sPassword = _Form.Password Else sPassword = Password
 End If

 ' Connect to database, avoiding multiple requests
 If IsNull(_Database) Then  ' 1st connection request from the current form instance
  If _FormType = ISBASEFORM And Not IsNull(_BaseComponent) Then
   ' Fetch the shared connection
   Set _Database = [_Parent].GetDatabase(User, Password)
  ElseIf _FormType = ISSUBFORM Then
   Set _Database = [_Parent].GetDatabase() ' Recursive call, climb the tree
  ElseIf Len(_Form.DataSourceName) = 0 Then ' There is no database linked with the form
   ' Return Nothing
  Else
   ' Check if DataSourceName is a file or a registered name and create database instance accordingly
   Set FSO = ScriptForge.SF_FileSystem
   sDataSource = FSO._ConvertFromUrl(_Form.DataSourceName)
   If FSO.FileExists(sDataSource) Then
    Set _Database = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _
        , sDataSource, , , sUser, sPassword)
   Else
    Set _Database = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _
        , , _Form.DataSourceName, , sUser, sPassword)
   End If
   If IsNull(_Database) Then GoTo CatchConnect
  End If
 Else
 EndIf

Finally:
 Set GetDatabase = _Database
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
CatchConnect:
 ScriptForge.SF_Exception.RaiseFatal(DBCONNECTERROR, "User", User, "Password", Password, [_Super]._FileIdent())
 GoTo Finally
End Function ' SFDocuments.SF_Form.GetDatabase

REM -----------------------------------------------------------------------------
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
''' Return the actual value of the given property
''' Args:
'''  PropertyName: the name of the property as a string
''' Returns:
'''  The actual value of the property
''' Exceptions:
'''  ARGUMENTERROR  The property does not exist
''' Examples:
'''  oDlg.GetProperty("Caption")

Const cstThisSub = "SFDocuments.Form.GetProperty"
Const cstSubArgs = ""

 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 GetProperty = Null

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
 End If

Try:
 GetProperty = _PropertyGet(PropertyName)

Finally:
 SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_Form.GetProperty

REM -----------------------------------------------------------------------------
Public Function Methods() As Variant
''' Return the list of public methods of the Form service as an array

 Methods = Array( _
     "Activate" _
     , "CloseForm" _
     , "Controls" _
     , "GetDatabase" _
     , "MoveFirst" _
     , "MoveLast" _
     , "MoveNew" _
     , "MoveNext" _
     , "MovePrevious" _
     , "Requery" _
     , "SubForms" _
     )

End Function ' SFDocuments.SF_Form.Methods

REM -----------------------------------------------------------------------------
Public Function MoveFirst() As Boolean
''' The cursor is (re)positioned on the first row
''' Args:
''' Returns:
'''  True if cursor move is successful
''' Example:
'''   myForm.MoveFirst()

Dim bMoveFirst As Boolean  ' Return value
Const cstThisSub = "SFDocuments.Form.MoveFirst"
Const cstSubArgs = ""

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bMoveFirst = False

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
 End If
Try:
 With _Form
  bMoveFirst = .first()
 End With

Finally:
 MoveFirst = bMoveFirst
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_Form.MoveFirst

REM -----------------------------------------------------------------------------
Public Function MoveLast() As Boolean
''' The cursor is (re)positioned on the last row
''' Args:
''' Returns:
'''  True if cursor move is successful
''' Example:
'''   myForm.MoveLast()

Dim bMoveLast As Boolean  ' Return value
Const cstThisSub = "SFDocuments.Form.MoveLast"
Const cstSubArgs = ""

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bMoveLast = False

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
 End If
Try:
 With _Form
  bMoveLast = .last()
 End With

Finally:
 MoveLast = bMoveLast
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_Form.MoveLast

REM -----------------------------------------------------------------------------
Public Function MoveNew() As Boolean
''' The cursor is (re)positioned in the new record area
''' Args:
''' Returns:
'''  True if cursor move is successful
''' Example:
'''   myForm.MoveNew()

Dim bMoveNew As Boolean  ' Return value
Const cstThisSub = "SFDocuments.Form.MoveNew"
Const cstSubArgs = ""

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bMoveNew = False

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
 End If
Try:
 With _Form
  .last()    ' To simulate the behaviour in the UI
  .moveToInsertRow()
 End With
 bMoveNew = True

Finally:
 MoveNew = bMoveNew
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_Form.MoveNew

REM -----------------------------------------------------------------------------
Public Function MoveNext(Optional ByVal Offset As Variant) As Boolean
''' The cursor is (re)positioned on the next row
''' Args:
'''  Offset: The number of records to go forward (default = 1)
''' Returns:
'''  True if cursor move is successful
''' Example:
'''   myForm.MoveNext()

Dim bMoveNext As Boolean  ' Return value
Dim lOffset As Long    ' Alias of Offset
Const cstThisSub = "SFDocuments.Form.MoveNext"
Const cstSubArgs = ""

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bMoveNext = False

Check:
 If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
 End If
Try:
 lOffset = CLng(Offset)  ' To be sure to have the right argument type
 With _Form
  If lOffset = 1 Then bMoveNext = .next() Else bMoveNext = .relative(lOffset)
 End With

Finally:
 MoveNext = bMoveNext
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_Form.MoveNext

REM -----------------------------------------------------------------------------
Public Function MovePrevious(Optional ByVal Offset As Variant) As Boolean
''' The cursor is (re)positioned on the previous row
''' Args:
'''  Offset: The number of records to go backward (default = 1)
''' Returns:
'''  True if cursor move is successful
''' Example:
'''   myForm.MovePrevious()

Dim bMovePrevious As Boolean  ' Return value
Dim lOffset As Long    ' Alias of Offset
Const cstThisSub = "SFDocuments.Form.MovePrevious"
Const cstSubArgs = ""

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bMovePrevious = False

Check:
 If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
 End If
Try:
 lOffset = CLng(Offset)  ' To be sure to have the right argument type
 With _Form
  If lOffset = 1 Then bMovePrevious = .previous() Else bMovePrevious = .relative(-lOffset)
 End With

Finally:
 MovePrevious = bMovePrevious
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_Form.MovePrevious

REM -----------------------------------------------------------------------------
Public Function Properties() As Variant
''' Return the list or properties of the Form class as an array

 Properties = Array( _
     "AllowDeletes" _
     , "AllowInserts" _
     , "AllowUpdates" _
     , "BaseForm" _
     , "Bookmark" _
     , "CurrentRecord" _
     , "Filter" _
     , "LinkChildFields" _
     , "LinkParentFields" _
     , "Name" _
     , "OnApproveCursorMove" _
     , "OnApproveParameter" _
     , "OnApproveReset" _
     , "OnApproveRowChange" _
     , "OnApproveSubmit" _
     , "OnConfirmDelete" _
     , "OnCursorMoved" _
     , "OnErrorOccurred" _
     , "OnLoaded" _
     , "OnReloaded" _
     , "OnReloading" _
     , "OnResetted" _
     , "OnRowChanged" _
     , "OnUnloaded" _
     , "OnUnloading" _
     , "OrderBy" _
     , "Parent" _
     , "RecordSource" _
     , "XForm" _
     )

End Function ' SFDocuments.SF_Form.Properties

REM -----------------------------------------------------------------------------
Public Function Requery() As Boolean
''' Reload from the database the actual data into the form
''' The cursor is (re)positioned on the first row
''' Args:
''' Returns:
'''  True if requery is successful
''' Example:
'''   myForm.Requery()

Dim bRequery As Boolean  ' Return value
Const cstThisSub = "SFDocuments.Form.Requery"
Const cstSubArgs = ""

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bRequery = False

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
 End If
Try:
 With _Form
  If .isLoaded() Then .reload() Else .load()
 End With
 bRequery = True

Finally:
 Requery = bRequery
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_Form.Requery

REM -----------------------------------------------------------------------------
Public Function SetProperty(Optional ByVal PropertyName As Variant _
        , Optional ByRef Value As Variant _
        ) As Boolean
''' Set a new value to the given property
''' Args:
'''  PropertyName: the name of the property as a string
'''  Value: its new value
''' Exceptions
'''  ARGUMENTERROR  The property does not exist

Const cstThisSub = "SFDocuments.Form.SetProperty"
Const cstSubArgs = "PropertyName, Value"

 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 SetProperty = False

Check:
 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
 End If

Try:
 SetProperty = _PropertySet(PropertyName, Value)

Finally:
 SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_Form.SetProperty

REM -----------------------------------------------------------------------------
Public Function Subforms(Optional ByVal Subform As Variant) As Variant
''' Return either
'''  - the list of the subforms contained in the actual form or subform instance
'''  - a SFDocuments.Form object based on its name or its index in the alphabetic list of subforms
''' Args:
'''  Subform: a subform stored in the parent form given by its name or its index
'''   When absent, the list of available subforms is returned
'''   To get the first (unique ?) subform stored in the parent form, set Subform = 0
''' Exceptions:
'''  SUBFORMNOTFOUNDERROR  Subform not found
''' Returns:
'''  A zero-based array of strings if Subform is absent
'''  An instance of the SF_Form class if Subform exists
''' Example:
'''   Dim myForm As Object, myList As Variant, mySubform As Object
'''    myList = myForm.Subforms()
'''    Set mySubform = myForm.Subforms("mySubform")

Dim oSubform As Object    ' The new Form class instance
Dim oXSubform As Object    ' com.sun.star.form.XForm
Dim vSubformNames As Variant  ' Array of subform names
Dim i As Long
Const cstDrawPage = 0    ' Only 1 drawpage in a Writer document

Const cstThisSub = "SFDocuments.Form.Subforms"
Const cstSubArgs = "[Subform=""""]"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch

Check:
 If IsMissing(Subform) Or IsEmpty(Subform) Then Subform = ""
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not _IsStillAlive() Then GoTo Finally
  If Not ScriptForge.SF_Utils._Validate(Subform, "Subform", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
 End If

Try:
 ' Collect all control names and retain only the subforms
 vSubformNames = _Form.getElementNames()
 For i = 0 To UBound(vSubformNames)
  Set oSubform = _Form.getByName(vSubformNames(i))
  ' Subforms are the only control types having no ClassId property
  If ScriptForge.SF_Session.HasUnoProperty(oSubform, "ClassId") Then vSubformNames(i) = ""
 Next i
 vSubformNames = ScriptForge.SF_Array.TrimArray(vSubformNames)

 If Len(Subform) = 0 Then ' Return the list of valid subform names
  Subforms = vSubformNames
 Else
  If VarType(Subform) = V_STRING Then ' Find the form by name
   If Not ScriptForge.SF_Array.Contains(vSubformNames, Subform, CaseSensitive := True) Then GoTo CatchNotFound
   Set oXSubform = _Form.getByName(Subform)
  Else        ' Find the form by index
   If Subform < 0 Or Subform > UBound(vSubformNames) Then GoTo CatchNotFound
   Set oXSubform = _Form.getByName(vSubformNames(Subform))
  End If
  ' Create the new Form class instance
  Set oSubform = SF_Register._NewForm(oXSubform)
  With oSubform
   Set .[_Parent] = [Me]
   ._FormType = ISSUBFORM
   Set ._Component = _Component
   Set ._BaseComponent = _BaseComponent
   Set ._FormDocument = _FormDocument
   ._SheetName = _SheetName
   ._FormDocumentName = _FormDocumentName
   Set ._Database = _Database
   ._Initialize()
  End With
  Set Subforms = oSubform
 End If

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
CatchNotFound:
 ScriptForge.SF_Exception.RaiseFatal(SUBFORMNOTFOUNDERROR, Subform, _Name)
 GoTo Finally
End Function ' SFDocuments.SF_Form.Subforms

REM =========================================================== PRIVATE FUNCTIONS

REM -----------------------------------------------------------------------------
Public Function _GetEventName(ByVal psProperty As String) As String
''' Return the LO internal event name derived from the SF property name
''' The SF property name is not case sensitive, while the LO name is case-sensitive
' Corrects the typo on ErrorOccur(r?)ed, if necessary

Dim vProperties As Variant   ' Array of class properties
Dim sProperty As String    ' Correctly cased property name

 vProperties = Properties()
 sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))

 _GetEventName = LCase(Mid(sProperty, 3, 1)) & Right(sProperty, Len(sProperty) - 3)
 
End Function ' SFDocuments.SF_Form._GetEventName

REM -----------------------------------------------------------------------------
Private Function _GetListener(ByVal psEventName As String) As String
''' Getting/Setting macros triggered by events requires a Listener-EventName pair
''' Return the X...Listener corresponding with the event name in argument

 Select Case UCase(psEventName)
  Case UCase("OnApproveCursorMove")
   _GetListener = "XRowSetApproveListener"
  Case UCase("OnApproveParameter")
   _GetListener = "XDatabaseParameterListener"
  Case UCase("OnApproveReset"), UCase("OnResetted")
   _GetListener = "XResetListener"
  Case UCase("OnApproveRowChange")
   _GetListener = "XRowSetApproveListener"
  Case UCase("OnApproveSubmit")
   _GetListener = "XSubmitListener"
  Case UCase("OnConfirmDelete")
   _GetListener = "XConfirmDeleteListener"
  Case UCase("OnCursorMoved"), UCase("OnRowChanged")
   _GetListener = "XRowSetListener"
  Case UCase("OnErrorOccurred")
   _GetListener = "XSQLErrorListener"
  Case UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnUnloaded"), UCase("OnUnloading")
   _GetListener = "XLoadListener"
 End Select
 
End Function ' SFDocuments.SF_Form._GetListener

REM -----------------------------------------------------------------------------
Private Sub _GetParents()
''' When the current instance is created top-down, the parents are completely defined
''' and nothing should be done in this method
''' When the a class instance is created in a (form/control) event, it is the opposite
''' The current method rebuilds the missing members in the instance from the bottom
''' Members potentially to collect are:
'''  - _FormType
'''  - [_Parent], the immediate parent: a form or a document instance
'''  + Only when the _FormType is a main form
'''   - _SheetName (Calc only)
'''   - _FormDocumentName (Base only)
'''   - _FormDocument, the topmost form collection
'''   - _Component, the containing document
''' They must be identified only starting from the _Form UNO object
'''
''' The method is called from the _Initialize() method at instance creation

Dim oParent As Object    ' Successive bottom-up parents
Dim sType As String     ' UNO object type
Dim iLevel As Integer    ' When = 1 => first parent
Dim oBase As Object     ' Empty Base instance
Dim oSession As Object    : Set oSession = ScriptForge.SF_Session

 On Local Error GoTo Finally  ' Being probably called from events, this method should avoid failures
 ' When the form type is known, the upper part of the branch is not scanned
 If _FormType <> ISUNDEFINED Then GoTo Finally

Try:
 ' The whole branch is scanned bottom-up
 If oSession.HasUnoProperty(_Form, "Parent") Then Set oParent = _Form.Parent Else Set oParent = Nothing
 _FormType = ISUNDEFINED
 iLevel = 1

 Do While Not IsNull(oParent)
  sType = SF_Session.UnoObjectType(oParent)
  Select Case sType
   ' Collect at each level the needed info
   Case "com.sun.star.comp.forms.ODatabaseForm" ' The parent _Form of a subform
    If iLevel = 1 Then
     _FormType = ISSUBFORM
     Set [_Parent] = SF_Register._NewForm(oParent)
     ' Everything is in the parent, copy items and stop scan
     [_Parent]._Initialize()  ' Current method is called recursively here
     With [_Parent]
      _SheetName = ._SheetName
      _FormDocumentName = ._FormDocumentName
      Set _FormDocument = ._FormDocument
      Set _Component = ._Component
     End With
     Exit Sub
    End If
   Case "com.sun.star.form.OFormsCollection"  ' The collection of forms inside a drawpage
   Case "SwXTextDocument"       ' The parent document: a Writer document or a Base form document
    If oParent.Identifier = "com.sun.star.sdb.FormDesign" Then
     _FormType = ISBASEFORM
     ' Make a new SF_FormDocument instance
     Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.FormDocument", oParent)
     With [_Parent]
      Set _FormDocument = ._FormDocument
      _FormDocumentName = ._HierarchicalName
      Set _BaseComponent = ._BaseComponent
      Set _Component = ._Component
     End With
    ElseIf oParent.Identifier = "com.sun.star.text.TextDocument" Then
     _FormType = ISDOCFORM
     Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
    End If
    Set _Component = oParent
   Case "ScModelObj"        ' The parent document: a Calc document
    _FormType = ISCALCFORM
    Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
    Set _Component = oParent
    ' The triggered form event is presumed to be located in the (drawpage of the) active sheet
    _SheetName = [_Parent].XSpreadsheet("~")
   Case "com.sun.star.comp.dba.ODatabaseDocument" ' The Base document
   Case Else
  End Select
  If oSession.HasUnoProperty(oParent, "Parent") Then Set oParent = oParent.Parent Else Set oParent = Nothing
  iLevel = iLevel + 1
 Loop

Finally:
 Exit Sub
End Sub ' SFDocuments.SF_Form._GetParents

REM -----------------------------------------------------------------------------
Public Sub _Initialize()
''' Achieve the creation of a SF_Form instance
'''  - complete the missing private members
'''  - store the new instance in the cache

 _GetParents()
 _CacheIndex = SF_Register._AddFormToCache(_Form, [Me])

End Sub   ' SFDocuments.SF_Form._Initialize

REM -----------------------------------------------------------------------------
Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
''' Return True if the Form is still open
''' If dead the actual instance is disposed
''' and the execution is cancelled when pbError = True (default)
''' Args:
'''  pbError: if True (default), raise a fatal error

Dim bAlive As Boolean  ' Return value
Dim sName As String   ' Alias of _Name
Dim sId As String   ' Alias of FileIdent

Check:
 On Local Error GoTo Catch  ' Anticipate DisposedException errors or alike
 If IsMissing(pbError) Then pbError = True

Try:
 ' At main form termination, all database connections are lost
 bAlive = Not IsNull(_Form)
 If Not bAlive Then GoTo Catch

Finally:
 _IsStillAlive = bAlive
 Exit Function
Catch:
 bAlive = False
 On Error GoTo 0
 ' Keep error message elements before disposing the instance
 sName = _SheetName & _FormDocumentName  ' At least one of them is a zero-length string
 sName = Iif(Len(sName) > 0, "[" & sName & "].", "") & _Name
 If Not IsNull(_Component) Then sId = _Component.Location Else sId = ""
 ' Dispose the actual forms instance
 Dispose()
 ' Display error message
 If pbError Then ScriptForge.SF_Exception.RaiseFatal(FORMDEADERROR, sName, sId)
 GoTo Finally
End Function ' SFDocuments.SF_Form._IsStillAlive

REM -----------------------------------------------------------------------------
Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
''' Return the value of the named property
''' Args:
'''  psProperty: the name of the property

Static oSession As Object  ' Alias of SF_Session
Dim vBookmark As Variant  ' Form bookmark
Dim cstThisSub As String
Const cstSubArgs = ""

 cstThisSub = "SFDocuments.Form.get" & psProperty
 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch

 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
 _PropertyGet = Empty
 If Not _IsStillAlive() Then GoTo Finally

 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
 Select Case UCase(psProperty)
  Case UCase("AllowDeletes")
   If Not IsNull(_Form) Then _PropertyGet = _Form.AllowDeletes
  Case UCase("AllowInserts")
   If Not IsNull(_Form) Then _PropertyGet = _Form.AllowInserts
  Case UCase("AllowUpdates")
   If Not IsNull(_Form) Then _PropertyGet = _Form.AllowUpdates
  Case UCase("BaseForm")
   _PropertyGet = _FormDocumentName
  Case UCase("Bookmark")
   If IsNull(_Form) Then
    _PropertyGet = 0
   Else
    On Local Error Resume Next   ' Disable error handler because bookmarking does not always react well in events ...
    If _Form.IsBookmarkable Then vBookmark = _Form.getBookmark() Else vBookmark = Nothing
    If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error Goto Catch Else On Local Error Goto 0
    If IsNull(vBookmark) Then Goto Catch
    _PropertyGet = vBookmark
   End If
  Case UCase("CurrentRecord")
   If IsNull(_Form) Then _PropertyGet = 0 Else _PropertyGet = _Form.Row
  Case UCase("Filter")
   If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Filter
  Case UCase("LinkChildFields")
   If IsNull(_Form) Or _FormType <> ISSUBFORM Then _PropertyGet = Array() Else _PropertyGet = _Form.DetailFields
  Case UCase("LinkParentFields")
   If IsNull(_Form) Or _FormType <> ISSUBFORM Then _PropertyGet = Array() Else _PropertyGet = _Form.MasterFields
  Case UCase("Name")
   _PropertyGet = _Name
  Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _
     , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
     , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
     , UCase("OnUnloaded"), UCase("OnUnloading")
   If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = SF_Register._GetEventScriptCode(_Form, psProperty, _Name)
  Case UCase("OrderBy")
   If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Order
  Case UCase("Parent")
   _PropertyGet = [_Parent]
  Case UCase("RecordSource")
   If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Command
  Case UCase("XForm")
   Set _PropertyGet = _Form
  Case Else
   _PropertyGet = Null
 End Select

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFDocuments.SF_Form._PropertyGet

REM -----------------------------------------------------------------------------
Private Function _PropertySet(Optional ByVal psProperty As String _
        , Optional ByVal pvValue As Variant _
        ) As Boolean
''' Set the new value of the named property
''' Args:
'''  psProperty: the name of the property
'''  pvValue: the new value of the given property
''' Returns:
'''  True if successful

Dim bSet As Boolean       ' Return value
Dim oDatabase As Object      ' Database class instance
Dim lCommandType As Long     ' Record source type: 0 = Table, 1 = Query, 2 = SELECT
Dim sCommand As String      ' Record source
Static oSession As Object     ' Alias of SF_Session
Dim cstThisSub As String
Const cstSubArgs = "Value"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 bSet = False

 cstThisSub = "SFDocuments.Form.set" & psProperty
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
 If Not _IsStillAlive() Then GoTo Finally

 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
 bSet = True
 Select Case UCase(psProperty)
--> --------------------

--> maximum size reached

--> --------------------