Current File : //proc/self/root/lib/libreoffice/share/basic/SFDocuments/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: 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>
Mini Shell