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. ''' For Base 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: ''' For usual documents, there is only 1 form document. It is in fact the document itself. ''' A Base document may contain an unlimited number of form documents. ''' In the Base terminology they are called "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 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 FormDocument and its FormName or FormIndex ''' ''' Service invocations: ''' ''' REM the form is stored in a not-Base document (Calc, Writer) ''' 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 one of the FormDocuments of a Base document ''' Dim oDoc As Object, myForm As Object, mySubForm As Object ''' Set oDoc = CreateScriptService("SFDocuments.Document", ThisDatabaseDocument) ''' oDoc.OpenFormDocument("thisFormDocument") ''' Set myForm = oDoc.Forms("thisFormDocument", "MainForm") ''' ' or, alternatively, when there is only 1 form ''' Set myForm = oDoc.Forms("thisFormDocument", 0) ''' ' To access a subform: myForm and mySubForm become distinct instances of the current class ''' Set mySubForm = myForm.SubForms("mySubForm") ''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS Private Const FORMDEADERROR = "FORMDEADERROR" 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 containing form document ' The form topmost container Private _Component As Object ' com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument ' EVents management Private _CacheIndex As Long ' Index in central cache storage Private _IssuedFromEvent As Boolean ' When True instance is always presumed alive ' 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 Private _Database As Object ' Database class instance ' Form attributes ' Persistent storage for controls 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 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 _FormType = ISUNDEFINED _CacheIndex = -1 _IssuedFromEvent = False Set _Form = Nothing Set _Database = Nothing _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 Caption() As Variant ''' The Caption property refers to the title of the Form Caption = _PropertyGet("Caption") End Property ' SFDocuments.SF_Form.Caption (get) REM ----------------------------------------------------------------------------- Property Let Caption(Optional ByVal pvCaption As Variant) ''' Set the updatable property Caption _PropertySet("Caption", pvCaption) End Property ' SFDocumentsDialog.SF_Form.Caption (let) REM ----------------------------------------------------------------------------- Property Get Height() As Variant ''' The Height property refers to the height of the Form box Height = _PropertyGet("Height") End Property ' SFDocuments.SF_Form.Height (get) REM ----------------------------------------------------------------------------- Property Let Height(Optional ByVal pvHeight As Variant) ''' Set the updatable property Height _PropertySet("Height", pvHeight) End Property ' SFDocuments.SF_Form.Height (let) 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 Visible() As Variant ''' The Visible property is False before the Execute() statement Visible = _PropertyGet("Visible") End Property ' SFDocuments.SF_Form.Visible (get) REM ----------------------------------------------------------------------------- Property Let Visible(Optional ByVal pvVisible As Variant) ''' Set the updatable property Visible _PropertySet("Visible", pvVisible) End Property ' SFDocuments.SF_Form.Visible (let) REM ----------------------------------------------------------------------------- Property Get Width() As Variant ''' The Width property refers to the Width of the Form box Width = _PropertyGet("Width") End Property ' SFDocuments.SF_Form.Width (get) REM ----------------------------------------------------------------------------- Property Let Width(Optional ByVal pvWidth As Variant) ''' Set the updatable property Width _PropertySet("Width", pvWidth) End Property ' SFDocuments.SF_Form.Width (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, ISSUBFORM Case ISBASEFORM _FormDocument.close() Dispose() bClose = True 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 = CreateScriptService("SFDocuments.Form", Container, Library, FormName) ''' 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 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: If Len(ControlName) = 0 Then Else End If Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchNotFound: ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _FormModel.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 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 ''' Example: ''' Dim myDb As Object ''' Set myDb = oForm.GetDatabase() Dim FSO As Object ' Alias for SF_FileSystem 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(True) 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 Then ' Fetch the shared connection Set _Database = [_Parent].GetDatabase(User, Password) 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 If FSO.FileExists(FSO._ConvertFromUrl(_Form.DataSourceName)) Then Set _Database = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _ , _Form.DataSourceName, , , 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" _ , "First" _ , "GetDatabase" _ , "Last" _ , "Move" _ , "New" _ , "Next" _ , "Previous" _ , "Refresh" _ , "Requery" _ , "SubForms" _ ) End Function ' SFDocuments.SF_Form.Methods REM ----------------------------------------------------------------------------- Public Function Properties() As Variant ''' Return the list or properties of the Form class as an array Properties = Array( _ "AllowAdditions" _ , "AllowDeletions" _ , "AllowEdits" _ , "Bookmark" _ , "Caption" _ , "CurrentRecord" _ , "Filter" _ , "FilterOn" _ , "Height" _ , "IsLoaded" _ , "LinkChildFields" _ , "LinkParentFields" _ , "Name" _ , "OnApproveCursorMove" _ , "OnApproveParameter" _ , "OnApproveReset" _ , "OnApproveRowChange" _ , "OnApproveSubmit" _ , "OnConfirmDelete" _ , "OnCursorMoved" _ , "OnErrorOccurred" _ , "OnLoaded" _ , "OnReloaded" _ , "OnReloading" _ , "OnResetted" _ , "OnRowChanged" _ , "OnUnloaded" _ , "OnUnloading" _ , "OrderBy" _ , "OrderByOn" _ , "Parent" _ , "RecordSource" _ , "Visible" _ , "Width" _ , "XForm" _ ) End Function ' SFDocuments.SF_Form.Properties 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) Set UI = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI") Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Form.SetProperty 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 Else _GetListener = "" 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 sPersistentName As String ' The Obj... name of a Base form Dim iLevel As Integer ' When = 1 => first parent 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) ' The parent form could be a main form [_Parent]._Initialize() ' Everything is in the parent, stop scan 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 sPersistentName = ScriptForge._GetPropertyValue(oParent.Args, "HierarchicalDocumentName") ElseIf oParent.Identifier = "com.sun.star.text.TextDocument" Then _FormType = ISDOCFORM Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent) Set _Component = [_Parent]._Component End If 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 _FormType = ISBASEFORM Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent) Set _Component = oParent If IsNull([_Parent]._FormDocuments) Then Set [_Parent]._FormDocuments = _Component.getFormDocuments() Set _FormDocument = [_Parent]._FindByPersistentName([_Parent]._FormDocuments, sPersistentName) 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: If _IssuedFromEvent Then ' Instance is presumed alive when issued from an event bAlive = True Else ' For usual documents, check that the parent document is still open ' For Base forms and subforms, check the openness of the main form Select Case _FormType Case ISDOCFORM, ISCALCFORM bAlive = [_Parent]._IsStillAlive(pbError) Case ISBASEFORM, ISSUBFORM ' A form that has never been opened has no component ' If ever opened and closed afterwards, it keeps the Component but loses its Controller bAlive = Not IsNull(_FormDocument.Component) If bAlive Then bAlive = Not IsNull(_FormDocument.Component.CurrentController) End Select If Not bAlive Then GoTo Catch End If 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 sId = [_Parent]._FileIdent() ' 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 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) If Not _IsStillAlive() Then GoTo Finally If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") Select Case UCase(psProperty) Case UCase("Caption") Case UCase("Height") Case UCase("Name") Case UCase("Parent") _PropertyGet = [_Parent] Case UCase("Visible") Case UCase("Width") 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 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("Caption") Case UCase("Height") Case UCase("Visible") Case UCase("Width") 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