3044d81586
Context: Base documents. In a form or formcontrol event, a user script might need the name of the form document in which the form or control is located, f.i. to close it. The name of the form document is supposed to be found in the SF_Form.BaseForm property. The property is set correctly when the Base form document to form/formcontrol path is taken (top-down), not when the opposite path is taken (bottom-up), typically in events. In the latter case BaseForm is equal to an empty string. The actual commit initializes correctly the BaseForm property with the hierarchical name of the form document. Change-Id: Icdee6ee9909f577f6c01ba96864fe3d6eaf3e750 Reviewed-on: https://gerrit.libreoffice.org/c/core/+/131618 Tested-by: Jean-Pierre Ledure <jp@ledure.be> Tested-by: Jenkins Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
1535 lines
No EOL
68 KiB
XML
1535 lines
No EOL
68 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:
|
|
''' For usual documents, there is only 1 form document. It is in fact the document itself.
|
|
''' A Base document may contain an unlimited number of form documents.
|
|
''' In the Base terminology they are called "forms" or "Base forms". This could create some confusion.
|
|
''' They can be organized in folders. Their name is then always the full path of folders + form
|
|
''' with the slash ("/") as path separator
|
|
''' A FormDocument is a set of Forms. Form names are visible in the user interface thanks to the form navigator
|
|
''' Often there is only 1 Form present in a FormDocument. Having more, however, might improve
|
|
''' the user experience significantly
|
|
'''
|
|
''' Form: WHERE IT IS ABOUT IN THE CURRENT "Form" SERVICE
|
|
''' Is an abstract set of Controls in an OPEN FormDocument
|
|
''' Each form is usually linked to one single dataset (table, query or Select statement),
|
|
''' located in any database (provided the user may access it)
|
|
''' A usual document may contain several forms. Each of which may have its own data source (database + dataset)
|
|
''' A Base form document may contain several forms. Each of which may address its own dataset. The database however is unique
|
|
''' A form is defined by its owning FormDocument and its FormName or FormIndex
|
|
'''
|
|
''' Service invocations:
|
|
'''
|
|
''' REM the form is stored in a not-Base document (Calc, Writer)
|
|
''' Dim oDoc As Object, myForm As Object
|
|
''' Set oDoc = CreateScriptService("SFDocuments.Document", ThisComponent)
|
|
''' Set myForm = oDoc.Forms("Form1")
|
|
''' ' or, alternatively, when there is only 1 form
|
|
''' Set myForm = oDoc.Forms(0)
|
|
'''
|
|
''' REM the form is stored in one of the FormDocuments of a Base document
|
|
''' Dim oDoc As Object, myForm As Object, mySubForm As Object
|
|
''' Set oDoc = CreateScriptService("SFDocuments.Document", ThisDatabaseDocument)
|
|
''' oDoc.OpenFormDocument("thisFormDocument")
|
|
''' Set myForm = oDoc.Forms("thisFormDocument", "MainForm")
|
|
''' ' or, alternatively, when there is only 1 form
|
|
''' Set myForm = oDoc.Forms("thisFormDocument", 0)
|
|
''' ' To access a subform: myForm and mySubForm become distinct instances of the current class
|
|
''' Set mySubForm = myForm.SubForms("mySubForm")
|
|
'''
|
|
''' REM the form is the subject of an event
|
|
''' Sub OnEvent(ByRef poEvent As Object)
|
|
''' Dim myForm As Object
|
|
''' Set myForm = CreateScriptService("SFDocuments.FormEvent", poEvent)
|
|
'''
|
|
''' Detailed user documentation:
|
|
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_form.html?DbPAR=BASIC
|
|
'''
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
Private Const FORMDEADERROR = "FORMDEADERROR"
|
|
Private Const SUBFORMNOTFOUNDERROR = "SUBFORMNOTFOUNDERROR"
|
|
|
|
REM ============================================================= PRIVATE MEMBERS
|
|
|
|
Private [Me] As Object
|
|
Private [_Parent] As Object
|
|
Private ObjectType As String ' Must be Form
|
|
Private ServiceName As String
|
|
|
|
' Form location
|
|
Private _Name As String ' Internal name of the form
|
|
Private _FormType As Integer ' One of the ISxxxFORM constants
|
|
Private _SheetName As String ' Name as the sheet containing the form (Calc only)
|
|
Private _FormDocumentName As String ' The hierarchical name of the containing form document (Base only)
|
|
Private _FormDocument As Object ' com.sun.star.comp.sdb.Content - the containing form document
|
|
' The form topmost container
|
|
Private _Component As Object ' com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument
|
|
|
|
' Events management
|
|
Private _CacheIndex As Long ' Index in central cache storage
|
|
|
|
' Form UNO references
|
|
' The entry to the interactions with the form. Validity checked by the _IsStillAlive() method
|
|
' Each method or property requiring that the form is opened should first invoke that method
|
|
Private _Form As Object ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
|
|
Private _Database As Object ' Database class instance
|
|
|
|
' Form attributes
|
|
|
|
' Cache storage for controls
|
|
Private _ControlNames As Variant ' Array of control names
|
|
Private _ControlCache As Variant ' Array of control objects sorted like ElementNames of XForm
|
|
|
|
REM ============================================================ MODULE CONSTANTS
|
|
|
|
Const ISDOCFORM = 1 ' Form is stored in a Writer document
|
|
Const ISCALCFORM = 2 ' Form is stored in a Calc document
|
|
Const ISBASEFORM = 3 ' Form is stored in a Base document
|
|
Const ISSUBFORM = 4 ' Form is a subform of a form or of another subform
|
|
Const ISUNDEFINED = -1 ' Undefined form type
|
|
|
|
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Initialize()
|
|
Set [Me] = Nothing
|
|
Set [_Parent] = Nothing
|
|
ObjectType = "FORM"
|
|
ServiceName = "SFDocuments.Form"
|
|
_Name = ""
|
|
_SheetName = ""
|
|
_FormDocumentName = ""
|
|
Set _FormDocument = Nothing
|
|
_FormType = ISUNDEFINED
|
|
_CacheIndex = -1
|
|
Set _Form = Nothing
|
|
Set _Database = Nothing
|
|
_ControlNames = Array()
|
|
_ControlCache = Array()
|
|
End Sub ' SFDocuments.SF_Form Constructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Terminate()
|
|
Call Class_Initialize()
|
|
End Sub ' SFDocuments.SF_Form Destructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Dispose() As Variant
|
|
If Not IsNull(_Database) And (_FormType = ISDOCFORM Or _FormType = ISCALCFORM) Then
|
|
Set _Database = _Database.Dispose()
|
|
End If
|
|
SF_Register._CleanCacheEntry(_CacheIndex)
|
|
Call Class_Terminate()
|
|
Set Dispose = Nothing
|
|
End Function ' SFDocuments.SF_Form Explicit Destructor
|
|
|
|
REM ================================================================== PROPERTIES
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get AllowDeletes() As Variant
|
|
''' The AllowDeletes property specifies if the form allows to delete records
|
|
AllowDeletes = _PropertyGet("AllowDeletes")
|
|
End Property ' SFDocuments.SF_Form.AllowDeletes (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let AllowDeletes(Optional ByVal pvAllowDeletes As Variant)
|
|
''' Set the updatable property AllowDeletes
|
|
_PropertySet("AllowDeletes", pvAllowDeletes)
|
|
End Property ' SFDocuments.SF_Form.AllowDeletes (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get AllowInserts() As Variant
|
|
''' The AllowInserts property specifies if the form allows to add records
|
|
AllowInserts = _PropertyGet("AllowInserts")
|
|
End Property ' SFDocuments.SF_Form.AllowInserts (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let AllowInserts(Optional ByVal pvAllowInserts As Variant)
|
|
''' Set the updatable property AllowInserts
|
|
_PropertySet("AllowInserts", pvAllowInserts)
|
|
End Property ' SFDocuments.SF_Form.AllowInserts (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get AllowUpdates() As Variant
|
|
''' The AllowUpdates property specifies if the form allows to update records
|
|
AllowUpdates = _PropertyGet("AllowUpdates")
|
|
End Property ' SFDocuments.SF_Form.AllowUpdates (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let AllowUpdates(Optional ByVal pvAllowUpdates As Variant)
|
|
''' Set the updatable property AllowUpdates
|
|
_PropertySet("AllowUpdates", pvAllowUpdates)
|
|
End Property ' SFDocuments.SF_Form.AllowUpdates (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get BaseForm() As String
|
|
''' The BaseForm property specifies the hierarchical name of the Base form containing the actual form
|
|
BaseForm = _PropertyGet("BaseForm")
|
|
End Property ' SFDocuments.SF_Form.BaseForm (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Bookmark() As Variant
|
|
''' The Bookmark property specifies uniquely the current record of the form's underlying table, query or SQL statement.
|
|
Bookmark = _PropertyGet("Bookmark")
|
|
End Property ' SFDocuments.SF_Form.Bookmark (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Bookmark(Optional ByVal pvBookmark As Variant)
|
|
''' Set the updatable property Bookmark
|
|
_PropertySet("Bookmark", pvBookmark)
|
|
End Property ' SFDocuments.SF_Form.Bookmark (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get CurrentRecord() As Variant
|
|
''' The CurrentRecord property identifies the current record in the recordset being viewed on a form
|
|
CurrentRecord = _PropertyGet("CurrentRecord")
|
|
End Property ' SFDocuments.SF_Form.CurrentRecord (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let CurrentRecord(Optional ByVal pvCurrentRecord As Variant)
|
|
''' Set the updatable property CurrentRecord
|
|
''' If the row number is positive, the cursor moves to the given row number with respect to the beginning of the result set.
|
|
''' The first row is row 1, the second is row 2, and so on.
|
|
''' If the given row number is negative, the cursor moves to an absolute row position with respect to the end of the result set.
|
|
''' For example, setting CurrentRecord = -1 positions the cursor on the last row, -2 indicates the next-to-last row, and so on
|
|
_PropertySet("CurrentRecord", pvCurrentRecord)
|
|
End Property ' SFDocuments.SF_Form.CurrentRecord (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Filter() As Variant
|
|
''' The Filter property specifies a subset of records to be displayed.
|
|
Filter = _PropertyGet("Filter")
|
|
End Property ' SFDocuments.SF_Form.Filter (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let Filter(Optional ByVal pvFilter As Variant)
|
|
''' Set the updatable property Filter
|
|
_PropertySet("Filter", pvFilter)
|
|
End Property ' SFDocuments.SF_Form.Filter (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get LinkChildFields() As Variant
|
|
''' The LinkChildFields property specifies how records in a subform (child) are linked to records in its parent form
|
|
''' It returns an array of strings
|
|
LinkChildFields = _PropertyGet("LinkChildFields")
|
|
End Property ' SFDocuments.SF_Form.LinkChildFields (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get LinkParentFields() As Variant
|
|
''' The LinkParentFields property specifies how records in a subform (Child) are linked to records in its parent form
|
|
''' It returns an array of strings
|
|
LinkParentFields = _PropertyGet("LinkParentFields")
|
|
End Property ' SFDocuments.SF_Form.LinkParentFields (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Name() As String
|
|
''' Return the name of the actual Form
|
|
Name = _PropertyGet("Name")
|
|
End Property ' SFDocuments.SF_Form.Name
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnApproveCursorMove() As Variant
|
|
''' The OnApproveCursorMove property specifies the script to trigger when this event occurs
|
|
OnApproveCursorMove = _PropertyGet("OnApproveCursorMove")
|
|
End Property ' SFDocuments.SF_Form.OnApproveCursorMove (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnApproveCursorMove(Optional ByVal pvOnApproveCursorMove As Variant)
|
|
''' Set the updatable property OnApproveCursorMove
|
|
_PropertySet("OnApproveCursorMove", pvOnApproveCursorMove)
|
|
End Property ' SFDocuments.SF_Form.OnApproveCursorMove (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnApproveReset() As Variant
|
|
''' The OnApproveReset property specifies the script to trigger when this event occurs
|
|
OnApproveReset = _PropertyGet("OnApproveReset")
|
|
End Property ' SFDocuments.SF_Form.OnApproveReset (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnApproveReset(Optional ByVal pvOnApproveReset As Variant)
|
|
''' Set the updatable property OnApproveReset
|
|
_PropertySet("OnApproveReset", pvOnApproveReset)
|
|
End Property ' SFDocuments.SF_Form.OnApproveReset (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnApproveRowChange() As Variant
|
|
''' The OnApproveRowChange property specifies the script to trigger when this event occurs
|
|
OnApproveRowChange = _PropertyGet("OnApproveRowChange")
|
|
End Property ' SFDocuments.SF_Form.OnApproveRowChange (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnApproveRowChange(Optional ByVal pvOnApproveRowChange As Variant)
|
|
''' Set the updatable property OnApproveRowChange
|
|
_PropertySet("OnApproveRowChange", pvOnApproveRowChange)
|
|
End Property ' SFDocuments.SF_Form.OnApproveRowChange (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnApproveSubmit() As Variant
|
|
''' The OnApproveSubmit property specifies the script to trigger when this event occurs
|
|
OnApproveSubmit = _PropertyGet("OnApproveSubmit")
|
|
End Property ' SFDocuments.SF_Form.OnApproveSubmit (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnApproveSubmit(Optional ByVal pvOnApproveSubmit As Variant)
|
|
''' Set the updatable property OnApproveSubmit
|
|
_PropertySet("OnApproveSubmit", pvOnApproveSubmit)
|
|
End Property ' SFDocuments.SF_Form.OnApproveSubmit (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnConfirmDelete() As Variant
|
|
''' The OnConfirmDelete property specifies the script to trigger when this event occurs
|
|
OnConfirmDelete = _PropertyGet("OnConfirmDelete")
|
|
End Property ' SFDocuments.SF_Form.OnConfirmDelete (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnConfirmDelete(Optional ByVal pvOnConfirmDelete As Variant)
|
|
''' Set the updatable property OnConfirmDelete
|
|
_PropertySet("OnConfirmDelete", pvOnConfirmDelete)
|
|
End Property ' SFDocuments.SF_Form.OnConfirmDelete (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnCursorMoved() As Variant
|
|
''' The OnCursorMoved property specifies the script to trigger when this event occurs
|
|
OnCursorMoved = _PropertyGet("OnCursorMoved")
|
|
End Property ' SFDocuments.SF_Form.OnCursorMoved (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnCursorMoved(Optional ByVal pvOnCursorMoved As Variant)
|
|
''' Set the updatable property OnCursorMoved
|
|
_PropertySet("OnCursorMoved", pvOnCursorMoved)
|
|
End Property ' SFDocuments.SF_Form.OnCursorMoved (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnErrorOccurred() As Variant
|
|
''' The OnErrorOccurred property specifies the script to trigger when this event occurs
|
|
OnErrorOccurred = _PropertyGet("OnErrorOccurred")
|
|
End Property ' SFDocuments.SF_Form.OnErrorOccurred (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnErrorOccurred(Optional ByVal pvOnErrorOccurred As Variant)
|
|
''' Set the updatable property OnErrorOccurred
|
|
_PropertySet("OnErrorOccurred", pvOnErrorOccurred)
|
|
End Property ' SFDocuments.SF_Form.OnErrorOccurred (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnLoaded() As Variant
|
|
''' The OnLoaded property specifies the script to trigger when this event occurs
|
|
OnLoaded = _PropertyGet("OnLoaded")
|
|
End Property ' SFDocuments.SF_Form.OnLoaded (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnLoaded(Optional ByVal pvOnLoaded As Variant)
|
|
''' Set the updatable property OnLoaded
|
|
_PropertySet("OnLoaded", pvOnLoaded)
|
|
End Property ' SFDocuments.SF_Form.OnLoaded (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnReloaded() As Variant
|
|
''' The OnReloaded property specifies the script to trigger when this event occurs
|
|
OnReloaded = _PropertyGet("OnReloaded")
|
|
End Property ' SFDocuments.SF_Form.OnReloaded (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnReloaded(Optional ByVal pvOnReloaded As Variant)
|
|
''' Set the updatable property OnReloaded
|
|
_PropertySet("OnReloaded", pvOnReloaded)
|
|
End Property ' SFDocuments.SF_Form.OnReloaded (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnReloading() As Variant
|
|
''' The OnReloading property specifies the script to trigger when this event occurs
|
|
OnReloading = _PropertyGet("OnReloading")
|
|
End Property ' SFDocuments.SF_Form.OnReloading (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnReloading(Optional ByVal pvOnReloading As Variant)
|
|
''' Set the updatable property OnReloading
|
|
_PropertySet("OnReloading", pvOnReloading)
|
|
End Property ' SFDocuments.SF_Form.OnReloading (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnResetted() As Variant
|
|
''' The OnResetted property specifies the script to trigger when this event occurs
|
|
OnResetted = _PropertyGet("OnResetted")
|
|
End Property ' SFDocuments.SF_Form.OnResetted (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnResetted(Optional ByVal pvOnResetted As Variant)
|
|
''' Set the updatable property OnResetted
|
|
_PropertySet("OnResetted", pvOnResetted)
|
|
End Property ' SFDocuments.SF_Form.OnResetted (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnRowChanged() As Variant
|
|
''' The OnRowChanged property specifies the script to trigger when this event occurs
|
|
OnRowChanged = _PropertyGet("OnRowChanged")
|
|
End Property ' SFDocuments.SF_Form.OnRowChanged (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnRowChanged(Optional ByVal pvOnRowChanged As Variant)
|
|
''' Set the updatable property OnRowChanged
|
|
_PropertySet("OnRowChanged", pvOnRowChanged)
|
|
End Property ' SFDocuments.SF_Form.OnRowChanged (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnUnloaded() As Variant
|
|
''' The OnUnloaded property specifies the script to trigger when this event occurs
|
|
OnUnloaded = _PropertyGet("OnUnloaded")
|
|
End Property ' SFDocuments.SF_Form.OnUnloaded (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnUnloaded(Optional ByVal pvOnUnloaded As Variant)
|
|
''' Set the updatable property OnUnloaded
|
|
_PropertySet("OnUnloaded", pvOnUnloaded)
|
|
End Property ' SFDocuments.SF_Form.OnUnloaded (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OnUnloading() As Variant
|
|
''' The OnUnloading property specifies the script to trigger when this event occurs
|
|
OnUnloading = _PropertyGet("OnUnloading")
|
|
End Property ' SFDocuments.SF_Form.OnUnloading (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OnUnloading(Optional ByVal pvOnUnloading As Variant)
|
|
''' Set the updatable property OnUnloading
|
|
_PropertySet("OnUnloading", pvOnUnloading)
|
|
End Property ' SFDocuments.SF_Form.OnUnloading (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get OrderBy() As Variant
|
|
''' The OrderBy property specifies in which order the records should be displayed.
|
|
OrderBy = _PropertyGet("OrderBy")
|
|
End Property ' SFDocuments.SF_Form.OrderBy (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let OrderBy(Optional ByVal pvOrderBy As Variant)
|
|
''' Set the updatable property OrderBy
|
|
_PropertySet("OrderBy", pvOrderBy)
|
|
End Property ' SFDocuments.SF_Form.OrderBy (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Parent() As Object
|
|
''' Return the Parent of the actual Form
|
|
Parent = _PropertyGet("Parent")
|
|
End Property ' SFDocuments.SF_Form.Parent
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get RecordSource() As Variant
|
|
''' The RecordSource property specifies the source of the data,
|
|
''' a table name, a query name or a SQL statement
|
|
RecordSource = _PropertyGet("RecordSource")
|
|
End Property ' SFDocuments.SF_Form.RecordSource (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let RecordSource(Optional ByVal pvRecordSource As Variant)
|
|
''' Set the updatable property RecordSource
|
|
_PropertySet("RecordSource", pvRecordSource)
|
|
End Property ' SFDocuments.SF_Form.RecordSource (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get XForm() As Object
|
|
''' The XForm property returns the XForm UNO object of the Form
|
|
XForm = _PropertyGet("XForm")
|
|
End Property ' SFDocuments.SF_Form.XForm (get)
|
|
|
|
REM ===================================================================== METHODS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Activate() As Boolean
|
|
''' Set the focus on the current Form instance
|
|
''' Probably called from after an event occurrence or to focus on an open Base form document
|
|
''' If the parent document is ...
|
|
''' Calc Activate the corresponding sheet
|
|
''' Writer Activate the parent document
|
|
''' Base Activate the parent form document
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if focusing is successful
|
|
''' Example:
|
|
''' myForm.Activate()
|
|
|
|
Dim bActivate As Boolean ' Return value
|
|
Dim oContainer As Object ' com.sun.star.awt.XWindow
|
|
Const cstThisSub = "SFDocuments.Form.Activate"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bActivate = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
Select Case _FormType
|
|
Case ISDOCFORM : bActivate = [_Parent].Activate()
|
|
Case ISCALCFORM : bActivate = [_Parent].Activate(_SheetName)
|
|
Case ISBASEFORM
|
|
Set oContainer = _FormDocument.Component.CurrentController.Frame.ContainerWindow
|
|
With oContainer
|
|
If .isVisible() = False Then .setVisible(True)
|
|
.IsMinimized = False
|
|
.setFocus()
|
|
.toFront() ' Force window change in Linux
|
|
Wait 1 ' Bypass desynchro issue in Linux
|
|
End With
|
|
bActivate = True
|
|
End Select
|
|
|
|
Finally:
|
|
Activate = bActivate
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.Activate
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CloseFormDocument() As Boolean
|
|
''' Close the form document containing the actual form instance
|
|
''' The form instance is disposed
|
|
''' The method does nothing if the actual form is not located in a Base form document
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if closure is successful
|
|
''' Example:
|
|
''' myForm.CloseFormDocument()
|
|
|
|
Dim bClose As Boolean ' Return value
|
|
Dim oContainer As Object ' com.sun.star.awt.XWindow
|
|
Const cstThisSub = "SFDocuments.Form.CloseFormDocument"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bClose = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
Select Case _FormType
|
|
Case ISDOCFORM, ISCALCFORM, ISSUBFORM
|
|
Case ISBASEFORM
|
|
_FormDocument.close()
|
|
Dispose()
|
|
bClose = True
|
|
End Select
|
|
|
|
Finally:
|
|
CloseFormDocument = bClose
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.CloseFormDocument
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Controls(Optional ByVal ControlName As Variant) As Variant
|
|
''' Return either
|
|
''' - the list of the controls contained in the Form
|
|
''' - a Form control object based on its name
|
|
''' Args:
|
|
''' ControlName: a valid control name as a case-sensitive string. If absent the list is returned
|
|
''' Returns:
|
|
''' A zero-base array of strings if ControlName is absent
|
|
''' An instance of the SF_FormControl class if ControlName exists
|
|
''' Exceptions:
|
|
''' ControlName is invalid
|
|
''' Example:
|
|
''' Dim myForm As Object, myList As Variant, myControl As Object
|
|
''' Set myForm = myDoc.Forms("myForm")
|
|
''' myList = myForm.Controls()
|
|
''' Set myControl = myForm.Controls("myTextBox")
|
|
|
|
Dim oControl As Object ' The new control class instance
|
|
Dim lIndexOfNames As Long ' Index in ElementNames array. Used to access _ControlCache
|
|
Dim vControl As Variant ' Alias of _ControlCache entry
|
|
Dim i As Long
|
|
Const cstThisSub = "SFDocuments.Form.Controls"
|
|
Const cstSubArgs = "[ControlName]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(ControlName) Or IsEmpty(ControlName) Then ControlName = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Collect all control names if not yet done
|
|
If UBound(_ControlNames) < 0 Then
|
|
_ControlNames = _Form.getElementNames()
|
|
' Remove all subforms from the list
|
|
For i = 0 To UBound(_ControlNames)
|
|
' Subforms have no ClassId property
|
|
If Not ScriptForge.SF_Session.HasUnoProperty(_Form.getByName(_ControlNames(i)), "ClassId") Then _ControlNames(i) = ""
|
|
Next i
|
|
_ControlNames = ScriptForge.SF_Array.TrimArray(_ControlNames)
|
|
' Size the cache accordingly
|
|
If UBound(_ControlNames) >= 0 Then
|
|
ReDim _ControlCache(0 To UBound(_ControlNames))
|
|
End If
|
|
End If
|
|
|
|
' Return the list of controls or a FormControl instance
|
|
If Len(ControlName) = 0 Then
|
|
Controls = _ControlNames
|
|
|
|
Else
|
|
|
|
If Not _Form.hasByName(ControlName) Then GoTo CatchNotFound
|
|
lIndexOfNames = ScriptForge.SF_Array.IndexOf(_ControlNames, ControlName, CaseSensitive := True)
|
|
' Reuse cache when relevant
|
|
vControl = _ControlCache(lIndexOfNames)
|
|
|
|
If IsEmpty(vControl) Then
|
|
' Create the new form control class instance
|
|
Set oControl = New SF_FormControl
|
|
With oControl
|
|
._Name = ControlName
|
|
Set .[Me] = oControl
|
|
Set .[_Parent] = [Me]
|
|
Set ._ParentForm = [Me]
|
|
._IndexOfNames = lIndexOfNames
|
|
._FormName = _Name
|
|
' Get model and view of the current control
|
|
Set ._ControlModel = _Form.getByName(ControlName)
|
|
._Initialize()
|
|
End With
|
|
Else
|
|
Set oControl = vControl
|
|
End If
|
|
|
|
Set Controls = oControl
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotFound:
|
|
ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _Form.getElementNames())
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.Controls
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetDatabase(Optional ByVal User As Variant _
|
|
, Optional ByVal Password As Variant _
|
|
) As Object
|
|
''' Returns a Database instance (service = SFDatabases.Database) giving access
|
|
''' to the execution of SQL commands on the database defined and/or stored in
|
|
''' the actual Base document
|
|
''' Each main form has its own database connection, except within Base documents where
|
|
''' they all share the same connection
|
|
''' Args:
|
|
''' User, Password: the login parameters as strings. Defaults = ""
|
|
''' Returns:
|
|
''' A SFDatabases.Database instance or Nothing
|
|
''' Example:
|
|
''' Dim myDb As Object
|
|
''' Set myDb = oForm.GetDatabase()
|
|
|
|
Dim FSO As Object ' Alias for SF_FileSystem
|
|
Dim sUser As String ' Alias for User
|
|
Dim sPassword As String ' Alias for Password
|
|
Const cstThisSub = "SFDocuments.Form.GetDatabase"
|
|
Const cstSubArgs = "[User=""""], [Password=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set GetDatabase = Nothing
|
|
|
|
Check:
|
|
If IsMissing(User) Or IsEmpty(User) Then User = ""
|
|
If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not [_Parent]._IsStillAlive(True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(User, "User", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Adjust connection arguments
|
|
If Len(User) = 0 Then
|
|
If ScriptForge.SF_Session.HasUnoProperty(_Form, "User") Then sUser = _Form.User Else sUser = ""
|
|
Else
|
|
sUser = User
|
|
End If
|
|
If Len(sUser) + Len(Password) = 0 Then
|
|
If ScriptForge.SF_Session.HasUnoProperty(_Form, "Password") Then sPassword = _Form.Password Else sPassword = Password
|
|
End If
|
|
|
|
' Connect to database, avoiding multiple requests
|
|
If IsNull(_Database) Then ' 1st connection request from the current form instance
|
|
If _FormType = ISBASEFORM Then
|
|
' Fetch the shared connection
|
|
Set _Database = [_Parent].GetDatabase(User, Password)
|
|
ElseIf _FormType = ISSUBFORM Then
|
|
Set _Database = [_Parent].GetDatabase() ' Recursive call, climb the tree
|
|
ElseIf Len(_Form.DataSourceName) = 0 Then ' There is no database linked with the form
|
|
' Return Nothing
|
|
Else
|
|
' Check if DataSourceName is a file or a registered name and create database instance accordingly
|
|
Set FSO = ScriptForge.SF_FileSystem
|
|
If FSO.FileExists(FSO._ConvertFromUrl(_Form.DataSourceName)) Then
|
|
Set _Database = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _
|
|
, _Form.DataSourceName, , , sUser, sPassword)
|
|
Else
|
|
Set _Database = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _
|
|
, , _Form.DataSourceName, , sUser, sPassword)
|
|
End If
|
|
If IsNull(_Database) Then GoTo CatchConnect
|
|
End If
|
|
Else
|
|
EndIf
|
|
|
|
Finally:
|
|
Set GetDatabase = _Database
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchConnect:
|
|
ScriptForge.SF_Exception.RaiseFatal(DBCONNECTERROR, "User", User, "Password", Password, [_Super]._FileIdent())
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.GetDatabase
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
|
|
''' Return the actual value of the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Returns:
|
|
''' The actual value of the property
|
|
''' Exceptions:
|
|
''' ARGUMENTERROR The property does not exist
|
|
''' Examples:
|
|
''' oDlg.GetProperty("Caption")
|
|
|
|
Const cstThisSub = "SFDocuments.Form.GetProperty"
|
|
Const cstSubArgs = ""
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
GetProperty = Null
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
GetProperty = _PropertyGet(PropertyName)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.GetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Methods() As Variant
|
|
''' Return the list of public methods of the Form service as an array
|
|
|
|
Methods = Array( _
|
|
"Activate" _
|
|
, "CloseForm" _
|
|
, "Controls" _
|
|
, "GetDatabase" _
|
|
, "MoveFirst" _
|
|
, "MoveLast" _
|
|
, "MoveNew" _
|
|
, "MoveNext" _
|
|
, "MovePrevious" _
|
|
, "Requery" _
|
|
, "SubForms" _
|
|
)
|
|
|
|
End Function ' SFDocuments.SF_Form.Methods
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveFirst() As Boolean
|
|
''' The cursor is (re)positioned on the first row
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if cursor move is successful
|
|
''' Example:
|
|
''' myForm.MoveFirst()
|
|
|
|
Dim bMoveFirst As Boolean ' Return value
|
|
Const cstThisSub = "SFDocuments.Form.MoveFirst"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMoveFirst = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
With _Form
|
|
bMoveFirst = .first()
|
|
End With
|
|
|
|
Finally:
|
|
MoveFirst = bMoveFirst
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.MoveFirst
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveLast() As Boolean
|
|
''' The cursor is (re)positioned on the last row
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if cursor move is successful
|
|
''' Example:
|
|
''' myForm.MoveLast()
|
|
|
|
Dim bMoveLast As Boolean ' Return value
|
|
Const cstThisSub = "SFDocuments.Form.MoveLast"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMoveLast = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
With _Form
|
|
bMoveLast = .last()
|
|
End With
|
|
|
|
Finally:
|
|
MoveLast = bMoveLast
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.MoveLast
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveNew() As Boolean
|
|
''' The cursor is (re)positioned in the new record area
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if cursor move is successful
|
|
''' Example:
|
|
''' myForm.MoveNew()
|
|
|
|
Dim bMoveNew As Boolean ' Return value
|
|
Const cstThisSub = "SFDocuments.Form.MoveNew"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMoveNew = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
With _Form
|
|
.last() ' To simulate the behaviour in the UI
|
|
.moveToInsertRow()
|
|
End With
|
|
bMoveNew = True
|
|
|
|
Finally:
|
|
MoveNew = bMoveNew
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.MoveNew
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveNext(Optional ByVal Offset As Variant) As Boolean
|
|
''' The cursor is (re)positioned on the next row
|
|
''' Args:
|
|
''' Offset: The number of records to go forward (default = 1)
|
|
''' Returns:
|
|
''' True if cursor move is successful
|
|
''' Example:
|
|
''' myForm.MoveNext()
|
|
|
|
Dim bMoveNext As Boolean ' Return value
|
|
Dim lOffset As Long ' Alias of Offset
|
|
Const cstThisSub = "SFDocuments.Form.MoveNext"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMoveNext = False
|
|
|
|
Check:
|
|
If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
Try:
|
|
lOffset = CLng(Offset) ' To be sure to have the right argument type
|
|
With _Form
|
|
If lOffset = 1 Then bMoveNext = .next() Else bMoveNext = .relative(lOffset)
|
|
End With
|
|
|
|
Finally:
|
|
MoveNext = bMoveNext
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.MoveNext
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MovePrevious(Optional ByVal Offset As Variant) As Boolean
|
|
''' The cursor is (re)positioned on the previous row
|
|
''' Args:
|
|
''' Offset: The number of records to go backward (default = 1)
|
|
''' Returns:
|
|
''' True if cursor move is successful
|
|
''' Example:
|
|
''' myForm.MovePrevious()
|
|
|
|
Dim bMovePrevious As Boolean ' Return value
|
|
Dim lOffset As Long ' Alias of Offset
|
|
Const cstThisSub = "SFDocuments.Form.MovePrevious"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMovePrevious = False
|
|
|
|
Check:
|
|
If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Offset, "Offset", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
Try:
|
|
lOffset = CLng(Offset) ' To be sure to have the right argument type
|
|
With _Form
|
|
If lOffset = 1 Then bMovePrevious = .previous() Else bMovePrevious = .relative(-lOffset)
|
|
End With
|
|
|
|
Finally:
|
|
MovePrevious = bMovePrevious
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.MovePrevious
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Properties() As Variant
|
|
''' Return the list or properties of the Form class as an array
|
|
|
|
Properties = Array( _
|
|
"AllowDeletes" _
|
|
, "AllowInserts" _
|
|
, "AllowUpdates" _
|
|
, "BaseForm" _
|
|
, "Bookmark" _
|
|
, "CurrentRecord" _
|
|
, "Filter" _
|
|
, "LinkChildFields" _
|
|
, "LinkParentFields" _
|
|
, "Name" _
|
|
, "OnApproveCursorMove" _
|
|
, "OnApproveParameter" _
|
|
, "OnApproveReset" _
|
|
, "OnApproveRowChange" _
|
|
, "OnApproveSubmit" _
|
|
, "OnConfirmDelete" _
|
|
, "OnCursorMoved" _
|
|
, "OnErrorOccurred" _
|
|
, "OnLoaded" _
|
|
, "OnReloaded" _
|
|
, "OnReloading" _
|
|
, "OnResetted" _
|
|
, "OnRowChanged" _
|
|
, "OnUnloaded" _
|
|
, "OnUnloading" _
|
|
, "OrderBy" _
|
|
, "Parent" _
|
|
, "RecordSource" _
|
|
, "XForm" _
|
|
)
|
|
|
|
End Function ' SFDocuments.SF_Form.Properties
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Requery() As Boolean
|
|
''' Reload from the database the actual data into the form
|
|
''' The cursor is (re)positioned on the first row
|
|
''' Args:
|
|
''' Returns:
|
|
''' True if requery is successful
|
|
''' Example:
|
|
''' myForm.Requery()
|
|
|
|
Dim bRequery As Boolean ' Return value
|
|
Const cstThisSub = "SFDocuments.Form.Requery"
|
|
Const cstSubArgs = ""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bRequery = False
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
Try:
|
|
With _Form
|
|
If .isLoaded() Then .reload() Else .load()
|
|
End With
|
|
bRequery = True
|
|
|
|
Finally:
|
|
Requery = bRequery
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.Requery
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetProperty(Optional ByVal PropertyName As Variant _
|
|
, Optional ByRef Value As Variant _
|
|
) As Boolean
|
|
''' Set a new value to the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Value: its new value
|
|
''' Exceptions
|
|
''' ARGUMENTERROR The property does not exist
|
|
|
|
Const cstThisSub = "SFDocuments.Form.SetProperty"
|
|
Const cstSubArgs = "PropertyName, Value"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
SetProperty = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
SetProperty = _PropertySet(PropertyName, Value)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.SetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Subforms(Optional ByVal Subform As Variant) As Variant
|
|
''' Return either
|
|
''' - the list of the subforms contained in the actual form or subform instance
|
|
''' - a SFDocuments.Form object based on its name or its index in the alphabetic list of subforms
|
|
''' Args:
|
|
''' Subform: a subform stored in the parent form given by its name or its index
|
|
''' When absent, the list of available subforms is returned
|
|
''' To get the first (unique ?) subform stored in the parent form, set Subform = 0
|
|
''' Exceptions:
|
|
''' SUBFORMNOTFOUNDERROR Subform not found
|
|
''' Returns:
|
|
''' A zero-based array of strings if Subform is absent
|
|
''' An instance of the SF_Form class if Subform exists
|
|
''' Example:
|
|
''' Dim myForm As Object, myList As Variant, mySubform As Object
|
|
''' myList = myForm.Subforms()
|
|
''' Set mySubform = myForm.Subforms("mySubform")
|
|
|
|
Dim oSubform As Object ' The new Form class instance
|
|
Dim oXSubform As Object ' com.sun.star.form.XForm
|
|
Dim vSubformNames As Variant ' Array of subform names
|
|
Dim i As Long
|
|
Const cstDrawPage = 0 ' Only 1 drawpage in a Writer document
|
|
|
|
Const cstThisSub = "SFDocuments.Form.Subforms"
|
|
Const cstSubArgs = "[Subform=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(Subform) Or IsEmpty(Subform) Then Subform = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Subform, "Subform", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Collect all control names and retain only the subforms
|
|
vSubformNames = _Form.getElementNames()
|
|
For i = 0 To UBound(vSubformNames)
|
|
Set oSubform = _Form.getByName(vSubformNames(i))
|
|
' Subforms are the only control types having no ClassId property
|
|
If ScriptForge.SF_Session.HasUnoProperty(oSubform, "ClassId") Then vSubformNames(i) = ""
|
|
Next i
|
|
vSubformNames = ScriptForge.SF_Array.TrimArray(vSubformNames)
|
|
|
|
If Len(Subform) = 0 Then ' Return the list of valid subform names
|
|
Subforms = vSubformNames
|
|
Else
|
|
If VarType(Subform) = V_STRING Then ' Find the form by name
|
|
If Not ScriptForge.SF_Array.Contains(vSubformNames, Subform, CaseSensitive := True) Then GoTo CatchNotFound
|
|
Set oXSubform = _Form.getByName(Subform)
|
|
Else ' Find the form by index
|
|
If Subform < 0 Or Subform > UBound(vSubformNames) Then GoTo CatchNotFound
|
|
Set oXSubform = _Form.getByName(vSubformNames(Subform))
|
|
End If
|
|
' Create the new Form class instance
|
|
Set oSubform = SF_Register._NewForm(oXSubform)
|
|
With oSubform
|
|
Set .[_Parent] = [Me]
|
|
._FormType = ISSUBFORM
|
|
Set ._Component = _Component
|
|
Set ._FormDocument = _FormDocument
|
|
._SheetName = _SheetName
|
|
._FormDocumentName = _FormDocumentName
|
|
Set ._Database = _Database
|
|
._Initialize()
|
|
End With
|
|
Set Subforms = oSubform
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotFound:
|
|
ScriptForge.SF_Exception.RaiseFatal(SUBFORMNOTFOUNDERROR, Subform, _Name)
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form.Subforms
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _GetEventName(ByVal psProperty As String) As String
|
|
''' Return the LO internal event name derived from the SF property name
|
|
''' The SF property name is not case sensitive, while the LO name is case-sensitive
|
|
' Corrects the typo on ErrorOccur(r?)ed, if necessary
|
|
|
|
Dim vProperties As Variant ' Array of class properties
|
|
Dim sProperty As String ' Correctly cased property name
|
|
|
|
vProperties = Properties()
|
|
sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
|
|
|
|
_GetEventName = LCase(Mid(sProperty, 3, 1)) & Right(sProperty, Len(sProperty) - 3)
|
|
|
|
End Function ' SFDocuments.SF_Form._GetEventName
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _GetListener(ByVal psEventName As String) As String
|
|
''' Getting/Setting macros triggered by events requires a Listener-EventName pair
|
|
''' Return the X...Listener corresponding with the event name in argument
|
|
|
|
Select Case UCase(psEventName)
|
|
Case UCase("OnApproveCursorMove")
|
|
_GetListener = "XRowSetApproveListener"
|
|
Case UCase("OnApproveParameter")
|
|
_GetListener = "XDatabaseParameterListener"
|
|
Case UCase("OnApproveReset"), UCase("OnResetted")
|
|
_GetListener = "XResetListener"
|
|
Case UCase("OnApproveRowChange")
|
|
_GetListener = "XRowSetApproveListener"
|
|
Case UCase("OnApproveSubmit")
|
|
_GetListener = "XSubmitListener"
|
|
Case UCase("OnConfirmDelete")
|
|
_GetListener = "XConfirmDeleteListener"
|
|
Case UCase("OnCursorMoved"), UCase("OnRowChanged")
|
|
_GetListener = "XRowSetListener"
|
|
Case UCase("OnErrorOccurred")
|
|
_GetListener = "XSQLErrorListener"
|
|
Case UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnUnloaded"), UCase("OnUnloading")
|
|
_GetListener = "XLoadListener"
|
|
End Select
|
|
|
|
End Function ' SFDocuments.SF_Form._GetListener
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub _GetParents()
|
|
''' When the current instance is created top-down, the parents are completely defined
|
|
''' and nothing should be done in this method
|
|
''' When the a class instance is created in a (form/control) event, it is the opposite
|
|
''' The current method rebuilds the missing members in the instance from the bottom
|
|
''' Members potentially to collect are:
|
|
''' - _FormType
|
|
''' - [_Parent], the immediate parent: a form or a document instance
|
|
''' + Only when the _FormType is a main form
|
|
''' - _SheetName (Calc only)
|
|
''' - _FormDocumentName (Base only)
|
|
''' - _FormDocument, the topmost form collection
|
|
''' - _Component, the containing document
|
|
''' They must be identified only starting from the _Form UNO object
|
|
'''
|
|
''' The method is called from the _Initialize() method at instance creation
|
|
|
|
Dim oParent As Object ' Successive bottom-up parents
|
|
Dim sType As String ' UNO object type
|
|
Dim sPersistentName As String ' The Obj... name of a Base form
|
|
Dim iLevel As Integer ' When = 1 => first parent
|
|
Dim oSession As Object : Set oSession = ScriptForge.SF_Session
|
|
|
|
On Local Error GoTo Finally ' Being probably called from events, this method should avoid failures
|
|
' When the form type is known, the upper part of the branch is not scanned
|
|
If _FormType <> ISUNDEFINED Then GoTo Finally
|
|
|
|
Try:
|
|
' The whole branch is scanned bottom-up
|
|
If oSession.HasUnoProperty(_Form, "Parent") Then Set oParent = _Form.Parent Else Set oParent = Nothing
|
|
_FormType = ISUNDEFINED
|
|
iLevel = 1
|
|
|
|
Do While Not IsNull(oParent)
|
|
sType = SF_Session.UnoObjectType(oParent)
|
|
Select Case sType
|
|
' Collect at each level the needed info
|
|
Case "com.sun.star.comp.forms.ODatabaseForm" ' The parent _Form of a subform
|
|
If iLevel = 1 Then
|
|
_FormType = ISSUBFORM
|
|
Set [_Parent] = SF_Register._NewForm(oParent)
|
|
' Everything is in the parent, copy items and stop scan
|
|
[_Parent]._Initialize() ' Current method is called recursively here
|
|
With [_Parent]
|
|
_SheetName = ._SheetName
|
|
_FormDocumentName = ._FormDocumentName
|
|
Set _FormDocument = ._FormDocument
|
|
Set _Component = ._Component
|
|
End With
|
|
Exit Sub
|
|
End If
|
|
Case "com.sun.star.form.OFormsCollection" ' The collection of forms inside a drawpage
|
|
Case "SwXTextDocument" ' The parent document: a Writer document or a Base form document
|
|
If oParent.Identifier = "com.sun.star.sdb.FormDesign" Then
|
|
sPersistentName = ScriptForge._GetPropertyValue(oParent.Args, "HierarchicalDocumentName")
|
|
ElseIf oParent.Identifier = "com.sun.star.text.TextDocument" Then
|
|
_FormType = ISDOCFORM
|
|
Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
|
|
Set _Component = [_Parent]._Component
|
|
End If
|
|
Case "ScModelObj" ' The parent document: a Calc document
|
|
_FormType = ISCALCFORM
|
|
Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
|
|
Set _Component = oParent
|
|
' The triggered form event is presumed to be located in the (drawpage of the) active sheet
|
|
_SheetName = [_Parent].XSpreadsheet("~")
|
|
Case "com.sun.star.comp.dba.ODatabaseDocument" ' The Base document
|
|
_FormType = ISBASEFORM
|
|
Set [_Parent] = ScriptForge.SF_Services.CreateScriptService("SFDocuments.Document", oParent)
|
|
Set _Component = oParent
|
|
If IsNull([_Parent]._FormDocuments) Then Set [_Parent]._FormDocuments = _Component.getFormDocuments()
|
|
Set _FormDocument = [_Parent]._FindByPersistentName([_Parent]._FormDocuments, sPersistentName)
|
|
_FormDocumentName = _FormDocument.HierarchicalName
|
|
Case Else
|
|
End Select
|
|
If oSession.HasUnoProperty(oParent, "Parent") Then Set oParent = oParent.Parent Else Set oParent = Nothing
|
|
iLevel = iLevel + 1
|
|
Loop
|
|
|
|
Finally:
|
|
Exit Sub
|
|
End Sub ' SFDocuments.SF_Form._GetParents
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub _Initialize()
|
|
''' Achieve the creation of a SF_Form instance
|
|
''' - complete the missing private members
|
|
''' - store the new instance in the cache
|
|
|
|
_GetParents()
|
|
_CacheIndex = SF_Register._AddFormToCache(_Form, [Me])
|
|
|
|
End Sub ' SFDocuments.SF_Form._Initialize
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean
|
|
''' Return True if the Form is still open
|
|
''' If dead the actual instance is disposed
|
|
''' and the execution is cancelled when pbError = True (default)
|
|
''' Args:
|
|
''' pbError: if True (default), raise a fatal error
|
|
|
|
Dim bAlive As Boolean ' Return value
|
|
Dim sName As String ' Alias of _Name
|
|
Dim sId As String ' Alias of FileIdent
|
|
|
|
Check:
|
|
On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
|
|
If IsMissing(pbError) Then pbError = True
|
|
|
|
Try:
|
|
' At main form termination, all database connections are lost
|
|
bAlive = Not IsNull(_Form)
|
|
If Not bAlive Then GoTo Catch
|
|
|
|
Finally:
|
|
_IsStillAlive = bAlive
|
|
Exit Function
|
|
Catch:
|
|
bAlive = False
|
|
On Error GoTo 0
|
|
' Keep error message elements before disposing the instance
|
|
sName = _SheetName & _FormDocumentName ' At least one of them is a zero-length string
|
|
sName = Iif(Len(sName) > 0, "[" & sName & "].", "") & _Name
|
|
If Not IsNull(_Component) Then sId = _Component.Location Else sId = ""
|
|
' Dispose the actual forms instance
|
|
Dispose()
|
|
' Display error message
|
|
If pbError Then ScriptForge.SF_Exception.RaiseFatal(FORMDEADERROR, sName, sId)
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form._IsStillAlive
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
|
|
''' Return the value of the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
|
|
Static oSession As Object ' Alias of SF_Session
|
|
Dim vBookmark As Variant ' Form bookmark
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = ""
|
|
|
|
cstThisSub = "SFDocuments.Form.get" & psProperty
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
_PropertyGet = Empty
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
|
|
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
Select Case UCase(psProperty)
|
|
Case UCase("AllowDeletes")
|
|
If Not IsNull(_Form) Then _PropertyGet = _Form.AllowDeletes
|
|
Case UCase("AllowInserts")
|
|
If Not IsNull(_Form) Then _PropertyGet = _Form.AllowInserts
|
|
Case UCase("AllowUpdates")
|
|
If Not IsNull(_Form) Then _PropertyGet = _Form.AllowUpdates
|
|
Case UCase("BaseForm")
|
|
_PropertyGet = _FormDocumentName
|
|
Case UCase("Bookmark")
|
|
If IsNull(_Form) Then
|
|
_PropertyGet = 0
|
|
Else
|
|
On Local Error Resume Next ' Disable error handler because bookmarking does not always react well in events ...
|
|
If _Form.IsBookmarkable Then vBookmark = _Form.getBookmark() Else vBookmark = Nothing
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error Goto Catch Else On Local Error Goto 0
|
|
If IsNull(vBookmark) Then Goto Catch
|
|
_PropertyGet = vBookmark
|
|
End If
|
|
Case UCase("CurrentRecord")
|
|
If IsNull(_Form) Then _PropertyGet = 0 Else _PropertyGet = _Form.Row
|
|
Case UCase("Filter")
|
|
If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Filter
|
|
Case UCase("LinkChildFields")
|
|
If IsNull(_Form) Or _FormType <> ISSUBFORM Then _PropertyGet = Array() Else _PropertyGet = _Form.DetailFields
|
|
Case UCase("LinkParentFields")
|
|
If IsNull(_Form) Or _FormType <> ISSUBFORM Then _PropertyGet = Array() Else _PropertyGet = _Form.MasterFields
|
|
Case UCase("Name")
|
|
_PropertyGet = _Name
|
|
Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _
|
|
, UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
|
|
, UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
|
|
, UCase("OnUnloaded"), UCase("OnUnloading")
|
|
If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = SF_Register._GetEventScriptCode(_Form, psProperty, _Name)
|
|
Case UCase("OrderBy")
|
|
If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Order
|
|
Case UCase("Parent")
|
|
_PropertyGet = [_Parent]
|
|
Case UCase("RecordSource")
|
|
If IsNull(_Form) Then _PropertyGet = "" Else _PropertyGet = _Form.Command
|
|
Case UCase("XForm")
|
|
Set _PropertyGet = _Form
|
|
Case Else
|
|
_PropertyGet = Null
|
|
End Select
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form._PropertyGet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertySet(Optional ByVal psProperty As String _
|
|
, Optional ByVal pvValue As Variant _
|
|
) As Boolean
|
|
''' Set the new value of the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
''' pvValue: the new value of the given property
|
|
''' Returns:
|
|
''' True if successful
|
|
|
|
Dim bSet As Boolean ' Return value
|
|
Dim oDatabase As Object ' Database class instance
|
|
Dim lCommandType As Long ' Record source type: 0 = Table, 1 = Query, 2 = SELECT
|
|
Dim sCommand As String ' Record source
|
|
Static oSession As Object ' Alias of SF_Session
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = "Value"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bSet = False
|
|
|
|
cstThisSub = "SFDocuments.Form.set" & psProperty
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
|
|
If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
bSet = True
|
|
Select Case UCase(psProperty)
|
|
Case UCase("AllowDeletes")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowDeletes", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not IsNull(_Form) Then
|
|
_Form.AllowDeletes = pvValue
|
|
_Form.reload()
|
|
End If
|
|
Case UCase("AllowInserts")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowInserts", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not IsNull(_Form) Then
|
|
_Form.AllowInserts = pvValue
|
|
_Form.reload()
|
|
End If
|
|
Case UCase("AllowUpdates")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "AllowUpdates", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not IsNull(_Form) Then
|
|
_Form.AllowUpdates = pvValue
|
|
_Form.reload()
|
|
End If
|
|
Case UCase("Bookmark")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Bookmark", Array(ScriptForge.V_NUMERIC, ScriptForge.V_OBJECT)) Then GoTo Finally
|
|
If Not IsNull(pvValue) And Not IsNull(_Form) Then bSet = _Form.moveToBookmark(pvValue)
|
|
Case UCase("CurrentRecord")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "CurrentRecord", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not IsNull(_Form) Then bSet = _Form.absolute(pvValue)
|
|
Case UCase("Filter")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "Filter", V_STRING) Then GoTo Finally
|
|
If Not IsNull(_Form) Then
|
|
With _Form
|
|
If Len(pvValue) > 0 Then
|
|
Set oDatabase = GetDatabase()
|
|
If Not IsNull(oDatabase) Then .Filter = oDatabase._ReplaceSquareBrackets(pvValue) Else .Filter = pvValue
|
|
Else
|
|
.Filter = ""
|
|
End If
|
|
.ApplyFilter = True
|
|
.reload()
|
|
End With
|
|
End If
|
|
Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _
|
|
, UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
|
|
, UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
|
|
, UCase("OnUnloaded"), UCase("OnUnloading")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then Goto Finally
|
|
If Not IsNull(_Form) Then
|
|
bSet = SF_Register._RegisterEventScript(_Form _
|
|
, psProperty _
|
|
, _GetListener(psProperty) _
|
|
, pvValue _
|
|
, _Name _
|
|
)
|
|
End If
|
|
Case UCase("OrderBy")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "OrderBy", V_STRING) Then GoTo Finally
|
|
If Not IsNull(_Form) Then
|
|
With _Form
|
|
If Len(pvValue) > 0 Then
|
|
Set oDatabase = GetDatabase()
|
|
If Not IsNull(oDatabase) Then .Order = oDatabase._ReplaceSquareBrackets(pvValue) Else .Order = pvValue
|
|
Else
|
|
.Order = ""
|
|
End If
|
|
.reload()
|
|
End With
|
|
End If
|
|
Case UCase("RecordSource")
|
|
If Not ScriptForge.SF_Utils._Validate(pvValue, "RecordSource", V_STRING) Then GoTo Finally
|
|
If Not IsNull(_Form) And Len(pvValue) > 0 Then
|
|
Set oDatabase = GetDatabase()
|
|
If Not IsNull(oDatabase) Then
|
|
With oDatabase
|
|
If ScriptForge.SF_Array.Contains(.Tables, pvValue, CaseSensitive := True) Then
|
|
sCommand = pvValue
|
|
lCommandType = com.sun.star.sdb.CommandType.TABLE
|
|
ElseIf ScriptForge.SF_Array.Contains(.Queries, pvValue, CaseSensitive := True) Then
|
|
sCommand = pvValue
|
|
lCommandType = com.sun.star.sdb.CommandType.QUERY
|
|
ElseIf ScriptForge.SF_String.StartsWith(pvValue, "SELECT", CaseSensitive := False) Then
|
|
sCommand = .ReplaceSquareBrackets(pvValue)
|
|
lCommandType = com.sun.star.sdb.CommandType.COMMAND
|
|
End If
|
|
_Form.Command = sCommand
|
|
_Form.CommandType = lCommandType
|
|
End With
|
|
End If
|
|
End If
|
|
Case Else
|
|
bSet = False
|
|
End Select
|
|
|
|
Finally:
|
|
_PropertySet = bSet
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Form._PropertySet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _Repr() As String
|
|
''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
|
''' Args:
|
|
''' Return:
|
|
''' "[Form]: Name"
|
|
|
|
Dim sParent As String ' To recognize the parent
|
|
|
|
sParent = _SheetName & _FormDocumentName ' At least one of them is a zero-length string
|
|
_Repr = "[Form]: " & Iif(Len(sParent) > 0, sParent & "...", "") & _Name
|
|
|
|
End Function ' SFDocuments.SF_Form._Repr
|
|
|
|
REM ============================================ END OF SFDOCUMENTS.SF_FORM
|
|
</script:module> |