diff options
Diffstat (limited to 'wizards/source/sfdocuments/SF_Document.xba')
| -rw-r--r-- | wizards/source/sfdocuments/SF_Document.xba | 2141 |
1 files changed, 2141 insertions, 0 deletions
diff --git a/wizards/source/sfdocuments/SF_Document.xba b/wizards/source/sfdocuments/SF_Document.xba new file mode 100644 index 0000000000..6382b7c628 --- /dev/null +++ b/wizards/source/sfdocuments/SF_Document.xba @@ -0,0 +1,2141 @@ +<?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" + +Private Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" + +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, ... +Private _DocumentSettings As Object ' com.sun.star.XXX.DocumentSettings (XXX = sheet, text, drawing or presentation) + +' 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 + +' Cache for static toolbar descriptions +Private _Toolbars As Object ' SF_Dictionary instance to hold toolbars stored in application or in document + +' Style descriptor +Type StyleDescriptor + Family As Object + StyleName As String + DisplayName As String + IsUsed As Boolean + BuiltIn As Boolean + Category As String + ParentStyle As String + XStyle As Object +End Type + +Private _StyleFamilies As Variant ' Array of available style families + +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 _DocumentSettings = Nothing + Set _DocumentProperties = Nothing + Set _CustomProperties = Nothing + Set _Toolbars = Nothing + _StyleFamilies = Array() +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 FileSystem() As String +''' Returns the root of the document's virtual file system +''' The "FileSystem" service may be used to explore it, as long as the document remains open +''' The property is not applicable to Base documents +''' Example: +''' Dim sRoot As String, FSO +''' sRoot = oDoc.FileSystem +''' Set FSO = CreateScriptService("FileSystem") +''' MsgBox FSO.FolderExists(FSO.BuildPath(sRoot, "Pictures")) + FileSystem = _PropertyGet("FileSystem") +End Property ' SFDocuments.SF_Document.FileSystem + +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 IsFormDocument() As Boolean + IsFormDocument = _PropertyGet("IsFormDocument") +End Property ' SFDocuments.SF_Document.IsFormDocument + +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 StyleFamilies() As Variant +''' Returns the list of available style families, as an array of strings + StyleFamilies = _PropertyGet("StyleFamilies") +End Property ' SFDocuments.SF_Document.StyleFamilies + +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 ----------------------------------------------------------------------------- +Property Get XDocumentSettings() As Variant +''' Gives access to a bunch of additional properties, specific to the document's type, about the document +''' Returns Nothing or a com.sun.star.XXX.DocumentSettings, XXX = text, sheet, drawing or presentation. + XDocumentSettings = _PropertyGet("XDocumentSettings") +End Property ' SFDocuments.SF_Document.XDocumentSettings + +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) + If .IsMinimized Then .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 = Not _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: + On Local Error GoTo 0 + 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 Sub DeleteStyles(Optional ByVal Family As Variant _ + , Optional ByRef StylesList As Variant _ + ) +''' Delete a single style or an array of styles given by their name(s) +''' within a specific styles family. +''' Only user-defined styles may be deleted. Built-in styles are ignored. +''' Args: +''' Family: one of the style families present in the actual document, as a case-sensitive string +''' StylesList: a single style name as a string or an array of style names. +''' The style names may be localized or not. +''' The StylesList is typically the output of the execution of a Styles() method. +''' Returns: +''' Examples: +''' ' Remove all unused styles +''' Const family = "ParagraphStyles" +''' doc.DeleteStyles(family, doc.Styles(family, Used := False, UserDefined := True)) + +Dim oFamily As Object ' Style names container +Dim vStylesList As Variant ' Alias of StylesList +Dim sStyle As String ' A single style name +Const cstThisSub = "SFDocuments.Document.DeleteStyles" +Const cstSubArgs = "Family, StylesList" + + 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 + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames() + If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally + If IsArray(StylesList) Then + If Not ScriptForge.SF_Utils._ValidateArray(StylesList, "StylesList", 1, V_STRING, True) Then GoTo Finally + Else + If Not ScriptForge.SF_Utils._Validate(StylesList, "StylesList", V_STRING) Then GoTo Finally + End If + End If + +Try: + Set oFamily = _GetStyleFamily(Family) + If Not IsNull(oFamily) Then + With oFamily + If Not IsArray(StylesList) Then vStylesList = Array(StylesList) Else vStylesList = StylesList + For Each sStyle In vStylesList + If .hasByName(sStyle) Then .removeByName(sStyle) + Next sStyle + End With + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' SFDocuments.SF_Document.DeleteStyles + +REM ----------------------------------------------------------------------------- +Public Sub Echo(Optional ByVal EchoOn As Variant _ + , Optional ByVal Hourglass As Variant _ + ) +''' While a script is executed any display update resulting from that execution +''' is done immediately. +''' For performance reasons it might be an advantage to differ the display updates +''' up to the end of the script. +''' This is where pairs of Echo() methods to set and reset the removal of the +''' immediate updates may be beneficial. +''' Optionally the actual mouse pointer can be modified to the image of an hourglass. +''' Args: +''' EchoOn: when False, the display updates are suspended. Default = True. +''' Multiple calls with EchoOn = False are harmless. +''' Hourglass: when True, the mouse pointer is changed to an hourglass. Default = False. +''' The mouse pointer needs to be inside the actual document's window. +''' Note that it is very likely that at the least manual movement of the mouse, +''' the operating system or the LibreOffice process will take back the control +''' of the mouse icon and its usual behaviour. +''' Returns: +''' Examples: +''' oDoc.Echo(False, Hourglass := True) +''' ' ... "long-lasting" script ... +''' oDoc.Echo() ' Reset to normal + +Dim oContainer As Object ' com.sun.star.awt.XWindow +Dim lPointer As Long ' com.sun.star.awt.SystemPointer constant +Dim oPointer As Object ' com.sun.star.awt.Pointer +Const cstThisSub = "SFDocuments.Document.Echo" +Const cstSubArgs = "[EchoOn=True], [Hourglass=False]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(EchoOn) Or IsEmpty(EchoOn) Then EchoOn = True + If IsMissing(Hourglass) Or IsEmpty(Hourglass) Then Hourglass = False + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not SF_Utils._Validate(EchoOn, "EchoOn", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Hourglass, "Hourglass", ScriptForge.V_BOOLEAN) Then GoTo Finally + End If + +Try: + With _Component + + Set oContainer = .CurrentController.Frame.GetContainerWindow() + Set oPointer = CreateUnoService("com.sun.star.awt.Pointer") + With com.sun.star.awt.SystemPointer + If Hourglass Then lPointer = .WAIT Else lPointer = .ARROW + End With + oPointer.setType(lPointer) + + ' Mouse icon is set when controller is unlocked + If Not EchoOn Then + oContainer.setPointer(oPointer) + .lockControllers() + Else ' EchoOn = True + Do While .hasControllersLocked() + .unlockControllers() + Loop + oContainer.setPointer(oPointer) + End If + + End With + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' SFDocuments.SF_Document.Echo + +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 + Select Case _DocumentType ' Disguise form documents as a Writer document + Case "FormDocument" : sFilter = "Writer_pdf_Export" + Case Else : sFilter = LCase(_DocumentType) & "_pdf_Export" + End Select + ' 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" _ + , "Echo" _ + , "DeleteStyles" _ + , "ExportAsPDF" _ + , "ImportStylesFromFile" _ + , "PrintOut" _ + , "RemoveMenu" _ + , "RunCommand" _ + , "Save" _ + , "SaveAs" _ + , "SaveCopyAs" _ + , "SetPrinter" _ + , "Styles" _ + , "Toolbars" _ + , "XStyle" _ + ) + +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" _ + , "FileSystem" _ + , "ImportFilters" _ + , "IsBase" _ + , "IsCalc" _ + , "IsDraw" _ + , "IsFormDocument" _ + , "IsImpress" _ + , "IsMath" _ + , "IsWriter" _ + , "Keywords" _ + , "Readonly" _ + , "StyleFamilies" _ + , "Subject" _ + , "Title" _ + , "XComponent" _ + , "XDocumentSettings" _ + ) + +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 Then + If IsArray(Args(0)) Then vArgs = Args(0) + End If + 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 ----------------------------------------------------------------------------- +Public Function Styles(Optional ByVal Family As Variant _ + , Optional ByVal NamePattern As variant _ + , Optional ByVal Used As variant _ + , Optional ByVal UserDefined As Variant _ + , Optional ByVal ParentStyle As Variant _ + , Optional ByVal Category As Variant _ + ) As Variant +''' Returns an array of style names matching the filters given in argument +''' Args: +''' Family: one of the style families present in the actual document, as a case-sensitive string +''' NamePattern: a filter on the style names, as a case-sensitive string pattern +''' Admitted wildcard are: the "?" represents any single character +''' the "*" represents zero, one, or multiple characters +''' The names include the internal and localized names. +''' Used: when True, the style must be used in the document +''' When absent, the argument is ignored. +''' UserDefined: when True, the style must have been added by the user, either in the document or its template +''' When absent, the argument is ignored. +''' ParentStyle: when present, only the children of the given, localized or not, parent style name are retained +''' Category: a case-insensitive string: TEXT, CHAPTER, LIST, INDEX, EXTRA, HTML +''' For their respective meanings, read https://api.libreoffice.org/docs/idl/ref/namespacecom_1_1sun_1_1star_1_1style_1_1ParagraphStyleCategory.html +''' The argument is ignored when the Family is not = "ParagraphStyles". +''' Returns: +''' An array of style localized names +''' An error is raised when the Family does not exist. +''' The returned array may be empty. +''' Example: +''' Dim vStyles As Variant +''' vStyles = doc.Styles("ParagraphStyles") ' All styles in the family +''' vStyles = doc.Styles("ParagraphStyles", "H*") ' Heading, Heading 1, ... +''' vStyles = doc.Styles("ParagraphStyles", Used := False, UserDefined := True) +''' ' All user-defined styles that are not used +''' vStyles = doc.Styles("ParagraphStyles", ParentStyle := "Standard") +''' ' All styles derived from the "Default Paragraph Style" + +Dim vStyles As Variant ' Return value +Dim sStyle As String ' A single style name +Dim oFamily As Object ' Style names container +Dim oStyle As Object ' _StyleDescriptor +Dim oParentStyle As Object ' _StyleDescriptor +Dim bValid As Boolean ' When True, a given style passes the filter +Dim i As Integer +Const cstCategories = "TEXT,CHAPTER,LIST,INDEX,EXTRA,HTML" + +Const cstThisSub = "SFDocuments.Document.Styles" +Const cstSubArgs = "Family, [NamePattern=""*""], [Used=True|False], [UserDefined=True|False], ParentStyle = """"" _ + & ", [Category=""""|""TEXT""|""CHAPTER""|""LIST""|""INDEX""|""EXTRA""|""HTML""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vStyles = Array() + +Check: + If IsMissing(NamePattern) Or IsEmpty(NamePattern) Then NamePattern = "" + If IsMissing(Used) Then Used = Empty + If IsMissing(UserDefined) Then UserDefined = Empty + If IsMissing(ParentStyle) Or IsEmpty(ParentStyle) Then ParentStyle = "" + If IsMissing(Category) Or IsEmpty(Category) Then Category = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames() + If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(NamePattern, "NamePattern", V_STRING) Then GoTo Finally + If Not IsEmpty(Used) Then + If Not ScriptForge.SF_Utils._Validate(Used, "Used", ScriptForge.V_BOOLEAN) Then GoTo Finally + End If + If Not IsEmpty(UserDefined) Then + If Not ScriptForge.SF_Utils._Validate(UserDefined, "UserDefined", ScriptForge.V_BOOLEAN) Then GoTo Finally + End If + If Not ScriptForge.SF_Utils._Validate(ParentStyle, "ParentStyle", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Category, "Category", V_STRING, Split("," & cstCategories, ",")) Then GoTo Finally + End If + +Try: + Set oFamily = _GetStyleFamily(Family) + If Not IsNull(oFamily) Then + ' Load it with the complete list of styles in the family + vStyles = oFamily.getElementNames() + ' Scan the list and retain those passing the filter + For i = 0 To UBound(vStyles) + With oStyle + sStyle = vStyles(i) + Set oStyle = _GetStyle(oFamily, sStyle) + If Not IsNull(oStyle) Then + ' Pattern ? + bValid = ( Len(NamePattern) = 0 ) + If Not bValid Then bValid = ScriptForge.SF_String.IsLike(.DisplayName, NamePattern, CaseSensitive := True) + ' Used ? + If bValid And Not IsEmpty(Used) Then bValid = ( Used = .IsUsed ) + ' User defined ? + If bValid And Not IsEmpty(UserDefined) Then bValid = ( UserDefined = Not .BuiltIn ) + ' Parent style ? + If bValid And Len(ParentStyle) > 0 Then + Set oParentStyle = _GetStyle(oFamily, .ParentStyle) + bValid = Not IsNull(oParentStyle) ' The child has a parent + If bValid Then bValid = ( ParentStyle = oParentStyle.DisplayName Or ParentStyle = oParentStyle.StyleName) + End If + ' Category ? + If bValid And Len(Category) > 0 Then bValid = ( UCase(Category) = .Category ) + If bValid Then vStyles(i) = .DisplayName Else vStyles(i) = "" + Else + vStyles(i) = "" + End If + End With + Next i + ' Reject when not valid + vStyles = ScriptForge.SF_Array.TrimArray(vStyles) + End If + +Finally: + Styles = vStyles + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.Styles + +REM ----------------------------------------------------------------------------- +Public Function Toolbars(Optional ByVal ToolbarName As Variant) As Variant +''' Returns either a list of the available toolbar names in the actual document +''' or a Toolbar object instance. +''' Args: +''' ToolbarName: the usual name of one of the available toolbars +''' Returns: +''' A zero-based array of toolbar names when the argument is absent, +''' or a new Toolbar object instance from the SF_Widgets library. + +Const cstThisSub = "SFDocuments.Document.Toolbars" +Const cstSubArgs = "[ToolbarName=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(ToolbarName) Or IsEmpty(ToolbarName) Then ToolbarName = "" + If IsNull(_Toolbars) Then _Toolbars = ScriptForge.SF_UI._ListToolbars(_Component) + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If VarType(ToolbarName) = V_STRING Then + If Len(ToolbarName) > 0 Then + If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING, _Toolbars.Keys()) Then GoTo Finally + End If + Else + If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING) Then GoTo Finally ' Manage here the VarType error + End If + End If + +Try: + If Len(ToolbarName) = 0 Then + Toolbars = _Toolbars.Keys() + Else + Toolbars = CreateScriptService("SFWidgets.Toolbar", _Toolbars.Item(ToolbarName)) + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.Toolbars + +REM ----------------------------------------------------------------------------- +Public Function XStyle(Optional ByVal Family As Variant _ + , Optional ByVal StyleName As variant _ + ) As Object +''' Returns a com.sun.star.style.Style UNO object corresponding with the arguments +''' Args: +''' Family: one of the style families present in the actual document, as a not case-sensitive string +''' StyleName: one of the styles present in the given family, as a case-sensitive string +''' The StyleName may be localized or not. +''' Returns: +''' A com.sun.star.style.XStyle UNO object or one of its descendants, +''' like com.sun.star.style.CellStyle or com.sun.star.style.ParagraphStyle etc. +''' An error is raised when the Family does not exist. +''' Nothing is returned when the StyleName does not exist in the given Family. +''' Example: +''' Dim oStyle As Object +''' Set oStyle = doc.XStyle("ParagraphStyle", "Heading 2") + +Dim oXStyle As Object ' Return value +Dim oFamily As Object ' Style names container + +Const cstThisSub = "SFDocuments.Document.XStyle" +Const cstSubArgs = "Family, StyleName" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oXStyle = Nothing + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames() + If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(StyleName, "StyleName", V_STRING) Then GoTo Finally + End If + +Try: + Set oFamily = _GetStyleFamily(Family) + If Not IsNull(oFamily) Then + If oFamily.hasByName(StyleName) Then Set oXStyle = oFamily.getByName(StyleName) + End If + +Finally: + Set XStyle = oXStyle + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.XStyle + +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 + + ' OS notation is used to avoid presence of "%nn" in error messages and wrong parameter substitutions + _FileIdent = Iif(Len(_WindowFileName) > 0, 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 = ScriptForge.SF_Utils._GetPropertyValue(vFilter, "DocumentService") + If sType = sIdentifier Then + lFlags = ScriptForge.SF_Utils._GetPropertyValue(vFilter, "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 _GetStyle(ByRef poFamily As Object _ + , Optional ByVal pvDisplayName As Variant _ + , Optional ByVal pvStyleIndex As Variant _ + ) As Object +''' Returns the style descriptor of the style passed as argument in the given family +''' Args: +''' poFamily: a com.sun.star.container.XNameContainer/XStyleFamily object +''' pvDisplayName: case-sensitive string, localized style name as visible in the user interface +''' pvStyleIndex: index of the style in the family, as an integer +''' Exactly 1 out of the last 2 arguments must be supplied +''' Returns: +''' A StyleDescriptor object or Nothing + +Dim oStyleDescriptor ' Return value +Dim oStyle As Object ' com.sun.star.style.XStyle and variants +Dim bFound As Boolean ' When True, the style has been found in the family +Dim vCategories As Variant ' Array of category constants +Dim iCategory As Integer ' Index of vCategories +Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") +Dim i As Integer + +Const cstCAT0 = "TEXT" ' is applied to styles that are used for common text +Const cstCAT1 = "CHAPTER" ' is applied to styles that are used as headings +Const cstCAT2 = "LIST" ' is applied to styles that are used in numberings and lists +Const cstCAT3 = "INDEX" ' is applied to styles that are used in indexes +Const cstCAT4 = "EXTRA" ' is applied to styles that are used in special regions like headers, footers, and footnote text +Const cstCAT5 = "HTML" ' is applied to styles that are used to support HTML +Const cstCAT = cstCAT0 & "," & cstCAT1 & "," & cstCAT2 & "," & cstCAT3 & "," & cstCAT4 & "," & cstCAT5 + + On Local Error GoTo Catch + Set oStyleDescriptor = Nothing + +Check: + If IsNull(poFamily) Then GoTo Catch + If IsMissing(pvDisplayName) Or IsEmpty(pvDisplayName) Then pvDisplayName = "" + If IsMissing(pvStyleIndex) Or IsEmpty(pvStyleIndex) Then pvStyleIndex = -1 +Try: + ' Find style corresponding with the given display name + With poFamily + If Len(pvDisplayName) > 0 Then + bFound = .hasByName(pvDisplayName) ' hasByName searches both for Name and DisplayName attributes here + If bFound Then Set oStyle = .getByName(pvDisplayName) Else GoTo Catch + ElseIf pvStyleIndex >= 0 And pvStyleIndex < .Count Then + Set oStyle = .getByIndex(pvStyleIndex) + Else + GoTo Catch ' Should not happen + End If + End With + + ' Setup the style descriptor + Set oStyleDescriptor = New StyleDescriptor + With oStyleDescriptor + Set .Family = poFamily + .StyleName = oStyle.Name + .DisplayName = oStyle.DisplayName + .IsUsed = oStyle.isInUse + .BuiltIn = Not oStyle.isUserDefined() + .Category = "" + If oSession.HasUnoProperty(oStyle, "Category") Then + vCategories = Split(cstCAT, ",") + iCategory = oStyle.Category + If iCategory >= 0 And iCategory <= UBound(vCategories) Then .Category = vCategories(iCategory) + End If + .ParentStyle = oStyle.ParentStyle + Set .XStyle = oStyle + End With + +Finally: + Set _GetStyle = oStyleDescriptor + Exit Function +Catch: + Set oStyleDescriptor = Nothing + GoTo Finally +End Function ' SFDocuments.SF_Document._GetStyle + +REM ----------------------------------------------------------------------------- +Private Function _GetStyleFamily(ByVal psFamilyName As String) As Object +''' Returns the style names container corresponding with the argument +''' Args: +''' psFamilyName: CellStyles, CharacterStyles, FrameStyles, GraphicsStyles, ListStyles, +''' NumberingStyles, PageStyles, ParagraphStyles, TableStyles +''' Returns: +''' A com.sun.star.container.XNameContainer/XStyleFamily object or Nothing + +Dim oFamily As Object ' Return value +Dim oFamilies As Object ' com.sun.star.container.XNameAccess +Dim iIndex As Integer ' Index in vFamilies of the given argument + + On Local Error GoTo Catch + Set oFamily = Nothing + +Try: + Set oFamilies = _Component.getStyleFamilies() + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = oFamilies.getElementNames() + ' oFamilies.hasByName()/getByName() not used here to admit not case-sensitive family names + iIndex = ScriptForge.SF_Array.IndexOf(_StyleFamilies, psFamilyName, CaseSensitive := False) + If iIndex >= 0 Then Set oFamily = oFamilies.getByName(_StyleFamilies(iIndex)) + +Finally: + Set _GetStyleFamily = oFamily + Exit Function +Catch: + Set oFamily = Nothing + GoTo Finally +End Function ' SFDocuments.SF_Document._GetStyleFamily + +REM ----------------------------------------------------------------------------- +Public Sub _ImportStylesFromFile(Optional FileName As Variant _ + , Optional ByRef Families As Variant _ + , Optional ByVal Overwrite As variant _ + ) As Variant +''' Load all the styles belonging to one or more style families from a closed file +''' into the actual document. The actual document must be a Calc or a Writer document. +''' Are always imported together: +''' ParagraphStyles and CharacterStyles +''' NumberingStyles and ListStyles +''' Args: +''' FileName: the file from which to load the styles in the FileSystem notation. +''' The file is presumed to be of the same document type as the actual document +''' Families: one of the style families present in the actual document, as a case-sensitive string +''' or an array of such strings. Default = all families +''' Overwrite: when True, the actual styles may be overwritten. Default = False +''' Returns: +''' Exceptions: +''' UNKNOWNFILEERROR The given file name does not exist +''' Example: +''' oDoc.ImportStylesFromFile("C:\...\abc.odt", Families := "ParagraphStyles", Overwrite := True) + +Dim vFamilies As Variant ' Alias of Families +Dim oFamilies As Object ' com.sun.star.container.XNameAccess +Dim vOptions As Variant ' Array of property values +Dim bAll As Boolean ' When True, ALL style families are considered +Dim sName As String ' A single name in vOptions +Dim FSO As Object : Set FSO = ScriptForge.SF_FileSystem +Dim i As Integer +Const cstThisSub = "SFDocuments.Document.ImportStylesFromFile" +Const cstSubArgs = "FileName, [Families], [Overwrite=False]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Families) Or IsEmpty(Families) Then Families = "" + If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False + + Set oFamilies = _Component.getStyleFamilies() + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = oFamilies.getElementNames() + + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName", False) Then GoTo Finally + If IsArray(Families) Then + If Not ScriptForge.SF_Utils._ValidateArray(Families, "Families", 1, V_STRING, True) Then GoTo Finally + Else + If Not ScriptForge.SF_Utils._Validate(Families, "Families", V_STRING, ScriptForge.SF_Array.Append(_StyleFamilies, "")) Then GoTo Finally + End If + If Not ScriptForge.SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally + End If + + If Not FSO.FileExists(FileName) Then GoTo CatchNotExists + If IsArray(Families) Then + vFamilies = Families + Else + bAll = ( Len(Families) = 0 ) ' When Families is absent (= ""), all families should be considered + vFamilies = Array(Families) + End If + +Try: + With ScriptForge.SF_Utils + Set vOptions = _Component.getStyleFamilies().getStyleLoaderOptions + ' By default, all style families are imported (True) + If Not bAll Then + For i = 0 To UBound(vOptions) + vOptions(i).Value = False + Next i + For i = LBound(vFamilies) To UBound(vFamilies) + Select Case UCase(vFamilies(i)) + Case "PARAGRAPHSTYLES", "CHARACTERSTYLES" : sName = "TextStyles" + Case "FRAMESTYLES" : sName = "FrameStyles" + Case "PAGESTYLES" : sName = "PageStyles" + Case "NUMBERINGSTYLES", "LISTSTYLES" : sName = "NumberingStyles" + Case "CELLSTYLES" : sName = "PageStyles" + Case Else : sName = "" + End Select + If Len(sName) > 0 Then Set vOptions = ._SetPropertyValue(vOptions, "Load" & sName, True) + Next i + End If + vOptions = ._SetPropertyValue(vOptions, "OverwriteStyles", Overwrite) + End With + + ' Finally, import + oFamilies.loadStylesFromURL(FSO._ConvertToUrl(FileName), vOptions) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +CatchNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName) + GoTo Finally +End Sub ' SFDocuments.SF_Document._ImportStylesFromFile + +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 oTransient As Object ' com.sun.star.frame.TransientDocumentsDocumentContentFactory +Dim oContent As Object ' com.sun.star.comp.ucb.TransientDocumentsContent +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 "FileSystem" + ' Natural choice would have been to use the component.RunTimeUID property + ' However it is optional in the OfficeDocument service and not available for Base documents + ' Below a more generic alternative derived from the get_document_uri() method found in apso.py + Set oTransient = ScriptForge.SF_Utils._GetUnoService("TransientDocumentFactory") + Set oContent = oTransient.createDocumentContent(_Component) + _PropertyGet = oContent.getIdentifier().ContentIdentifier & "/" + Case "ImportFilters" + _PropertyGet = _GetFilterNames(False) + Case "IsBase", "IsCalc", "IsDraw", "IsFormDocument", "IsImpress", "IsMath", "IsWriter" + _PropertyGet = ( Mid(psProperty, 3) = _DocumentType ) + Case "Keywords" + _PropertyGet = Join(_Component.DocumentProperties.Keywords, ", ") + Case "Readonly" + _PropertyGet = _Component.isReadonly() + Case "StyleFamilies" + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames() + _PropertyGet = _StyleFamilies + Case "Subject" + _PropertyGet = _Component.DocumentProperties.Subject + Case "Title" + _PropertyGet = _Component.DocumentProperties.Title + Case "XComponent" + Set _PropertyGet = _Component + Case "XDocumentSettings" + With _Component + If IsNull(_DocumentSettings) Then + Select Case _DocumentType + Case "Calc" : Set _DocumentSettings = .createInstance("com.sun.star.sheet.DocumentSettings") + Case "Draw" : Set _DocumentSettings = .createInstance("com.sun.star.drawing.DocumentSettings") + Case "FormDocument", "Writer" + Set _DocumentSettings = .createInstance("com.sun.star.text.DocumentSettings") + Case "Impress" : Set _DocumentSettings = .createInstance("com.sun.star.presentation.DocumentSettings") + Case Else : Set _DocumentSettings = Nothing + End Select + End If + Set _PropertyGet = _DocumentSettings + End With + 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> |