1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507 |
- <?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 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 =========================================================== 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 _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>
|