Linux ns1.utparral.edu.mx 6.8.0-79-generic #79~22.04.1-Ubuntu SMP PREEMPT_DYNAMIC Fri Aug 15 16:54:53 UTC 2 x86_64
Apache/2.4.58 (Unix) OpenSSL/1.1.1w PHP/8.2.12 mod_perl/2.0.12 Perl/v5.34.1
: 10.10.1.9 | : 10.10.1.254
Cant Read [ /etc/named.conf ]
daemon
Terminal
AUTO ROOT
Adminer
Backdoor Destroyer
Linux Exploit
Lock Shell
Lock File
Create User
README
+ Create Folder
+ Create File
/
usr /
lib /
libreoffice /
share /
basic /
SFDocuments /
[ HOME SHELL ]
Name
Size
Permission
Action
dialog.xlb
290
B
-rw-r--r--
__License.xba
1.77
KB
-rw-r--r--
script.xlb
770
B
-rw-r--r--
SF_Base.xba
43.71
KB
-rw-r--r--
SF_Calc.xba
174.42
KB
-rw-r--r--
SF_Chart.xba
36.89
KB
-rw-r--r--
SF_DocumentListener.xba
5.58
KB
-rw-r--r--
SF_Document.xba
55.97
KB
-rw-r--r--
SF_FormControl.xba
92.72
KB
-rw-r--r--
SF_Form.xba
67.91
KB
-rw-r--r--
SF_Register.xba
24.31
KB
-rw-r--r--
SF_Writer.xba
27.21
KB
-rw-r--r--
Delete
Unzip
Zip
${this.title}
Close
Code Editor : SF_Form.xba
<?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: ''' 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" 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 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 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" 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 ' 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 ' 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 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 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, 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 = 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 ''' 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 _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 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" _ , "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 ._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 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) ' 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 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) _FormDocumentName = _FormDocument.HierarchicalName 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>
Close