diff options
Diffstat (limited to '')
| -rw-r--r-- | wizards/source/sfdocuments/SF_Base.xba | 993 |
1 files changed, 993 insertions, 0 deletions
diff --git a/wizards/source/sfdocuments/SF_Base.xba b/wizards/source/sfdocuments/SF_Base.xba new file mode 100644 index 000000000..1e6395dbf --- /dev/null +++ b/wizards/source/sfdocuments/SF_Base.xba @@ -0,0 +1,993 @@ +<?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_Base" 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_Base +''' ======= +''' +''' The SFDocuments library gathers a number of methods and properties making easy +''' the management and several manipulations of 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, ... +''' +''' 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. +''' They should also duplicate some generic private members as a subset of their own set of members +''' +''' 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 +''' +''' Service invocation examples: +''' 1) From the UI service +''' Dim ui As Object, oDoc As Object +''' Set ui = CreateScriptService("UI") +''' Set oDoc = ui.CreateBaseDocument("C:\Me\MyFile.odb", ...) +''' ' or Set oDoc = ui.OpenDocument("C:\Me\MyFile.odb") +''' 2) Directly if the document is already opened +''' Dim oDoc As Object +''' Set oDoc = CreateScriptService("SFDocuments.Base", "MyFile.odb") +''' ' The substring "SFDocuments." in the service name is optional +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_base.html?DbPAR=BASIC +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Private Const DBCONNECTERROR = "DBCONNECTERROR" +Private Const FORMDEADERROR = "FORMDEADERROR" +Private Const BASEFORMNOTFOUNDERROR = "BASEFORMNOTFOUNDERROR" + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private [_Parent] As Object +Private [_Super] As Object ' Document superclass, which the current instance is a subclass of +Private ObjectType As String ' Must be BASE +Private ServiceName As String + +' 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 + +Const ISBASEFORM = 3 ' 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() + Set [Me] = Nothing + Set [_Parent] = Nothing + Set [_Super] = Nothing + ObjectType = "BASE" + ServiceName = "SFDocuments.Base" + Set _Component = Nothing + Set _DataSource = Nothing + Set _Database = Nothing + Set _FormDocuments = Nothing +End Sub ' SFDocuments.SF_Base Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' SFDocuments.SF_Base Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + If Not IsNull([_Super]) Then Set [_Super] = [_Super].Dispose() + Call Class_Terminate() + Set Dispose = Nothing +End Function ' SFDocuments.SF_Base Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean +''' The closure of a Base document requires the closures of +''' 1) the connection => done in the CloseDatabase() method +''' 2) the data source +''' 3) the document itself => done in the superclass + +Const cstThisSub = "SFDocuments.Base.CloseDocument" +Const cstSubArgs = "[SaveAsk=True]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", ScriptForge.V_BOOLEAN) Then GoTo Finally + End If + +Try: + If Not IsNull(_Database) Then _Database.CloseDatabase() + If Not IsNull(_DataSource) Then _DataSource.dispose() + CloseDocument = [_Super].CloseDocument(SaveAsk) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Base.CloseDocument + +REM ----------------------------------------------------------------------------- +Public Function CloseFormDocument(Optional ByVal FormDocument As Variant) As Boolean +''' Close the given form document +''' Nothing happens if the form document is not open +''' Args: +''' FormDocument: a valid document form name as a case-sensitive string +''' Returns: +''' True if closure is successful +''' Example: +''' oDoc.CloseFormDocument("Folder1/myFormDocument") + +Dim bClose As Boolean ' Return value +Dim oMainForm As Object ' com.sun.star.comp.sdb.Content +Dim vFormNames As Variant ' Array of all document form names present in the document + +Const cstThisSub = "SFDocuments.Base.CloseFormDocument" +Const cstSubArgs = "FormDocument" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bClose = False + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + ' 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 + If Not IsLoaded(FormDocument) Then GoTo Finally + +Try: + Set oMainForm = _FormDocuments.getByHierarchicalName(FormDocument) + bClose = oMainForm.close() + +Finally: + CloseFormDocument = bClose + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Base.CloseFormDocument + +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-based 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 oFormDocument 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 oFormDocument = _FormDocuments.getByHierarchicalName(FormDocument) + Set oForms = oFormDocument.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] + Set ._Component = _Component + ._FormDocumentName = FormDocument + Set ._FormDocument = oFormDocument + ._FormType = ISBASEFORM + Set ._Form = oXForm + ._Initialize() + 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 +''' 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 +''' Args: +''' User, Password: the login parameters as strings. Defaults = "" +''' Returns: +''' A SFDatabases.Database instance or Nothing +''' Example: +''' Dim myDb As Object +''' Set myDb = oDoc.GetDatabase() + +Const cstThisSub = "SFDocuments.Base.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 _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: + If IsNull(_Database) Then ' 1st connection from the current document instance + If IsNull(_DataSource) Then GoTo CatchConnect + Set _Database = ScriptForge.SF_Services.CreateScriptService("SFDatabases.DatabaseFromDocument" _ + , _DataSource, User, Password) + If IsNull(_Database) Then GoTo CatchConnect + _Database._Location = [_Super]._WindowFileName + 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_Base.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 + +Const cstThisSub = "SFDocuments.Base.GetProperty" +Const cstSubArgs = "" + + If ScriptForge.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: + ' Superclass or subclass property ? + If ScriptForge.SF_Array.Contains([_Super].Properties(), PropertyName) Then + GetProperty = [_Super].GetProperty(PropertyName) + Else + GetProperty = _PropertyGet(PropertyName) + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +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, otherwise False +''' Exceptions: +''' Form name 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 Base class as an array + + Methods = Array( _ + "CloseFormDocument" _ + , "FormDocuments" _ + , "Forms" _ + , "GetDatabase" _ + , "IsLoaded" _ + , "OpenFormDocument" _ + , "PrintOut" _ + , "SetPrinter" _ + ) + +End Function ' SFDocuments.SF_Base.Methods + +REM ----------------------------------------------------------------------------- +Public Function OpenFormDocument(Optional ByVal FormDocument As Variant _ + , Optional ByVal DesignMode As Variant _ + ) As Boolean +''' Open the FormDocument given by its hierarchical name either in normal or in design mode +''' If the form document is already open, the form document is made active without changing its mode +''' Args: +''' FormDocument: a valid document form name as a case-sensitive string +''' DesignMode: when True the form document is opened in design mode (Default = False) +''' Returns: +''' True if the form document could be opened, otherwise False +''' Exceptions: +''' Form name is invalid +''' Example: +''' oDoc.OpenFormDocument("Folder1/myFormDocument") + +Dim bOpen As Boolean ' Return value +Dim vFormNames As Variant ' Array of all document form names present in the document +Dim oContainer As Object ' com.sun.star.awt.XWindow +Dim oNewForm As Object ' Output of loadComponent() +Const cstThisSub = "SFDocuments.Base.OpenFormDocument" +Const cstSubArgs = "FormDocument, [DesignMode=False]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bOpen = False + +Check: + If IsMissing(DesignMode) Or IsEmpty(DesignMode) Then DesignMode = False + 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 + If Not ScriptForge.SF_Utils._Validate(DesignMode, "DesignMode", ScriptForge.V_BOOLEAN) Then GoTo Finally + End If + +Try: + With _Component.CurrentController + If Not .IsConnected Then .connect() + ' loadComponent activates the form when already loaded + Set oNewForm = .loadComponent(com.sun.star.sdb.application.DatabaseObject.FORM, FormDocument, DesignMode) + ' When user opened manually the form in design mode and closed it, the next execution in normal mode needs to be confirmed as below + With oNewForm.CurrentController + If .isFormDesignMode() <> DesignMode Then .setFormDesignMode(DesignMode) + End With + End With + bOpen = True + +Finally: + OpenFormDocument = bOpen + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Base.OpenFormDocument + +REM ----------------------------------------------------------------------------- +Public Function PrintOut(Optional ByVal FormDocument As Variant _ + , Optional ByVal Pages As Variant _ + , Optional ByVal Copies As Variant _ + ) As Boolean +''' Send the content of the given form document to the printer. +''' The printer might be defined previously by default, by the user or by the SetPrinter() method +''' The given form document must be open. It is activated by the method. +''' Args: +''' FormDocument: a valid document form name as a case-sensitive string +''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages +''' Copies: the number of copies +''' Exceptions: +''' FORMDEADERROR The form is not open +''' Returns: +''' True when successful +''' Examples: +''' oDoc.PrintOut("myForm", "1-4;10;15-18", Copies := 2) + +Dim bPrint As Boolean ' Return value +Dim vFormNames As Variant ' Array of all document form names present in the document +Dim oFormDocument As Object ' com.sun.star.comp.sdb.Content + +Const cstThisSub = "SFDocuments.Base.PrintOut" +Const cstSubArgs = "FormDocument, [Pages=""""], [Copies=1]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bPrint = False + +Check: + If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = "" + If IsMissing(Copies) Or IsEmpty(Copies) Then Copies = 1 + + 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 + If Not ScriptForge.SF_Utils._Validate(Pages, "Pages", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Copies, "Copies", ScriptForge.V_NUMERIC) Then GoTo Finally + End If + If Not IsLoaded(FormDocument) Then GoTo CatchClosed + +Try: + Set oFormDocument = _FormDocuments.getByHierarchicalName(FormDocument) + bPrint = [_Super].PrintOut(Pages, Copies, oFormDocument.Component) + +Finally: + PrintOut = bPrint + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchClosed: + ScriptForge.SF_Exception.RaiseFatal(FORMDEADERROR, FormDocument, _FileIdent()) +End Function ' SFDocuments.SF_Base.PrintOut + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Base class as an array + + Properties = Array( _ + "DocumentType" _ + , "IsBase" _ + , "IsCalc" _ + , "IsDraw " _ + , "IsImpress" _ + , "IsMath" _ + , "IsWriter" _ + , "XComponent" _ + ) + +End Function ' SFDocuments.SF_Base.Properties + +REM ----------------------------------------------------------------------------- +Public Function SetPrinter(Optional ByVal FormDocument As Variant _ + , Optional ByVal Printer As Variant _ + , Optional ByVal Orientation As Variant _ + , Optional ByVal PaperFormat As Variant _ + ) As Boolean +''' Define the printer options for a form document. The form document must be open. +''' Args: +''' FormDocument: a valid document form name as a case-sensitive string +''' Printer: the name of the printer queue where to print to +''' When absent or space, the default printer is set +''' Orientation: either "PORTRAIT" or "LANDSCAPE". Left unchanged when absent +''' PaperFormat: one of next values +''' "A3", "A4", "A5", "B4", "B5", "LETTER", "LEGAL", "TABLOID" +''' Left unchanged when absent +''' Returns: +''' True when successful +''' Examples: +''' oDoc.SetPrinter("myForm", Orientation := "PORTRAIT") + +Dim bPrinter As Boolean ' Return value +Dim vFormDocuments As Variant ' Array of form documents +Dim oFormDocument As Object ' com.sun.star.comp.sdb.Content + +Const cstThisSub = "SFDocuments.Base.SetPrinter" +Const cstSubArgs = "FormDocument, [Printer=""""], [Orientation=""PORTRAIT""|""LANDSCAPE""]" _ + & ", [PaperFormat=""A3""|""A4""|""A5""|""B4""|""B5""|""LETTER""|""LEGAL""|""TABLOID""" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bPrinter = False + +Check: + If IsMissing(Printer) Or IsEmpty(Printer) Then Printer = "" + If IsMissing(Orientation) Or IsEmpty(Orientation) Then Orientation = "" + If IsMissing(PaperFormat) Or IsEmpty(PaperFormat) Then PaperFormat = "" + + 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 + End If + If Not IsLoaded(FormDocument) Then GoTo CatchClosed + +Try: + Set oFormDocument = _FormDocuments.getByHierarchicalName(FormDocument) + bPrinter = [_Super].SetPrinter(Printer, Orientation, PaperFormat, oFormDocument.Component) + +Finally: + SetPrinter = bPrinter + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchClosed: + ScriptForge.SF_Exception.RaiseFatal(FORMDEADERROR, FormDocument, _FileIdent()) +End Function ' SFDocuments.SF_Base.SetPrinter + +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.Base.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: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Base.SetProperty + +REM ======================================================= SUPERCLASS PROPERTIES + +REM ----------------------------------------------------------------------------- +'Property Get CustomProperties() As Variant +' CustomProperties = [_Super].GetProperty("CustomProperties") +'End Property ' SFDocuments.SF_Base.CustomProperties + +REM ----------------------------------------------------------------------------- +'Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant) +' [_Super].CustomProperties = pvCustomProperties +'End Property ' SFDocuments.SF_Base.CustomProperties + +REM ----------------------------------------------------------------------------- +'Property Get Description() As Variant +' Description = [_Super].GetProperty("Description") +'End Property ' SFDocuments.SF_Base.Description + +REM ----------------------------------------------------------------------------- +'Property Let Description(Optional ByVal pvDescription As Variant) +' [_Super].Description = pvDescription +'End Property ' SFDocuments.SF_Base.Description + +REM ----------------------------------------------------------------------------- +'Property Get DocumentProperties() As Variant +' DocumentProperties = [_Super].GetProperty("DocumentProperties") +'End Property ' SFDocuments.SF_Base.DocumentProperties + +REM ----------------------------------------------------------------------------- +Property Get DocumentType() As String + DocumentType = [_Super].GetProperty("DocumentType") +End Property ' SFDocuments.SF_Base.DocumentType + +REM ----------------------------------------------------------------------------- +Property Get IsBase() As Boolean + IsBase = [_Super].GetProperty("IsBase") +End Property ' SFDocuments.SF_Base.IsBase + +REM ----------------------------------------------------------------------------- +Property Get IsCalc() As Boolean + IsCalc = [_Super].GetProperty("IsCalc") +End Property ' SFDocuments.SF_Base.IsCalc + +REM ----------------------------------------------------------------------------- +Property Get IsDraw() As Boolean + IsDraw = [_Super].GetProperty("IsDraw") +End Property ' SFDocuments.SF_Base.IsDraw + +REM ----------------------------------------------------------------------------- +Property Get IsImpress() As Boolean + IsImpress = [_Super].GetProperty("IsImpress") +End Property ' SFDocuments.SF_Base.IsImpress + +REM ----------------------------------------------------------------------------- +Property Get IsMath() As Boolean + IsMath = [_Super].GetProperty("IsMath") +End Property ' SFDocuments.SF_Base.IsMath + +REM ----------------------------------------------------------------------------- +Property Get IsWriter() As Boolean + IsWriter = [_Super].GetProperty("IsWriter") +End Property ' SFDocuments.SF_Base.IsWriter + +REM ----------------------------------------------------------------------------- +'Property Get Keywords() As Variant +' Keywords = [_Super].GetProperty("Keywords") +'End Property ' SFDocuments.SF_Base.Keywords + +REM ----------------------------------------------------------------------------- +'Property Let Keywords(Optional ByVal pvKeywords As Variant) +' [_Super].Keywords = pvKeywords +'End Property ' SFDocuments.SF_Base.Keywords + +REM ----------------------------------------------------------------------------- +'Property Get Readonly() As Variant +' Readonly = [_Super].GetProperty("Readonly") +'End Property ' SFDocuments.SF_Base.Readonly + +REM ----------------------------------------------------------------------------- +'Property Get Subject() As Variant +' Subject = [_Super].GetProperty("Subject") +'End Property ' SFDocuments.SF_Base.Subject + +REM ----------------------------------------------------------------------------- +'Property Let Subject(Optional ByVal pvSubject As Variant) +' [_Super].Subject = pvSubject +'End Property ' SFDocuments.SF_Base.Subject + +REM ----------------------------------------------------------------------------- +'Property Get Title() As Variant +' Title = [_Super].GetProperty("Title") +'End Property ' SFDocuments.SF_Base.Title + +REM ----------------------------------------------------------------------------- +'Property Let Title(Optional ByVal pvTitle As Variant) +' [_Super].Title = pvTitle +'End Property ' SFDocuments.SF_Base.Title + +REM ----------------------------------------------------------------------------- +Property Get XComponent() As Variant + XComponent = [_Super].GetProperty("XComponent") +End Property ' SFDocuments.SF_Base.XComponent + +REM ========================================================== SUPERCLASS METHODS + +REM ----------------------------------------------------------------------------- +Public Function Activate() As Boolean + Activate = [_Super].Activate() +End Function ' SFDocuments.SF_Base.Activate + +REM ----------------------------------------------------------------------------- +Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ + , Optional ByVal Before As Variant _ + , Optional ByVal SubmenuChar As Variant _ + ) As Object + Set CreateMenu = [_Super].CreateMenu(MenuHeader, Before, SubmenuChar) +End Function ' SFDocuments.SF_Base.CreateMenu + +REM ----------------------------------------------------------------------------- +Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean + RemoveMenu = [_Super].RemoveMenu(MenuHeader) +End Function ' SFDocuments.SF_Base.RemoveMenu + +REM ----------------------------------------------------------------------------- +Public Sub RunCommand(Optional ByVal Command As Variant _ + , ParamArray Args As Variant _ + ) + [_Super].RunCommand(Command, Args) +End Sub ' SFDocuments.SF_Base.RunCommand + +REM ----------------------------------------------------------------------------- +Public Function Save() As Boolean + Save = [_Super].Save() +End Function ' SFDocuments.SF_Base.Save + +REM ----------------------------------------------------------------------------- +Public Function SaveAs(Optional ByVal FileName As Variant _ + , Optional ByVal Overwrite As Variant _ + , Optional ByVal Password As Variant _ + , Optional ByVal FilterName As Variant _ + , Optional ByVal FilterOptions As Variant _ + ) As Boolean + SaveAs = [_Super].SaveAs(FileName, Overwrite, Password, FilterName, FilterOptions) +End Function ' SFDocuments.SF_Base.SaveAs + +REM ----------------------------------------------------------------------------- +Public Function SaveCopyAs(Optional ByVal FileName As Variant _ + , Optional ByVal Overwrite As Variant _ + , Optional ByVal Password As Variant _ + , Optional ByVal FilterName As Variant _ + , Optional ByVal FilterOptions As Variant _ + ) As Boolean + SaveCopyAs = [_Super].SaveCopyAs(FileName, Overwrite, Password, FilterName, FilterOptions) +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 whole tree below the container +''' The initial call starts from the container _Component.getFormDocuments +''' The list contains closed and open forms + +Dim sCollectNames As String ' Return value +Dim oSubItem As Object ' com.sun.star.container.XNameAccess (folder) or com.sun.star.ucb.XContent (form) +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 _FindByPersistentName(ByRef poContainer As Object _ + , psPersistent As String _ + ) As Object +''' The FormDocuments property of a Base component has strangely +''' a getByHierarchical() method but no access to the same com.sun.star.comp.sdb.Content +''' object via its persistent/ODF name +''' This method returns the object having the given persistent name +''' The function traverses recursively the whole tree below the container until found +''' The initial call starts from the container _Component.getFormDocuments +''' The list contains closed and open forms +''' Args: +''' poContainer: the actual top of the free, initially _FormDocuments +''' psPersistent: a name like "Obj..." +''' Returns: +''' A com.sun.star.comp.sdb.Content object (object found, the process stops) +''' or Nothing (object not found, the process continues) + +Dim oMainForm As Object ' Return value +Dim oSubItem As Object ' com.sun.star.container.XNameAccess (folder) or com.sun.star.ucb.XContent (form) +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: + Set oMainForm = Nothing + With poContainer + For i = 0 To .Count - 1 + Set oSubItem = .getByIndex(i) + If oSubItem.ContentType = cstFormType Then ' Examine its persistent name + If oSubItem.PersistentName = psPersistent Then + Set oMainForm = oSubItem + Exit For + End If + Else + Set oMainForm = _FindByPersistentName(oSubItem, psPersistent) + End If + Next i + End With + +Finally: + Set _FindByPersistentName = oMainForm + Exit Function +End Function ' SFDocuments.SF_Base.FindByPersistentName + +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 +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property + +Dim oProperties As Object ' Document or Custom properties +Dim vLastCell As Variant ' Coordinates of last used cell in a sheet +Dim oSelect As Object ' Current selection +Dim vRanges As Variant ' List of selected ranges +Dim i As Long +Dim cstThisSub As String +Const cstSubArgs = "" + + _PropertyGet = False + + cstThisSub = "SFDocuments.SF_Base.get" & psProperty + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not _IsStillAlive() Then GoTo Finally + + Select Case psProperty + Case Else + _PropertyGet = Null + End Select + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDocuments.SF_Base._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the SF_Base instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[Base]: Type/File" + + _Repr = "[Base]: " & [_Super]._FileIdent() + +End Function ' SFDocuments.SF_Base._Repr + +REM ============================================ END OF SFDOCUMENTS.SF_BASE +</script:module>
\ No newline at end of file |