diff options
| author | Jean-Pierre Ledure <jp@ledure.be> | 2020-12-16 17:34:04 +0100 |
|---|---|---|
| committer | Jean-Pierre Ledure <jp@ledure.be> | 2020-12-17 08:56:47 +0100 |
| commit | e6915d4be4d576fdfd4d612c7968f493edba62c5 (patch) | |
| tree | 9570a04759820be5180df2e57ca4c91ecc83483e /wizards | |
| parent | 11382ccf2ff58ba470dfa604654685730e0411f8 (diff) | |
ScriptForge - (SFDocuments) Introduce form class
New SF_Form class in SFDocuments library
Support for Writer, Calc and Base forms
Skeleton of Form class module
Forms() methods in Calc, Base and Document modules
to create a new instance
New error messages in po file
Change-Id: Id78a4604caf61901d87750026be45cef8f74f110
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/107848
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
Diffstat (limited to 'wizards')
| -rw-r--r-- | wizards/Package_sfdocuments.mk | 1 | ||||
| -rw-r--r-- | wizards/source/scriptforge/SF_Exception.xba | 18 | ||||
| -rw-r--r-- | wizards/source/scriptforge/SF_Root.xba | 38 | ||||
| -rw-r--r-- | wizards/source/scriptforge/SF_Utils.xba | 2 | ||||
| -rw-r--r-- | wizards/source/scriptforge/po/ScriptForge.pot | 65 | ||||
| -rw-r--r-- | wizards/source/scriptforge/po/en.po | 65 | ||||
| -rw-r--r-- | wizards/source/sfdatabases/SF_Register.xba | 2 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Base.xba | 265 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Calc.xba | 172 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Document.xba | 88 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Form.xba | 652 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Register.xba | 2 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/script.xlb | 1 |
13 files changed, 1325 insertions, 46 deletions
diff --git a/wizards/Package_sfdocuments.mk b/wizards/Package_sfdocuments.mk index e79570ae906b..8d8be4597dd7 100644 --- a/wizards/Package_sfdocuments.mk +++ b/wizards/Package_sfdocuments.mk @@ -23,6 +23,7 @@ $(eval $(call gb_Package_add_files,wizards_basicsrvsfdocuments,$(LIBO_SHARE_FOLD SF_Base.xba \ SF_Calc.xba \ SF_Document.xba \ + SF_Form.xba \ SF_Register.xba \ __License.xba \ dialog.xlb \ diff --git a/wizards/source/scriptforge/SF_Exception.xba b/wizards/source/scriptforge/SF_Exception.xba index 5a04fc0bca29..c3f9c96dc93a 100644 --- a/wizards/source/scriptforge/SF_Exception.xba +++ b/wizards/source/scriptforge/SF_Exception.xba @@ -104,6 +104,12 @@ Const CALCADDRESSERROR = "CALCADDRESSERROR" Const DUPLICATESHEETERROR = "DUPLICATESHEETERROR" Const OFFSETADDRESSERROR = "OFFSETADDRESSERROR" +' SF_Form +Const FORMDEADERROR = "FORMDEADERROR" +Const CALCFORMNOTFOUNDERROR = "CALCFORMNOTFOUNDERROR" +Const WRITERFORMNOTFOUNDERROR = "WRITERFORMNOTFOUNDERROR" +Const BASEFORMNOTFOUNDERROR = "BASEFORMNOTFOUNDERROR" + ' SF_Dialog Const DIALOGNOTFOUNDERROR = "DIALOGNOTFOUNDERROR" Const DIALOGDEADERROR = "DIALOGDEADERROR" @@ -824,6 +830,18 @@ Try: sMessage = sLocation _ & "\n" & "\n" & .GetText("OFFSETADDRESS", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4) _ , pvArgs(5), pvArgs(6), pvArgs(7), pvArgs(8), pvArgs(9), pvArgs(10), pvArgs(11)) + Case FORMDEADERROR ' SF_Form._IsStillAlive(FormName, DocumentName) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("FORMDEAD", pvArgs(0), pvArgs(1)) + Case CALCFORMNOTFOUNDERROR ' SF_Calc.Forms(Index, SheetName, Document) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("CALCFORMNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2)) + Case WRITERFORMNOTFOUNDERROR ' SF_Document.Forms(Index, Document) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("WRITERFORMNOTFOUND", pvArgs(0), pvArgs(1)) + Case BASEFORMNOTFOUNDERROR ' SF_Base.Forms(Index, FormDocument, BaseDocument) + sMessage = sLocation _ + & "\n" & "\n" & .GetText("BASEFORMNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2)) Case DIALOGNOTFOUNDERROR ' SF_Dialog._NewDialog(Service, DialogName, WindowName) sMessage = sLocation _ & "\n" & "\n" & .GetText("DIALOGNOTFOUND", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4) _ diff --git a/wizards/source/scriptforge/SF_Root.xba b/wizards/source/scriptforge/SF_Root.xba index 74154285f551..07ec5acfca8d 100644 --- a/wizards/source/scriptforge/SF_Root.xba +++ b/wizards/source/scriptforge/SF_Root.xba @@ -725,6 +725,44 @@ Try: & "%11: An identifier\n" _ & "%12: A file name" _ ) + ' SF_Form._IsStillAlive + .AddText( Context := "FORMDEAD" _ + , MsgId := "The requested action could not be executed because the form is not open or the document was closed inadvertently.\n\n" _ + & "The concerned form is '%1' in document '%2'." _ + , Comment := "SF_Dialog._IsStillAlive error message\n" _ + & "%1: An identifier" _ + & "%2: A file name" _ + ) + ' SF_Calc.Forms + .AddText( Context := "CALCFORMNOTFOUND" _ + , MsgId := "The requested form could not be found in the Calc sheet. The given index is off-limits.\n\n" _ + & "The concerned Calc document is '%3'.\n\n" _ + & "The name of the sheet = '%2'\n" _ + & "The index = %1" _ + , Comment := "SF_Form determination\n" _ + & "%1: A number\n" _ + & "%2: A sheet name\n" _ + & "%3: A file name" _ + ) + ' SF_Document.Forms + .AddText( Context := "WRITERFORMNOTFOUND" _ + , MsgId := "The requested form could not be found in the Writer document. The given index is off-limits.\n\n" _ + & "The concerned Writer document is '%2'.\n\n" _ + & "The index = %1" _ + , Comment := "SF_Form determination\n" _ + & "%1: A number\n" _ + & "%2: A file name" _ + ) + ' SF_Base.Forms + .AddText( Context := "BASEFORMNOTFOUND" _ + , MsgId := "The requested form could not be found in the form document '%2'. The given index is off-limits.\n\n" _ + & "The concerned Base document is '%3'.\n\n" _ + & "The index = %1" _ + , Comment := "SF_Form determination\n" _ + & "%1: A number\n" _ + & "%2: A string\n" _ + & "%3: A file name" _ + ) ' SF_Dialog._NewDialog .AddText( Context := "DIALOGNOTFOUND" _ , MsgId := "The requested dialog could not be located in the given container or library.\n" _ diff --git a/wizards/source/scriptforge/SF_Utils.xba b/wizards/source/scriptforge/SF_Utils.xba index 80c939b697bd..22ad2dbceaab 100644 --- a/wizards/source/scriptforge/SF_Utils.xba +++ b/wizards/source/scriptforge/SF_Utils.xba @@ -226,6 +226,8 @@ Dim sHeader As String ' The specific header to insert Try: With _SF_ + If Not IsNull(.Interface) Then .Interface.Dispose() + ._LoadLocalizedInterface(psMode := "ADDTEXT") ' Force reload of labels from the code .Interface.ExportToPOTFile(FileName, Header := sHeader) End With diff --git a/wizards/source/scriptforge/po/ScriptForge.pot b/wizards/source/scriptforge/po/ScriptForge.pot index ea7209881cb7..9e39b5da6896 100644 --- a/wizards/source/scriptforge/po/ScriptForge.pot +++ b/wizards/source/scriptforge/po/ScriptForge.pot @@ -14,7 +14,7 @@ msgid "" msgstr "" "Project-Id-Version: PACKAGE VERSION\n" "Report-Msgid-Bugs-To: https://bugs.libreoffice.org/enter_bug.cgi?product=LibreOffice&bug_status=UNCONFIRMED&component=UI\n" -"POT-Creation-Date: 2020-12-06 12:16:30\n" +"POT-Creation-Date: 2020-12-15 15:57:29\n" "PO-Revision-Date: YYYY-MM-DD HH:MM:SS\n" "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" "Language-Team: LANGUAGE <EMAIL@ADDRESS>\n" @@ -465,7 +465,7 @@ msgstr "" #. SF_Session.ExecuteBasicScript error message #. %1: An identifier #. %2: A string -#. %3: A number +#. %3: A (long) string #, kde-format msgctxt "SCRIPTEXEC" msgid "" @@ -726,6 +726,62 @@ msgid "" "« %11 » = %12" msgstr "" +#. SF_Dialog._IsStillAlive error message +#. %1: An identifier%2: A file name +#, kde-format +msgctxt "FORMDEAD" +msgid "" +"The requested action could not be executed because the form is not " +"open or the document was closed inadvertently.\n" +"\n" +"The concerned form is '%1' in document '%2'." +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A sheet name +#. %3: A file name +#, kde-format +msgctxt "CALCFORMNOTFOUND" +msgid "" +"The requested form could not be found in the Calc sheet. The given " +"index is off-limits.\n" +"\n" +"The concerned Calc document is '%3'.\n" +"\n" +"The name of the sheet = '%2'\n" +"The index = %1" +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A file name +#, kde-format +msgctxt "WRITERFORMNOTFOUND" +msgid "" +"The requested form could not be found in the Writer document. The " +"given index is off-limits.\n" +"\n" +"The concerned Writer document is '%2'.\n" +"\n" +"The index = %1" +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A string +#. %3: A file name +#, kde-format +msgctxt "BASEFORMNOTFOUND" +msgid "" +"The requested form could not be found in the form document '%2'. The " +"given index is off-limits.\n" +"\n" +"The concerned Base document is '%3'.\n" +"\n" +"The index = %1" +msgstr "" + #. SF_Dialog creation #. %1: An identifier #. %2: A string @@ -766,7 +822,8 @@ msgstr "" msgctxt "CONTROLTYPE" msgid "" "The control '%1' in dialog '%2' is of type '%3'.\n" -"The property or method '%4' is not applicable on that type of dialog controls." +"The property or method '%4' is not applicable on that type of dialog " +"controls." msgstr "" #. SF_DialogControl add line in textbox @@ -798,4 +855,4 @@ msgid "" "Check its syntax, table and/or field names, ...\n" "\n" "SQL Statement : « %1 »" -msgstr "" +msgstr ""
\ No newline at end of file diff --git a/wizards/source/scriptforge/po/en.po b/wizards/source/scriptforge/po/en.po index ea7209881cb7..9e39b5da6896 100644 --- a/wizards/source/scriptforge/po/en.po +++ b/wizards/source/scriptforge/po/en.po @@ -14,7 +14,7 @@ msgid "" msgstr "" "Project-Id-Version: PACKAGE VERSION\n" "Report-Msgid-Bugs-To: https://bugs.libreoffice.org/enter_bug.cgi?product=LibreOffice&bug_status=UNCONFIRMED&component=UI\n" -"POT-Creation-Date: 2020-12-06 12:16:30\n" +"POT-Creation-Date: 2020-12-15 15:57:29\n" "PO-Revision-Date: YYYY-MM-DD HH:MM:SS\n" "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" "Language-Team: LANGUAGE <EMAIL@ADDRESS>\n" @@ -465,7 +465,7 @@ msgstr "" #. SF_Session.ExecuteBasicScript error message #. %1: An identifier #. %2: A string -#. %3: A number +#. %3: A (long) string #, kde-format msgctxt "SCRIPTEXEC" msgid "" @@ -726,6 +726,62 @@ msgid "" "« %11 » = %12" msgstr "" +#. SF_Dialog._IsStillAlive error message +#. %1: An identifier%2: A file name +#, kde-format +msgctxt "FORMDEAD" +msgid "" +"The requested action could not be executed because the form is not " +"open or the document was closed inadvertently.\n" +"\n" +"The concerned form is '%1' in document '%2'." +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A sheet name +#. %3: A file name +#, kde-format +msgctxt "CALCFORMNOTFOUND" +msgid "" +"The requested form could not be found in the Calc sheet. The given " +"index is off-limits.\n" +"\n" +"The concerned Calc document is '%3'.\n" +"\n" +"The name of the sheet = '%2'\n" +"The index = %1" +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A file name +#, kde-format +msgctxt "WRITERFORMNOTFOUND" +msgid "" +"The requested form could not be found in the Writer document. The " +"given index is off-limits.\n" +"\n" +"The concerned Writer document is '%2'.\n" +"\n" +"The index = %1" +msgstr "" + +#. SF_Form determination +#. %1: A number +#. %2: A string +#. %3: A file name +#, kde-format +msgctxt "BASEFORMNOTFOUND" +msgid "" +"The requested form could not be found in the form document '%2'. The " +"given index is off-limits.\n" +"\n" +"The concerned Base document is '%3'.\n" +"\n" +"The index = %1" +msgstr "" + #. SF_Dialog creation #. %1: An identifier #. %2: A string @@ -766,7 +822,8 @@ msgstr "" msgctxt "CONTROLTYPE" msgid "" "The control '%1' in dialog '%2' is of type '%3'.\n" -"The property or method '%4' is not applicable on that type of dialog controls." +"The property or method '%4' is not applicable on that type of dialog " +"controls." msgstr "" #. SF_DialogControl add line in textbox @@ -798,4 +855,4 @@ msgid "" "Check its syntax, table and/or field names, ...\n" "\n" "SQL Statement : « %1 »" -msgstr "" +msgstr ""
\ No newline at end of file diff --git a/wizards/source/sfdatabases/SF_Register.xba b/wizards/source/sfdatabases/SF_Register.xba index 63ad2085d772..c9b3f03d7334 100644 --- a/wizards/source/sfdatabases/SF_Register.xba +++ b/wizards/source/sfdatabases/SF_Register.xba @@ -133,7 +133,7 @@ End Function ' SFDatabases.SF_Register._NewDatabase REM ----------------------------------------------------------------------------- Public Function _NewDatabaseFromSource(Optional ByVal pvArgs As Variant) As Object -'ByRef poDataSource As Object _ +' ByRef poDataSource As Object _ ' , ByVal psUser As String _ ' , ByVal psPassword As String _ ' ) As Object diff --git a/wizards/source/sfdocuments/SF_Base.xba b/wizards/source/sfdocuments/SF_Base.xba index 05787fa99a33..6ae761eef85c 100644 --- a/wizards/source/sfdocuments/SF_Base.xba +++ b/wizards/source/sfdocuments/SF_Base.xba @@ -26,7 +26,9 @@ Option Explicit ''' the parent methods and properties. ''' They should also duplicate some generic private members as a subset of their own set of members ''' -''' The SF_Base module is provided only to block parent properties that are NOT applicable to Base documents +''' The SF_Base module is provided mainly to block parent properties that are NOT applicable to Base documents +''' In addition, it provides methods to identify form documents and access their internal forms +''' (read more elsewhere (the "SFDocuments.Form" service) about this subject) ''' ''' The current module is closely related to the "UI" service of the ScriptForge library ''' @@ -46,6 +48,8 @@ Option Explicit REM ================================================================== EXCEPTIONS Private Const DBCONNECTERROR = "DBCONNECTERROR" +Private Const FORMDEADERROR = "FORMDEADERROR" +Private Const BASEFORMNOTFOUNDERROR = "BASEFORMNOTFOUNDERROR" REM ============================================================= PRIVATE MEMBERS @@ -55,14 +59,18 @@ Private [_Super] As Object ' Document superclass, which the current ins Private ObjectType As String ' Must be BASE Private ServiceName As String -' Window component +' UNO references Private _Component As Object ' com.sun.star.comp.dba.ODatabaseDocument Private _DataSource As Object ' com.sun.star.comp.dba.ODatabaseSource Private _Database As Object ' SFDatabases.Database service instance +Private _FormDocuments As Object REM ============================================================ MODULE CONSTANTS -REM ===================================================== CONSTRUCTOR/DESTRUCTOR +Const ISBASEFORM = 2 ' Form is stored in a Base document +Const cstToken = "//" ' Form names accept special characters but not slashes + +REM ====================================================== CONSTRUCTOR/DESTRUCTOR REM ----------------------------------------------------------------------------- Private Sub Class_Initialize() @@ -74,6 +82,7 @@ Private Sub Class_Initialize() Set _Component = Nothing Set _DataSource = Nothing Set _Database = Nothing + Set _FormDocuments = Nothing End Sub ' SFDocuments.SF_Base Constructor REM ----------------------------------------------------------------------------- @@ -107,7 +116,7 @@ Const cstSubArgs = "[SaveAsk=True]" Check: If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", V_BOOLEAN) Then GoTo Finally End If @@ -124,6 +133,131 @@ Catch: End Function ' SFDocuments.SF_Base.CloseDocument REM ----------------------------------------------------------------------------- +Public Function FormDocuments() As Variant +''' Return the list of the FormDocuments contained in the Base document +''' Args: +''' Returns: +''' A zero-base array of strings +''' Each entry is the full path name of a form document. The path separator is the slash ("/") +''' Example: +''' Dim myForm As Object, myList As Variant +''' myList = oDoc.FormDocuments() + +Dim vFormNames As Variant ' Array of all form names present in the document +Const cstThisSub = "SFDocuments.Base.FormDocuments" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + End If + +Try: + ' Build list of available FormDocuments recursively with _CollectFormDocuments + If IsNull(_FormDocuments) Then Set _FormDocuments = _Component.getFormDocuments() + vFormNames = Split(_CollectFormDocuments(_FormDocuments), cstToken) + +Finally: + FormDocuments = vFormNames + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Base.FormDocuments + +REM ----------------------------------------------------------------------------- +Public Function Forms(Optional ByVal FormDocument As Variant _ + , Optional ByVal Form As Variant _ + ) As Variant +''' Return either +''' - the list of the Forms contained in the form document +''' - a SFDocuments.Form object based on its name or its index +''' Args: +''' FormDocument: a valid document form name as a case-sensitive string +''' Form: a form stored in the Base document given by its name or its index +''' When absent, the list of available forms is returned +''' To get the first (unique ?) form stored in the form document, set Form = 0 +''' Returns: +''' A zero-base array of strings if Form is absent +''' An instance of the SF_Form class if Form exists +''' Exceptions: +''' FORMDEADERROR The form is not open +''' BASEFORMNOTFOUNDERROR FormDocument OK but Form not found +''' Example: +''' Dim myForm As Object, myList As Variant +''' myList = oDoc.Forms("Folder1/myFormDocument") +''' Set myForm = oDoc.Forms("Folder1/myFormDocument", 0) + +Dim oForm As Object ' The new Form class instance +Dim oMainForm As Object ' com.sun.star.comp.sdb.Content +Dim oXForm As Object ' com.sun.star.form.XForm +Dim vFormDocuments As Variant ' Array of form documents +Dim vFormNames As Variant ' Array of form names +Dim oForms As Object ' Forms collection +Const cstDrawPage = 0 ' Only 1 drawpage in a Base document + +Const cstThisSub = "SFDocuments.Base.Forms" +Const cstSubArgs = "FormDocument, [Form=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Form) Or IsEmpty(Form) Then Form = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + ' Build list of available FormDocuments recursively with _CollectFormDocuments + If IsNull(_FormDocuments) Then Set _FormDocuments = _Component.getFormDocuments() + vFormDocuments = Split(_CollectFormDocuments(_FormDocuments), cstToken) + If Not ScriptForge.SF_Utils._Validate(FormDocument, "FormDocument", V_STRING, vFormDocuments) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Form, "Form", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally + End If + If Not IsLoaded(FormDocument) Then GoTo CatchClosed + +Try: + ' Start from the form document and go down to forms + Set oMainForm = _FormDocuments.getByHierarchicalName(FormDocument) + Set oForms = oMainForm.Component.DrawPages(cstDrawPage).Forms + vFormNames = oForms.getElementNames() + + If Len(Form) = 0 Then ' Return the list of valid form names + Forms = vFormNames + Else + If VarType(Form) = V_STRING Then ' Find the form by name + If Not ScriptForge.SF_Utils._Validate(Form, "Form", V_STRING, vFormNames) Then GoTo Finally + Set oXForm = oForms.getByName(Form) + Else ' Find the form by index + If Form < 0 Or Form >= oForms.Count Then GoTo CatchNotFound + Set oXForm = oForms.getByIndex(Form) + End If + ' Create the new Form class instance + Set oForm = New SF_Form + With oForm + ._Name = oXForm.Name + Set .[Me] = oForm + Set .[_Parent] = [Me] + ._DrawPage = cstDrawPage + ._UsualName = FormDocument & " : " & ._Name + Set ._MainForm = oMainForm + ._FormType = ISBASEFORM + Set ._Form = oXForm + End With + Set Forms = oForm + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchClosed: + ScriptForge.SF_Exception.RaiseFatal(FORMDEADERROR, FormDocument, _FileIdent()) +CatchNotFound: + ScriptForge.SF_Exception.RaiseFatal(BASEFORMNOTFOUNDERROR, Form, FormDocument, _FileIdent()) +End Function ' SFDocuments.SF_Base.Forms + +REM ----------------------------------------------------------------------------- Public Function GetDatabase(Optional ByVal User As Variant _ , Optional ByVal Password As Variant _ ) As Object @@ -148,7 +282,7 @@ 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 [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _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 @@ -210,12 +344,60 @@ Catch: End Function ' SFDocuments.SF_Base.GetProperty REM ----------------------------------------------------------------------------- +Public Function IsLoaded(Optional ByVal FormDocument As Variant) As Boolean +''' Return True if the given FormDocument is open for the user +''' Args: +''' FormDocument: a valid document form name as a case-sensitive string +''' Returns: +''' True if the form document is currently open, otherise False +''' Exceptions: +''' Form is invalid +''' Example: +''' MsgBox oDoc.IsLoaded("Folder1/myFormDocument") + +Dim bLoaded As Boolean ' Return value +Dim vFormNames As Variant ' Array of all document form names present in the document +Dim oMainForm As Object ' com.sun.star.comp.sdb.Content +Const cstThisSub = "SFDocuments.Base.IsLoaded" +Const cstSubArgs = "FormDocument" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bLoaded = False + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + ' Build list of available FormDocuments recursively with _CollectFormDocuments + If IsNull(_FormDocuments) Then Set _FormDocuments = _Component.getFormDocuments() + vFormNames = Split(_CollectFormDocuments(_FormDocuments), cstToken) + If Not ScriptForge.SF_Utils._Validate(FormDocument, "FormDocument", V_STRING, vFormNames) Then GoTo Finally + End If + +Try: + + Set oMainForm = _FormDocuments.getByHierarchicalName(FormDocument) + ' A document form that has never been opened has no component + ' If ever opened and closed afterwards, it keeps the Component but loses its Controller + bLoaded = Not IsNull(oMainForm.Component) + If bLoaded Then bLoaded = Not IsNull(oMainForm.Component.CurrentController) + +Finally: + IsLoaded = bLoaded + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Base.IsLoaded + +REM ----------------------------------------------------------------------------- Public Function Methods() As Variant ''' Return the list of public methods of the Model service as an array Methods = Array( _ "Activate" _ , "CloseDocument" _ + , "FormDocuments" _ + , "Forms" _ , "GetDatabase" _ , "RunCommand" _ , "Save" _ @@ -274,7 +456,7 @@ Finally: Exit Function Catch: GoTo Finally -End Function ' SFDocuments.SF_Documents.SetProperty +End Function ' SFDocuments.SF_Base.SetProperty REM ======================================================= SUPERCLASS PROPERTIES @@ -418,6 +600,73 @@ End Function ' SFDocuments.SF_Base.SaveCopyAs REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- +Private Function _CollectFormDocuments(ByRef poContainer As Object) As String +''' Returns a token-separated string of all hierarchical formdocument names +''' depending on the formdocuments container in argument +''' The function traverses recursively the whle tree below the container +''' The initial call starts from the container _Component.getFormDocuments +''' The list contains closed and open forms + +Dim sCollectNames As String ' Returno value +Dim oSubItem As Object ' com.sun.star.container.XNameAccess (folder) or com.sun.star.ucb.XContent (form) +Dim sFormName As String ' Single form name +Dim i As Long +Const cstFormType = "application/vnd.oasis.opendocument.text" + ' Identifies forms. Folders have a zero-length content type + + On Local Error GoTo Finally + +Try: + sCollectNames = "" + With poContainer + For i = 0 To .Count - 1 + Set oSubItem = .getByIndex(i) + If oSubItem.ContentType = cstFormType Then ' Add the form to the list + sCollectNames = sCollectNames & cstToken & oSubItem.HierarchicalName + Else + sCollectNames = sCollectNames & cstToken & _CollectFormDocuments(oSubItem) + End If + Next i + End With + +Finally: + _CollectFormDocuments = Mid(sCollectNames, Len(cstToken) + 1) ' Skip the initial token + Exit Function +End Function ' SFDocuments.SF_Base._CollectFormDocuments + +REM ----------------------------------------------------------------------------- +Private Function _FileIdent() As String +''' Returns a file identification from the information that is currently available +''' Useful e.g. for display in error messages + + _FileIdent = [_Super]._FileIdent() + +End Function ' SFDocuments.SF_Base._FileIdent + +REM ----------------------------------------------------------------------------- +Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _ + , Optional ByVal pbError As Boolean _ + ) As Boolean +''' Returns True if the document has not been closed manually or incidentally since the last use +''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default) +''' Args: +''' pbForUpdate: if True (default = False), check additionally if document is open for editing +''' pbError: if True (default), raise a fatal error + +Dim bAlive As Boolean ' Return value + + If IsMissing(pbForUpdate) Then pbForUpdate = False + If IsMissing(pbError) Then pbError = True + +Try: + bAlive = [_Super]._IsStillAlive(pbForUpdate, pbError) + +Finally: + _IsStillAlive = bAlive + Exit Function +End Function ' SFDocuments.SF_Base._IsStillAlive + +REM ----------------------------------------------------------------------------- Private Function _PropertyGet(Optional ByVal psProperty As String _ , Optional ByVal pvArg As Variant _ ) As Variant @@ -437,7 +686,7 @@ Const cstSubArgs = "" cstThisSub = "SFDocuments.SF_Base.get" & psProperty ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally Select Case psProperty Case Else @@ -461,4 +710,4 @@ Private Function _Repr() As String End Function ' SFDocuments.SF_Base._Repr REM ============================================ END OF SFDOCUMENTS.SF_BASE -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/SF_Calc.xba b/wizards/source/sfdocuments/SF_Calc.xba index 892d7268ad5f..86825961630c 100644 --- a/wizards/source/sfdocuments/SF_Calc.xba +++ b/wizards/source/sfdocuments/SF_Calc.xba @@ -80,6 +80,7 @@ Private Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR" Private Const CALCADDRESSERROR = "CALCADDRESSERROR" Private Const DUPLICATESHEETERROR = "DUPLICATESHEETERROR" Private Const OFFSETADDRESSERROR = "OFFSETADDRESSERROR" +Private Const CALCFORMNOTFOUNDERROR = "CALCFORMNOTFOUNDERROR" REM ============================================================= PRIVATE MEMBERS @@ -115,7 +116,9 @@ Private Const MAXROWS = 2^20 ' Max number of rows in a sheet Private Const CALCREFERENCE = "SF_CalcReference" ' Object type of _Address -REM ===================================================== CONSTRUCTOR/DESTRUCTOR +Private Const ISCALCFORM = 2 ' Form is stored in a Calc document + +REM ====================================================== CONSTRUCTOR/DESTRUCTOR REM ----------------------------------------------------------------------------- Private Sub Class_Initialize() @@ -163,7 +166,7 @@ Const cstSubArgs = "Selection" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If IsArray(pvSelection) Then If Not ScriptForge.SF_Utils._ValidateArray(pvSelection, "pvSelection", 1, V_STRING, True) Then GoTo Finally Else @@ -276,7 +279,7 @@ Const cstSubArgs = "[SheetName]" Check: If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = "" If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not _ValidateSheet(SheetName, "SheetName", , , True) Then GoTo Finally End If @@ -315,7 +318,7 @@ Const cstSubArgs = "Range" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If @@ -360,7 +363,7 @@ Const cstSubArgs = "Range" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If @@ -399,7 +402,7 @@ Const cstSubArgs = "Range" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If @@ -460,7 +463,7 @@ Const cstSubArgs = "SheetName, NewName, [BeforeSheet="""&quo Check: If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not _ValidateSheet(SheetName, "SheetName", , True, , , True) Then GoTo Finally If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally @@ -549,7 +552,7 @@ Const cstSubArgs = "FileName, SheetName, NewName, [BeforeSheet="" Check: If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(SheetName, "SheetName", V_STRING) Then GoTo Finally If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally @@ -623,7 +626,7 @@ Const cstSubArgs = "SourceRange, DestinationCell" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , , CALCREFERENCE) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally End If @@ -714,7 +717,7 @@ Const cstSubArgs = "SourceRange, DestinationRange" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , , CALCREFERENCE) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(DestinationRange, "DestinationRange", V_STRING) Then GoTo Finally End If @@ -849,6 +852,86 @@ Finally: End Function ' SF_Documents.SF_Calc.DSum REM ----------------------------------------------------------------------------- +Public Function Forms(Optional ByVal SheetName As Variant _ + , Optional ByVal Form As Variant _ + ) As Variant +''' Return either +''' - the list of the Forms contained in the given sheet +''' - a SFDocuments.Form object based on its name or its index +''' Args: +''' Form: a form stored in the document given by its name or its index +''' When absent, the list of available forms is returned +''' To get the first (unique ?) form stored in the form document, set Form = 0 +''' Exceptions: +''' CALCFORMNOTFOUNDERROR Form not found +''' Returns: +''' A zero-base array of strings if Form is absent +''' An instance of the SF_Form class if Form exists +''' Example: +''' Dim myForm As Object, myList As Variant +''' myList = oDoc.Forms() +''' Set myForm = oDoc.Forms("myForm") + +Dim oForm As Object ' The new Form class instance +Dim oMainForm As Object ' com.sun.star.comp.sdb.Content +Dim oXForm As Object ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm +Dim vFormNames As Variant ' Array of form names +Dim oForms As Object ' Forms collection +Const cstDrawPage = -1 ' There is no DrawPages collection in Calc sheets + +Const cstThisSub = "SFDocuments.Calc.Forms" +Const cstSubArgs = "SheetName, [Form=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Form) Or IsEmpty(Form) Then Form = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Form, "Form", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally + End If + +Try: + ' Start from the Calc sheet and go down to forms + Set oForms = _Component.getSheets.getByName(SheetName).DrawPage.Forms + vFormNames = oForms.getElementNames() + + If Len(Form) = 0 Then ' Return the list of valid form names + Forms = vFormNames + Else + If VarType(Form) = V_STRING Then ' Find the form by name + If Not ScriptForge.SF_Utils._Validate(Form, "Form", V_STRING, vFormNames) Then GoTo Finally + Set oXForm = oForms.getByName(Form) + Else ' Find the form by index + If Form < 0 Or Form >= oForms.Count Then GoTo CatchNotFound + Set oXForm = oForms.getByIndex(Form) + End If + ' Create the new Form class instance + Set oForm = New SF_Form + With oForm + ._Name = oXForm.Name + Set .[Me] = oForm + Set .[_Parent] = [Me] + ._DrawPage = cstDrawPage + ._UsualName = SheetName & " : " & ._Name + Set ._MainForm = Nothing + ._FormType = ISCALCFORM + Set ._Form = oXForm + End With + Set Forms = oForm + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotFound: + ScriptForge.SF_Exception.RaiseFatal(CALCFORMNOTFOUNDERROR, Form, _FileIdent()) +End Function ' SFDocuments.SF_Calc.Forms + +REM ----------------------------------------------------------------------------- Function GetColumnName(Optional ByVal ColumnNumber As Variant) As String ''' Convert a column number (range 1, 2,..1024) into its letter counterpart (range 'A', 'B',..'AMJ'). ''' Args: @@ -905,7 +988,7 @@ Const cstSubArgs = "Range" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If @@ -988,7 +1071,7 @@ Const cstSubArgs = "Range" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If @@ -1053,7 +1136,7 @@ Const cstSubArgs = "FileName, DestinationCell, [FilterOptions]="" Check: If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = cstFilterOptions If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally End If @@ -1129,7 +1212,7 @@ Check: If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = "" If IsMissing(DirectSQL) Or IsEmpty(DirectSQL) Then DirectSQL = False If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName", , True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(SQLCommand, "SQLCommand", V_STRING) Then GoTo Finally @@ -1219,7 +1302,7 @@ Const cstSubArgs = "SheetName, [BeforeSheet=""""]" Check: If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not _ValidateSheet(SheetName, "SheetName", True) Then GoTo Finally If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally End If @@ -1321,7 +1404,7 @@ Const cstSubArgs = "Source, Destination" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not _Validate(Source, "Source", V_STRING) Then GoTo Finally If Not _Validate(Destination, "Destination", V_STRING) Then GoTo Finally End If @@ -1375,7 +1458,7 @@ Const cstSubArgs = "SheetName, [BeforeSheet=""""]" Check: If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally End If @@ -1442,7 +1525,7 @@ Check: If IsMissing(Height) Or IsEmpty(Height) Then Height = 0 If IsMissing(Width) Or IsEmpty(Width) Then Width = 0 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally @@ -1517,7 +1600,7 @@ Const cstSubArgs = "SheetName" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally End If @@ -1557,7 +1640,7 @@ Const cstSubArgs = "SheetName, NewName" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _IsStillAlive(True) Then GoTo Finally If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally End If @@ -1604,7 +1687,7 @@ Const cstSubArgs = "TargetCell, Value" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(TargetCell, "TargetCell", V_STRING) Then GoTo Finally If IsArray(Value) Then If Not ScriptForge.SF_Utils._ValidateArray(Value, "Value") Then GoTo Finally @@ -1659,7 +1742,7 @@ Const cstSubArgs = "TargetRange, Style" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally Set oStyleFamilies = _Component.StyleFamilies If oStyleFamilies.hasByName(cstStyle) Then vStyles = oStyleFamilies.getByName(cstStyle).getElementNames() Else vStyles = Array() @@ -1714,7 +1797,7 @@ Const cstSubArgs = "TargetRange, Formula" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally If IsArray(Formula) Then If Not ScriptForge.SF_Utils._ValidateArray(Formula, "Formula", 0, V_STRING) Then GoTo Finally @@ -1831,7 +1914,7 @@ Const cstSubArgs = "TargetRange, Value" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally If IsArray(Value) Then If Not ScriptForge.SF_Utils._ValidateArray(Value, "Value") Then GoTo Finally @@ -1920,7 +2003,7 @@ Check: If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False If IsMissing(SortColumns) Or IsEmpty(SortColumns) Then SortColumns = False If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._ValidateArray(SortKeys, "SortKeys", 1, V_NUMERIC, True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally @@ -2339,7 +2422,7 @@ Const cstSubArgs = "Range" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If @@ -2365,6 +2448,15 @@ Catch: End Function ' SF_Documents.SF_Calc._DFunction REM ----------------------------------------------------------------------------- +Private Function _FileIdent() As String +''' Returns a file identification from the information that is currently available +''' Useful e.g. for display in error messages + + _FileIdent = [_Super]._FileIdent() + +End Function ' SFDocuments.SF_Calc._FileIdent + +REM ----------------------------------------------------------------------------- Function _GetColumnName(ByVal plColumnNumber As Long) As String ''' Convert a column number (range 1, 2,..1024) into its letter counterpart (range 'A', 'B',..'AMJ'). ''' Args: @@ -2391,6 +2483,29 @@ Finally: End Function ' SFDocuments.SF_Calc._GetColumnName REM ----------------------------------------------------------------------------- +Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _ + , Optional ByVal pbError As Boolean _ + ) As Boolean +''' Returns True if the document has not been closed manually or incidentally since the last use +''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default) +''' Args: +''' pbForUpdate: if True (default = False), check additionally if document is open for editing +''' pbError: if True (default), raise a fatal error + +Dim bAlive As Boolean ' Return value + + If IsMissing(pbForUpdate) Then pbForUpdate = False + If IsMissing(pbError) Then pbError = True + +Try: + bAlive = [_Super]._IsStillAlive(pbForUpdate, pbError) + +Finally: + _IsStillAlive = bAlive + Exit Function +End Function ' SFDocuments.SF_Calc._IsStillAlive + +REM ----------------------------------------------------------------------------- Private Function _LastCell(ByRef poSheet As Object) As Variant ''' Returns in an array the coordinates of the last used cell in the given sheet @@ -2632,7 +2747,7 @@ Const cstSubArgs = "" cstThisSub = "SFDocuments.SF_Calc.get" & psProperty ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) - If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _IsStillAlive() Then GoTo Finally Select Case psProperty Case "CurrentSelection" @@ -2782,6 +2897,7 @@ Private Function _ValidateSheet(Optional ByRef pvSheetName As Variant _ ''' Sheet designation validation function similar to the SF_Utils._ValidateXXX functions ''' Args: ''' pvSheetName: string or numeric position +''' pvArgName: the name of the variable to be used in the error message ''' pvNew: if True, sheet must not exist (default = False) ''' pvActive: if True, the shortcut "~" is accepted (default = False) ''' pvOptional: if True, a zero-length string is accepted (default = False) @@ -2840,4 +2956,4 @@ CatchDuplicate: End Function ' SFDocuments.SF_Calc._ValidateSheet REM ============================================ END OF SFDOCUMENTS.SF_CALC -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/SF_Document.xba b/wizards/source/sfdocuments/SF_Document.xba index a9fd48af0424..227638e99efa 100644 --- a/wizards/source/sfdocuments/SF_Document.xba +++ b/wizards/source/sfdocuments/SF_Document.xba @@ -24,6 +24,8 @@ Option Explicit ''' - accessing their standard or custom properties ''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Writer, ... ''' +''' Documents might contain forms. The current service gives access to the "SFDocuments.Form" service +''' ''' 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 ''' the parent methods and properties implemented below @@ -53,10 +55,13 @@ Private Const DOCUMENTSAVEERROR = "DOCUMENTSAVEERROR" Private Const DOCUMENTSAVEASERROR = "DOCUMENTSAVEASERROR" Private Const DOCUMENTREADONLYERROR = "DOCUMENTREADONLYERROR" +Private Const FORMDEADERROR = "FORMDEADERROR" + REM ============================================================= PRIVATE MEMBERS Private [Me] As Object Private [_Parent] As Object +Private [_SubClass] As Object ' Subclass instance Private ObjectType As String ' Must be DOCUMENT Private ServiceName As String @@ -74,12 +79,15 @@ Private _CustomProperties As Object ' Dictionary of custom properties REM ============================================================ MODULE CONSTANTS -REM ===================================================== CONSTRUCTOR/DESTRUCTOR +Const ISDOCFORM = 1 ' Form is stored in a Calc, Writer, ... document + +REM ====================================================== CONSTRUCTOR/DESTRUCTOR REM ----------------------------------------------------------------------------- Private Sub Class_Initialize() Set [Me] = Nothing Set [_Parent] = Nothing + Set [_SubClass] = Nothing ObjectType = "DOCUMENT" ServiceName = "SFDocuments.Document" Set _Component = Nothing @@ -449,6 +457,84 @@ Catch: End Function ' SFDocuments.SF_Document.CloseDocument REM ----------------------------------------------------------------------------- +Public Function Forms(Optional ByVal Form As Variant) As Variant +''' APPLICABLE ONLY ON WRITER DOCUMENTS +''' Return either +''' - the list of the Forms contained in the form document +''' - a SFDocuments.Form object based on its name or its index +''' Args: +''' Form: a form stored in the document given by its name or its index +''' When absent, the list of available forms is returned +''' To get the first (unique ?) form stored in the form document, set Form = 0 +''' Exceptions: +''' WRITERFORMNOTFOUNDERROR Form not found +''' Returns: +''' A zero-base array of strings if Form is absent +''' An instance of the SF_Form class if Form exists +''' Example: +''' Dim myForm As Object, myList As Variant +''' myList = oDoc.Forms() +''' Set myForm = oDoc.Forms("myForm") + +Dim oForm As Object ' The new Form class instance +Dim oMainForm As Object ' com.sun.star.comp.sdb.Content +Dim oXForm As Object ' com.sun.star.form.XForm +Dim vFormNames As Variant ' Array of form names +Dim oForms As Object ' Forms collection +Const cstDrawPage = 0 ' Only 1 drawpage in a Writer document + +Const cstThisSub = "SFDocuments.Document.Forms" +Const cstSubArgs = "[Form=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Form) Or IsEmpty(Form) Then Form = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Form, "Form", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally + End If + +Try: + ' Start from the document component and go down to forms + Set oForms = _Component.DrawPages(cstDrawPage).Forms + vFormNames = oForms.getElementNames() + + If Len(Form) = 0 Then ' Return the list of valid form names + Forms = vFormNames + Else + If VarType(Form) = V_STRING Then ' Find the form by name + If Not ScriptForge.SF_Utils._Validate(Form, "Form", V_STRING, vFormNames) Then GoTo Finally + Set oXForm = oForms.getByName(Form) + Else ' Find the form by index + If Form < 0 Or Form >= oForms.Count Then GoTo CatchNotFound + Set oXForm = oForms.getByIndex(Form) + End If + ' Create the new Form class instance + Set oForm = New SF_Form + With oForm + ._Name = oXForm.Name + Set .[Me] = oForm + Set .[_Parent] = [Me] + ._DrawPage = cstDrawPage + ._UsualName = ._Name + Set ._MainForm = Nothing + ._FormType = ISDOCFORM + Set ._Form = oXForm + End With + Set Forms = oForm + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotFound: + ScriptForge.SF_Exception.RaiseFatal(WRITERFORMNOTFOUNDERROR, Form, _FileIdent()) +End Function ' SFDocuments.SF_Document.Forms + +REM ----------------------------------------------------------------------------- Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant ''' Return the actual value of the given property ''' Args: diff --git a/wizards/source/sfdocuments/SF_Form.xba b/wizards/source/sfdocuments/SF_Form.xba new file mode 100644 index 000000000000..cdc4fbe92c35 --- /dev/null +++ b/wizards/source/sfdocuments/SF_Form.xba @@ -0,0 +1,652 @@ +<?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. +''' For Base 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". 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 (often) linked to a 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 ================================================================== EXCEPTIONS + +Private Const FORMDEADERROR = "FORMDEADERROR" + +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 _DrawPage As Long ' Index in DrawOages collection +Private _UsualName As String ' Name as known by user +Private _FormType As Integer ' One of the ISxxxFORM constants + +' Form UNO references +' The forms container found in a Base document +' Vital for Base forms and subforms +Private _MainForm As Object ' com.sun.star.comp.sdb.Content +' The entry to the interactions with the form. Set 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 + +' Persistent storage for controls +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 stored in a Base document or of another subform + +REM ====================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + ObjectType = "Form" + ServiceName = "SFDocuments.Form" + _Name = "" + _DrawPage = -1 + _FormType = 0 + Set _MainForm = Nothing + Set _Form = Nothing + Set _Database = Nothing + _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 + Call Class_Terminate() + Set Dispose = Nothing +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) + +REM ----------------------------------------------------------------------------- +Property Let Caption(Optional ByVal pvCaption As Variant) +''' Set the updatable property Caption + _PropertySet("Caption", pvCaption) +End Property ' SFDocumentsDialog.SF_Form.Caption (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) + +REM ----------------------------------------------------------------------------- +Property Let Height(Optional ByVal pvHeight As Variant) +''' Set the updatable property Height + _PropertySet("Height", pvHeight) +End Property ' SFDocuments.SF_Form.Height (let) + +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 Visible() As Variant +''' The Visible property is False before the Execute() statement + Visible = _PropertyGet("Visible") +End Property ' SFDocuments.SF_Form.Visible (get) + +REM ----------------------------------------------------------------------------- +Property Let Visible(Optional ByVal pvVisible As Variant) +''' Set the updatable property Visible + _PropertySet("Visible", pvVisible) +End Property ' SFDocuments.SF_Form.Visible (let) + +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) + +REM ----------------------------------------------------------------------------- +Property Let Width(Optional ByVal pvWidth As Variant) +''' Set the updatable property Width + _PropertySet("Width", pvWidth) +End Property ' SFDocuments.SF_Form.Width (let) + +REM ----------------------------------------------------------------------------- +Property Get XFormModel() As Object +''' The XFormModel property returns the model UNO object of the Form + XFormModel = _PropertyGet("XFormModel") +End Property ' SFDocuments.SF_Form.XFormModel (get) + +REM ----------------------------------------------------------------------------- +Property Get XFormView() As Object +''' The XFormView property returns the view UNO object of the Form + XFormView = _PropertyGet("XFormView") +End Property ' SFDocuments.SF_Form.XFormView (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 fForm +''' Args: +''' Returns: +''' True if focusing is successful +''' Example: +''' Dim oDlg As Object +''' Set oDlg = CreateScriptService(,, "myForm") ' Form stored in current document's standard library +''' oDlg.Activate() + +Dim bActivate As Boolean ' Return value +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: + +Finally: + Activate = bActivate + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Form.Activate + +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 = CreateScriptService("SFDocuments.Form", Container, Library, FormName) +''' 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 +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: + If Len(ControlName) = 0 Then + Else + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotFound: + ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING, _FormModel.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 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 Len(_Form.DataSOurceName) = 0 Then ' There is no database linked with the form + ' Return Nothing + Else + ' Check if DataSourceName is a file or a registrered 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 Model service as an array + + Methods = Array( _ + "Activate" _ + , "CloseForm" _ + , "Controls" _ + , "First" _ + , "GetDatabase" _ + , "Last" _ + , "Move" _ + , "New" _ + , "Next" _ + , "Previous" _ + , "Refresh" _ + , "Requery" _ + , "SubForms" _ + ) + +End Function ' SFDocuments.SF_Form.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Form class as an array + + Properties = Array( _ + "AllowAdditions" _ + , "AllowDeletions" _ + , "AllowEdits" _ + , "Bookmark" _ + , "Caption" _ + , "CurrentRecord" _ + , "Filter" _ + , "FilterOn" _ + , "Height" _ + , "IsLoaded" _ + , "LinkChildFields" _ + , "LinkParentFields" _ + , "Name" _ + , "OnApproveCursorMove" _ + , "OnApproveParameter" _ + , "OnApproveReset" _ + , "OnApproveRowChange" _ + , "OnApproveSubmit" _ + , "OnConfirmDelete" _ + , "OnCursorMoved" _ + , "OnErrorOccurred" _ + , "OnLoaded" _ + , "OnReloaded" _ + , "OnReloading" _ + , "OnResetted" _ + , "OnRowChanged" _ + , "OnUnloaded" _ + , "OnUnloading" _ + , "OrderBy" _ + , "OrderByOn" _ + , "RecordSource" _ + , "Visible" _ + , "Width" _ + ) + +End Function ' SFDocuments.SF_Form.Properties + +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 =========================================================== 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 Else + _GetListener = "" + End Select + +End Function ' SFDocuments.SF_Form._GetListener + +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 partially (part related to open forms) 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 + +Check: + On Local Error GoTo Catch ' Anticipate DisposedException errors or alike + If IsMissing(pbError) Then pbError = True + +Try: + ' For usual documents, check that the parent document is still open + ' For Base forms and subforms, check the openess of the main form + Select Case _FormType + Case ISDOCFORM, ISCALCFORM + bAlive = [_Parent]._IsStillAlive(pbError) + Case ISBASEFORM, ISSUBFORM + ' A form that has never been opened has no component + ' If ever opened and closed afterwards, it keeps the Component but loses its Controller + bAlive = Not IsNull(_MainForm.Component) + If bAlive Then bAlive = Not IsNull(_MainForm.Component.CurrentController) + End Select + If Not bAlive Then GoTo Catch + +Finally: + _IsStillAlive = bAlive + Exit Function +Catch: + bAlive = False + On Error GoTo 0 + ' Dispose the properties related to *open* forms + Set _Form = Nothing + If Not IsNull(_Database) And _FormType = ISDOCFORM Then Set _Database = _Database.Dispose() + Set _ControlCache = Nothing + ' Display error message + If pbError Then ScriptForge.SF_Exception.RaiseFatal(FORMDEADERROR, _Name, [_Parent]._FileIdent()) + 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 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) + ' All the properties except one require an open form + 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("Name") + Case UCase("Visible") + Case UCase("Width") + 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 +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("Caption") + Case UCase("Height") + Case UCase("Visible") + Case UCase("Width") + 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" + + _Repr = "[Form]: " & _UsualName + +End Function ' SFDocuments.SF_Form._Repr + +REM ============================================ END OF SFDOCUMENTS.SF_FORM +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/SF_Register.xba b/wizards/source/sfdocuments/SF_Register.xba index 40f327bb0d41..d003eee71c31 100644 --- a/wizards/source/sfdocuments/SF_Register.xba +++ b/wizards/source/sfdocuments/SF_Register.xba @@ -158,10 +158,12 @@ Try: Set oDocument = New SF_Base Set oSuperDocument = New SF_Document Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned + Set oSuperDocument.[_SubClass] = oDocument Case "Calc" Set oDocument = New SF_Calc Set oSuperDocument = New SF_Document Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned + Set oSuperDocument.[_SubClass] = oDocument Case Else ' Only superclass Set oDocument = New SF_Document Set oSuperDocument = oDocument diff --git a/wizards/source/sfdocuments/script.xlb b/wizards/source/sfdocuments/script.xlb index 82a939306752..fc075b026fc1 100644 --- a/wizards/source/sfdocuments/script.xlb +++ b/wizards/source/sfdocuments/script.xlb @@ -6,4 +6,5 @@ <library:element library:name="SF_Calc"/> <library:element library:name="SF_Register"/> <library:element library:name="SF_Base"/> + <library:element library:name="SF_Form"/> </library:library>
\ No newline at end of file |