diff options
| author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
|---|---|---|
| committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
| commit | ed5640d8b587fbcfed7dd7967f3de04b37a76f26 (patch) | |
| tree | 7a5f7c6c9d02226d7471cb3cc8fbbf631b415303 /wizards/source/sfdocuments/SF_Document.xba | |
| parent | Initial commit. (diff) | |
| download | libreoffice-upstream.tar.xz libreoffice-upstream.zip | |
Adding upstream version 4:7.4.7.upstream/4%7.4.7upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'wizards/source/sfdocuments/SF_Document.xba')
| -rw-r--r-- | wizards/source/sfdocuments/SF_Document.xba | 1504 |
1 files changed, 1504 insertions, 0 deletions
diff --git a/wizards/source/sfdocuments/SF_Document.xba b/wizards/source/sfdocuments/SF_Document.xba new file mode 100644 index 000000000..c54409445 --- /dev/null +++ b/wizards/source/sfdocuments/SF_Document.xba @@ -0,0 +1,1504 @@ +<?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_Document" 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_Document +''' =========== +''' +''' The SFDocuments library gathers a number of methods and properties making easy +''' managing and manipulating LibreOffice documents +''' +''' Some methods are generic for all types of documents: they are combined in the +''' current SF_Document module +''' - saving, closing documents +''' - accessing their standard or custom properties +''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Base, ... +''' +''' 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 +''' They should also duplicate some generic private members as a subset of their own set of members +''' +''' The current module is closely related to the "UI" and "FileSystem" services +''' 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.GetDocument("Untitled 1") +''' ' or Set oDoc = ui.CreateDocument("Calc", ...) +''' ' or Set oDoc = ui.OpenDocument("C:\Me\MyFile.odt") +''' 2) Directly if the document is already opened +''' Dim oDoc As Object +''' Set oDoc = CreateScriptService("SFDocuments.Document", "Untitled 1") ' Default = ActiveWindow +''' ' The substring "SFDocuments." in the service name is optional +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_document.html?DbPAR=BASIC +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Private Const DOCUMENTDEADERROR = "DOCUMENTDEADERROR" +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 + +' Window description +Private _Component As Object ' com.sun.star.lang.XComponent +Private _Frame As Object ' com.sun.star.comp.framework.Frame +Private _WindowName As String ' Object Name +Private _WindowTitle As String ' Only mean to identify new documents +Private _WindowFileName As String ' URL of file name +Private _DocumentType As String ' Writer, Calc, ... + +' Properties (work variables - real properties could have been set manually by user) +Private _DocumentProperties As Object ' Dictionary of document properties +Private _CustomProperties As Object ' Dictionary of custom properties + +REM ============================================================ MODULE CONSTANTS + +Const ISDOCFORM = 1 ' Form is stored in a 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 + Set _Frame = Nothing + _WindowName = "" + _WindowTitle = "" + _WindowFileName = "" + _DocumentType = "" + Set _DocumentProperties = Nothing + Set _CustomProperties = Nothing +End Sub ' SFDocuments.SF_Document Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' SFDocuments.SF_Document Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Call Class_Terminate() + Set Dispose = Nothing +End Function ' SFDocuments.SF_Document Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get CustomProperties() As Variant +''' Returns a dictionary of all custom properties of the document + CustomProperties = _PropertyGet("CustomProperties") +End Property ' SFDocuments.SF_Document.CustomProperties + +REM ----------------------------------------------------------------------------- +Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant) +''' Sets the updatable custom properties +''' The argument is a dictionary + +Dim vPropertyValues As Variant ' Array of com.sun.star.beans.PropertyValue +Dim vCustomProperties As Variant ' Alias of argument +Dim oUserdefinedProperties As Object ' Custom properties object +Dim vOldPropertyValues As Variant ' Array of (to remove) existing user defined properties +Dim oProperty As Object ' Single com.sun.star.beans.PropertyValues +Dim sProperty As String ' Property name +Dim vKeys As Variant ' Array of dictionary keys +Dim vItems As Variant ' Array of dictionary items +Dim vValue As Variant ' Value to store in property +Dim iAttribute As Integer ' com.sun.star.beans.PropertyAttribute.REMOVEABLE +Dim i As Long +Const cstThisSub = "SFDocuments.Document.setCustomProperties" +Const cstSubArgs = "CustomProperties" + + On Local Error GoTo Catch + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(pvCustomProperties, "CustomProperties", ScriptForge.V_OBJECT, , , "DICTIONARY") Then GoTo Finally + End If + +Try: + Set oUserDefinedProperties = _Component.getDocumentProperties().UserDefinedProperties + + Set vCustomProperties = pvCustomProperties ' To avoid "Object variable not set" error + With vCustomProperties + + ' All existing custom properties must first be removed to avoid type conflicts + vOldPropertyValues = oUserDefinedProperties.getPropertyValues + For Each oProperty In vOldPropertyValues + sProperty = oProperty.Name + oUserDefinedProperties.removeProperty(sProperty) + Next oProperty + + ' Insert new properties one by one after type adjustment (dates, arrays, numbers) + vKeys = .Keys + vItems = .Items + iAttribute = com.sun.star.beans.PropertyAttribute.REMOVEABLE + For i = 0 To UBound(vKeys) + If VarType(vItems(i)) = V_DATE Then + vValue = ScriptForge.SF_Utils._CDateToUnoDate(vItems(i)) + ElseIf IsArray(vItems(i)) Then + vValue = Null + ElseIf ScriptForge.SF_Utils._VarTypeExt(vItems(i)) = ScriptForge.V_NUMERIC Then + vValue = CreateUnoValue("double", vItems(i)) + Else + vValue = vItems(i) + End If + oUserDefinedProperties.addProperty(vKeys(i), iAttribute, vValue) + Next i + + ' Declare the document as changed + _Component.setModified(True) + End With + + ' Reload custom properties in current object instance + _PropertyGet("CustomProperties") + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Property +Catch: + GoTo Finally +End Property ' SFDocuments.SF_Document.CustomProperties + +REM ----------------------------------------------------------------------------- +Property Get Description() As Variant +''' Returns the updatable document property Description + Description = _PropertyGet("Description") +End Property ' SFDocuments.SF_Document.Description + +REM ----------------------------------------------------------------------------- +Property Let Description(Optional ByVal pvDescription As Variant) +''' Sets the updatable document property Description +''' If multilined, separate lines by "\n" escape sequence or by hard breaks + +Dim sDescription As String ' Alias of pvDescription +Const cstThisSub = "SFDocuments.Document.setDescription" +Const cstSubArgs = "Description" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(pvDescription, "Description", V_STRING) Then GoTo Finally + End If + +Try: + ' Update in UNO component object and in current instance + sDescription = Replace(pvDescription, "\n", ScriptForge.SF_String.sfNEWLINE) + _Component.DocumentProperties.Description = sDescription + If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Description", sdescription) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Property +End Property ' SFDocuments.SF_Document.Description + +REM ----------------------------------------------------------------------------- +Property Get DocumentProperties() As Variant +''' Returns a dictionary of all standard document properties, custom properties are excluded + DocumentProperties = _PropertyGet("DocumentProperties") +End Property ' SFDocuments.SF_Document.DocumentProperties + +REM ----------------------------------------------------------------------------- +Property Get DocumentType() As String +''' Returns "Base", "Calc", "Draw", ... or "Writer" + DocumentType = _PropertyGet("DocumentType") +End Property ' SFDocuments.SF_Document.DocumentType + +REM ----------------------------------------------------------------------------- +Property Get ExportFilters() As Variant +''' Returns the list of the export filter names applicable to the current document +''' as a zero-based array of strings +''' Import/Export filters are included + ExportFilters = _PropertyGet("ExportFilters") +End Property ' SFDocuments.SF_Document.ExportFilters + +REM ----------------------------------------------------------------------------- +Property Get ImportFilters() As Variant +''' Returns the list of the import filter names applicable to the current document +''' as a zero-based array of strings +''' Import/Export filters are included + ImportFilters = _PropertyGet("ImportFilters") +End Property ' SFDocuments.SF_Document.ImportFilters + +REM ----------------------------------------------------------------------------- +Property Get IsBase() As Boolean + IsBase = _PropertyGet("IsBase") +End Property ' SFDocuments.SF_Document.IsBase + +REM ----------------------------------------------------------------------------- +Property Get IsCalc() As Boolean + IsCalc = _PropertyGet("IsCalc") +End Property ' SFDocuments.SF_Document.IsCalc + +REM ----------------------------------------------------------------------------- +Property Get IsDraw() As Boolean + IsDraw = _PropertyGet("IsDraw") +End Property ' SFDocuments.SF_Document.IsDraw + +REM ----------------------------------------------------------------------------- +Property Get IsImpress() As Boolean + IsImpress = _PropertyGet("IsImpress") +End Property ' SFDocuments.SF_Document.IsImpress + +REM ----------------------------------------------------------------------------- +Property Get IsMath() As Boolean + IsMath = _PropertyGet("IsMath") +End Property ' SFDocuments.SF_Document.IsMath + +REM ----------------------------------------------------------------------------- +Property Get IsWriter() As Boolean + IsWriter = _PropertyGet("IsWriter") +End Property ' SFDocuments.SF_Document.IsWriter + +REM ----------------------------------------------------------------------------- +Property Get Keywords() As Variant +''' Returns the updatable document property Keywords + Keywords = _PropertyGet("Keywords") +End Property ' SFDocuments.SF_Document.Keywords + +REM ----------------------------------------------------------------------------- +Property Let Keywords(Optional ByVal pvKeywords As Variant) +''' Sets the updatable document property Keywords + +Dim vKeywords As Variant ' Alias of pvKeywords +Const cstThisSub = "SFDocuments.Document.setKeywords" +Const cstSubArgs = "Keywords" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(pvKeywords, "Keywords", V_STRING) Then GoTo Finally + End If + +Try: + ' Update in UNO component object and in current instance + vKeywords = ScriptForge.SF_Array.TrimArray(Split(pvKeywords, ",")) + _Component.DocumentProperties.Keywords = vKeywords + If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Keywords", Join(vKeywords, ", ")) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Property +End Property ' SFDocuments.SF_Document.Keywords + +REM ----------------------------------------------------------------------------- +Property Get Readonly() As Boolean +''' Returns True if the document must not be modified + Readonly = _PropertyGet("Readonly") +End Property ' SFDocuments.SF_Document.Readonly + +REM ----------------------------------------------------------------------------- +Property Get Subject() As Variant +''' Returns the updatable document property Subject + Subject = _PropertyGet("Subject") +End Property ' SFDocuments.SF_Document.Subject + +REM ----------------------------------------------------------------------------- +Property Let Subject(Optional ByVal pvSubject As Variant) +''' Sets the updatable document property Subject + +Const cstThisSub = "SFDocuments.Document.setSubject" +Const cstSubArgs = "Subject" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(pvSubject, "Subject", V_STRING) Then GoTo Finally + End If + +Try: + ' Update in UNO component object and in current instance + _Component.DocumentProperties.Subject = pvSubject + If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Subject", pvSubject) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Property +End Property ' SFDocuments.SF_Document.Subject + +REM ----------------------------------------------------------------------------- +Property Get Title() As Variant +''' Returns the updatable document property Title + Title = _PropertyGet("Title") +End Property ' SFDocuments.SF_Document.Title + +REM ----------------------------------------------------------------------------- +Property Let Title(Optional ByVal pvTitle As Variant) +''' Sets the updatable document property Title + +Const cstThisSub = "SFDocuments.Document.setTitle" +Const cstSubArgs = "Title" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(pvTitle, "Title", V_STRING) Then GoTo Finally + End If + +Try: + ' Update in UNO component object and in current instance + _Component.DocumentProperties.Title = pvTitle + If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Title", pvTitle) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Property +End Property ' SFDocuments.SF_Document.Title + +REM ----------------------------------------------------------------------------- +Property Get XComponent() As Variant +''' Returns the com.sun.star.lang.XComponent UNO object representing the document + XComponent = _PropertyGet("XComponent") +End Property ' SFDocuments.SF_Document.XComponent + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function Activate() As Boolean +''' Make the current document active +''' Args: +''' Returns: +''' True if the document could be activated +''' Otherwise, there is no change in the actual user interface +''' Examples: +''' oDoc.Activate() + +Dim bActivate As Boolean ' Return value +Dim oContainer As Object ' com.sun.star.awt.XWindow +Const cstThisSub = "SFDocuments.Document.Activate" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bActivate = False + +Check: + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not _IsStillAlive() Then GoTo Finally + +Try: + Set oContainer = _Frame.ContainerWindow + With oContainer + If .isVisible() = False Then .setVisible(True) + .IsMinimized = False + .setFocus() + .toFront() ' Force window change in Linux + Wait 1 ' Bypass desynchro issue in Linux + End With + bActivate = True + +Finally: + Activate = bActivate + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.Activate + +REM ----------------------------------------------------------------------------- +Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean +''' Close the document. Does nothing if the document is already closed +''' regardless of how the document was closed, manually or by program +''' Args: +''' SaveAsk: If True (default), the user is invited to confirm or not the writing of the changes on disk +''' No effect if the document was not modified +''' Returns: +''' False if the user declined to close +''' Examples: +''' If oDoc.CloseDocument() Then +''' ' ... + +Dim bClosed As Boolean ' return value +Dim oDispatch ' com.sun.star.frame.DispatchHelper +Const cstThisSub = "SFDocuments.Document.CloseDocument" +Const cstSubArgs = "[SaveAsk=True]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bClosed = False + +Check: + If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", ScriptForge.V_BOOLEAN) Then GoTo Finally + End If + +Try: + If SaveAsk And _Component.IsModified Then ' Execute closure with the File/Close menu command + Activate() + RunCommand("CloseDoc") + bClosed = _IsStillAlive(, False) ' Do not raise error + Else + _Frame.close(True) + _Frame.dispose() + bClosed = True + End If + +Finally: + If bClosed Then Dispose() + CloseDocument = bClosed + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.CloseDocument + +REM ----------------------------------------------------------------------------- +Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ + , Optional ByVal Before As Variant _ + , Optional ByVal SubmenuChar As Variant _ + , Optional ByRef _Document As Variant _ + ) As Object +''' Create a new menu entry in the document's menubar +''' The menu is not intended to be saved neither in the LibreOffice global environment, nor in the document +''' The method returns a SFWidgets.Menu instance. Its methods let define the menu further. +''' Args: +''' MenuHeader: the name/header of the menu +''' Before: the place where to put the new menu on the menubar (string or number >= 1) +''' When not found => last position +''' SubmenuChar: the delimiter used in menu trees. Default = ">" +''' _Document: undocumented argument to designate the document where the menu will be located +''' Returns: +''' A SFWidgets.Menu instance or Nothing +''' Examples: +''' Dim oMenu As Object +''' Set oMenu = oDoc.CreateMenu("My menu", Before := "Styles") +''' With oMenu +''' .AddItem("Item 1", Command := "About") +''' '... +''' .Dispose() ' When definition is complete, the menu instance may be disposed +''' End With +''' ' ... + +Dim oMenu As Object ' return value +Const cstThisSub = "SFDocuments.Document.CreateMenu" +Const cstSubArgs = "MenuHeader, [Before=""""], [SubmenuChar="">""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oMenu = Nothing + +Check: + If IsMissing(Before) Or IsEmpty(Before) Then Before = "" + If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = "" + If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component + + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Before, "Before", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally + End If + +Try: + Set oMenu = ScriptForge.SF_Services.CreateScriptService("SFWidgets.Menu", _Document, MenuHeader, Before, SubmenuChar) + +Finally: + Set CreateMenu = oMenu + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.CreateMenu + +REM ----------------------------------------------------------------------------- +Public Function ExportAsPDF(Optional ByVal FileName As Variant _ + , Optional ByVal Overwrite As Variant _ + , Optional ByVal Pages As Variant _ + , Optional ByVal Password As Variant _ + , Optional ByVal Watermark As Variant _ + ) As Boolean +''' Store the document to the given file location in PDF format +''' Args: +''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation +''' Overwrite: True if the destination file may be overwritten (default = False) +''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages +''' Password: password to open the document +''' Watermark: the text for a watermark to be drawn on every page of the exported PDF file +''' Returns: +''' False if the document could not be saved +''' Exceptions: +''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected +''' Examples: +''' oDoc.ExportAsPDF("C:\Me\myDoc.pdf", Overwrite := True) + +Dim bSaved As Boolean ' return value +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess +Dim sFile As String ' Alias of FileName +Dim sFilter As String ' One of the pdf filter names +Dim vFilterData As Variant ' Array of com.sun.star.beans.PropertyValue +Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue +Dim FSO As Object ' SF_FileSystem +Const cstThisSub = "SFDocuments.Document.ExportAsPDF" +Const cstSubArgs = "FileName, [Overwrite=False], [Pages=""""], [Password=""""], [Watermark=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError + bSaved = False + +Check: + If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False + If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = "" + If IsMissing(Password) Or IsEmpty(Password) Then Password = "" + If IsMissing(Watermark) Or IsEmpty(Watermark) Then Watermark = "" + + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Pages, "Pages", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Watermark, "Watermark", V_STRING) Then GoTo Finally + End If + + ' Check destination file overwriting + Set FSO = CreateScriptService("FileSystem") + sFile = FSO._ConvertToUrl(FileName) + If FSO.FileExists(FileName) Then + If Overwrite = False Then GoTo CatchError + Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess") + If oSfa.isReadonly(sFile) Then GoTo CatchError + End If + +Try: + ' Setup arguments + sFilter = LCase(_DocumentType) & "_pdf_Export" + ' FilterData parameters are added only if they are meaningful + vFilterData = Array() + If Len(Pages) > 0 Then + vFilterData = ScriptForge.SF_Array.Append(vFilterData _ + , ScriptForge.SF_Utils._MakePropertyValue("PageRange", Pages)) + End If + If Len(Password) > 0 Then + vFilterData = ScriptForge.SF_Array.Append(vFilterData _ + , ScriptForge.SF_Utils._MakePropertyValue("EncryptFile", True) _ + , ScriptForge.SF_Utils._MakePropertyValue("DocumentOpenPassword", Password)) + End If + If Len(Watermark) > 0 Then + vFilterData = ScriptForge.SF_Array.Append(vFilterData _ + , ScriptForge.SF_Utils._MakePropertyValue("Watermark", Watermark)) + End If + + ' Finalize properties and export + vProperties = Array( _ + ScriptForge.SF_Utils._MakePropertyValue("FilterName", sFilter) _ + , ScriptForge.SF_Utils._MakePropertyValue("FilterData", vFilterData)) + _Component.StoreToURL(sFile, vProperties) + bSaved = True + +Finally: + ExportAsPDF = bSaved + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchError: + ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _ + , "FilterName", "PDF Export") + GoTo Finally +End Function ' SFDocuments.SF_Document.ExportAsPDF + +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 +''' If the property does not exist, returns Null +''' Exceptions: +''' see the exceptions of the individual properties +''' Examples: +''' myModel.GetProperty("MyProperty") + +Const cstThisSub = "SFDocuments.Document.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: + GetProperty = _PropertyGet(PropertyName) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Document service as an array + + Methods = Array( _ + "Activate" _ + , "CloseDocument" _ + , "CreateMenu" _ + , "ExportAsPDF" _ + , "PrintOut" _ + , "RemoveMenu" _ + , "RunCommand" _ + , "Save" _ + , "SaveAs" _ + , "SaveCopyAs" _ + , "SetPrinter" _ + ) + +End Function ' SFDocuments.SF_Document.Methods + +REM ----------------------------------------------------------------------------- +Public Function PrintOut(Optional ByVal Pages As Variant _ + , Optional ByVal Copies As Variant _ + , Optional ByRef _Document As Variant _ + ) As Boolean +''' Send the content of the document to the printer. +''' The printer might be defined previously by default, by the user or by the SetPrinter() method +''' Args: +''' 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 +''' _Document: undocumented argument to designate the document to print when called from a subclass +''' Returns: +''' True when successful +''' Examples: +''' oDoc.PrintOut("1-4;10;15-18", Copies := 2) + +Dim bPrint As Boolean ' Return value +Dim vPrintGoal As Variant ' Array of property values + +Const cstThisSub = "SFDocuments.Document.PrintOut" +Const cstSubArgs = "[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 IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component + + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() 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 + +Try: + vPrintGoal = Array( _ + ScriptForge.SF_Utils._MakePropertyValue("CopyCount", CInt(Copies)) _ + , ScriptForge.SF_Utils._MakePropertyValue("Collate", True) _ + , ScriptForge.SF_Utils._MakePropertyValue("Pages", Pages) _ + , ScriptForge.SF_Utils._MakePropertyValue("Wait", False) _ + ) + + _Document.Print(vPrintGoal) + bPrint = True + +Finally: + PrintOut = bPrint + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.PrintOut + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Document class as an array + + Properties = Array( _ + "CustomProperties" _ + , "Description" _ + , "DocumentProperties" _ + , "DocumentType" _ + , "ExportFilters" _ + , "ImportFilters" _ + , "IsBase" _ + , "IsCalc" _ + , "IsDraw" _ + , "IsImpress" _ + , "IsMath" _ + , "IsWriter" _ + , "Keywords" _ + , "Readonly" _ + , "Subject" _ + , "Title" _ + , "XComponent" _ + ) + +End Function ' SFDocuments.SF_Document.Properties + +REM ----------------------------------------------------------------------------- +Public Function RemoveMenu(Optional ByVal MenuHeader As Variant _ + , Optional ByRef _Document As Variant _ +) As Boolean +''' Remove a menu entry in the document's menubar +''' The removal is not intended to be saved neither in the LibreOffice global environment, nor in the document +''' Args: +''' MenuHeader: the name/header of the menu, without tilde "~", as a case-sensitive string +''' _Document: undocumented argument to designate the document where the menu is located +''' Returns: +''' True when successful +''' Examples: +''' oDoc.RemoveMenu("File") +''' ' ... + +Dim bRemove As Boolean ' Return value +Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager +Dim oMenuBar As Object ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar +Dim sName As String ' Menu name +Dim iMenuId As Integer ' Menu identifier +Dim iMenuPosition As Integer ' Menu position >= 0 +Dim i As Integer +Const cstTilde = "~" + +Const cstThisSub = "SFDocuments.Document.RemoveMenu" +Const cstSubArgs = "MenuHeader" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bRemove = False + +Check: + If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally + End If + +Try: + Set oLayout = _Document.CurrentController.Frame.LayoutManager + Set oMenuBar = oLayout.getElement("private:resource/menubar/menubar").XMenuBar + + ' Search the menu identifier to remove by its name, Mark its position + With oMenuBar + iMenuPosition = -1 + For i = 0 To .ItemCount - 1 + iMenuId = .getItemId(i) + sName = Replace(.getItemText(iMenuId), cstTilde, "") + If MenuHeader= sName Then + iMenuPosition = i + Exit For + End If + Next i + ' Remove the found menu item + If iMenuPosition >= 0 Then + .removeItem(iMenuPosition, 1) + bRemove = True + End If + End With + +Finally: + RemoveMenu = bRemove + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.RemoveMenu + +REM ----------------------------------------------------------------------------- +Public Sub RunCommand(Optional ByVal Command As Variant _ + , ParamArray Args As Variant _ + ) +''' Run on the current document window the given menu command. The command is executed with or without arguments +''' A few typical commands: +''' Save, SaveAs, ExportToPDF, SetDocumentProperties, Undo, Copy, Paste, ... +''' Dozens can be found on next page: https://wiki.documentfoundation.org/Development/DispatchCommands +''' Args: +''' Command: Case-sensitive. The command itself is not checked. +''' If the command does not contain the ".uno:" prefix, it is added. +''' If nothing happens, then the command is probably wrong +''' Args: Pairs of arguments name (string), value (any) +''' Returns: +''' Examples: +''' oDoc.RunCommand("EditDoc", "Editable", False) ' Toggle edit mode + +Dim vArgs As Variant ' Alias of Args +Dim oDispatch ' com.sun.star.frame.DispatchHelper +Dim vProps As Variant ' Array of PropertyValues +Dim vValue As Variant ' A single value argument +Dim sCommand As String ' Alias of Command +Dim i As Long +Const cstPrefix = ".uno:" + +Const cstThisSub = "SFDocuments.Document.RunCommand" +Const cstSubArgs = "Command, [arg0Name, arg0Value], [arg1Name, arg1Value], ..." + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + ' When called from a subclass (Calc, Writer, ..) the arguments are gathered into one single array item + vArgs = Args + If IsArray(Args) Then + If UBound(Args) >= 0 And IsArray(Args(0)) Then vArgs = Args(0) + End If + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._ValidateArray(vArgs, "Args", 1) Then GoTo Finally + For i = 0 To UBound(vArgs) - 1 Step 2 + If Not ScriptForge.SF_Utils._Validate(vArgs(i), "Arg" & CStr(i/2) & "Name", V_STRING) Then GoTo Finally + Next i + End If + +Try: + ' Build array of property values + vProps = Array() + For i = 0 To UBound(vArgs) - 1 Step 2 + If IsEmpty(vArgs(i + 1)) Then vValue = Null Else vValue = vArgs(i + 1) + vProps = ScriptForge.SF_Array.Append(vProps, ScriptForge.SF_Utils._MakePropertyValue(vArgs(i), vValue)) + Next i + Set oDispatch = ScriptForge.SF_Utils._GetUNOService("DispatchHelper") + If ScriptForge.SF_String.StartsWith(Command, cstPrefix) Then sCommand = Command Else sCommand = cstPrefix & Command + oDispatch.executeDispatch(_Frame, sCommand, "", 0, vProps) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' SFDocuments.SF_Document.RunCommand + +REM ----------------------------------------------------------------------------- +Public Function Save() As Boolean +''' Store the document to the file location from which it was loaded +''' Ignored if the document was not modified +''' Args: +''' Returns: +''' False if the document could not be saved +''' Exceptions: +''' DOCUMENTSAVEERROR The file has been opened readonly or was opened as new and was not yet saved +''' Examples: +''' If Not oDoc.Save() Then +''' ' ... + +Dim bSaved As Boolean ' return value +Const cstThisSub = "SFDocuments.Document.Save" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bSaved = False + +Check: + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not _IsStillAlive() Then GoTo Finally + bSaved = False + +Try: + With _Component + If .isReadonly() Or Not .hasLocation() Then GoTo CatchReadonly + If .IsModified() Then + .store() + bSaved = True + End If + End With + +Finally: + Save = bSaved + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchReadonly: + ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEERROR, "FileName", _FileIdent()) + GoTo Finally +End Function ' SFDocuments.SF_Document.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 +''' Store the document to the given file location +''' The new location becomes the new file name on which simple Save method calls will be applied +''' Args: +''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation +''' Overwrite: True if the destination file may be overwritten (default = False) +''' Password: Use to protect the document +''' FilterName: the name of a filter that should be used for saving the document +''' If present, the filter must exist +''' FilterOptions: an optional string of options associated with the filter +''' Returns: +''' False if the document could not be saved +''' Exceptions: +''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected +''' Examples: +''' oDoc.SaveAs("C:\Me\Copy2.odt", Overwrite := True) + +Dim bSaved As Boolean ' return value +Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess +Dim sFile As String ' Alias of FileName +Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue +Dim FSO As Object ' SF_FileSystem +Const cstThisSub = "SFDocuments.Document.SaveAs" +Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError + bSaved = False + +Check: + If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False + If IsMissing(Password) Or IsEmpty(Password) Then Password = "" + If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = "" + If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = "" + + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(FilterName, "FilterName", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally + End If + + ' Check that the filter exists + If Len(FilterName) > 0 Then + Set oFilterFactory = ScriptForge.SF_Utils._GetUNOService("FilterFactory") + If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError + End If + + ' Check destination file overwriting + Set FSO = CreateScriptService("FileSystem") + sFile = FSO._ConvertToUrl(FileName) + If FSO.FileExists(FileName) Then + If Overwrite = False Then GoTo CatchError + Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess") + If oSfa.isReadonly(sFile) Then GoTo CatchError + End If + +Try: + ' Setup arguments + If Len(Password) + Len(FilterName) = 0 Then + vProperties = Array() + Else + vProperties = Array( _ + ScriptForge.SF_Utils._MakePropertyValue("FilterName", FilterName) _ + , ScriptForge.SF_Utils._MakePropertyValue("FilterOptions", FilterOptions) _ + ) + If Len(Password) > 0 Then ' Password is to add only if <> "" !? + vProperties = ScriptForge.SF_Array.Append(vProperties _ + , ScriptForge.SF_Utils._MakePropertyValue("Password", Password)) + End If + End If + + _Component.StoreAsURL(sFile, vProperties) + + ' Remind the new file name + _WindowFileName = sFile + _WindowName = FSO.GetName(FileName) + bSaved = True + +Finally: + SaveAs = bSaved + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchError: + ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _ + , "FilterName", FilterName) + GoTo Finally +End Function ' SFDocuments.SF_Document.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 +''' Store a copy or export the document to the given file location +''' The actual location is unchanged +''' Args: +''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation +''' Overwrite: True if the destination file may be overwritten (default = False) +''' Password: Use to protect the document +''' FilterName: the name of a filter that should be used for saving the document +''' If present, the filter must exist +''' FilterOptions: an optional string of options associated with the filter +''' Returns: +''' False if the document could not be saved +''' Exceptions: +''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected +''' Examples: +''' oDoc.SaveCopyAs("C:\Me\Copy2.odt", Overwrite := True) + +Dim bSaved As Boolean ' return value +Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess +Dim sFile As String ' Alias of FileName +Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue +Dim FSO As Object ' SF_FileSystem +Const cstThisSub = "SFDocuments.Document.SaveCopyAs" +Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError + bSaved = False + +Check: + If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False + If IsMissing(Password) Or IsEmpty(Password) Then Password = "" + If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = "" + If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = "" + + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(FilterName, "FilterName", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally + End If + + ' Check that the filter exists + If Len(FilterName) > 0 Then + Set oFilterFactory = ScriptForge.SF_Utils._GetUNOService("FilterFactory") + If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError + End If + + ' Check destination file overwriting + Set FSO = CreateScriptService("FileSystem") + sFile = FSO._ConvertToUrl(FileName) + If FSO.FileExists(FileName) Then + If Overwrite = False Then GoTo CatchError + Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess") + If oSfa.isReadonly(sFile) Then GoTo CatchError + End If + +Try: + ' Setup arguments + If Len(Password) + Len(FilterName) = 0 Then + vProperties = Array() + Else + vProperties = Array( _ + ScriptForge.SF_Utils._MakePropertyValue("FilterName", FilterName) _ + , ScriptForge.SF_Utils._MakePropertyValue("FilterOptions", FilterOptions) _ + ) + If Len(Password) > 0 Then ' Password is to add only if <> "" !? + vProperties = ScriptForge.SF_Array.Append(vProperties _ + , ScriptForge.SF_Utils._MakePropertyValue("Password", Password)) + End If + End If + + _Component.StoreToURL(sFile, vProperties) + bSaved = True + +Finally: + SaveCopyAs = bSaved + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchError: + ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _ + , "FilterName", FilterName) + GoTo Finally +End Function ' SFDocuments.SF_Document.SaveCopyAs + +REM ----------------------------------------------------------------------------- +Public Function SetPrinter(Optional ByVal Printer As Variant _ + , Optional ByVal Orientation As Variant _ + , Optional ByVal PaperFormat As Variant _ + , Optional ByRef _PrintComponent As Variant _ + ) As Boolean +''' Define the printer options for the document +''' Args: +''' 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 +''' _PrintComponent: undocumented argument to determine the component +''' Useful typically to apply printer settings on a Base form document +''' Returns: +''' True when successful +''' Examples: +''' oDoc.SetPrinter(Orientation := "PORTRAIT") + +Dim bPrinter As Boolean ' Return value +Dim vPrinters As Variant ' Array of known printers +Dim vOrientations As Variant ' Array of allowed paper orientations +Dim vPaperFormats As Variant ' Array of allowed formats +Dim vPrinterSettings As Variant ' Array of property values +Dim oPropertyValue As New com.sun.star.beans.PropertyValue + ' A single property value item +Const cstThisSub = "SFDocuments.Document.SetPrinter" +Const cstSubArgs = "[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 IsMissing(_PrintComponent) Or IsEmpty(_PrintComponent) Then Set _PrintComponent = _Component + + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional validation + If Not _IsStillAlive() Then GoTo Finally + If VarType(Printer) = V_STRING Then + vPrinters = ScriptForge.SF_Platform.Printers + If Len(Printer) > 0 Then + If Not ScriptForge.SF_Utils._Validate(Printer, "Printer", V_STRING, vPrinters) Then GoTo Finally + End If + Else + If Not ScriptForge.SF_Utils._Validate(Printer, "Printer", V_STRING) Then GoTo Finally ' Manage here the VarType error + End If + If VarType(Orientation) = V_STRING Then + vOrientations = Array("PORTRAIT", "LANDSCAPE") + If Len(Orientation) > 0 Then + If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, vOrientations) Then GoTo Finally + End If + Else + If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING) Then GoTo Finally + End If + If VarType(PaperFormat) = V_STRING Then + vPaperFormats = Array("A3", "A4", "A5", "B4", "B5", "LETTER", "LEGAL", "TABLOID") + If Len(PaperFormat) > 0 Then + If Not ScriptForge.SF_Utils._Validate(PaperFormat, "PaperFormat", V_STRING, vPaperFormats) Then GoTo Finally + End If + Else + If Not ScriptForge.SF_Utils._Validate(PaperFormat, "PaperFormat", V_STRING) Then GoTo Finally + End If + +Try: + With _PrintComponent + Set oPropertyValue = ScriptForge.SF_Utils._MakePropertyValue("Name", Iif(Len(Printer) > 0, Printer, vPrinters(0))) + vPrinterSettings = Array(oPropertyValue) + If Len(Orientation) > 0 Then + vPrinterSettings = ScriptForge.SF_Utils._SetPropertyValue(vPrinterSettings, "PaperOrientation" _ + , ScriptForge.SF_Array.IndexOf(vOrientations, Orientation, CaseSensitive := False)) + End If + If Len(PaperFormat) > 0 Then + vPrinterSettings = ScriptForge.SF_Utils._SetPropertyValue(vPrinterSettings, "PaperFormat" _ + , ScriptForge.SF_Array.IndexOf(vPaperFormats, PaperFormat, CaseSensitive := False)) + End If + .setPrinter(vPrinterSettings) + End With + bPrinter = True + +Finally: + SetPrinter = bPrinter + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.SetPrinter + +REM ----------------------------------------------------------------------------- +Private Function SetProperty(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.Document.set" & psProperty + If IsMissing(pvValue) Then pvValue = Empty + 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets + + If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") + bSet = True + Select Case UCase(psProperty) + Case UCase("CustomProperties") + CustomProperties = pvValue + Case UCase("Description") + Description = pvValue + Case UCase("Keywords") + Keywords = pvValue + Case UCase("Subject") + Subject = pvValue + Case UCase("Title") + Title = pvValue + Case Else + bSet = False + End Select + +Finally: + SetProperty = bSet + 'ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.SetProperty + +REM =========================================================== PRIVATE FUNCTIONS + +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 = Iif(Len(_WindowFileName) > 0, SF_FileSystem._ConvertFromUrl(_WindowFileName), _WindowTitle) + +End Function ' SFDocuments.SF_Document._FileIdent + +REM ----------------------------------------------------------------------------- +Private Function _GetFilterNames(ByVal pbExport As Boolean) As Variant +''' Returns the list of export (pbExport = True) or import filters +''' applicable to the current document +''' Args: +''' pbExport: True for export, False for import +''' Returns: +''' A zero-based array of strings + +Dim vFilters As Variant ' Return value +Dim sIdentifier As String ' Document service, like com.sun.star.text.TextDocument +Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory +Dim vAllFilters As Variant ' The full list of installed filters +Dim sFilter As String ' A single filter name +Dim iCount As Integer ' Filters counter +Dim vFilter As Variant ' A filter descriptor as an array of Name/Value pairs +Dim sType As String ' The filter type to be compared with the document service +Dim lFlags As Long ' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Office_Development#Properties_of_a_Filter +Dim bExport As Boolean ' Filter valid for export when True +Dim bImport As Boolean ' Filter valid for import when True +Dim bImportExport As Boolean ' Filter valid both for import and export when True + + vFilters = Array() + On Local Error GoTo Finally ' Return empty or partial list if error + +Try: + sIdentifier = _Component.Identifier + Set oFilterFactory = ScriptForge.SF_Utils._GetUNOService("FilterFactory") + vAllFilters = oFilterFactory.getElementNames() + ReDim vFilters(0 To UBound(vAllFilters)) + iCount = -1 + + For Each sFilter In vAllFilters + vFilter = oFilterFactory.getByName(sFilter) + sType = vFilter(12).Value ' Hard-coded index for document types + If sType = sIdentifier Then + lFlags = vFilter(10).Value ' Hard-coded index for flags + ' export: flag is even + ' import: flag is odd and flag/2 is even + ' import/export: flag is odd and flag/2 is odd + bExport = ( lFlags Mod 2 = 0 ) + bImport = ( (lFlags Mod 2 = 1) And ((lFlags \ 2) Mod 2 = 0) ) + bImportExport = ( (lFlags Mod 2 = 1) And ((lFlags \ 2) Mod 2 = 1) ) + ' Select filter ? + If bImportExport _ + Or (pbExport And bExport) _ + Or (Not pbExport And bImport) Then + iCount = iCount + 1 + vFilters(iCount) = sFilter + End If + End If + Next sFilter + + If iCount > -1 Then + ReDim Preserve vFilters(0 To iCount) + End If + +Finally: + _GetFilterNames = vFilters + Exit Function +End Function ' SFDocuments.SF_Document._GetFilterNames + +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 +Dim sFileName As String ' File identification used to display error message + + On Local Error GoTo Catch ' Anticipate DisposedException errors or alike + If IsMissing(pbForUpdate) Then pbForUpdate = False + If IsMissing(pbError) Then pbError = True + +Try: + ' Check existence of document + bAlive = Not IsNull(_Frame) + If bAlive Then bAlive = Not IsNull(_Component) + If bAlive Then bAlive = Not IsNull(_Component.CurrentController) + + ' Check document is not read only + If bAlive And pbForUpdate Then + If _Component.isreadonly() Then GoTo CatchReadonly + End If + +Finally: + _IsStillAlive = bAlive + Exit Function +Catch: + bAlive = False + On Error GoTo 0 + sFileName = _FileIdent() + Dispose() + If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTDEADERROR, sFileName) + GoTo Finally +CatchReadonly: + bAlive = False + If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTREADONLYERROR, "Document", _FileIdent()) + GoTo Finally +End Function ' SFDocuments.SF_Document._IsStillAlive + +REM ----------------------------------------------------------------------------- +Private Sub _LoadDocumentProperties() +''' Create dictionary with document properties as entries/ Custom properties are excluded +''' Document is presumed still alive +''' Special values: +''' Only valid dates are taken +''' Statistics are exploded in subitems. Subitems are specific to document type +''' Keywords are joined +''' Language is aligned on L10N convention la-CO + +Dim oProperties As Object ' Document properties +Dim vNamedValue As Variant ' com.sun.star.beans.NamedValue + + If IsNull(_DocumentProperties) Then + Set oProperties = _Component.getDocumentProperties + Set _DocumentProperties = CreateScriptService("Dictionary") + With _DocumentProperties + .Add("Author", oProperties.Author) + .Add("AutoloadSecs", oProperties.AutoloadSecs) + .Add("AutoloadURL", oProperties.AutoloadURL) + If oProperties.CreationDate.Year > 0 Then .Add("CreationDate", CDateFromUnoDateTime(oProperties.CreationDate)) + .Add("DefaultTarget", oProperties.DefaultTarget) + .Add("Description", oProperties.Description) ' The description can be multiline + ' DocumentStatistics : number and names of statistics depend on document type + For Each vNamedValue In oProperties.DocumentStatistics + .Add(vNamedValue.Name, vNamedValue.Value) + Next vNamedValue + .Add("EditingDuration", oProperties.EditingDuration) + .Add("Generator", oProperties.Generator) + .Add("Keywords", Join(oProperties.Keywords, ", ")) + .Add("Language", oProperties.Language.Language & Iif(Len(oProperties.Language.Country) > 0, "-" & oProperties.Language.Country, "")) + If oProperties.ModificationDate.Year > 0 Then .Add("ModificationDate", CDateFromUnoDateTime(oProperties.ModificationDate)) + If oProperties.PrintDate.Year > 0 Then .Add("PrintDate", CDateFromUnoDateTime(oProperties.PrintDate)) + .Add("PrintedBy", oProperties.PrintedBy) + .Add("Subject", oProperties.Subject) + If oProperties.TemplateDate.Year > 0 Then .Add("TemplateDate", CDateFromUnoDateTime(oProperties.TemplateDate)) + .Add("TemplateName", oProperties.TemplateName) + .Add("TemplateURL", oProperties.TemplateURL) + .Add("Title", oProperties.Title) + End With + End If + +End Sub ' SFDocuments.SF_Document._LoadDocumentProperties + +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 + +Dim oProperties As Object ' Document or Custom properties +Dim cstThisSub As String +Const cstSubArgs = "" + + _PropertyGet = False + + Select Case _DocumentType + Case "Calc" : cstThisSub = "SFDocuments.SF_" & _DocumentType & ".get" & psProperty + Case Else : cstThisSub = "SFDocuments.SF_Document.get" & psProperty + End Select + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not _IsStillAlive() Then GoTo Finally + + Select Case psProperty + Case "CustomProperties" + _CustomProperties = CreateScriptService("Dictionary") ' Always reload as updates could have been done manually by user + _CustomProperties.ImportFromPropertyValues(_Component.getDocumentProperties().UserDefinedProperties.getPropertyValues) + _PropertyGet = _CustomProperties + Case "Description" + _PropertyGet = _Component.DocumentProperties.Description + Case "DocumentProperties" + _LoadDocumentProperties() ' Always reload as updates could have been done manually by user + Set _PropertyGet = _DocumentProperties + Case "DocumentType" + _PropertyGet = _DocumentType + Case "ExportFilters" + _PropertyGet = _GetFilterNames(True) + Case "ImportFilters" + _PropertyGet = _GetFilterNames(False) + Case "IsBase", "IsCalc", "IsDraw", "IsImpress", "IsMath", "IsWriter" + _PropertyGet = ( Mid(psProperty, 3) = _DocumentType ) + Case "Keywords" + _PropertyGet = Join(_Component.DocumentProperties.Keywords, ", ") + Case "Readonly" + _PropertyGet = _Component.isReadonly() + Case "Subject" + _PropertyGet = _Component.DocumentProperties.Subject + Case "Title" + _PropertyGet = _Component.DocumentProperties.Title + Case "XComponent" + Set _PropertyGet = _Component + Case Else + _PropertyGet = Null + End Select + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDocuments.SF_Document._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the SF_Document instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[DOCUMENT]: Type - File" + + _Repr = "[Document]: " & _DocumentType & " - " & _FileIdent() + +End Function ' SFDocuments.SF_Document._Repr + +REM ============================================ END OF SFDOCUMENTS.SF_DOCUMENT +</script:module>
\ No newline at end of file |