diff options
| author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-15 05:54:39 +0000 |
|---|---|---|
| committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-15 05:54:39 +0000 |
| commit | 267c6f2ac71f92999e969232431ba04678e7437e (patch) | |
| tree | 358c9467650e1d0a1d7227a21dac2e3d08b622b2 /wizards/source/sfdocuments/SF_Form.xba | |
| parent | Initial commit. (diff) | |
| download | libreoffice-267c6f2ac71f92999e969232431ba04678e7437e.tar.xz libreoffice-267c6f2ac71f92999e969232431ba04678e7437e.zip | |
Adding upstream version 4:24.2.0.upstream/4%24.2.0
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'wizards/source/sfdocuments/SF_Form.xba')
| -rw-r--r-- | wizards/source/sfdocuments/SF_Form.xba | 1551 |
1 files changed, 1551 insertions, 0 deletions
diff --git a/wizards/source/sfdocuments/SF_Form.xba b/wizards/source/sfdocuments/SF_Form.xba new file mode 100644 index 0000000000..a5559ae06a --- /dev/null +++ b/wizards/source/sfdocuments/SF_Form.xba @@ -0,0 +1,1551 @@ +<?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()) + 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) + Set _FormDocument = [_Parent]._FormDocument + 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) + Case UCase("AllowDeletes") + If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowDeletes", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not IsNull(_Form) Then + _Form.AllowDeletes = pvValue + _Form.reload() + End If + Case UCase("AllowInserts") + If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowInserts", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not IsNull(_Form) Then + _Form.AllowInserts = pvValue + _Form.reload() + End If + Case UCase("AllowUpdates") + If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowUpdates", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not IsNull(_Form) Then + _Form.AllowUpdates = pvValue + _Form.reload() + End If + Case UCase("Bookmark") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Bookmark", Array(ScriptForge.V_NUMERIC, ScriptForge.V_OBJECT)) Then GoTo Finally + If Not IsNull(pvValue) And Not IsNull(_Form) Then bSet = _Form.moveToBookmark(pvValue) + Case UCase("CurrentRecord") + If Not ScriptForge.SF_Utils._Validate(pvValue, "CurrentRecord", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not IsNull(_Form) Then bSet = _Form.absolute(pvValue) + Case UCase("Filter") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Filter", V_STRING) Then GoTo Finally + If Not IsNull(_Form) Then + With _Form + If Len(pvValue) > 0 Then + Set oDatabase = GetDatabase() + If Not IsNull(oDatabase) Then .Filter = oDatabase._ReplaceSquareBrackets(pvValue) Else .Filter = pvValue + Else + .Filter = "" + End If + .ApplyFilter = True + .reload() + End With + End If + 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 Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally + If Not IsNull(_Form) Then + bSet = SF_Register._RegisterEventScript(_Form _ + , psProperty _ + , _GetListener(psProperty) _ + , pvValue _ + , _Name _ + ) + End If + Case UCase("OrderBy") + If Not ScriptForge.SF_Utils._Validate(pvValue, "OrderBy", V_STRING) Then GoTo Finally + If Not IsNull(_Form) Then + With _Form + If Len(pvValue) > 0 Then + Set oDatabase = GetDatabase() + If Not IsNull(oDatabase) Then .Order = oDatabase._ReplaceSquareBrackets(pvValue) Else .Order = pvValue + Else + .Order = "" + End If + .reload() + End With + End If + Case UCase("RecordSource") + If Not ScriptForge.SF_Utils._Validate(pvValue, "RecordSource", V_STRING) Then GoTo Finally + If Not IsNull(_Form) And Len(pvValue) > 0 Then + Set oDatabase = GetDatabase() + If Not IsNull(oDatabase) Then + With oDatabase + If ScriptForge.SF_Array.Contains(.Tables, pvValue, CaseSensitive := True) Then + sCommand = pvValue + lCommandType = com.sun.star.sdb.CommandType.TABLE + ElseIf ScriptForge.SF_Array.Contains(.Queries, pvValue, CaseSensitive := True) Then + sCommand = pvValue + lCommandType = com.sun.star.sdb.CommandType.QUERY + ElseIf ScriptForge.SF_String.StartsWith(pvValue, "SELECT", CaseSensitive := False) Then + sCommand = .ReplaceSquareBrackets(pvValue) + lCommandType = com.sun.star.sdb.CommandType.COMMAND + End If + _Form.Command = sCommand + _Form.CommandType = lCommandType + End With + End If + End If + Case Else + bSet = False + End Select + +Finally: + _PropertySet = bSet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Form._PropertySet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[Form]: Name" + +Dim sParent As String ' To recognize the parent + + sParent = _SheetName & _FormDocumentName ' At least one of them is a zero-length string + _Repr = "[Form]: " & Iif(Len(sParent) > 0, sParent & "...", "") & _Name + +End Function ' SFDocuments.SF_Form._Repr + +REM ============================================ END OF SFDOCUMENTS.SF_FORM +</script:module>
\ No newline at end of file |