1551 lines
No EOL
69 KiB
XML
1551 lines
No EOL
69 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Form" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
|
|
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
|
REM === The SFDocuments library is one of the associated libraries. ===
|
|
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
|
REM =======================================================================================================================
|
|
|
|
Option Compatible
|
|
Option ClassModule
|
|
|
|
Option Explicit
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''' SF_Form
|
|
''' =======
|
|
''' Management of forms defined in LibreOffice documents. Supported types are Base, Calc and Writer documents.
|
|
''' It includes the management of subforms
|
|
''' Each instance of the current class represents a single form or a single subform
|
|
'''
|
|
''' A form may optionally be (understand "is often") linked to a data source manageable with the SFDatabases.Database service
|
|
''' The current service offers a rapid access to that service
|
|
'''
|
|
''' Definitions:
|
|
'''
|
|
''' FormDocument: BASE DOCUMENTS ONLY
|
|
''' For usual documents, there is only 1 forms container. It is either the document itself or one of its sheets (Calc)
|
|
''' A Base document may contain an unlimited number of form documents.
|
|
''' In the Base terminology they are called "forms" or "Base forms". This could create some confusion.
|
|
''' They can be organized in folders. Their name is then always the full path of folders + form
|
|
''' with the slash ("/") as path separator
|
|
''' A FormDocument is a set of Forms. Form names are visible in the user interface thanks to the form navigator
|
|
''' Often there is only 1 Form present in a FormDocument. Having more, however, might improve
|
|
''' the user experience significantly
|
|
'''
|
|
''' Form: WHERE IT IS ABOUT IN THE CURRENT "Form" SERVICE
|
|
''' Is an abstract set of Controls in an OPEN Document or FormDocument
|
|
''' Each form is usually linked to one single dataset (table, query or Select statement),
|
|
''' located in any database (provided the user may access it)
|
|
''' A usual document may contain several forms. Each of which may have its own data source (database + dataset)
|
|
''' A Base form document may contain several forms. Each of which may address its own dataset. The database however is unique
|
|
''' A form is defined by its owning Document or FormDocument and its FormName or FormIndex
|
|
'''
|
|
''' Service invocations:
|
|
'''
|
|
''' REM the form is stored in a Writer document
|
|
''' Dim oDoc As Object, myForm As Object
|
|
''' Set oDoc = CreateScriptService("SFDocuments.Document", ThisComponent)
|
|
''' Set myForm = oDoc.Forms("Form1")
|
|
''' ' or, alternatively, when there is only 1 form
|
|
''' Set myForm = oDoc.Forms(0)
|
|
'''
|
|
''' REM the form is stored in a Calc document
|
|
''' Dim oCalc As Object, myForm As Object
|
|
''' Set oCalc = CreateScriptService("SFDocuments.Document", ThisComponent)
|
|
''' Set myForm = oCalc.Forms("Sheet1", "Form1")
|
|
''' ' or, alternatively, when there is only 1 form
|
|
''' Set myForm = oCalc.Forms("Sheet1", 0)
|
|
'''
|
|
''' REM the form is stored in one of the FormDocuments of a Base document
|
|
''' Dim oBase As Object, myFormDoc As Object, myForm As Object, mySubForm As Object
|
|
''' Set oBase = CreateScriptService("SFDocuments.Document", ThisDatabaseDocument)
|
|
''' Set oFormDoc = oBase.OpenFormDocument("thisFormDocument")
|
|
''' Set myForm = oFormDoc.Forms("MainForm")
|
|
''' ' or, alternatively, when there is only 1 form
|
|
''' Set myForm = oFormDoc.Forms(0)
|
|
''' ' To access a subform: myForm and mySubForm become distinct instances of the current class
|
|
''' Set mySubForm = myForm.SubForms("mySubForm")
|
|
'''
|
|
''' REM the form is the subject of an event
|
|
''' Sub OnEvent(ByRef poEvent As Object)
|
|
''' Dim myForm As Object
|
|
''' Set myForm = CreateScriptService("SFDocuments.FormEvent", poEvent)
|
|
'''
|
|
''' Detailed user documentation:
|
|
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_form.html?DbPAR=BASIC
|
|
'''
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
Private Const FORMDEADERROR = "FORMDEADERROR"
|
|
Private Const SUBFORMNOTFOUNDERROR = "SUBFORMNOTFOUNDERROR"
|
|
Private Const DBCONNECTERROR = "DBCONNECTERROR"
|
|
|
|
REM ============================================================= PRIVATE MEMBERS
|
|
|
|
Private [Me] As Object
|
|
Private [_Parent] As Object
|
|
Private ObjectType As String ' Must be Form
|
|
Private ServiceName As String
|
|
|
|
' Form location
|
|
Private _Name As String ' Internal name of the form
|
|
Private _FormType As Integer ' One of the ISxxxFORM constants
|
|
Private _SheetName As String ' Name as the sheet containing the form (Calc only)
|
|
Private _FormDocumentName As String ' The hierarchical name of the containing form document (Base only)
|
|
Private _FormDocument As Object ' com.sun.star.comp.sdb.Content - the form document container
|
|
' The form topmost containers
|
|
Private _Component As Object ' com.sun.star.lang.XComponent
|
|
Private _BaseComponent As Object ' com.sun.star.comp.dba.ODatabaseDocument
|
|
|
|
' Events management
|
|
Private _CacheIndex As Long ' Index in central cache storage
|
|
|
|
' Form UNO references
|
|
' The entry to the interactions with the form. Validity checked by the _IsStillAlive() method
|
|
' Each method or property requiring that the form is opened should first invoke that method
|
|
Private _Form As Object ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
|
|
|
|
' Form attributes
|
|
Private _Database As Object ' Database class instance
|
|
|
|
' Cache storage for controls
|
|
Private _ControlNames As Variant ' Array of control names
|
|
Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of XForm
|
|
|
|
REM ============================================================ MODULE CONSTANTS
|
|
|
|
Const ISDOCFORM = 1 ' Form is stored in a Writer document
|
|
Const ISCALCFORM = 2 ' Form is stored in a Calc document
|
|
Const ISBASEFORM = 3 ' Form is stored in a Base form document
|
|
Const ISSUBFORM = 4 ' Form is a subform of a form or of another subform
|
|
Const ISUNDEFINED = -1 ' Undefined form type
|
|
|
|
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Initialize()
|
|
Set [Me] = Nothing
|
|
Set [_Parent] = Nothing
|
|
ObjectType = "FORM"
|
|
ServiceName = "SFDocuments.Form"
|
|
_Name = ""
|
|
_SheetName = ""
|
|
_FormDocumentName = ""
|
|
Set _FormDocument = Nothing
|
|
Set _Component = Nothing
|
|
Set _BaseComponent = Nothing
|
|
_FormType = ISUNDEFINED
|
|
_CacheIndex = -1
|
|
Set _Form = Nothing
|
|
Set _Database = Nothing
|
|
_ControlNames = Array()
|
|
_ControlCache = Array()
|
|
End Sub ' SFDocuments.SF_Form Constructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Terminate()
|
|
Call Class_Initialize()
|
|
End Sub ' SFDocuments.SF_Form Destructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Dispose() As Variant
|
|
If Not IsNull(_Database) And (_FormType = ISDOCFORM Or _FormType = ISCALCFORM) Then
|
|
Set _Database = _Database.Dispose()
|
|
End If
|
|
SF_Register._CleanCacheEntry(_CacheIndex)
|
|
Call Class_Terminate()
|
|
Set Dispose = Nothing
|
|
End Function ' SFDocuments.SF_Form Explicit Destructor
|
|
|
|
REM ================================================================== PROPERTIES
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get AllowDeletes() As Variant
|
|
''' The AllowDeletes property specifies if the form allows to delete records
|
|
AllowDeletes = _PropertyGet("AllowDeletes")
|
|
End Property ' SFDocuments.SF_Form.AllowDeletes (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let AllowDeletes(Optional ByVal pvAllowDeletes As Variant)
|
|
''' Set the updatable property AllowDeletes
|
|
_PropertySet("AllowDeletes", pvAllowDeletes)
|
|
End Property ' SFDocuments.SF_Form.AllowDeletes (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get AllowInserts() As Variant
|
|
''' The AllowInserts property specifies if the form allows to add records
|
|
AllowInserts = _PropertyGet("AllowInserts")
|
|
End Property ' SFDocuments.SF_Form.AllowInserts (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let AllowInserts(Optional ByVal pvAllowInserts As Variant)
|
|
''' Set the updatable property AllowInserts
|
|
_PropertySet("AllowInserts", pvAllowInserts)
|
|
End Property ' SFDocuments.SF_Form.AllowInserts (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get AllowUpdates() As Variant
|
|
''' The AllowUpdates property specifies if the form allows to update records
|
|
AllowUpdates = _PropertyGet("AllowUpdates")
|
|
End Property ' SFDocuments.SF_Form.AllowUpdates (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let AllowUpdates(Optional ByVal pvAllowUpdates As Variant)
|
|
''' Set the updatable property AllowUpdates
|
|
_PropertySet("AllowUpdates", pvAllowUpdates)
|
|
End Property ' SFDocuments.SF_Form.AllowUpdates (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get BaseForm() As String
|
|
''' The BaseForm property specifies the hierarchical name of the Base form containing the actual form
|
|
BaseForm = _PropertyGet("BaseForm")
|
|
End Property ' SFDocuments.SF_Form.BaseForm (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Bookmark() As Variant
|
|
''' The Bookmark property specifies uniquely the current record of the form's underlying table, query or SQL statement.
|
|
Bookmark = _PropertyGet("Bookmark")
|
|
End Property ' SFDocuments.SF_Form.Bookmark (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Bookmark(Optional ByVal pvBookmark As Variant)
|
|
''' Set the updatable property Bookmark
|
|
_PropertySet("Bookmark", pvBookmark)
|
|
End Property ' SFDocuments.SF_Form.Bookmark (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get CurrentRecord() As Variant
|
|
''' The CurrentRecord property identifies the current record in the recordset being viewed on a form
|
|
CurrentRecord = _PropertyGet("CurrentRecord")
|
|
End Property ' SFDocuments.SF_Form.CurrentRecord (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let CurrentRecord(Optional ByVal pvCurrentRecord As Variant)
|
|
''' Set the updatable property CurrentRecord
|
|
''' If the row number is positive, the cursor moves to the given row number with respect to the beginning of the result set.
|
|
''' The first row is row 1, the second is row 2, and so on.
|
|
''' If the given row number is negative, the cursor moves to an absolute row position with respect to the end of the result set.
|
|
''' For example, setting CurrentRecord = -1 positions the cursor on the last row, -2 indicates the next-to-last row, and so on
|
|
_PropertySet("CurrentRecord", pvCurrentRecord)
|
|
End Property ' SFDocuments.SF_Form.CurrentRecord (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Filter() As Variant
|
|
''' The Filter property specifies a subset of records to be displayed.
|
|
Filter = _PropertyGet("Filter")
|
|
End Property ' SFDocuments.SF_Form.Filter (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Filter(Optional ByVal pvFilter As Variant)
|
|
''' Set the updatable property Filter
|
|
_PropertySet("Filter", pvFilter)
|
|
End Property ' SFDocuments.SF_Form.Filter (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get LinkChildFields() As Variant
|
|
''' The LinkChildFields property specifies how records in a subform (child) are linked to records in its parent form
|
|
''' It returns an array of strings
|
|
LinkChildFields = _PropertyGet("LinkChildFields")
|
|
End Property ' SFDocuments.SF_Form.LinkChildFields (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get LinkParentFields() As Variant
|
|
''' The LinkParentFields property specifies how records in a subform (Child) are linked to records in its parent form
|
|
''' It returns an array of strings
|
|
LinkParentFields = _PropertyGet("LinkParentFields")
|
|
End Property ' SFDocuments.SF_Form.LinkParentFields (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Name() As String
|
|
''' Return the name of the actual Form
|
|
Name = _PropertyGet("Name")
|
|
End Property ' SFDocuments.SF_Form.Name
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnApproveCursorMove() As Variant
|
|
''' The OnApproveCursorMove property specifies the script to trigger when this event occurs
|
|
OnApproveCursorMove = _PropertyGet("OnApproveCursorMove")
|
|
End Property ' SFDocuments.SF_Form.OnApproveCursorMove (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnApproveCursorMove(Optional ByVal pvOnApproveCursorMove As Variant)
|
|
''' Set the updatable property OnApproveCursorMove
|
|
_PropertySet("OnApproveCursorMove", pvOnApproveCursorMove)
|
|
End Property ' SFDocuments.SF_Form.OnApproveCursorMove (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnApproveReset() As Variant
|
|
''' The OnApproveReset property specifies the script to trigger when this event occurs
|
|
OnApproveReset = _PropertyGet("OnApproveReset")
|
|
End Property ' SFDocuments.SF_Form.OnApproveReset (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnApproveReset(Optional ByVal pvOnApproveReset As Variant)
|
|
''' Set the updatable property OnApproveReset
|
|
_PropertySet("OnApproveReset", pvOnApproveReset)
|
|
End Property ' SFDocuments.SF_Form.OnApproveReset (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnApproveRowChange() As Variant
|
|
''' The OnApproveRowChange property specifies the script to trigger when this event occurs
|
|
OnApproveRowChange = _PropertyGet("OnApproveRowChange")
|
|
End Property ' SFDocuments.SF_Form.OnApproveRowChange (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnApproveRowChange(Optional ByVal pvOnApproveRowChange As Variant)
|
|
''' Set the updatable property OnApproveRowChange
|
|
_PropertySet("OnApproveRowChange", pvOnApproveRowChange)
|
|
End Property ' SFDocuments.SF_Form.OnApproveRowChange (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnApproveSubmit() As Variant
|
|
''' The OnApproveSubmit property specifies the script to trigger when this event occurs
|
|
OnApproveSubmit = _PropertyGet("OnApproveSubmit")
|
|
End Property ' SFDocuments.SF_Form.OnApproveSubmit (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnApproveSubmit(Optional ByVal pvOnApproveSubmit As Variant)
|
|
''' Set the updatable property OnApproveSubmit
|
|
_PropertySet("OnApproveSubmit", pvOnApproveSubmit)
|
|
End Property ' SFDocuments.SF_Form.OnApproveSubmit (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnConfirmDelete() As Variant
|
|
''' The OnConfirmDelete property specifies the script to trigger when this event occurs
|
|
OnConfirmDelete = _PropertyGet("OnConfirmDelete")
|
|
End Property ' SFDocuments.SF_Form.OnConfirmDelete (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnConfirmDelete(Optional ByVal pvOnConfirmDelete As Variant)
|
|
''' Set the updatable property OnConfirmDelete
|
|
_PropertySet("OnConfirmDelete", pvOnConfirmDelete)
|
|
End Property ' SFDocuments.SF_Form.OnConfirmDelete (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnCursorMoved() As Variant
|
|
''' The OnCursorMoved property specifies the script to trigger when this event occurs
|
|
OnCursorMoved = _PropertyGet("OnCursorMoved")
|
|
End Property ' SFDocuments.SF_Form.OnCursorMoved (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnCursorMoved(Optional ByVal pvOnCursorMoved As Variant)
|
|
''' Set the updatable property OnCursorMoved
|
|
_PropertySet("OnCursorMoved", pvOnCursorMoved)
|
|
End Property ' SFDocuments.SF_Form.OnCursorMoved (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnErrorOccurred() As Variant
|
|
''' The OnErrorOccurred property specifies the script to trigger when this event occurs
|
|
OnErrorOccurred = _PropertyGet("OnErrorOccurred")
|
|
End Property ' SFDocuments.SF_Form.OnErrorOccurred (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnErrorOccurred(Optional ByVal pvOnErrorOccurred As Variant)
|
|
''' Set the updatable property OnErrorOccurred
|
|
_PropertySet("OnErrorOccurred", pvOnErrorOccurred)
|
|
End Property ' SFDocuments.SF_Form.OnErrorOccurred (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnLoaded() As Variant
|
|
''' The OnLoaded property specifies the script to trigger when this event occurs
|
|
OnLoaded = _PropertyGet("OnLoaded")
|
|
End Property ' SFDocuments.SF_Form.OnLoaded (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnLoaded(Optional ByVal pvOnLoaded As Variant)
|
|
''' Set the updatable property OnLoaded
|
|
_PropertySet("OnLoaded", pvOnLoaded)
|
|
End Property ' SFDocuments.SF_Form.OnLoaded (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnReloaded() As Variant
|
|
''' The OnReloaded property specifies the script to trigger when this event occurs
|
|
OnReloaded = _PropertyGet("OnReloaded")
|
|
End Property ' SFDocuments.SF_Form.OnReloaded (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnReloaded(Optional ByVal pvOnReloaded As Variant)
|
|
''' Set the updatable property OnReloaded
|
|
_PropertySet("OnReloaded", pvOnReloaded)
|
|
End Property ' SFDocuments.SF_Form.OnReloaded (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnReloading() As Variant
|
|
''' The OnReloading property specifies the script to trigger when this event occurs
|
|
OnReloading = _PropertyGet("OnReloading")
|
|
End Property ' SFDocuments.SF_Form.OnReloading (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnReloading(Optional ByVal pvOnReloading As Variant)
|
|
''' Set the updatable property OnReloading
|
|
_PropertySet("OnReloading", pvOnReloading)
|
|
End Property ' SFDocuments.SF_Form.OnReloading (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnResetted() As Variant
|
|
''' The OnResetted property specifies the script to trigger when this event occurs
|
|
OnResetted = _PropertyGet("OnResetted")
|
|
End Property ' SFDocuments.SF_Form.OnResetted (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnResetted(Optional ByVal pvOnResetted As Variant)
|
|
''' Set the updatable property OnResetted
|
|
_PropertySet("OnResetted", pvOnResetted)
|
|
End Property ' SFDocuments.SF_Form.OnResetted (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnRowChanged() As Variant
|
|
''' The OnRowChanged property specifies the script to trigger when this event occurs
|
|
OnRowChanged = _PropertyGet("OnRowChanged")
|
|
End Property ' SFDocuments.SF_Form.OnRowChanged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnRowChanged(Optional ByVal pvOnRowChanged As Variant)
|
|
''' Set the updatable property OnRowChanged
|
|
_PropertySet("OnRowChanged", pvOnRowChanged)
|
|
End Property ' SFDocuments.SF_Form.OnRowChanged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnUnloaded() As Variant
|
|
''' The OnUnloaded property specifies the script to trigger when this event occurs
|
|
OnUnloaded = _PropertyGet("OnUnloaded")
|
|
End Property ' SFDocuments.SF_Form.OnUnloaded (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnUnloaded(Optional ByVal pvOnUnloaded As Variant)
|
|
''' Set the updatable property OnUnloaded
|
|
_PropertySet("OnUnloaded", pvOnUnloaded)
|
|
End Property ' SFDocuments.SF_Form.OnUnloaded (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnUnloading() As Variant
|
|
''' The OnUnloading property specifies the script to trigger when this event occurs
|
|
OnUnloading = _PropertyGet("OnUnloading")
|
|
End Property ' SFDocuments.SF_Form.OnUnloading (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnUnloading(Optional ByVal pvOnUnloading As Variant)
|
|
''' Set the updatable property OnUnloading
|
|
_PropertySet("OnUnloading", pvOnUnloading)
|
|
End Property ' SFDocuments.SF_Form.OnUnloading (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OrderBy() As Variant
|
|
''' The OrderBy property specifies in which order the records should be displayed.
|
|
OrderBy = _PropertyGet("OrderBy")
|
|
End Property ' SFDocuments.SF_Form.OrderBy (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OrderBy(Optional ByVal pvOrderBy As Variant)
|
|
''' Set the updatable property OrderBy
|
|
_PropertySet("OrderBy", pvOrderBy)
|
|
End Property ' SFDocuments.SF_Form.OrderBy (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Parent() As Object
|
|
''' Return the Parent of the actual Form
|
|
Parent = _PropertyGet("Parent")
|
|
End Property ' SFDocuments.SF_Form.Parent
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get RecordSource() As Variant
|
|
''' The RecordSource property specifies the source of the data,
|
|
''' a table name, a query name or a SQL statement
|
|
RecordSource = _PropertyGet("RecordSource")
|
|
End Property ' SFDocuments.SF_Form.RecordSource (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let RecordSource(Optional ByVal pvRecordSource As Variant)
|
|
''' Set the updatable property RecordSource
|
|
_PropertySet("RecordSource", pvRecordSource)
|
|
End Property ' SFDocuments.SF_Form.RecordSource (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XForm() As Object
|
|
''' The XForm property returns the XForm UNO object of the Form
|
|
XForm = _PropertyGet("XForm")
|
|
End Property ' SFDocuments.SF_Form.XForm (get)
|
|
|
|
REM ===================================================================== METHODS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Activate() As Boolean
|
|
''' Set the focus on the current Form instance
|
|
''' Probably called from after an event occurrence or to focus on an open Base form document
|
|
''' If the parent document is ...
|
|
''' Calc Activate the corresponding sheet
|
|
''' Writer Activate the parent document
|
|
''' Base Activate the parent form document
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if focusing is successful
|
|
''' Example:
|
|
''' myForm.Activate()
|
|
|
|
Dim bActivate As Boolean ' Return value
|
|
Dim oContainer As Object ' com.sun.star.awt.XWindow
|
|
Const cstThisSub = "SFDocuments.Form.Activate"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bActivate = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
Select Case _FormType
|
|
Case ISDOCFORM : bActivate = [_Parent].Activate()
|
|
Case ISCALCFORM : bActivate = [_Parent].Activate(_SheetName)
|
|
Case ISBASEFORM
|
|
Set oContainer = _FormDocument.Component.CurrentController.Frame.ContainerWindow
|
|
With oContainer
|
|
If .isVisible() = False Then .setVisible(True)
|
|
.IsMinimized = False
|
|
.setFocus()
|
|
.toFront() ' Force window change in Linux
|
|
Wait 1 ' Bypass desynchro issue in Linux
|
|
End With
|
|
bActivate = True
|
|
End Select
|
|
|
|
Finally:
|
|
Activate = bActivate
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.Activate
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CloseFormDocument() As Boolean
|
|
''' Close the form document containing the actual form instance
|
|
''' The form instance is disposed
|
|
''' The method does nothing if the actual form is not located in a Base form document
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if closure is successful
|
|
''' Example:
|
|
''' myForm.CloseFormDocument()
|
|
|
|
Dim bClose As Boolean ' Return value
|
|
Dim oContainer As Object ' com.sun.star.awt.XWindow
|
|
Const cstThisSub = "SFDocuments.Form.CloseFormDocument"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bClose = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
Select Case _FormType
|
|
Case ISDOCFORM, ISCALCFORM
|
|
Case ISBASEFORM, ISSUBFORM
|
|
If Not IsNull(_FormDocument) Then
|
|
_FormDocument.close()
|
|
Dispose()
|
|
bClose = True
|
|
End If
|
|
Case Else
|
|
End Select
|
|
|
|
Finally:
|
|
CloseFormDocument = bClose
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.CloseFormDocument
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Controls(Optional ByVal ControlName As Variant) As Variant
|
|
''' Return either
|
|
''' - the list of the controls contained in the Form
|
|
''' - a Form control object based on its name
|
|
''' Args:
|
|
''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
|
|
''' Returns:
|
|
''' A zero-base array of strings if ControlName is absent
|
|
''' An instance of the SF_FormControl class if ControlName exists
|
|
''' Exceptions:
|
|
''' ControlName is invalid
|
|
''' Example:
|
|
''' Dim myForm As Object, myList As Variant, myControl As Object
|
|
''' Set myForm = myDoc.Forms("myForm")
|
|
''' myList = myForm.Controls()
|
|
''' Set myControl = myForm.Controls("myTextBox")
|
|
|
|
Dim oControl As Object ' The new control class instance
|
|
Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache
|
|
Dim vControl As Variant ' Alias of _ControlCache entry
|
|
Dim i As Long
|
|
Const cstThisSub = "SFDocuments.Form.Controls"
|
|
Const cstSubArgs = "[ControlName]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Collect all control names if not yet done
|
|
If UBound(_ControlNames) < 0 Then
|
|
_ControlNames = _Form.getElementNames()
|
|
' Remove all subforms from the list
|
|
For i = 0 To UBound(_ControlNames)
|
|
' Subforms have no ClassId property
|
|
If Not ScriptForge.SF_Session.HasUnoProperty(_Form.getByName(_ControlNames(i)), "ClassId") Then _ControlNames(i) = ""
|
|
Next i
|
|
_ControlNames = ScriptForge.SF_Array.TrimArray(_ControlNames)
|
|
' Size the cache accordingly
|
|
If UBound(_ControlNames) >= 0 Then
|
|
ReDim _ControlCache(0 To UBound(_ControlNames))
|
|
End If
|
|
End If
|
|
|
|
' Return the list of controls or a FormControl instance
|
|
If Len(ControlName) = 0 Then
|
|
Controls = _ControlNames
|
|
|
|
Else
|
|
|
|
If Not _Form.hasByName(ControlName) Then GoTo CatchNotFound
|
|
lIndexOfNames = ScriptForge.SF_Array.IndexOf(_ControlNames, ControlName, CaseSensitive := True)
|
|
' Reuse cache when relevant
|
|
vControl = _ControlCache(lIndexOfNames)
|
|
|
|
If IsEmpty(vControl) Then
|
|
' Create the new form control class instance
|
|
Set oControl = New SF_FormControl
|
|
With oControl
|
|
._Name = ControlName
|
|
Set .[Me] = oControl
|
|
Set .[_Parent] = [Me]
|
|
Set ._ParentForm = [Me]
|
|
._IndexOfNames = lIndexOfNames
|
|
._FormName = _Name
|
|
' Get model and view of the current control
|
|
Set ._ControlModel = _Form.getByName(ControlName)
|
|
._Initialize()
|
|
End With
|
|
Else
|
|
Set oControl = vControl
|
|
End If
|
|
|
|
Set Controls = oControl
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotFound:
|
|
ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _Form.getElementNames(), True)
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.Controls
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetDatabase(Optional ByVal User As Variant _
|
|
, Optional ByVal Password As Variant _
|
|
) As Object
|
|
''' Returns a Database instance (service = SFDatabases.Database) giving access
|
|
''' to the execution of SQL commands on the database defined and/or stored in
|
|
''' the actual Base document
|
|
''' Each main form has its own database connection, except within Base documents where
|
|
''' they all share the same connection
|
|
''' Args:
|
|
''' User, Password: the login parameters as strings. Defaults = ""
|
|
''' Returns:
|
|
''' A SFDatabases.Database instance or Nothing
|
|
''' Exceptions:
|
|
''' DBCONNECTERROR The database could not be connected, credentials are probably wrong
|
|
''' Example:
|
|
''' Dim myDb As Object
|
|
''' Set myDb = oForm.GetDatabase()
|
|
|
|
Dim FSO As Object ' Alias for SF_FileSystem
|
|
Dim sDataSource As String ' Database file name in FileNaming format
|
|
Dim sUser As String ' Alias for User
|
|
Dim sPassword As String ' Alias for Password
|
|
Const cstThisSub = "SFDocuments.Form.GetDatabase"
|
|
Const cstSubArgs = "[User=""""], [Password=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set GetDatabase = Nothing
|
|
|
|
Check:
|
|
If IsMissing(User) Or IsEmpty(User) Then User = ""
|
|
If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not [_Parent]._IsStillAlive(False) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(User, "User", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Adjust connection arguments
|
|
If Len(User) = 0 Then
|
|
If ScriptForge.SF_Session.HasUnoProperty(_Form, "User") Then sUser = _Form.User Else sUser = ""
|
|
Else
|
|
sUser = User
|
|
End If
|
|
If Len(sUser) + Len(Password) = 0 Then
|
|
If ScriptForge.SF_Session.HasUnoProperty(_Form, "Password") Then sPassword = _Form.Password Else sPassword = Password
|
|
End If
|
|
|
|
' Connect to database, avoiding multiple requests
|
|
If IsNull(_Database) Then ' 1st connection request from the current form instance
|
|
If _FormType = ISBASEFORM And Not IsNull(_BaseComponent) Then
|
|
' Fetch the shared connection
|
|
Set _Database = [_Parent].GetDatabase(User, Password)
|
|
ElseIf _FormType = ISSUBFORM Then
|
|
Set _Database = [_Parent].GetDatabase() ' Recursive call, climb the tree
|
|
ElseIf Len(_Form.DataSourceName) = 0 Then ' There is no database linked with the form
|
|
' Return Nothing
|
|
Else
|
|
' Check if DataSourceName is a file or a registered name and create database instance accordingly
|
|
Set FSO = ScriptForge.SF_FileSystem
|
|
sDataSource = FSO._ConvertFromUrl(_Form.DataSourceName)
|
|
If FSO.FileExists(sDataSource) Then
|
|
Set _Database = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _
|
|
, sDataSource, , , sUser, sPassword)
|
|
Else
|
|
Set _Database = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _
|
|
, , _Form.DataSourceName, , sUser, sPassword)
|
|
End If
|
|
If IsNull(_Database) Then GoTo CatchConnect
|
|
End If
|
|
Else
|
|
EndIf
|
|
|
|
Finally:
|
|
Set GetDatabase = _Database
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchConnect:
|
|
ScriptForge.SF_Exception.RaiseFatal(DBCONNECTERROR, "User", User, "Password", Password, [_Super]._FileIdent())
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.GetDatabase
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
|
|
''' Return the actual value of the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Returns:
|
|
''' The actual value of the property
|
|
''' Exceptions:
|
|
''' ARGUMENTERROR The property does not exist
|
|
''' Examples:
|
|
''' oDlg.GetProperty("Caption")
|
|
|
|
Const cstThisSub = "SFDocuments.Form.GetProperty"
|
|
Const cstSubArgs = ""
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
GetProperty = Null
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
GetProperty = _PropertyGet(PropertyName)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.GetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Methods() As Variant
|
|
''' Return the list of public methods of the Form service as an array
|
|
|
|
Methods = Array( _
|
|
"Activate" _
|
|
, "CloseForm" _
|
|
, "Controls" _
|
|
, "GetDatabase" _
|
|
, "MoveFirst" _
|
|
, "MoveLast" _
|
|
, "MoveNew" _
|
|
, "MoveNext" _
|
|
, "MovePrevious" _
|
|
, "Requery" _
|
|
, "SubForms" _
|
|
)
|
|
|
|
End Function ' SFDocuments.SF_Form.Methods
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveFirst() As Boolean
|
|
''' The cursor is (re)positioned on the first row
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if cursor move is successful
|
|
''' Example:
|
|
''' myForm.MoveFirst()
|
|
|
|
Dim bMoveFirst As Boolean ' Return value
|
|
Const cstThisSub = "SFDocuments.Form.MoveFirst"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMoveFirst = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
With _Form
|
|
bMoveFirst = .first()
|
|
End With
|
|
|
|
Finally:
|
|
MoveFirst = bMoveFirst
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.MoveFirst
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveLast() As Boolean
|
|
''' The cursor is (re)positioned on the last row
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if cursor move is successful
|
|
''' Example:
|
|
''' myForm.MoveLast()
|
|
|
|
Dim bMoveLast As Boolean ' Return value
|
|
Const cstThisSub = "SFDocuments.Form.MoveLast"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMoveLast = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
With _Form
|
|
bMoveLast = .last()
|
|
End With
|
|
|
|
Finally:
|
|
MoveLast = bMoveLast
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.MoveLast
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveNew() As Boolean
|
|
''' The cursor is (re)positioned in the new record area
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if cursor move is successful
|
|
''' Example:
|
|
''' myForm.MoveNew()
|
|
|
|
Dim bMoveNew As Boolean ' Return value
|
|
Const cstThisSub = "SFDocuments.Form.MoveNew"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMoveNew = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
With _Form
|
|
.last() ' To simulate the behaviour in the UI
|
|
.moveToInsertRow()
|
|
End With
|
|
bMoveNew = True
|
|
|
|
Finally:
|
|
MoveNew = bMoveNew
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.MoveNew
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveNext(Optional ByVal Offset As Variant) As Boolean
|
|
''' The cursor is (re)positioned on the next row
|
|
''' Args:
|
|
''' Offset: The number of records to go forward (default = 1)
|
|
''' Returns:
|
|
''' True if cursor move is successful
|
|
''' Example:
|
|
''' myForm.MoveNext()
|
|
|
|
Dim bMoveNext As Boolean ' Return value
|
|
Dim lOffset As Long ' Alias of Offset
|
|
Const cstThisSub = "SFDocuments.Form.MoveNext"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMoveNext = False
|
|
|
|
Check:
|
|
If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
Try:
|
|
lOffset = CLng(Offset) ' To be sure to have the right argument type
|
|
With _Form
|
|
If lOffset = 1 Then bMoveNext = .next() Else bMoveNext = .relative(lOffset)
|
|
End With
|
|
|
|
Finally:
|
|
MoveNext = bMoveNext
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.MoveNext
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MovePrevious(Optional ByVal Offset As Variant) As Boolean
|
|
''' The cursor is (re)positioned on the previous row
|
|
''' Args:
|
|
''' Offset: The number of records to go backward (default = 1)
|
|
''' Returns:
|
|
''' True if cursor move is successful
|
|
''' Example:
|
|
''' myForm.MovePrevious()
|
|
|
|
Dim bMovePrevious As Boolean ' Return value
|
|
Dim lOffset As Long ' Alias of Offset
|
|
Const cstThisSub = "SFDocuments.Form.MovePrevious"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMovePrevious = False
|
|
|
|
Check:
|
|
If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
Try:
|
|
lOffset = CLng(Offset) ' To be sure to have the right argument type
|
|
With _Form
|
|
If lOffset = 1 Then bMovePrevious = .previous() Else bMovePrevious = .relative(-lOffset)
|
|
End With
|
|
|
|
Finally:
|
|
MovePrevious = bMovePrevious
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.MovePrevious
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Properties() As Variant
|
|
''' Return the list or properties of the Form class as an array
|
|
|
|
Properties = Array( _
|
|
"AllowDeletes" _
|
|
, "AllowInserts" _
|
|
, "AllowUpdates" _
|
|
, "BaseForm" _
|
|
, "Bookmark" _
|
|
, "CurrentRecord" _
|
|
, "Filter" _
|
|
, "LinkChildFields" _
|
|
, "LinkParentFields" _
|
|
, "Name" _
|
|
, "OnApproveCursorMove" _
|
|
, "OnApproveParameter" _
|
|
, "OnApproveReset" _
|
|
, "OnApproveRowChange" _
|
|
, "OnApproveSubmit" _
|
|
, "OnConfirmDelete" _
|
|
, "OnCursorMoved" _
|
|
, "OnErrorOccurred" _
|
|
, "OnLoaded" _
|
|
, "OnReloaded" _
|
|
, "OnReloading" _
|
|
, "OnResetted" _
|
|
, "OnRowChanged" _
|
|
, "OnUnloaded" _
|
|
, "OnUnloading" _
|
|
, "OrderBy" _
|
|
, "Parent" _
|
|
, "RecordSource" _
|
|
, "XForm" _
|
|
)
|
|
|
|
End Function ' SFDocuments.SF_Form.Properties
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Requery() As Boolean
|
|
''' Reload from the database the actual data into the form
|
|
''' The cursor is (re)positioned on the first row
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if requery is successful
|
|
''' Example:
|
|
''' myForm.Requery()
|
|
|
|
Dim bRequery As Boolean ' Return value
|
|
Const cstThisSub = "SFDocuments.Form.Requery"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bRequery = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
With _Form
|
|
If .isLoaded() Then .reload() Else .load()
|
|
End With
|
|
bRequery = True
|
|
|
|
Finally:
|
|
Requery = bRequery
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.Requery
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetProperty(Optional ByVal PropertyName As Variant _
|
|
, Optional ByRef Value As Variant _
|
|
) As Boolean
|
|
''' Set a new value to the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Value: its new value
|
|
''' Exceptions
|
|
''' ARGUMENTERROR The property does not exist
|
|
|
|
Const cstThisSub = "SFDocuments.Form.SetProperty"
|
|
Const cstSubArgs = "PropertyName, Value"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
SetProperty = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
SetProperty = _PropertySet(PropertyName, Value)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.SetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Subforms(Optional ByVal Subform As Variant) As Variant
|
|
''' Return either
|
|
''' - the list of the subforms contained in the actual form or subform instance
|
|
''' - a SFDocuments.Form object based on its name or its index in the alphabetic list of subforms
|
|
''' Args:
|
|
''' Subform: a subform stored in the parent form given by its name or its index
|
|
''' When absent, the list of available subforms is returned
|
|
''' To get the first (unique ?) subform stored in the parent form, set Subform = 0
|
|
''' Exceptions:
|
|
''' SUBFORMNOTFOUNDERROR Subform not found
|
|
''' Returns:
|
|
''' A zero-based array of strings if Subform is absent
|
|
''' An instance of the SF_Form class if Subform exists
|
|
''' Example:
|
|
''' Dim myForm As Object, myList As Variant, mySubform As Object
|
|
''' myList = myForm.Subforms()
|
|
''' Set mySubform = myForm.Subforms("mySubform")
|
|
|
|
Dim oSubform As Object ' The new Form class instance
|
|
Dim oXSubform As Object ' com.sun.star.form.XForm
|
|
Dim vSubformNames As Variant ' Array of subform names
|
|
Dim i As Long
|
|
Const cstDrawPage = 0 ' Only 1 drawpage in a Writer document
|
|
|
|
Const cstThisSub = "SFDocuments.Form.Subforms"
|
|
Const cstSubArgs = "[Subform=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(Subform) Or IsEmpty(Subform) Then Subform = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Subform, "Subform", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Collect all control names and retain only the subforms
|
|
vSubformNames = _Form.getElementNames()
|
|
For i = 0 To UBound(vSubformNames)
|
|
Set oSubform = _Form.getByName(vSubformNames(i))
|
|
' Subforms are the only control types having no ClassId property
|
|
If ScriptForge.SF_Session.HasUnoProperty(oSubform, "ClassId") Then vSubformNames(i) = ""
|
|
Next i
|
|
vSubformNames = ScriptForge.SF_Array.TrimArray(vSubformNames)
|
|
|
|
If Len(Subform) = 0 Then ' Return the list of valid subform names
|
|
Subforms = vSubformNames
|
|
Else
|
|
If VarType(Subform) = V_STRING Then ' Find the form by name
|
|
If Not ScriptForge.SF_Array.Contains(vSubformNames, Subform, CaseSensitive := True) Then GoTo CatchNotFound
|
|
Set oXSubform = _Form.getByName(Subform)
|
|
Else ' Find the form by index
|
|
If Subform < 0 Or Subform > UBound(vSubformNames) Then GoTo CatchNotFound
|
|
Set oXSubform = _Form.getByName(vSubformNames(Subform))
|
|
End If
|
|
' Create the new Form class instance
|
|
Set oSubform = SF_Register._NewForm(oXSubform)
|
|
With oSubform
|
|
Set .[_Parent] = [Me]
|
|
._FormType = ISSUBFORM
|
|
Set ._Component = _Component
|
|
Set ._BaseComponent = _BaseComponent
|
|
Set ._FormDocument = _FormDocument
|
|
._SheetName = _SheetName
|
|
._FormDocumentName = _FormDocumentName
|
|
Set ._Database = _Database
|
|
._Initialize()
|
|
End With
|
|
Set Subforms = oSubform
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotFound:
|
|
ScriptForge.SF_Exception.RaiseFatal(SUBFORMNOTFOUNDERROR, Subform, _Name)
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.Subforms
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _GetEventName(ByVal psProperty As String) As String
|
|
''' Return the LO internal event name derived from the SF property name
|
|
''' The SF property name is not case sensitive, while the LO name is case-sensitive
|
|
' Corrects the typo on ErrorOccur(r?)ed, if necessary
|
|
|
|
Dim vProperties As Variant ' Array of class properties
|
|
Dim sProperty As String ' Correctly cased property name
|
|
|
|
vProperties = Properties()
|
|
sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
|
|
|
|
_GetEventName = LCase(Mid(sProperty, 3, 1)) & Right(sProperty, Len(sProperty) - 3)
|
|
|
|
End Function ' SFDocuments.SF_Form._GetEventName
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _GetListener(ByVal psEventName As String) As String
|
|
''' Getting/Setting macros triggered by events requires a Listener-EventName pair
|
|
''' Return the X...Listener corresponding with the event name in argument
|
|
|
|
Select Case UCase(psEventName)
|
|
Case UCase("OnApproveCursorMove")
|
|
_GetListener = "XRowSetApproveListener"
|
|
Case UCase("OnApproveParameter")
|
|
_GetListener = "XDatabaseParameterListener"
|
|
Case UCase("OnApproveReset"), UCase("OnResetted")
|
|
_GetListener = "XResetListener"
|
|
Case UCase("OnApproveRowChange")
|
|
_GetListener = "XRowSetApproveListener"
|
|
Case UCase("OnApproveSubmit")
|
|
_GetListener = "XSubmitListener"
|
|
Case UCase("OnConfirmDelete")
|
|
_GetListener = "XConfirmDeleteListener"
|
|
Case UCase("OnCursorMoved"), UCase("OnRowChanged")
|
|
_GetListener = "XRowSetListener"
|
|
Case UCase("OnErrorOccurred")
|
|
_GetListener = "XSQLErrorListener"
|
|
Case UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnUnloaded"), UCase("OnUnloading")
|
|
_GetListener = "XLoadListener"
|
|
End Select
|
|
|
|
End Function ' SFDocuments.SF_Form._GetListener
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub _GetParents()
|
|
''' When the current instance is created top-down, the parents are completely defined
|
|
''' and nothing should be done in this method
|
|
''' When the a class instance is created in a (form/control) event, it is the opposite
|
|
''' The current method rebuilds the missing members in the instance from the bottom
|
|
''' Members potentially to collect are:
|
|
''' - _FormType
|
|
''' - [_Parent], the immediate parent: a form or a document instance
|
|
''' + Only when the _FormType is a main form
|
|
''' - _SheetName (Calc only)
|
|
''' - _FormDocumentName (Base only)
|
|
''' - _FormDocument, the topmost form collection
|
|
''' - _Component, the containing document
|
|
''' They must be identified only starting from the _Form UNO object
|
|
'''
|
|
''' The method is called from the _Initialize() method at instance creation
|
|
|
|
Dim oParent As Object ' Successive bottom-up parents
|
|
Dim sType As String ' UNO object type
|
|
Dim iLevel As Integer ' When = 1 => first parent
|
|
Dim oBase As Object ' Empty Base instance
|
|
Dim oSession As Object : Set oSession = ScriptForge.SF_Session
|
|
|
|
On Local Error GoTo Finally ' Being probably called from events, this method should avoid failures
|
|
' When the form type is known, the upper part of the branch is not scanned
|
|
If _FormType <> ISUNDEFINED Then GoTo Finally
|
|
|
|
Try:
|
|
' The whole branch is scanned bottom-up
|
|
If oSession.HasUnoProperty(_Form, "Parent") Then Set oParent = _Form.Parent Else Set oParent = Nothing
|
|
_FormType = ISUNDEFINED
|
|
iLevel = 1
|
|
|
|
Do While Not IsNull(oParent)
|
|
sType = SF_Session.UnoObjectType(oParent)
|
|
Select Case sType
|
|
' Collect at each level the needed info
|
|
Case "com.sun.star.comp.forms.ODatabaseForm" ' The parent _Form of a subform
|
|
If iLevel = 1 Then
|
|
_FormType = ISSUBFORM
|
|
Set [_Parent] = SF_Register._NewForm(oParent)
|
|
' Everything is in the parent, copy items and stop scan
|
|
[_Parent]._Initialize() ' Current method is called recursively here
|
|
With [_Parent]
|
|
_SheetName = ._SheetName
|
|
_FormDocumentName = ._FormDocumentName
|
|
Set _FormDocument = ._FormDocument
|
|
Set _Component = ._Component
|
|
End With
|
|
Exit Sub
|
|
End If
|
|
Case "com.sun.star.form.OFormsCollection" ' The collection of forms inside a drawpage
|
|
Case "SwXTextDocument" ' The parent document: a Writer document or a Base form document
|
|
If oParent.Identifier = "com.sun.star.sdb.FormDesign" Then
|
|
_FormType = ISBASEFORM
|
|
' Make a new SF_FormDocument instance
|
|
Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.FormDocument", oParent)
|
|
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> |