wizards/source/sfdocuments/SF_Calc.xba | 4
wizards/source/sfdocuments/SF_Document.xba | 4
wizards/source/sfdocuments/SF_Form.xba | 485 +++++++++++++++++++++++++----
wizards/source/sfdocuments/SF_Register.xba | 123 +++++++
4 files changed, 553 insertions(+), 63 deletions(-)
New commits:
commit edb2724623e58cd8c9a5d3a85e8ee5d3858872d5
Author: Jean-Pierre Ledure <j...@ledure.be>
AuthorDate: Tue Jan 12 15:38:15 2021 +0100
Commit: Jean-Pierre Ledure <j...@ledure.be>
CommitDate: Wed Jan 13 10:43:28 2021 +0100
ScriptForge - (SF_Form)get/set properties of forms/subforms
Includes a bunch of OnXxx event properties
Change-Id: Ie2cbb91bb29288a17eb835e8abeeeaa6e8ef6d2a
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/109177
Tested-by: Jean-Pierre Ledure <j...@ledure.be>
Tested-by: Jenkins
Reviewed-by: Jean-Pierre Ledure <j...@ledure.be>
diff --git a/wizards/source/sfdocuments/SF_Calc.xba
b/wizards/source/sfdocuments/SF_Calc.xba
index 852cd0ad138d..c1e4c1c75549 100644
--- a/wizards/source/sfdocuments/SF_Calc.xba
+++ b/wizards/source/sfdocuments/SF_Calc.xba
@@ -16,10 +16,10 @@ Option Explicit
''' =======
'''
''' The SFDocuments library gathers a number of
methods and properties making easy
-''' the management and several manipulations of
LibreOffice documents
+''' managing and manipulating LibreOffice documents
'''
''' Some methods are generic for all types of
documents: they are combined in the SF_Document module.
-''' Specific properties and methods are implemented
in the concerned subclass(es) SF_Calc, SF_Writer, ...
+''' Specific properties and methods are implemented
in the concerned subclass(es) SF_Calc, SF_Base, ...
'''
''' To workaround the absence of class inheritance
in LibreOffice Basic, some redundancy is necessary
''' Each subclass MUST implement also the generic
methods and properties, even if they only call
diff --git a/wizards/source/sfdocuments/SF_Document.xba
b/wizards/source/sfdocuments/SF_Document.xba
index 7b66600794a9..b4d3edbe915a 100644
--- a/wizards/source/sfdocuments/SF_Document.xba
+++ b/wizards/source/sfdocuments/SF_Document.xba
@@ -16,13 +16,13 @@ Option Explicit
''' ===========
'''
''' The SFDocuments library gathers a number of
methods and properties making easy
-''' the management and several manipulations of
LibreOffice documents
+''' managing and manipulating LibreOffice documents
'''
''' Some methods are generic for all types of
documents: they are combined in the
''' current SF_Document module
''' - saving, closing documents
''' - accessing their standard or custom
properties
-''' Specific properties and methods are implemented
in the concerned subclass(es) SF_Calc, SF_Writer, ...
+''' Specific properties and methods are implemented
in the concerned subclass(es) SF_Calc, SF_Base, ...
'''
''' Documents might contain forms. The current
service gives access to the "SFDocuments.Form" service
'''
diff --git a/wizards/source/sfdocuments/SF_Form.xba
b/wizards/source/sfdocuments/SF_Form.xba
index 1c6b14770055..56e60785e40c 100644
--- a/wizards/source/sfdocuments/SF_Form.xba
+++ b/wizards/source/sfdocuments/SF_Form.xba
@@ -26,7 +26,7 @@ Option Explicit
''' FormDocument:
''' For usual documents, there is
only 1 form document. It is in fact the document itself.
''' A Base document may contain an
unlimited number of form documents.
-''' In the Base terminology
they are called "forms". This could create some confusion.
+''' 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
@@ -142,28 +142,100 @@ End Function ' SFDocuments.SF_Form Explicit
Destructor
REM ==================================================================
PROPERTIES
REM
-----------------------------------------------------------------------------
-Property Get Caption() As Variant
-''' The Caption property refers to the title of the Form
- Caption = _PropertyGet("Caption")
-End Property ' SFDocuments.SF_Form.Caption (get)
+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 Caption(Optional ByVal pvCaption As Variant)
-''' Set the updatable property Caption
- _PropertySet("Caption", pvCaption)
-End Property ' SFDocumentsDialog.SF_Form.Caption (let)
+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 Height() As Variant
-''' The Height property refers to the height of the Form box
- Height = _PropertyGet("Height")
-End Property ' SFDocuments.SF_Form.Height (get)
+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 Height(Optional ByVal pvHeight As Variant)
-''' Set the updatable property Height
- _PropertySet("Height", pvHeight)
-End Property ' SFDocuments.SF_Form.Height (let)
+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
@@ -172,34 +244,203 @@ Property Get Name() As String
End Property ' SFDocuments.SF_Form.Name
REM
-----------------------------------------------------------------------------
-Property Get Parent() As Object
-''' Return the Parent of the actual Form
- Parent = _PropertyGet("Parent")
-End Property ' SFDocuments.SF_Form.Parent
+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 Get Visible() As Variant
-''' The Visible property is False before the Execute()
statement
- Visible = _PropertyGet("Visible")
-End Property ' SFDocuments.SF_Form.Visible (get)
+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 Let Visible(Optional ByVal pvVisible As Variant)
-''' Set the updatable property Visible
- _PropertySet("Visible", pvVisible)
-End Property ' SFDocuments.SF_Form.Visible (let)
+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 Get Width() As Variant
-''' The Width property refers to the Width of the Form box
- Width = _PropertyGet("Width")
-End Property ' SFDocuments.SF_Form.Width (get)
+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 Let Width(Optional ByVal pvWidth As Variant)
-''' Set the updatable property Width
- _PropertySet("Width", pvWidth)
-End Property ' SFDocuments.SF_Form.Width (let)
+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
@@ -399,7 +640,7 @@ Try:
' Fetch the shared connection
Set _Database = [_Parent].GetDatabase(User, Password)
ElseIf _FormType = ISSUBFORM Then
- ' Return Nothing : method is not applicable to
subforms
+ 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
@@ -488,16 +729,12 @@ Public Function Properties() As Variant
''' Return the list or properties of the Form class as an
array
Properties = Array( _
- "AllowAdditions" _
- , "AllowDeletions" _
- , "AllowEdits" _
+ "AllowDeletes" _
+ , "AllowInserts" _
+ , "AllowUpdates" _
, "Bookmark" _
- , "Caption" _
, "CurrentRecord" _
, "Filter" _
- , "FilterOn" _
- , "Height" _
- , "IsLoaded" _
, "LinkChildFields" _
, "LinkParentFields" _
, "Name" _
@@ -517,11 +754,8 @@ Public Function Properties() As Variant
, "OnUnloaded" _
, "OnUnloading" _
, "OrderBy" _
- , "OrderByOn" _
, "Parent" _
, "RecordSource" _
- , "Visible" _
- , "Width" _
, "XForm" _
)
@@ -551,7 +785,6 @@ Check:
Try:
SetProperty = _PropertySet(PropertyName, Value)
- Set UI =
ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI")
Finally:
SF_Utils._ExitFunction(cstThisSub)
@@ -626,6 +859,7 @@ Try:
Set ._FormDocument = _FormDocument
._SheetName = _SheetName
._FormDocumentName = _FormDocumentName
+ Set ._Database = _Database
._Initialize()
End With
Set Subforms = oSubform
@@ -665,8 +899,24 @@ Private Function _GetListener(ByVal psEventName As String)
As String
''' Return the X...Listener corresponding with the event
name in argument
Select Case UCase(psEventName)
- Case Else
- _GetListener = ""
+ 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
@@ -811,6 +1061,7 @@ Private Function _PropertyGet(Optional ByVal psProperty As
String) As Variant
''' 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 = ""
@@ -818,18 +1069,50 @@ Const cstSubArgs = ""
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("Caption")
-' Case UCase("Height")
+ 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("Visible")
-' Case UCase("Width")
+ Case UCase("RecordSource")
+ If IsNull(_Form) Then _PropertyGet = "" Else
_PropertyGet = _Form.Command
Case UCase("XForm")
Set _PropertyGet = _Form
Case Else
@@ -855,6 +1138,9 @@ Private Function _PropertySet(Optional ByVal psProperty As
String _
''' True if successful
Dim bSet As Boolean '
Return value
+Dim oDatabase As Object '
Database class instance
+Dim iCommandType As Integer ' 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"
@@ -869,10 +1155,91 @@ Const cstSubArgs = "Value"
If IsNull(oSession) Then Set oSession =
ScriptForge.SF_Services.CreateScriptService("Session")
bSet = True
Select Case UCase(psProperty)
- Case UCase("Caption")
- Case UCase("Height")
- Case UCase("Visible")
- Case UCase("Width")
+ Case 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
+ iCommandType =
com.sun.star.sdb.CommandType.TABLE
+ ElseIf
ScriptForge.SF_Array.Contains(.Queries, pvValue, CaseSensitive := True) Then
+ sCommand = pvValue
+ iCommandType =
com.sun.star.sdb.CommandType.QUERY
+ ElseIf
ScriptForge.SF_String.StartsWith(pvValue, "SELECT", CaseSensitive :=
False) Then
+ sCommand =
.ReplaceSquareBrackets(pvValue)
+ iCommandType =
com.sun.star.sdb.CommandType.COMMAND
+ End If
+ _Form.Command = sCommand
+ _Form.CommandType = iCommandType
+ End With
+ End If
+ End If
Case Else
bSet = False
End Select
diff --git a/wizards/source/sfdocuments/SF_Register.xba
b/wizards/source/sfdocuments/SF_Register.xba
index d530d5b84181..b83518d9491c 100644
--- a/wizards/source/sfdocuments/SF_Register.xba
+++ b/wizards/source/sfdocuments/SF_Register.xba
@@ -256,6 +256,64 @@ Finally:
Exit Function
End Function ' SFDocuments.SF_Register._FormEventManager
+REM
-----------------------------------------------------------------------------
+Public Function _GetEventScriptCode(poObject As Object _
+ , ByVal psEvent As String _
+ , ByVal psName As String _
+ ) As String
+''' Extract from the parent of poObject the Basic script
linked to psEvent.
+''' Helper function common to forms and form controls
+''' Args:
+''' poObject: a com.sun.star.form.XForm or XControl
object
+''' psEvent: the "On..." name of the event
+''' psName: the name of the object to be identified
from the parent object
+''' Returne:
+''' The script to trigger when psEvent occurs
+''' See Scripting Framework URI Specification :
https://wiki.openoffice.org/wiki/Documentation/DevGuide/Scripting/Scripting_Framework_URI_Specification
+
+Dim vEvents As Variant ' List of available events in the
parent object
+ ' Array
of com.sun.star.script.ScriptEventDescriptor
+Dim sEvent As String ' The targeted event name
+Dim oParent As Object ' The parent object
+Dim lIndex As Long ' The index of the
targeted event in the events list of the parent object
+Dim sName As String ' The corrected UNO event
name
+Dim i As Long
+
+ _GetEventScriptCode = ""
+ On Local Error GoTo Catch
+ If Not ScriptForge.SF_Session.HasUnoMethod(poObject,
"getParent") Then GoTo Finally
+
+Try:
+ ' Find form index i.e. find control via getByIndex()
+ ' The name is known (= psName) but getByIndex() is not in the
same sequence as getElementNames()
+ Set oParent = poObject.getParent()
+ lIndex = -1
+ For i = 0 To oParent.getCount() - 1
+ sName = oParent.getByIndex(i).Name
+ If (sName = psName) Then
+ lIndex = i
+ Exit For
+ End If
+ Next i
+ If lIndex < 0 Then GoTo Finally ' Not found,
should not happen
+
+ ' Find script triggered by event
+ vEvents = oParent.getScriptEvents(lIndex)
' Returns an array
+ ' Fix historical typo error
+ sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4),
"errorOccurred", "errorOccured")
+ For i = 0 To UBound(vEvents)
+ If vEvents(i).EventMethod = sEvent Then
+ _GetEventScriptCode = vEvents(i).ScriptCode
+ Exit For
+ End If
+ Next i
+
+Finally:
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDocuments.SF_Register._GetEventScriptCode
+
REM
-----------------------------------------------------------------------------
Public Function _NewDocument(Optional ByVal pvArgs As Variant) As Object
''' Create a new instance of the (super) SF_Document class
or of one of its subclasses (SF_Calc, ...)
@@ -385,5 +443,70 @@ Finally:
Exit Function
End Function ' SFDocuments.SF_Register._NewForm
+REM
-----------------------------------------------------------------------------
+Public Function _RegisterEventScript(poObject As Object _
+ , ByVal psEvent
As String _
+ , ByVal
psListener As String _
+ , ByVal
psScriptCode As String _
+ , ByVal psName
As String _
+ ) As Boolean
+''' Register a script event (psEvent) to poObject (Form,
SubForm or Control)
+''' Args:
+''' poObject: a com.sun.star.form.XForm or XControl
object
+''' psEvent: the "On..." name of the event
+''' psListener: the listener name corresponding
with the event
+''' psScriptCode: The script to trigger when
psEvent occurs
+''' See Scripting Framework URI
Specification :
https://wiki.openoffice.org/wiki/Documentation/DevGuide/Scripting/Scripting_Framework_URI_Specification
+''' psName: the name of the object to associate
with the event
+''' Returne:
+''' True when successful
+
+Dim oEvent As Object '
com.sun.star.script.ScriptEventDescriptor
+Dim sEvent As String ' The targeted event name
+Dim oParent As Object ' The parent object
+Dim lIndex As Long ' The index of the
targeted event in the events list of the parent object
+Dim sName As String ' The corrected UNO event
name
+Dim i As Long
+
+ _RegisterEventScript = False
+ On Local Error GoTo Catch
+ If Not ScriptForge.SF_Session.HasUnoMethod(poObject,
"getParent") Then GoTo Finally
+
+Try:
+ ' Find object's internal index i.e. how to reach it via
getByIndex()
+ Set oParent = poObject.getParent()
+ lIndex = -1
+ For i = 0 To oParent.getCount() - 1
+ sName = oParent.getByIndex(i).Name
+ If (sName = psName) Then
+ lIndex = i
+ Exit For
+ End If
+ Next i
+ If lIndex < 0 Then GoTo Finally ' Not found,
should not happen
+
+ ' Fix historical typo error
+ sEvent = Replace(LCase(Mid(psEvent, 3, 1)) & Mid(psEvent, 4),
"errorOccurred", "errorOccured")
+ ' Apply new script code. Erasing it is done with a specific UNO
method
+ If psScriptCode = "" Then
+ oParent.revokeScriptEvent(lIndex, psListener, sEvent,
"")
+ Else
+ Set oEvent =
CreateUnoStruct("com.sun.star.script.ScriptEventDescriptor")
+ With oEvent
+ .ListenerType = psListener
+ .EventMethod = sEvent
+ .ScriptType = "Script"
' Better than "Basic"
+ .ScriptCode = psScriptCode
+ End With
+ oParent.registerScriptEvent(lIndex, oEvent)
+ End If
+ _RegisterEventScript = True
+
+Finally:
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDocuments.SF_Register._RegisterEventScript
+
REM ============================================== END OF
SFDOCUMENTS.SF_REGISTER
</script:module>
\ No newline at end of file
_______________________________________________
Libreoffice-commits mailing list
libreoffice-comm...@lists.freedesktop.org
https://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
