| blob | 2233aeb5c6500c998a9b02cc2f2dc8480764b327 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Document" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === The SFDocuments library is one of the associated libraries. ===
6 REM === Full documentation is available on https://help.libreoffice.org/ ===
7 REM =======================================================================================================================
9 Option Compatible
10 Option ClassModule
12 Option Explicit
14 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
15 ''' SF_Document
16 ''' ===========
17 '''
18 ''' The SFDocuments library gathers a number of methods and properties making easy
19 ''' managing and manipulating LibreOffice documents
20 '''
21 ''' Some methods are generic for all types of documents: they are combined in the
22 ''' current SF_Document module
23 ''' - saving, closing documents
24 ''' - accessing their standard or custom properties
25 ''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Base, ...
26 '''
27 ''' Documents might contain forms. The current service gives access to the "SFDocuments.Form" service
28 '''
29 ''' To workaround the absence of class inheritance in LibreOffice Basic, some redundancy is necessary
30 ''' Each subclass MUST implement also the generic methods and properties, even if they only call
31 ''' the parent methods and properties implemented below
32 ''' They should also duplicate some generic private members as a subset of their own set of members
33 '''
34 ''' The current module is closely related to the "UI" and "FileSystem" services
35 ''' of the ScriptForge library
36 '''
37 ''' Service invocation examples:
39 ''' Dim ui As Object, oDoc As Object
45 ''' Dim oDoc As Object
46 ''' Set oDoc = CreateScriptService("SFDocuments.Document", "Untitled 1") ' Default = ActiveWindow
48 '''
49 ''' Detailed user documentation:
50 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_document.html?DbPAR=BASIC
51 '''
52 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
54 REM ================================================================== EXCEPTIONS
63 REM ============================================================= PRIVATE MEMBERS
65 Private [Me] As Object
66 Private [_Parent] As Object
67 Private [_SubClass] As Object ' Subclass instance
68 Private ObjectType As String ' Must be DOCUMENT
69 Private ServiceName As String
71 ' Window description
72 Private _Component As Object ' com.sun.star.lang.XComponent
73 Private _Frame As Object ' com.sun.star.comp.framework.Frame
74 Private _WindowName As String ' Object Name
75 Private _WindowTitle As String ' Only mean to identify new documents
76 Private _WindowFileName As String ' URL of file name
77 Private _DocumentType As String ' Writer, Calc, ...
79 ' Properties (work variables - real properties could have been set manually by user)
80 Private _DocumentProperties As Object ' Dictionary of document properties
81 Private _CustomProperties As Object ' Dictionary of custom properties
83 ' Cache for static toolbar descriptions
84 Private _Toolbars As Object ' SF_Dictionary instance to hold toolbars stored in application or in document
86 REM ============================================================ MODULE CONSTANTS
90 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
92 REM -----------------------------------------------------------------------------
93 Private Sub Class_Initialize()
94 Set [Me] = Nothing
95 Set [_Parent] = Nothing
96 Set [_SubClass] = Nothing
99 Set _Component = Nothing
100 Set _Frame = Nothing
101 _WindowName = ""
102 _WindowTitle = ""
103 _WindowFileName = ""
104 _DocumentType = ""
105 Set _DocumentProperties = Nothing
106 Set _CustomProperties = Nothing
107 Set _Toolbars = Nothing
108 End Sub ' SFDocuments.SF_Document Constructor
110 REM -----------------------------------------------------------------------------
111 Private Sub Class_Terminate()
112 Call Class_Initialize()
113 End Sub ' SFDocuments.SF_Document Destructor
115 REM -----------------------------------------------------------------------------
116 Public Function Dispose() As Variant
117 Call Class_Terminate()
118 Set Dispose = Nothing
119 End Function ' SFDocuments.SF_Document Explicit Destructor
121 REM ================================================================== PROPERTIES
123 REM -----------------------------------------------------------------------------
124 Property Get CustomProperties() As Variant
125 ''' Returns a dictionary of all custom properties of the document
127 End Property ' SFDocuments.SF_Document.CustomProperties
129 REM -----------------------------------------------------------------------------
130 Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant)
131 ''' Sets the updatable custom properties
132 ''' The argument is a dictionary
134 Dim vPropertyValues As Variant ' Array of com.sun.star.beans.PropertyValue
135 Dim vCustomProperties As Variant ' Alias of argument
136 Dim oUserdefinedProperties As Object ' Custom properties object
137 Dim vOldPropertyValues As Variant ' Array of (to remove) existing user defined properties
138 Dim oProperty As Object ' Single com.sun.star.beans.PropertyValues
139 Dim sProperty As String ' Property name
140 Dim vKeys As Variant ' Array of dictionary keys
141 Dim vItems As Variant ' Array of dictionary items
142 Dim vValue As Variant ' Value to store in property
143 Dim iAttribute As Integer ' com.sun.star.beans.PropertyAttribute.REMOVEABLE
144 Dim i As Long
148 On Local Error GoTo Catch
150 Check:
151 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
152 If Not _IsStillAlive(True) Then GoTo Finally
153 If Not ScriptForge.SF_Utils._Validate(pvCustomProperties, "CustomProperties", ScriptForge.V_OBJECT, , , "DICTIONARY") Then GoTo Finally
154 End If
156 Try:
157 Set oUserDefinedProperties = _Component.getDocumentProperties().UserDefinedProperties
159 Set vCustomProperties = pvCustomProperties ' To avoid "Object variable not set" error
160 With vCustomProperties
162 ' All existing custom properties must first be removed to avoid type conflicts
163 vOldPropertyValues = oUserDefinedProperties.getPropertyValues
164 For Each oProperty In vOldPropertyValues
165 sProperty = oProperty.Name
166 oUserDefinedProperties.removeProperty(sProperty)
167 Next oProperty
169 ' Insert new properties one by one after type adjustment (dates, arrays, numbers)
170 vKeys = .Keys
171 vItems = .Items
172 iAttribute = com.sun.star.beans.PropertyAttribute.REMOVEABLE
173 For i = 0 To UBound(vKeys)
174 If VarType(vItems(i)) = V_DATE Then
175 vValue = ScriptForge.SF_Utils._CDateToUnoDate(vItems(i))
176 ElseIf IsArray(vItems(i)) Then
177 vValue = Null
178 ElseIf ScriptForge.SF_Utils._VarTypeExt(vItems(i)) = ScriptForge.V_NUMERIC Then
180 Else
181 vValue = vItems(i)
182 End If
183 oUserDefinedProperties.addProperty(vKeys(i), iAttribute, vValue)
184 Next i
186 ' Declare the document as changed
187 _Component.setModified(True)
188 End With
190 ' Reload custom properties in current object instance
193 Finally:
194 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
195 Exit Property
196 Catch:
197 GoTo Finally
198 End Property ' SFDocuments.SF_Document.CustomProperties
200 REM -----------------------------------------------------------------------------
201 Property Get Description() As Variant
202 ''' Returns the updatable document property Description
204 End Property ' SFDocuments.SF_Document.Description
206 REM -----------------------------------------------------------------------------
207 Property Let Description(Optional ByVal pvDescription As Variant)
208 ''' Sets the updatable document property Description
209 ''' If multilined, separate lines by "\n" escape sequence or by hard breaks
211 Dim sDescription As String ' Alias of pvDescription
215 Check:
216 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
217 If Not _IsStillAlive(True) Then GoTo Finally
218 If Not ScriptForge.SF_Utils._Validate(pvDescription, "Description", V_STRING) Then GoTo Finally
219 End If
221 Try:
222 ' Update in UNO component object and in current instance
224 _Component.DocumentProperties.Description = sDescription
225 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Description", sdescription)
227 Finally:
228 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
229 Exit Property
230 End Property ' SFDocuments.SF_Document.Description
232 REM -----------------------------------------------------------------------------
233 Property Get DocumentProperties() As Variant
234 ''' Returns a dictionary of all standard document properties, custom properties are excluded
236 End Property ' SFDocuments.SF_Document.DocumentProperties
238 REM -----------------------------------------------------------------------------
239 Property Get DocumentType() As String
240 ''' Returns "Base", "Calc", "Draw", ... or "Writer"
242 End Property ' SFDocuments.SF_Document.DocumentType
244 REM -----------------------------------------------------------------------------
245 Property Get ExportFilters() As Variant
246 ''' Returns the list of the export filter names applicable to the current document
247 ''' as a zero-based array of strings
248 ''' Import/Export filters are included
250 End Property ' SFDocuments.SF_Document.ExportFilters
252 REM -----------------------------------------------------------------------------
253 Property Get ImportFilters() As Variant
254 ''' Returns the list of the import filter names applicable to the current document
255 ''' as a zero-based array of strings
256 ''' Import/Export filters are included
258 End Property ' SFDocuments.SF_Document.ImportFilters
260 REM -----------------------------------------------------------------------------
261 Property Get IsBase() As Boolean
263 End Property ' SFDocuments.SF_Document.IsBase
265 REM -----------------------------------------------------------------------------
266 Property Get IsCalc() As Boolean
268 End Property ' SFDocuments.SF_Document.IsCalc
270 REM -----------------------------------------------------------------------------
271 Property Get IsDraw() As Boolean
273 End Property ' SFDocuments.SF_Document.IsDraw
275 REM -----------------------------------------------------------------------------
276 Property Get IsFormDocument() As Boolean
278 End Property ' SFDocuments.SF_Document.IsFormDocument
280 REM -----------------------------------------------------------------------------
281 Property Get IsImpress() As Boolean
283 End Property ' SFDocuments.SF_Document.IsImpress
285 REM -----------------------------------------------------------------------------
286 Property Get IsMath() As Boolean
288 End Property ' SFDocuments.SF_Document.IsMath
290 REM -----------------------------------------------------------------------------
291 Property Get IsWriter() As Boolean
293 End Property ' SFDocuments.SF_Document.IsWriter
295 REM -----------------------------------------------------------------------------
296 Property Get Keywords() As Variant
297 ''' Returns the updatable document property Keywords
299 End Property ' SFDocuments.SF_Document.Keywords
301 REM -----------------------------------------------------------------------------
302 Property Let Keywords(Optional ByVal pvKeywords As Variant)
303 ''' Sets the updatable document property Keywords
305 Dim vKeywords As Variant ' Alias of pvKeywords
309 Check:
310 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
311 If Not _IsStillAlive(True) Then GoTo Finally
312 If Not ScriptForge.SF_Utils._Validate(pvKeywords, "Keywords", V_STRING) Then GoTo Finally
313 End If
315 Try:
316 ' Update in UNO component object and in current instance
318 _Component.DocumentProperties.Keywords = vKeywords
319 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Keywords", Join(vKeywords, ", "))
321 Finally:
322 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
323 Exit Property
324 End Property ' SFDocuments.SF_Document.Keywords
326 REM -----------------------------------------------------------------------------
327 Property Get Readonly() As Boolean
328 ''' Returns True if the document must not be modified
330 End Property ' SFDocuments.SF_Document.Readonly
332 REM -----------------------------------------------------------------------------
333 Property Get Subject() As Variant
334 ''' Returns the updatable document property Subject
336 End Property ' SFDocuments.SF_Document.Subject
338 REM -----------------------------------------------------------------------------
339 Property Let Subject(Optional ByVal pvSubject As Variant)
340 ''' Sets the updatable document property Subject
345 Check:
346 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
347 If Not _IsStillAlive(True) Then GoTo Finally
348 If Not ScriptForge.SF_Utils._Validate(pvSubject, "Subject", V_STRING) Then GoTo Finally
349 End If
351 Try:
352 ' Update in UNO component object and in current instance
353 _Component.DocumentProperties.Subject = pvSubject
354 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Subject", pvSubject)
356 Finally:
357 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
358 Exit Property
359 End Property ' SFDocuments.SF_Document.Subject
361 REM -----------------------------------------------------------------------------
362 Property Get Title() As Variant
363 ''' Returns the updatable document property Title
365 End Property ' SFDocuments.SF_Document.Title
367 REM -----------------------------------------------------------------------------
368 Property Let Title(Optional ByVal pvTitle As Variant)
369 ''' Sets the updatable document property Title
374 Check:
375 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
376 If Not _IsStillAlive(True) Then GoTo Finally
378 End If
380 Try:
381 ' Update in UNO component object and in current instance
382 _Component.DocumentProperties.Title = pvTitle
383 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Title", pvTitle)
385 Finally:
386 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
387 Exit Property
388 End Property ' SFDocuments.SF_Document.Title
390 REM -----------------------------------------------------------------------------
391 Property Get XComponent() As Variant
392 ''' Returns the com.sun.star.lang.XComponent UNO object representing the document
394 End Property ' SFDocuments.SF_Document.XComponent
396 REM ===================================================================== METHODS
398 REM -----------------------------------------------------------------------------
399 Public Function Activate() As Boolean
400 ''' Make the current document active
401 ''' Args:
402 ''' Returns:
403 ''' True if the document could be activated
404 ''' Otherwise, there is no change in the actual user interface
405 ''' Examples:
406 ''' oDoc.Activate()
408 Dim bActivate As Boolean ' Return value
409 Dim oContainer As Object ' com.sun.star.awt.XWindow
411 Const cstSubArgs = ""
413 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
414 bActivate = False
416 Check:
417 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
418 If Not _IsStillAlive() Then GoTo Finally
420 Try:
421 Set oContainer = _Frame.ContainerWindow
422 With oContainer
423 If .isVisible() = False Then .setVisible(True)
424 If .IsMinimized Then .IsMinimized = False
425 .setFocus()
426 .toFront() ' Force window change in Linux
428 End With
429 bActivate = True
431 Finally:
432 Activate = bActivate
433 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
434 Exit Function
435 Catch:
436 GoTo Finally
437 End Function ' SFDocuments.SF_Document.Activate
439 REM -----------------------------------------------------------------------------
440 Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean
441 ''' Close the document. Does nothing if the document is already closed
442 ''' regardless of how the document was closed, manually or by program
443 ''' Args:
444 ''' SaveAsk: If True (default), the user is invited to confirm or not the writing of the changes on disk
445 ''' No effect if the document was not modified
446 ''' Returns:
447 ''' False if the user declined to close
448 ''' Examples:
449 ''' If oDoc.CloseDocument() Then
450 ''' ' ...
452 Dim bClosed As Boolean ' return value
453 Dim oDispatch ' com.sun.star.frame.DispatchHelper
457 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
458 bClosed = False
460 Check:
461 If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True
462 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
463 If Not _IsStillAlive() Then GoTo Finally
464 If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", ScriptForge.V_BOOLEAN) Then GoTo Finally
465 End If
467 Try:
468 If SaveAsk And _Component.IsModified Then ' Execute closure with the File/Close menu command
469 Activate()
471 bClosed = Not _IsStillAlive(, False) ' Do not raise error
472 Else
473 _Frame.close(True)
474 _Frame.dispose()
475 bClosed = True
476 End If
478 Finally:
479 If bClosed Then Dispose()
480 CloseDocument = bClosed
481 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
482 Exit Function
483 Catch:
484 On Local Error GoTo 0
485 GoTo Finally
486 End Function ' SFDocuments.SF_Document.CloseDocument
488 REM -----------------------------------------------------------------------------
489 Public Function CreateMenu(Optional ByVal MenuHeader As Variant _
490 , Optional ByVal Before As Variant _
491 , Optional ByVal SubmenuChar As Variant _
492 , Optional ByRef _Document As Variant _
493 ) As Object
495 ''' The menu is not intended to be saved neither in the LibreOffice global environment, nor in the document
496 ''' The method returns a SFWidgets.Menu instance. Its methods let define the menu further.
497 ''' Args:
498 ''' MenuHeader: the name/header of the menu
499 ''' Before: the place where to put the new menu on the menubar (string or number >= 1)
502 ''' _Document: undocumented argument to designate the document where the menu will be located
503 ''' Returns:
504 ''' A SFWidgets.Menu instance or Nothing
505 ''' Examples:
506 ''' Dim oMenu As Object
507 ''' Set oMenu = oDoc.CreateMenu("My menu", Before := "Styles")
508 ''' With oMenu
510 ''' '...
511 ''' .Dispose() ' When definition is complete, the menu instance may be disposed
512 ''' End With
513 ''' ' ...
515 Dim oMenu As Object ' return value
517 Const cstSubArgs = "MenuHeader, [Before=""""], [SubmenuChar="">""]"
519 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
520 Set oMenu = Nothing
522 Check:
523 If IsMissing(Before) Or IsEmpty(Before) Then Before = ""
524 If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = ""
525 If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component
527 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
528 If Not _IsStillAlive() Then GoTo Finally
529 If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
531 If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally
532 End If
534 Try:
535 Set oMenu = ScriptForge.SF_Services.CreateScriptService("SFWidgets.Menu", _Document, MenuHeader, Before, SubmenuChar)
537 Finally:
538 Set CreateMenu = oMenu
539 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
540 Exit Function
541 Catch:
542 GoTo Finally
543 End Function ' SFDocuments.SF_Document.CreateMenu
545 REM -----------------------------------------------------------------------------
546 Public Sub Echo(Optional ByVal EchoOn As Variant _
547 , Optional ByVal Hourglass As Variant _
548 )
549 ''' While a script is executed any display update resulting from that execution
550 ''' is done immediately.
551 ''' For performance reasons it might be an advantage to differ the display updates
552 ''' up to the end of the script.
553 ''' This is where pairs of Echo() methods to set and reset the removal of the
554 ''' immediate updates may be beneficial.
555 ''' Optionally the actual mouse pointer can be modified to the image of an hourglass.
556 ''' Args:
557 ''' EchoOn: when False, the display updates are suspended. Default = True.
558 ''' Multiple calls with EchoOn = False are harmless.
559 ''' Hourglass: when True, the mouse pointer is changed to an hourglass. Default = False.
561 ''' Note that it is very likely that at the least manual movement of the mouse,
562 ''' the operating system or the LibreOffice process will take back the control
563 ''' of the mouse icon and its usual behaviour.
564 ''' Returns:
565 ''' Examples:
566 ''' oDoc.Echo(False, Hourglass := True)
570 Dim oContainer As Object ' com.sun.star.awt.XWindow
571 Dim lPointer As Long ' com.sun.star.awt.SystemPointer constant
572 Dim oPointer As Object ' com.sun.star.awt.Pointer
576 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
578 Check:
579 If IsMissing(EchoOn) Or IsEmpty(EchoOn) Then EchoOn = True
580 If IsMissing(Hourglass) Or IsEmpty(Hourglass) Then Hourglass = False
581 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
582 If Not _IsStillAlive() Then GoTo Finally
584 If Not SF_Utils._Validate(Hourglass, "Hourglass", ScriptForge.V_BOOLEAN) Then GoTo Finally
585 End If
587 Try:
588 With _Component
590 Set oContainer = .CurrentController.Frame.GetContainerWindow()
592 With com.sun.star.awt.SystemPointer
593 If Hourglass Then lPointer = .WAIT Else lPointer = .ARROW
594 End With
595 oPointer.setType(lPointer)
597 ' Mouse icon is set when controller is unlocked
598 If Not EchoOn Then
599 oContainer.setPointer(oPointer)
600 .lockControllers()
601 Else ' EchoOn = True
602 Do While .hasControllersLocked()
603 .unlockControllers()
604 Loop
605 oContainer.setPointer(oPointer)
606 End If
608 End With
610 Finally:
611 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
612 Exit Sub
613 Catch:
614 GoTo Finally
615 End Sub ' SFDocuments.SF_Document.Echo
617 REM -----------------------------------------------------------------------------
618 Public Function ExportAsPDF(Optional ByVal FileName As Variant _
619 , Optional ByVal Overwrite As Variant _
620 , Optional ByVal Pages As Variant _
621 , Optional ByVal Password As Variant _
622 , Optional ByVal Watermark As Variant _
623 ) As Boolean
624 ''' Store the document to the given file location in PDF format
625 ''' Args:
626 ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
627 ''' Overwrite: True if the destination file may be overwritten (default = False)
628 ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages
629 ''' Password: password to open the document
630 ''' Watermark: the text for a watermark to be drawn on every page of the exported PDF file
631 ''' Returns:
632 ''' False if the document could not be saved
633 ''' Exceptions:
634 ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected
635 ''' Examples:
638 Dim bSaved As Boolean ' return value
639 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
640 Dim sFile As String ' Alias of FileName
641 Dim sFilter As String ' One of the pdf filter names
642 Dim vFilterData As Variant ' Array of com.sun.star.beans.PropertyValue
643 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
644 Dim FSO As Object ' SF_FileSystem
646 Const cstSubArgs = "FileName, [Overwrite=False], [Pages=""""], [Password=""""], [Watermark=""""]"
648 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
649 bSaved = False
651 Check:
652 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
653 If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = ""
654 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
655 If IsMissing(Watermark) Or IsEmpty(Watermark) Then Watermark = ""
657 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
658 If Not _IsStillAlive() Then GoTo Finally
660 If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
664 End If
666 ' Check destination file overwriting
668 sFile = FSO._ConvertToUrl(FileName)
669 If FSO.FileExists(FileName) Then
670 If Overwrite = False Then GoTo CatchError
672 If oSfa.isReadonly(sFile) Then GoTo CatchError
673 End If
675 Try:
676 ' Setup arguments
677 Select Case _DocumentType ' Disguise form documents as a Writer document
680 End Select
681 ' FilterData parameters are added only if they are meaningful
682 vFilterData = Array()
684 vFilterData = ScriptForge.SF_Array.Append(vFilterData _
686 End If
688 vFilterData = ScriptForge.SF_Array.Append(vFilterData _
691 End If
693 vFilterData = ScriptForge.SF_Array.Append(vFilterData _
695 End If
697 ' Finalize properties and export
698 vProperties = Array( _
701 _Component.StoreToURL(sFile, vProperties)
702 bSaved = True
704 Finally:
705 ExportAsPDF = bSaved
706 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
707 Exit Function
708 Catch:
709 GoTo Finally
710 CatchError:
711 ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _
713 GoTo Finally
714 End Function ' SFDocuments.SF_Document.ExportAsPDF
716 REM -----------------------------------------------------------------------------
717 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
718 ''' Return the actual value of the given property
719 ''' Args:
720 ''' PropertyName: the name of the property as a string
721 ''' Returns:
722 ''' The actual value of the property
723 ''' If the property does not exist, returns Null
724 ''' Exceptions:
725 ''' see the exceptions of the individual properties
726 ''' Examples:
730 Const cstSubArgs = ""
732 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
733 GetProperty = Null
735 Check:
736 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
737 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
738 End If
740 Try:
741 GetProperty = _PropertyGet(PropertyName)
743 Finally:
744 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
745 Exit Function
746 Catch:
747 GoTo Finally
748 End Function ' SFDocuments.SF_Document.GetProperty
750 REM -----------------------------------------------------------------------------
751 Public Function Methods() As Variant
752 ''' Return the list of public methods of the Document service as an array
754 Methods = Array( _
767 )
769 End Function ' SFDocuments.SF_Document.Methods
771 REM -----------------------------------------------------------------------------
772 Public Function PrintOut(Optional ByVal Pages As Variant _
773 , Optional ByVal Copies As Variant _
774 , Optional ByRef _Document As Variant _
775 ) As Boolean
776 ''' Send the content of the document to the printer.
777 ''' The printer might be defined previously by default, by the user or by the SetPrinter() method
778 ''' Args:
779 ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages
780 ''' Copies: the number of copies
781 ''' _Document: undocumented argument to designate the document to print when called from a subclass
782 ''' Returns:
783 ''' True when successful
784 ''' Examples:
787 Dim bPrint As Boolean ' Return value
788 Dim vPrintGoal As Variant ' Array of property values
793 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
794 bPrint = False
796 Check:
797 If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = ""
798 If IsMissing(Copies) Or IsEmpty(Copies) Then Copies = 1
799 If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component
801 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
802 If Not _IsStillAlive() Then GoTo Finally
804 If Not ScriptForge.SF_Utils._Validate(Copies, "Copies", ScriptForge.V_NUMERIC) Then GoTo Finally
805 End If
807 Try:
808 vPrintGoal = Array( _
813 )
815 _Document.Print(vPrintGoal)
816 bPrint = True
818 Finally:
819 PrintOut = bPrint
820 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
821 Exit Function
822 Catch:
823 GoTo Finally
824 End Function ' SFDocuments.SF_Document.PrintOut
826 REM -----------------------------------------------------------------------------
827 Public Function Properties() As Variant
828 ''' Return the list or properties of the Document class as an array
830 Properties = Array( _
849 )
851 End Function ' SFDocuments.SF_Document.Properties
853 REM -----------------------------------------------------------------------------
854 Public Function RemoveMenu(Optional ByVal MenuHeader As Variant _
855 , Optional ByRef _Document As Variant _
856 ) As Boolean
858 ''' The removal is not intended to be saved neither in the LibreOffice global environment, nor in the document
859 ''' Args:
860 ''' MenuHeader: the name/header of the menu, without tilde "~", as a case-sensitive string
861 ''' _Document: undocumented argument to designate the document where the menu is located
862 ''' Returns:
863 ''' True when successful
864 ''' Examples:
866 ''' ' ...
868 Dim bRemove As Boolean ' Return value
869 Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager
870 Dim oMenuBar As Object ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar
871 Dim sName As String ' Menu name
872 Dim iMenuId As Integer ' Menu identifier
874 Dim i As Integer
880 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
881 bRemove = False
883 Check:
884 If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component
885 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
886 If Not _IsStillAlive() Then GoTo Finally
887 If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
888 End If
890 Try:
891 Set oLayout = _Document.CurrentController.Frame.LayoutManager
894 ' Search the menu identifier to remove by its name, Mark its position
895 With oMenuBar
896 iMenuPosition = -1
898 iMenuId = .getItemId(i)
899 sName = Replace(.getItemText(iMenuId), cstTilde, "")
900 If MenuHeader= sName Then
901 iMenuPosition = i
902 Exit For
903 End If
904 Next i
905 ' Remove the found menu item
907 .removeItem(iMenuPosition, 1)
908 bRemove = True
909 End If
910 End With
912 Finally:
913 RemoveMenu = bRemove
914 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
915 Exit Function
916 Catch:
917 GoTo Finally
918 End Function ' SFDocuments.SF_Document.RemoveMenu
920 REM -----------------------------------------------------------------------------
921 Public Sub RunCommand(Optional ByVal Command As Variant _
922 , ParamArray Args As Variant _
923 )
924 ''' Run on the current document window the given menu command. The command is executed with or without arguments
925 ''' A few typical commands:
926 ''' Save, SaveAs, ExportToPDF, SetDocumentProperties, Undo, Copy, Paste, ...
927 ''' Dozens can be found on next page: https://wiki.documentfoundation.org/Development/DispatchCommands
928 ''' Args:
929 ''' Command: Case-sensitive. The command itself is not checked.
931 ''' If nothing happens, then the command is probably wrong
932 ''' Args: Pairs of arguments name (string), value (any)
933 ''' Returns:
934 ''' Examples:
935 ''' oDoc.RunCommand("EditDoc", "Editable", False) ' Toggle edit mode
937 Dim vArgs As Variant ' Alias of Args
938 Dim oDispatch ' com.sun.star.frame.DispatchHelper
939 Dim vProps As Variant ' Array of PropertyValues
940 Dim vValue As Variant ' A single value argument
941 Dim sCommand As String ' Alias of Command
942 Dim i As Long
948 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
950 Check:
951 ' When called from a subclass (Calc, Writer, ..) the arguments are gathered into one single array item
952 vArgs = Args
953 If IsArray(Args) Then
956 End If
957 End If
958 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
959 If Not _IsStillAlive() Then GoTo Finally
963 If Not ScriptForge.SF_Utils._Validate(vArgs(i), "Arg" & CStr(i/2) & "Name", V_STRING) Then GoTo Finally
964 Next i
965 End If
967 Try:
968 ' Build array of property values
969 vProps = Array()
972 vProps = ScriptForge.SF_Array.Append(vProps, ScriptForge.SF_Utils._MakePropertyValue(vArgs(i), vValue))
973 Next i
975 If ScriptForge.SF_String.StartsWith(Command, cstPrefix) Then sCommand = Command Else sCommand = cstPrefix & Command
978 Finally:
979 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
980 Exit Sub
981 Catch:
982 GoTo Finally
983 End Sub ' SFDocuments.SF_Document.RunCommand
985 REM -----------------------------------------------------------------------------
986 Public Function Save() As Boolean
987 ''' Store the document to the file location from which it was loaded
988 ''' Ignored if the document was not modified
989 ''' Args:
990 ''' Returns:
991 ''' False if the document could not be saved
992 ''' Exceptions:
993 ''' DOCUMENTSAVEERROR The file has been opened readonly or was opened as new and was not yet saved
994 ''' Examples:
995 ''' If Not oDoc.Save() Then
996 ''' ' ...
998 Dim bSaved As Boolean ' return value
1000 Const cstSubArgs = ""
1002 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1003 bSaved = False
1005 Check:
1006 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1007 If Not _IsStillAlive() Then GoTo Finally
1008 bSaved = False
1010 Try:
1011 With _Component
1012 If .isReadonly() Or Not .hasLocation() Then GoTo CatchReadonly
1013 If .IsModified() Then
1014 .store()
1015 bSaved = True
1016 End If
1017 End With
1019 Finally:
1020 Save = bSaved
1021 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1022 Exit Function
1023 Catch:
1024 GoTo Finally
1025 CatchReadonly:
1027 GoTo Finally
1028 End Function ' SFDocuments.SF_Document.Save
1030 REM -----------------------------------------------------------------------------
1031 Public Function SaveAs(Optional ByVal FileName As Variant _
1032 , Optional ByVal Overwrite As Variant _
1033 , Optional ByVal Password As Variant _
1034 , Optional ByVal FilterName As Variant _
1035 , Optional ByVal FilterOptions As Variant _
1036 ) As Boolean
1037 ''' Store the document to the given file location
1038 ''' The new location becomes the new file name on which simple Save method calls will be applied
1039 ''' Args:
1040 ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
1041 ''' Overwrite: True if the destination file may be overwritten (default = False)
1042 ''' Password: Use to protect the document
1043 ''' FilterName: the name of a filter that should be used for saving the document
1044 ''' If present, the filter must exist
1045 ''' FilterOptions: an optional string of options associated with the filter
1046 ''' Returns:
1047 ''' False if the document could not be saved
1048 ''' Exceptions:
1049 ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected
1050 ''' Examples:
1053 Dim bSaved As Boolean ' return value
1054 Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
1055 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1056 Dim sFile As String ' Alias of FileName
1057 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
1058 Dim FSO As Object ' SF_FileSystem
1060 Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]"
1062 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
1063 bSaved = False
1065 Check:
1066 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
1067 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
1068 If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = ""
1069 If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = ""
1071 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1072 If Not _IsStillAlive() Then GoTo Finally
1074 If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
1077 If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally
1078 End If
1080 ' Check that the filter exists
1083 If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError
1084 End If
1086 ' Check destination file overwriting
1088 sFile = FSO._ConvertToUrl(FileName)
1089 If FSO.FileExists(FileName) Then
1090 If Overwrite = False Then GoTo CatchError
1092 If oSfa.isReadonly(sFile) Then GoTo CatchError
1093 End If
1095 Try:
1096 ' Setup arguments
1097 If Len(Password) + Len(FilterName) = 0 Then
1098 vProperties = Array()
1099 Else
1100 vProperties = Array( _
1103 )
1105 vProperties = ScriptForge.SF_Array.Append(vProperties _
1107 End If
1108 End If
1110 _Component.StoreAsURL(sFile, vProperties)
1112 ' Remind the new file name
1113 _WindowFileName = sFile
1114 _WindowName = FSO.GetName(FileName)
1115 bSaved = True
1117 Finally:
1118 SaveAs = bSaved
1119 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1120 Exit Function
1121 Catch:
1122 GoTo Finally
1123 CatchError:
1124 ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _
1126 GoTo Finally
1127 End Function ' SFDocuments.SF_Document.SaveAs
1129 REM -----------------------------------------------------------------------------
1130 Public Function SaveCopyAs(Optional ByVal FileName As Variant _
1131 , Optional ByVal Overwrite As Variant _
1132 , Optional ByVal Password As Variant _
1133 , Optional ByVal FilterName As Variant _
1134 , Optional ByVal FilterOptions As Variant _
1135 ) As Boolean
1136 ''' Store a copy or export the document to the given file location
1137 ''' The actual location is unchanged
1138 ''' Args:
1139 ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
1140 ''' Overwrite: True if the destination file may be overwritten (default = False)
1141 ''' Password: Use to protect the document
1142 ''' FilterName: the name of a filter that should be used for saving the document
1143 ''' If present, the filter must exist
1144 ''' FilterOptions: an optional string of options associated with the filter
1145 ''' Returns:
1146 ''' False if the document could not be saved
1147 ''' Exceptions:
1148 ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected
1149 ''' Examples:
1152 Dim bSaved As Boolean ' return value
1153 Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
1154 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1155 Dim sFile As String ' Alias of FileName
1156 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
1157 Dim FSO As Object ' SF_FileSystem
1159 Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]"
1161 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
1162 bSaved = False
1164 Check:
1165 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
1166 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
1167 If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = ""
1168 If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = ""
1170 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1171 If Not _IsStillAlive() Then GoTo Finally
1173 If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
1176 If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally
1177 End If
1179 ' Check that the filter exists
1182 If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError
1183 End If
1185 ' Check destination file overwriting
1187 sFile = FSO._ConvertToUrl(FileName)
1188 If FSO.FileExists(FileName) Then
1189 If Overwrite = False Then GoTo CatchError
1191 If oSfa.isReadonly(sFile) Then GoTo CatchError
1192 End If
1194 Try:
1195 ' Setup arguments
1196 If Len(Password) + Len(FilterName) = 0 Then
1197 vProperties = Array()
1198 Else
1199 vProperties = Array( _
1202 )
1204 vProperties = ScriptForge.SF_Array.Append(vProperties _
1206 End If
1207 End If
1209 _Component.StoreToURL(sFile, vProperties)
1210 bSaved = True
1212 Finally:
1213 SaveCopyAs = bSaved
1214 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1215 Exit Function
1216 Catch:
1217 GoTo Finally
1218 CatchError:
1219 ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _
1221 GoTo Finally
1222 End Function ' SFDocuments.SF_Document.SaveCopyAs
1224 REM -----------------------------------------------------------------------------
1225 Public Function SetPrinter(Optional ByVal Printer As Variant _
1226 , Optional ByVal Orientation As Variant _
1227 , Optional ByVal PaperFormat As Variant _
1228 , Optional ByRef _PrintComponent As Variant _
1229 ) As Boolean
1230 ''' Define the printer options for the document
1231 ''' Args:
1232 ''' Printer: the name of the printer queue where to print to
1233 ''' When absent or space, the default printer is set
1234 ''' Orientation: either "PORTRAIT" or "LANDSCAPE". Left unchanged when absent
1235 ''' PaperFormat: one of next values
1236 ''' "A3", "A4", "A5", "B4", "B5", "LETTER", "LEGAL", "TABLOID"
1237 ''' Left unchanged when absent
1238 ''' _PrintComponent: undocumented argument to determine the component
1239 ''' Useful typically to apply printer settings on a Base form document
1240 ''' Returns:
1241 ''' True when successful
1242 ''' Examples:
1245 Dim bPrinter As Boolean ' Return value
1246 Dim vPrinters As Variant ' Array of known printers
1247 Dim vOrientations As Variant ' Array of allowed paper orientations
1248 Dim vPaperFormats As Variant ' Array of allowed formats
1249 Dim vPrinterSettings As Variant ' Array of property values
1250 Dim oPropertyValue As New com.sun.star.beans.PropertyValue
1251 ' A single property value item
1253 Const cstSubArgs = "[Printer=""""], [Orientation=""PORTRAIT""|""LANDSCAPE""]" _
1254 & ", [PaperFormat=""A3""|""A4""|""A5""|""B4""|""B5""|""LETTER""|""LEGAL""|""TABLOID"""
1256 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1257 bPrinter = False
1259 Check:
1260 If IsMissing(Printer) Or IsEmpty(Printer) Then Printer = ""
1261 If IsMissing(Orientation) Or IsEmpty(Orientation) Then Orientation = ""
1262 If IsMissing(PaperFormat) Or IsEmpty(PaperFormat) Then PaperFormat = ""
1263 If IsMissing(_PrintComponent) Or IsEmpty(_PrintComponent) Then Set _PrintComponent = _Component
1265 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional validation
1266 If Not _IsStillAlive() Then GoTo Finally
1267 If VarType(Printer) = V_STRING Then
1268 vPrinters = ScriptForge.SF_Platform.Printers
1270 If Not ScriptForge.SF_Utils._Validate(Printer, "Printer", V_STRING, vPrinters) Then GoTo Finally
1271 End If
1272 Else
1273 If Not ScriptForge.SF_Utils._Validate(Printer, "Printer", V_STRING) Then GoTo Finally ' Manage here the VarType error
1274 End If
1275 If VarType(Orientation) = V_STRING Then
1278 If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, vOrientations) Then GoTo Finally
1279 End If
1280 Else
1281 If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING) Then GoTo Finally
1282 End If
1283 If VarType(PaperFormat) = V_STRING Then
1284 vPaperFormats = Array("A3", "A4", "A5", "B4", "B5", "LETTER", "LEGAL", "TABLOID")
1286 If Not ScriptForge.SF_Utils._Validate(PaperFormat, "PaperFormat", V_STRING, vPaperFormats) Then GoTo Finally
1287 End If
1288 Else
1289 If Not ScriptForge.SF_Utils._Validate(PaperFormat, "PaperFormat", V_STRING) Then GoTo Finally
1290 End If
1292 Try:
1293 With _PrintComponent
1294 Set oPropertyValue = ScriptForge.SF_Utils._MakePropertyValue("Name", Iif(Len(Printer) > 0, Printer, vPrinters(0)))
1295 vPrinterSettings = Array(oPropertyValue)
1297 vPrinterSettings = ScriptForge.SF_Utils._SetPropertyValue(vPrinterSettings, "PaperOrientation" _
1298 , ScriptForge.SF_Array.IndexOf(vOrientations, Orientation, CaseSensitive := False))
1299 End If
1301 vPrinterSettings = ScriptForge.SF_Utils._SetPropertyValue(vPrinterSettings, "PaperFormat" _
1302 , ScriptForge.SF_Array.IndexOf(vPaperFormats, PaperFormat, CaseSensitive := False))
1303 End If
1304 .setPrinter(vPrinterSettings)
1305 End With
1306 bPrinter = True
1308 Finally:
1309 SetPrinter = bPrinter
1310 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1311 Exit Function
1312 Catch:
1313 GoTo Finally
1314 End Function ' SFDocuments.SF_Document.SetPrinter
1316 REM -----------------------------------------------------------------------------
1317 Private Function SetProperty(Optional ByVal psProperty As String _
1318 , Optional ByVal pvValue As Variant _
1319 ) As Boolean
1320 ''' Set the new value of the named property
1321 ''' Args:
1322 ''' psProperty: the name of the property
1323 ''' pvValue: the new value of the given property
1324 ''' Returns:
1325 ''' True if successful
1327 Dim bSet As Boolean ' Return value
1328 Static oSession As Object ' Alias of SF_Session
1329 Dim cstThisSub As String
1332 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1333 bSet = False
1336 If IsMissing(pvValue) Then pvValue = Empty
1337 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets
1339 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1340 bSet = True
1341 Select Case UCase(psProperty)
1343 CustomProperties = pvValue
1345 Description = pvValue
1347 Keywords = pvValue
1349 Subject = pvValue
1351 Title = pvValue
1352 Case Else
1353 bSet = False
1354 End Select
1356 Finally:
1357 SetProperty = bSet
1358 'ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1359 Exit Function
1360 Catch:
1361 GoTo Finally
1362 End Function ' SFDocuments.SF_Document.SetProperty
1364 REM -----------------------------------------------------------------------------
1365 Public Function Toolbars(Optional ByVal ToolbarName As Variant) As Variant
1366 ''' Returns either a list of the available toolbar names in the actual document
1367 ''' or a Toolbar object instance.
1368 ''' Args:
1369 ''' ToolbarName: the usual name of one of the available toolbars
1370 ''' Returns:
1371 ''' A zero-based array of toolbar names when the argument is absent,
1372 ''' or a new Toolbar object instance from the SF_Widgets library.
1377 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1379 Check:
1380 If IsMissing(ToolbarName) Or IsEmpty(ToolbarName) Then ToolbarName = ""
1381 If IsNull(_Toolbars) Then _Toolbars = ScriptForge.SF_UI._ListToolbars(_Component)
1382 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1383 If Not _IsStillAlive() Then GoTo Finally
1384 If VarType(ToolbarName) = V_STRING Then
1386 If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING, _Toolbars.Keys()) Then GoTo Finally
1387 End If
1388 Else
1389 If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING) Then GoTo Finally ' Manage here the VarType error
1390 End If
1391 End If
1393 Try:
1394 If Len(ToolbarName) = 0 Then
1395 Toolbars = _Toolbars.Keys()
1396 Else
1398 End If
1400 Finally:
1401 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1402 Exit Function
1403 Catch:
1404 GoTo Finally
1405 End Function ' SFDocuments.SF_Document.Toolbars
1407 REM =========================================================== PRIVATE FUNCTIONS
1409 REM -----------------------------------------------------------------------------
1410 Private Function _FileIdent() As String
1411 ''' Returns a file identification from the information that is currently available
1412 ''' Useful e.g. for display in error messages
1414 ' OS notation is used to avoid presence of "%nn" in error messages and wrong parameter substitutions
1417 End Function ' SFDocuments.SF_Document._FileIdent
1419 REM -----------------------------------------------------------------------------
1420 Private Function _GetFilterNames(ByVal pbExport As Boolean) As Variant
1421 ''' Returns the list of export (pbExport = True) or import filters
1422 ''' applicable to the current document
1423 ''' Args:
1424 ''' pbExport: True for export, False for import
1425 ''' Returns:
1426 ''' A zero-based array of strings
1428 Dim vFilters As Variant ' Return value
1429 Dim sIdentifier As String ' Document service, like com.sun.star.text.TextDocument
1430 Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
1431 Dim vAllFilters As Variant ' The full list of installed filters
1432 Dim sFilter As String ' A single filter name
1433 Dim iCount As Integer ' Filters counter
1434 Dim vFilter As Variant ' A filter descriptor as an array of Name/Value pairs
1435 Dim sType As String ' The filter type to be compared with the document service
1436 Dim lFlags As Long ' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Office_Development#Properties_of_a_Filter
1437 Dim bExport As Boolean ' Filter valid for export when True
1438 Dim bImport As Boolean ' Filter valid for import when True
1439 Dim bImportExport As Boolean ' Filter valid both for import and export when True
1441 vFilters = Array()
1442 On Local Error GoTo Finally ' Return empty or partial list if error
1444 Try:
1445 sIdentifier = _Component.Identifier
1447 vAllFilters = oFilterFactory.getElementNames()
1448 ReDim vFilters(0 To UBound(vAllFilters))
1449 iCount = -1
1451 For Each sFilter In vAllFilters
1452 vFilter = oFilterFactory.getByName(sFilter)
1454 If sType = sIdentifier Then
1456 ' export: flag is even
1462 ' Select filter ?
1463 If bImportExport _
1464 Or (pbExport And bExport) _
1465 Or (Not pbExport And bImport) Then
1466 iCount = iCount + 1
1467 vFilters(iCount) = sFilter
1468 End If
1469 End If
1470 Next sFilter
1473 ReDim Preserve vFilters(0 To iCount)
1474 End If
1476 Finally:
1477 _GetFilterNames = vFilters
1478 Exit Function
1479 End Function ' SFDocuments.SF_Document._GetFilterNames
1481 REM -----------------------------------------------------------------------------
1482 Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _
1483 , Optional ByVal pbError As Boolean _
1484 ) As Boolean
1485 ''' Returns True if the document has not been closed manually or incidentally since the last use
1486 ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
1487 ''' Args:
1488 ''' pbForUpdate: if True (default = False), check additionally if document is open for editing
1489 ''' pbError: if True (default), raise a fatal error
1491 Dim bAlive As Boolean ' Return value
1492 Dim sFileName As String ' File identification used to display error message
1494 On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
1495 If IsMissing(pbForUpdate) Then pbForUpdate = False
1496 If IsMissing(pbError) Then pbError = True
1498 Try:
1499 ' Check existence of document
1500 bAlive = Not IsNull(_Frame)
1501 If bAlive Then bAlive = Not IsNull(_Component)
1502 If bAlive Then bAlive = Not IsNull(_Component.CurrentController)
1504 ' Check document is not read only
1505 If bAlive And pbForUpdate Then
1506 If _Component.isreadonly() Then GoTo CatchReadonly
1507 End If
1509 Finally:
1510 _IsStillAlive = bAlive
1511 Exit Function
1512 Catch:
1513 bAlive = False
1514 On Error GoTo 0
1515 sFileName = _FileIdent()
1516 Dispose()
1517 If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTDEADERROR, sFileName)
1518 GoTo Finally
1519 CatchReadonly:
1520 bAlive = False
1521 If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTREADONLYERROR, "Document", _FileIdent())
1522 GoTo Finally
1523 End Function ' SFDocuments.SF_Document._IsStillAlive
1525 REM -----------------------------------------------------------------------------
1526 Private Sub _LoadDocumentProperties()
1527 ''' Create dictionary with document properties as entries/ Custom properties are excluded
1528 ''' Document is presumed still alive
1529 ''' Special values:
1530 ''' Only valid dates are taken
1531 ''' Statistics are exploded in subitems. Subitems are specific to document type
1532 ''' Keywords are joined
1533 ''' Language is aligned on L10N convention la-CO
1535 Dim oProperties As Object ' Document properties
1536 Dim vNamedValue As Variant ' com.sun.star.beans.NamedValue
1538 If IsNull(_DocumentProperties) Then
1539 Set oProperties = _Component.getDocumentProperties
1541 With _DocumentProperties
1545 If oProperties.CreationDate.Year > 0 Then .Add("CreationDate", CDateFromUnoDateTime(oProperties.CreationDate))
1548 ' DocumentStatistics : number and names of statistics depend on document type
1549 For Each vNamedValue In oProperties.DocumentStatistics
1550 .Add(vNamedValue.Name, vNamedValue.Value)
1551 Next vNamedValue
1555 .Add("Language", oProperties.Language.Language & Iif(Len(oProperties.Language.Country) > 0, "-" & oProperties.Language.Country, ""))
1556 If oProperties.ModificationDate.Year > 0 Then .Add("ModificationDate", CDateFromUnoDateTime(oProperties.ModificationDate))
1557 If oProperties.PrintDate.Year > 0 Then .Add("PrintDate", CDateFromUnoDateTime(oProperties.PrintDate))
1560 If oProperties.TemplateDate.Year > 0 Then .Add("TemplateDate", CDateFromUnoDateTime(oProperties.TemplateDate))
1564 End With
1565 End If
1567 End Sub ' SFDocuments.SF_Document._LoadDocumentProperties
1569 REM -----------------------------------------------------------------------------
1570 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
1571 ''' Return the value of the named property
1572 ''' Args:
1573 ''' psProperty: the name of the property
1575 Dim oProperties As Object ' Document or Custom properties
1576 Dim cstThisSub As String
1577 Const cstSubArgs = ""
1579 _PropertyGet = False
1581 Select Case _DocumentType
1582 Case "Calc" : cstThisSub = "SFDocuments.SF_" & _DocumentType & ".get" & psProperty
1584 End Select
1585 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1586 If Not _IsStillAlive() Then GoTo Finally
1588 Select Case psProperty
1590 _CustomProperties = CreateScriptService("Dictionary") ' Always reload as updates could have been done manually by user
1591 _CustomProperties.ImportFromPropertyValues(_Component.getDocumentProperties().UserDefinedProperties.getPropertyValues)
1592 _PropertyGet = _CustomProperties
1594 _PropertyGet = _Component.DocumentProperties.Description
1596 _LoadDocumentProperties() ' Always reload as updates could have been done manually by user
1597 Set _PropertyGet = _DocumentProperties
1599 _PropertyGet = _DocumentType
1601 _PropertyGet = _GetFilterNames(True)
1603 _PropertyGet = _GetFilterNames(False)
1604 Case "IsBase", "IsCalc", "IsDraw", "IsFormDocument", "IsImpress", "IsMath", "IsWriter"
1605 _PropertyGet = ( Mid(psProperty, 3) = _DocumentType )
1609 _PropertyGet = _Component.isReadonly()
1611 _PropertyGet = _Component.DocumentProperties.Subject
1613 _PropertyGet = _Component.DocumentProperties.Title
1615 Set _PropertyGet = _Component
1616 Case Else
1617 _PropertyGet = Null
1618 End Select
1620 Finally:
1621 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1622 Exit Function
1623 End Function ' SFDocuments.SF_Document._PropertyGet
1625 REM -----------------------------------------------------------------------------
1626 Private Function _Repr() As String
1627 ''' Convert the SF_Document instance to a readable string, typically for debugging purposes (DebugPrint ...)
1628 ''' Args:
1629 ''' Return:
1634 End Function ' SFDocuments.SF_Document._Repr
1636 REM ============================================ END OF SFDOCUMENTS.SF_DOCUMENT
1637 </script:module>