| blob | 38767666300eeb4d5ecc0a1f8fe4e8a774d5da3d |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Writer" 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_Writer
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 SF_Document module.
22 ''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Writer, SF_Base, ...
23 '''
24 ''' To workaround the absence of class inheritance in LibreOffice Basic, some redundancy is necessary
25 ''' Each subclass MUST implement also the generic methods and properties, even if they only call
26 ''' the parent methods and properties.
27 ''' They should also duplicate some generic private members as a subset of their own set of members
28 '''
29 ''' The SF_Writer module is focused on selecting, reading, inserting, modifying texts and values
30 ''' on well-identified and predefined places in the document.
31 ''' Usually such customization of the document starts from a predefined template.
32 ''' Multiple customizations are also known as mail merging.
33 '''
34 ''' As a consequence, focus is not on text formatting, except by the application of styles
35 ''' onto the targeted text fragments.
36 '''
37 ''' The positions in the text where customization can take place easily are:
38 ''' - the start and end positions of the text body
39 ''' - the start and end positions of text frames
40 ''' - bookmarks
41 ''' - text fields
42 ''' - the start and end positions of document sections
43 ''' - writer tables and table cells
44 ''' - the area currently selected by the user, i.e. the "visible" selection
45 '''
46 ''' The current module is closely related to the "UI" service of the ScriptForge library
47 '''
48 ''' Service invocation examples:
50 ''' Dim ui As Object, oDoc As Object
55 ''' Dim oDoc As Object
56 ''' Set oDoc = CreateScriptService("SFDocuments.Writer", ThisComponent) ' Default = ActiveWindow
57 ''' ' or Set oDoc = CreateScriptService("SFDocuments.Writer", "Untitled 1") ' Untitled 1 is presumed a Writer document
59 '''
60 ''' Definitions:
62 ''' A textrange is a string describing the scope on which to apply the method.
63 ''' Such a textrange corresponds either with a single insertion point or with a (text) interval between 2 insertion points.
64 ''' Multiple textranges are not supported in this context.
65 '''
66 ''' TextRange: a string containing one of next variants :
67 ''' (names may be surrounded with single or double quotes)
68 ''' "~" or "SELECTION" or "SEL" = current selection (if multiple selections, its 1st component)
71 ''' "BOOKMARK!name" = the given bookmark, may be zero or more characters long
75 ''' "TABLE!name!cellrange" = a cell (cellrange = "B3") or a range of cells ("A2:B3")
78 ''' "PARAGRAPH" or "ยง" = the paragraph containing the current selection (0 is the default)
79 ''' optionally combined with next control character:
81 ''' "|~" = the point immediately before the current visible selection (starting point)
82 ''' "~|" = the point immediately after the current visible selection (ending point)
84 '''
85 '''
86 ''' Detailed user documentation:
87 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_writer.html?DbPAR=BASIC
88 '''
89 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
91 REM ================================================================== EXCEPTIONS
96 REM ============================================================= PRIVATE MEMBERS
98 Private [Me] As Object
99 Private [_Parent] As Object
100 Private [_Super] As Object ' Document superclass, which the current instance is a subclass of
101 Private ObjectType As String ' Must be WRITER
102 Private ServiceName As String
104 ' Window component
105 Private _Component As Object ' com.sun.star.lang.XComponent
107 ' Text Range
108 Type _TextRange
109 RangeString As String ' The input string
110 Target As String ' Selection or Body or Frame or ...
111 TargetName As String ' Name of Frame or Table or ...
112 TargetCell As String ' Cell
113 TargetObject As Object ' Field, TableCell, Section, ... object
114 Offset As Long ' Number of items to right (+) or to left (-)
115 StartPoint As Boolean ' When True, vertical bar before target
116 EndPoint As Boolean ' When True, vertical bar after target
117 Anchor As Object ' com.sun.star.text.XTextRange
118 Text As Object ' com.sun.star.text.XText
119 Cursor As Object ' com.sun.star.text.XTextCursor
120 Location As String ' BODY or FOOTNOTE or HEADER/FOOTER ...
121 End Type
123 REM ============================================================ MODULE CONSTANTS
127 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
129 REM -----------------------------------------------------------------------------
130 Private Sub Class_Initialize()
131 Set [Me] = Nothing
132 Set [_Parent] = Nothing
133 Set [_Super] = Nothing
136 Set _Component = Nothing
137 End Sub ' SFDocuments.SF_Writer Constructor
139 REM -----------------------------------------------------------------------------
140 Private Sub Class_Terminate()
141 Call Class_Initialize()
142 End Sub ' SFDocuments.SF_Writer Destructor
144 REM -----------------------------------------------------------------------------
145 Public Function Dispose() As Variant
146 If Not IsNull([_Super]) Then Set [_Super] = [_Super].Dispose()
147 Call Class_Terminate()
148 Set Dispose = Nothing
149 End Function ' SFDocuments.SF_Writer Explicit Destructor
151 REM ================================================================== PROPERTIES
153 REM -----------------------------------------------------------------------------
154 Property Get Bookmarks() As Variant
155 ''' Return the list of currently available bookmarks as a zero-based array
157 End Property ' SFDocuments.SF_Writer.Bookmarks (get)
159 REM -----------------------------------------------------------------------------
160 Property Get CurrentSelection() As Variant
161 ''' Return the list of currently available CurrentSelection as a zero-based array
163 End Property ' SFDocuments.SF_Writer.CurrentSelection (get)
165 REM -----------------------------------------------------------------------------
166 Property Let CurrentSelection(Optional ByVal pvSelection As Variant)
167 ''' Set the selection to a single or a multiple range
168 ''' The argument can be:
169 ''' - a string (a textrange)
170 ''' - a com.sun.star.text.XTextRange object
171 ''' - a collection of com.sun.star.text.XTextRange objects
173 Dim vSelection As Variant ' Alias of pvSelection
174 Dim oSelection As Object ' com.sun.star.text.XTextRange
175 Dim sType As String ' session.UnoObjectType()
176 Dim oSess As Object : Set oSess = ScriptForge.SF_Session
177 Dim i As Long
182 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
184 Check:
185 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
186 If Not _IsStillAlive(True) Then GoTo Finally
187 If Not ScriptForge.SF_Utils._Validate(pvSelection, "Selection", Array(V_STRING, ScriptForge.V_Object)) Then GoTo Finally
188 End If
190 Try:
191 vSelection = pvSelection ' Necessary to avoid the "Object variable not set" error
192 With _Component.CurrentController
193 If VarType(vSelection) = V_STRING Then
194 Set oSelection = _ParseRange(vSelection).Cursor
195 If Not IsNull(oSelection) Then .select(oSelection)
196 Else
197 sType = oSess.UnoObjectType(vSelection)
198 Select Case sType
201 If oSess.UnoObjectType(vSelection.getByIndex(i)) <> "SwXTextRange" Then GoTo Catch ' Do nothing
202 Next i
203 .select(vSelection)
204 Case "SwXTextRange", "SwXTextCursor", "SwXTextTableCursor" ' Argument is a simple selection (anchor/cursor)
205 .select(vSelection)
206 Case Else
207 End Select
208 End If
209 End With
211 Finally:
212 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
213 Exit Property
214 Catch:
215 GoTo Finally
216 End Property ' SFDocuments.SF_Writer.CurrentSelection (let)
218 REM -----------------------------------------------------------------------------
219 Property Get Fields() As Variant
220 ''' Return the list of currently available fields as a zero-based array
221 ''' Are considered only next field-types:
222 ''' - user fields: com.sun.star.text.textfield.User
223 ''' - variable fields: com.sun.star.text.textfield.SetExpression
225 End Property ' SFDocuments.SF_Writer.Fields (get)
227 REM -----------------------------------------------------------------------------
228 Property Get Frames() As Variant
229 ''' Return the list of currently available frames as a zero-based array
231 End Property ' SFDocuments.SF_Writer.Frames (get)
233 REM ===================================================================== METHODS
235 REM -----------------------------------------------------------------------------
236 Public Function Forms(Optional ByVal Form As Variant) As Variant
237 ''' Return either
238 ''' - the list of the Forms contained in the form document
239 ''' - a SFDocuments.Form object based on its name or its index
240 ''' Args:
241 ''' Form: a form stored in the document given by its name or its index
242 ''' When absent, the list of available forms is returned
244 ''' Exceptions:
245 ''' WRITERFORMNOTFOUNDERROR Form not found
246 ''' Returns:
247 ''' A zero-based array of strings if Form is absent
248 ''' An instance of the SF_Form class if Form exists
249 ''' Example:
250 ''' Dim myForm As Object, myList As Variant
251 ''' myList = oDoc.Forms()
254 Dim oForm As Object ' The new Form class instance
255 Dim oMainForm As Object ' com.sun.star.comp.sdb.Content
256 Dim oXForm As Object ' com.sun.star.form.XForm
257 Dim vFormNames As Variant ' Array of form names
258 Dim oForms As Object ' Forms collection
264 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
266 Check:
267 If IsMissing(Form) Or IsEmpty(Form) Then Form = ""
268 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
269 If Not _IsStillAlive() Then GoTo Finally
270 If Not ScriptForge.SF_Utils._Validate(Form, "Form", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
271 End If
273 Try:
274 ' Start from the document component and go down to forms
275 Set oForms = _Component.DrawPages(cstDrawPage).Forms
276 vFormNames = oForms.getElementNames()
279 Forms = vFormNames
280 Else
281 If VarType(Form) = V_STRING Then ' Find the form by name
282 If Not ScriptForge.SF_Array.Contains(vFormNames, Form, CaseSensitive := True) Then GoTo CatchNotFound
283 Set oXForm = oForms.getByName(Form)
284 Else ' Find the form by index
286 Set oXForm = oForms.getByIndex(Form)
287 End If
288 ' Create the new Form class instance
289 Set oForm = SF_Register._NewForm(oXForm)
290 With oForm
291 Set .[_Parent] = [Me]
292 ._FormType = ISDOCFORM
293 Set ._Component = _Component
294 ._Initialize()
295 End With
296 Set Forms = oForm
297 End If
299 Finally:
300 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
301 Exit Function
302 Catch:
303 GoTo Finally
304 CatchNotFound:
305 ScriptForge.SF_Exception.RaiseFatal(WRITERFORMNOTFOUNDERROR, Form, _FileIdent())
306 End Function ' SFDocuments.SF_Writer.Forms
308 REM -----------------------------------------------------------------------------
309 Public Function GetProperty(Optional ByVal PropertyName As Variant _
310 ) As Variant
311 ''' Return the actual value of the given property
312 ''' Args:
313 ''' PropertyName: the name of the property as a string
314 ''' Returns:
315 ''' The actual value of the property
316 ''' Exceptions:
317 ''' ARGUMENTERROR The property does not exist
320 Const cstSubArgs = ""
322 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
323 GetProperty = Null
325 Check:
326 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
327 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
328 End If
330 Try:
331 ' Superclass or subclass property ?
332 If ScriptForge.SF_Array.Contains([_Super].Properties(), PropertyName) Then
333 GetProperty = [_Super].GetProperty(PropertyName)
334 Else
335 GetProperty = _PropertyGet(PropertyName)
336 End If
338 Finally:
339 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
340 Exit Function
341 Catch:
342 GoTo Finally
343 End Function ' SFDocuments.SF_Writer.GetProperty
345 REM -----------------------------------------------------------------------------
346 Public Function Methods() As Variant
347 ''' Return the list of public methods of the Writer service as an array
349 Methods = Array( _
352 )
354 End Function ' SFDocuments.SF_Writer.Methods
356 REM -----------------------------------------------------------------------------
357 Public Function PrintOut(Optional ByVal Pages As Variant _
358 , Optional ByVal Copies As Variant _
359 , Optional ByVal PrintBackground As Variant _
360 , Optional ByVal PrintBlankPages As Variant _
361 , Optional ByVal PrintEvenPages As Variant _
362 , Optional ByVal PrintOddPages As Variant _
363 , Optional ByVal PrintImages As Variant _
364 ) As Boolean
365 ''' Send the content of the document to the printer.
366 ''' The printer might be defined previously by default, by the user or by the SetPrinter() method
367 ''' Args:
368 ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages
369 ''' Copies: the number of copies
370 ''' PrintBackground: print the background image when True (default)
371 ''' PrintBlankPages: when False (default), omit empty pages
372 ''' PrintEvenPages: print the left pages when True (default)
373 ''' PrintOddPages: print the right pages when True (default)
374 ''' PrintImages: print the graphic objects when True (default)
375 ''' Returns:
376 ''' True when successful
377 ''' Examples:
380 Dim bPrint As Boolean ' Return value
381 Dim vPrintOptions As Variant ' com.sun.star.text.DocumentSettings
384 Const cstSubArgs = "[Pages=""""], [Copies=1], [PrintBackground=True], [PrintBlankPages=False], [PrintEvenPages=True]" _
387 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
388 bPrint = False
390 Check:
391 If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = ""
392 If IsMissing(Copies) Or IsEmpty(Copies) Then Copies = 1
393 If IsMissing(PrintBackground) Or IsEmpty(PrintBackground) Then PrintBackground = True
394 If IsMissing(PrintBlankPages) Or IsEmpty(PrintBlankPages) Then PrintBlankPages = False
395 If IsMissing(PrintEvenPages) Or IsEmpty(PrintEvenPages) Then PrintEvenPages = True
396 If IsMissing(PrintOddPages) Or IsEmpty(PrintOddPages) Then PrintOddPages = True
397 If IsMissing(PrintImages) Or IsEmpty(PrintImages) Then PrintImages = True
399 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
400 If Not _IsStillAlive() Then GoTo Finally
402 If Not ScriptForge.SF_Utils._Validate(Copies, "Copies", ScriptForge.V_NUMERIC) Then GoTo Finally
403 If Not ScriptForge.SF_Utils._Validate(PrintBackground, "PrintBackground", ScriptForge.V_BOOLEAN) Then GoTo Finally
404 If Not ScriptForge.SF_Utils._Validate(PrintBlankPages, "PrintBlankPages", ScriptForge.V_BOOLEAN) Then GoTo Finally
405 If Not ScriptForge.SF_Utils._Validate(PrintEvenPages, "PrintEvenPages", ScriptForge.V_BOOLEAN) Then GoTo Finally
406 If Not ScriptForge.SF_Utils._Validate(PrintOddPages, "PrintOddPages", ScriptForge.V_BOOLEAN) Then GoTo Finally
407 If Not ScriptForge.SF_Utils._Validate(PrintImages, "PrintImages", ScriptForge.V_BOOLEAN) Then GoTo Finally
408 End If
410 Try:
412 With vPrintOptions
413 .PrintPageBackground = PrintBackground
414 .PrintEmptyPages = PrintBlankPages
415 .PrintLeftPages = PrintEvenPages
416 .PrintRightPages = PrintOddPages
417 .PrintGraphics = PrintImages
418 .PrintDrawings = PrintImages
419 End With
421 bPrint = [_Super].PrintOut(Pages, Copies, _Component)
423 Finally:
424 PrintOut = bPrint
425 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
426 Exit Function
427 Catch:
428 GoTo Finally
429 End Function ' SFDocuments.SF_Writer.PrintOut
431 REM -----------------------------------------------------------------------------
432 Public Function Properties() As Variant
433 ''' Return the list or properties of the Writer class as an array
435 Properties = Array( _
462 )
464 End Function ' SFDocuments.SF_Writer.Properties
466 REM -----------------------------------------------------------------------------
467 Private Function SetProperty(Optional ByVal psProperty As String _
468 , Optional ByVal pvValue As Variant _
469 ) As Boolean
470 ''' Set the new value of the named property
471 ''' Args:
472 ''' psProperty: the name of the property
473 ''' pvValue: the new value of the given property
474 ''' Returns:
475 ''' True if successful
477 Dim bSet As Boolean ' Return value
478 Static oSession As Object ' Alias of SF_Session
479 Dim cstThisSub As String
482 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
483 bSet = False
486 If IsMissing(pvValue) Then pvValue = Empty
487 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets
489 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
490 bSet = True
491 Select Case UCase(psProperty)
493 CustomProperties = pvValue
495 Description = pvValue
497 Keywords = pvValue
499 Subject = pvValue
501 Title = pvValue
502 Case Else
503 bSet = False
504 End Select
506 Finally:
507 SetProperty = bSet
508 'ScriptForge.SF_Utils._ExitFunction(cstThisSub)
509 Exit Function
510 Catch:
511 GoTo Finally
512 End Function ' SFDocuments.SF_Writer.SetProperty
514 REM ======================================================= SUPERCLASS PROPERTIES
516 REM -----------------------------------------------------------------------------
517 Property Get CustomProperties() As Variant
519 End Property ' SFDocuments.SF_Writer.CustomProperties
521 REM -----------------------------------------------------------------------------
522 Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant)
523 [_Super].CustomProperties = pvCustomProperties
524 End Property ' SFDocuments.SF_Writer.CustomProperties
526 REM -----------------------------------------------------------------------------
527 Property Get Description() As Variant
529 End Property ' SFDocuments.SF_Writer.Description
531 REM -----------------------------------------------------------------------------
532 Property Let Description(Optional ByVal pvDescription As Variant)
533 [_Super].Description = pvDescription
534 End Property ' SFDocuments.SF_Writer.Description
536 REM -----------------------------------------------------------------------------
537 Property Get DocumentProperties() As Variant
539 End Property ' SFDocuments.SF_Writer.DocumentProperties
541 REM -----------------------------------------------------------------------------
542 Property Get DocumentType() As String
544 End Property ' SFDocuments.SF_Writer.DocumentType
546 REM -----------------------------------------------------------------------------
547 Property Get ExportFilters() As Variant
549 End Property ' SFDocuments.SF_Writer.ExportFilters
551 REM -----------------------------------------------------------------------------
552 Property Get FileSystem() As String
554 End Property ' SFDocuments.SF_Writer.FileSystem
556 REM -----------------------------------------------------------------------------
557 Property Get ImportFilters() As Variant
559 End Property ' SFDocuments.SF_Writer.ImportFilters
561 REM -----------------------------------------------------------------------------
562 Property Get IsAlive() As Boolean
564 End Property ' SFDocuments.SF_Writer.IsAlive
566 REM -----------------------------------------------------------------------------
567 Property Get IsBase() As Boolean
569 End Property ' SFDocuments.SF_Writer.IsBase
571 REM -----------------------------------------------------------------------------
572 Property Get IsCalc() As Boolean
574 End Property ' SFDocuments.SF_Writer.IsCalc
576 REM -----------------------------------------------------------------------------
577 Property Get IsDraw() As Boolean
579 End Property ' SFDocuments.SF_Writer.IsDraw
581 REM -----------------------------------------------------------------------------
582 Property Get IsFormDocument() As Boolean
584 End Property ' SFDocuments.SF_Writer.IsFormDocument
586 REM -----------------------------------------------------------------------------
587 Property Get IsImpress() As Boolean
589 End Property ' SFDocuments.SF_Writer.IsImpress
591 REM -----------------------------------------------------------------------------
592 Property Get IsMath() As Boolean
594 End Property ' SFDocuments.SF_Writer.IsMath
596 REM -----------------------------------------------------------------------------
597 Property Get IsWriter() As Boolean
599 End Property ' SFDocuments.SF_Writer.IsWriter
601 REM -----------------------------------------------------------------------------
602 Property Get Keywords() As Variant
604 End Property ' SFDocuments.SF_Writer.Keywords
606 REM -----------------------------------------------------------------------------
607 Property Let Keywords(Optional ByVal pvKeywords As Variant)
608 [_Super].Keywords = pvKeywords
609 End Property ' SFDocuments.SF_Writer.Keywords
611 REM -----------------------------------------------------------------------------
612 Property Get Readonly() As Variant
614 End Property ' SFDocuments.SF_Writer.Readonly
616 REM -----------------------------------------------------------------------------
617 Property Get StyleFamilies() As Variant
619 End Property ' SFDocuments.SF_Writer.StyleFamilies
621 REM -----------------------------------------------------------------------------
622 Property Get Subject() As Variant
624 End Property ' SFDocuments.SF_Writer.Subject
626 REM -----------------------------------------------------------------------------
627 Property Let Subject(Optional ByVal pvSubject As Variant)
628 [_Super].Subject = pvSubject
629 End Property ' SFDocuments.SF_Writer.Subject
631 REM -----------------------------------------------------------------------------
632 Property Get Title() As Variant
634 End Property ' SFDocuments.SF_Writer.Title
636 REM -----------------------------------------------------------------------------
637 Property Let Title(Optional ByVal pvTitle As Variant)
638 [_Super].Title = pvTitle
639 End Property ' SFDocuments.SF_Writer.Title
641 REM -----------------------------------------------------------------------------
642 Property Get XComponent() As Variant
644 End Property ' SFDocuments.SF_Writer.XComponent
646 REM -----------------------------------------------------------------------------
647 Property Get XDocumentSettings() As Variant
649 End Property ' SFDocuments.SF_Writer.XDocumentSettings
651 REM ========================================================== SUPERCLASS METHODS
653 REM -----------------------------------------------------------------------------
654 Public Function Activate() As Boolean
655 Activate = [_Super].Activate()
656 End Function ' SFDocuments.SF_Writer.Activate
658 REM -----------------------------------------------------------------------------
659 Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean
660 CloseDocument = [_Super].CloseDocument(SaveAsk)
661 End Function ' SFDocuments.SF_Writer.CloseDocument
663 REM -----------------------------------------------------------------------------
664 Public Function ContextMenus(Optional ByVal ContextMenuName As Variant _
665 , Optional ByVal SubmenuChar As Variant _
666 ) As Variant
667 ContextMenus = [_Super].ContextMenus(ContextMenuName, SubmenuChar)
668 End Function ' SFDocuments.SF_Writer.ContextMenus
670 REM -----------------------------------------------------------------------------
671 Public Function CreateMenu(Optional ByVal MenuHeader As Variant _
672 , Optional ByVal Before As Variant _
673 , Optional ByVal SubmenuChar As Variant _
674 ) As Object
675 Set CreateMenu = [_Super].CreateMenu(MenuHeader, Before, SubmenuChar)
676 End Function ' SFDocuments.SF_Writer.CreateMenu
678 REM -----------------------------------------------------------------------------
679 Public Sub DeleteStyles(Optional ByVal Family As Variant _
680 , Optional ByRef StylesList As Variant _
681 )
682 [_Super].DeleteStyles(Family, StylesList)
683 End Sub ' SFDocuments.SF_Writer.DeleteStyles
685 REM -----------------------------------------------------------------------------
686 Public Sub Echo(Optional ByVal EchoOn As Variant _
687 , Optional ByVal Hourglass As Variant _
688 )
689 [_Super].Echo(EchoOn, Hourglass)
690 End Sub ' SFDocuments.SF_Writer.Echo
692 REM -----------------------------------------------------------------------------
693 Public Function ExportAsPDF(Optional ByVal FileName As Variant _
694 , Optional ByVal Overwrite As Variant _
695 , Optional ByVal Pages As Variant _
696 , Optional ByVal Password As Variant _
697 , Optional ByVal Watermark As Variant _
698 ) As Boolean
699 ExportAsPDF = [_Super].ExportAsPDF(FileName, Overwrite, Pages, Password, Watermark)
700 End Function ' SFDocuments.SF_Writer.ExportAsPDF
702 REM -----------------------------------------------------------------------------
703 Public Sub ImportStylesFromFile(Optional FileName As Variant _
704 , Optional ByRef Families As Variant _
705 , Optional ByVal Overwrite As variant _
706 ) As Variant
707 [_Super]._ImportStylesFromFile(FileName, Families, Overwrite)
708 End Sub ' SFDocuments.SF_Writer.ImportStylesFromFile
710 REM -----------------------------------------------------------------------------
711 Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean
712 RemoveMenu = [_Super].RemoveMenu(MenuHeader)
713 End Function ' SFDocuments.SF_Writer.RemoveMenu
715 REM -----------------------------------------------------------------------------
716 Public Sub RunCommand(Optional ByVal Command As Variant _
717 , ParamArray Args As Variant _
718 )
719 [_Super].RunCommand(Command, Args)
720 End Sub ' SFDocuments.SF_Writer.RunCommand
722 REM -----------------------------------------------------------------------------
723 Public Function Save() As Boolean
724 Save = [_Super].Save()
725 End Function ' SFDocuments.SF_Writer.Save
727 REM -----------------------------------------------------------------------------
728 Public Function SaveAs(Optional ByVal FileName As Variant _
729 , Optional ByVal Overwrite As Variant _
730 , Optional ByVal Password As Variant _
731 , Optional ByVal FilterName As Variant _
732 , Optional ByVal FilterOptions As Variant _
733 ) As Boolean
734 SaveAs = [_Super].SaveAs(FileName, Overwrite, Password, FilterName, FilterOptions)
735 End Function ' SFDocuments.SF_Writer.SaveAs
737 REM -----------------------------------------------------------------------------
738 Public Function SaveCopyAs(Optional ByVal FileName As Variant _
739 , Optional ByVal Overwrite As Variant _
740 , Optional ByVal Password As Variant _
741 , Optional ByVal FilterName As Variant _
742 , Optional ByVal FilterOptions As Variant _
743 ) As Boolean
744 SaveCopyAs = [_Super].SaveCopyAs(FileName, Overwrite, Password, FilterName, FilterOptions)
745 End Function ' SFDocuments.SF_Writer.SaveCopyAs
747 REM -----------------------------------------------------------------------------
748 Public Function SetPrinter(Optional ByVal Printer As Variant _
749 , Optional ByVal Orientation As Variant _
750 , Optional ByVal PaperFormat As Variant _
751 ) As Boolean
752 SetPrinter = [_Super].SetPrinter(Printer, Orientation, PaperFormat)
753 End Function ' SFDocuments.SF_Writer.SetPrinter
755 REM -----------------------------------------------------------------------------
756 Public Function Styles(Optional ByVal Family As Variant _
757 , Optional ByVal NamePattern As variant _
758 , Optional ByVal Used As variant _
759 , Optional ByVal UserDefined As Variant _
760 , Optional ByVal ParentStyle As Variant _
761 , Optional ByVal Category As Variant _
762 ) As Variant
763 Styles = [_Super].Styles(Family, NamePattern, Used, UserDefined, ParentStyle, Category)
764 End Function ' SFDocuments.SF_Writer.Styles
766 REM -----------------------------------------------------------------------------
767 Public Function Toolbars(Optional ByVal ToolbarName As Variant) As Variant
768 Toolbars = [_Super].Toolbars(ToolbarName)
769 End Function ' SFDocuments.SF_Writer.Toolbars
771 REM -----------------------------------------------------------------------------
772 Public Function XStyle(Optional ByVal Family As Variant _
773 , Optional ByVal StyleName As variant _
774 ) As Object
775 Set XStyle = [_Super].XStyle(Family, StyleName)
776 End Function ' SFDocuments.SF_Writer.XStyle
778 REM =========================================================== PRIVATE FUNCTIONS
780 REM -----------------------------------------------------------------------------
781 Private Function _FileIdent() As String
782 ''' Returns a file identification from the information that is currently available
783 ''' Useful e.g. for display in error messages
785 _FileIdent = [_Super]._FileIdent()
787 End Function ' SFDocuments.SF_Writer._FileIdent
789 REM -----------------------------------------------------------------------------
790 Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _
791 , Optional ByVal pbError As Boolean _
792 ) As Boolean
793 ''' Returns True if the document has not been closed manually or incidentally since the last use
794 ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
795 ''' Args:
796 ''' pbForUpdate: if True (default = False), check additionally if document is open for editing
797 ''' pbError: if True (default), raise a fatal error
799 Dim bAlive As Boolean ' Return value
801 If IsMissing(pbForUpdate) Then pbForUpdate = False
802 If IsMissing(pbError) Then pbError = True
804 Try:
805 bAlive = [_Super]._IsStillAlive(pbForUpdate, pbError)
807 Finally:
808 _IsStillAlive = bAlive
809 Exit Function
810 End Function ' SFDocuments.SF_Writer._IsStillAlive
812 REM -----------------------------------------------------------------------------
813 Private Function _ParseRange(psTextRange As String) As Object
814 ''' Parse and validate a text range passed as a string
815 ''' Syntax to parse:
817 ''' [|]BODY[|]
818 ''' [|]FRAME!name[|]
819 ''' BOOKMARK!name
820 ''' FIELD!name
821 ''' [|]SECTION!name[|]
822 ''' TABLE!name!cell
823 ''' [|]WORDยฑn[|]
824 ''' [|]SENTENCEยฑn[|]
825 ''' [|]PARAGRAPHยฑn or ยงยฑn[|]
826 ''' A name must be surrounded with single or double quotes when it contains a space or a not alphanumeric character
827 ''' Returns:
828 ''' An object of type _TextRange
829 ''' Exceptions:
832 Dim oTextRange As Object ' Return value
833 Dim bParsing As Boolean ' When True, parsing could identify the target
834 Dim lSelects As Long ' Number of items in the current selection
835 Dim sTarget As String ' Alias of _TextRange.Target
836 Dim sString As String ' Work variable
838 Dim sSign As String ' + or -
839 Dim oColl As Object ' Collection of TargetObjects (bookmarks or frames or ...)
840 Dim oItem As Object ' An item in the oColl collection
841 Dim vNames As Variant ' Array of the available object names within a collection
842 Dim oStr As Object : Set oStr = ScriptForge.SF_String
843 Dim bMove As Boolean ' Return value of a cursor move
844 Dim i As Long
846 ' Reinitialize a new _TextRange object
847 Set oTextRange = New _TextRange
848 With oTextRange
849 Set .TargetObject = Nothing
850 .RangeString = "" : .Target = "" : .TargetName = "" : .TargetCell = ""
851 .Offset = 0 : .StartPoint = False : .EndPoint = False
852 Set .Anchor = Nothing : Set .Text = Nothing : Set .Cursor = Nothing
853 .Location = ""
854 End With
856 ' Identify the type of range with adequate regular expressions
857 With oTextRange
858 .RangeString = psTextRange
862 Select Case True
863 ' Parsing is done with regular expressions because names may really contain any character, including "รง"
865 ' Selection
869 lSelects = _Component.CurrentSelection.Count
871 Set .Anchor = _Component.CurrentSelection.getByIndex(lSelects - 1)
872 If .StartPoint And Not .EndPoint Then
873 Set .Anchor = .Anchor.Start
874 ElseIf Not .StartPoint And .EndPoint Then
875 Set .Anchor = .Anchor.End
876 End If
877 Set .Text = .Anchor.Text
878 Set .Cursor = .Text.createTextCursorByRange(.Anchor)
879 End If
880 End If
881 If IsNull(.Cursor) Then .Location = _Component.CurrentSelection.ImplementationName
883 ' WORD, SENTENCE, PARAGRAPH
884 Case oStr.IsRegex(psTextRange, "\|?\s*(PARAGRAPH|ยง|SENTENCE|WORD)\s*([+-][0-9]+)?\s*\|?")
889 End If
891 If InStr(Iif(.StartPoint, 2, 1), sTarget, "PARAGRAPH", 1) > 0 Or InStr(Iif(.StartPoint, 2, 1), sTarget, "ยง", 1) > 0 Then
897 End If
899 ' Identify the offset
900 If Len(sSign) = 0 Then
901 .Offset = 0
902 Else
903 sString = Split(psTextRange, sSign)(1)
904 If .EndPoint Then sString = Left(sString, Len(sString) - 1)
906 End If
908 ' Build the cursor pointing at the current selection
910 lSelects = _Component.CurrentSelection.Count
912 Set .Anchor = _Component.CurrentSelection.getByIndex(lSelects - 1)
913 Set .Text = .Anchor.Text
914 Set .Cursor = .Text.createTextCursorByRange(.Anchor)
915 End If
916 End If
917 If IsNull(.Cursor) Then
918 .Location = _Component.CurrentSelection.ImplementationName
919 Else
920 ' Move the cursor to the requested area
921 With .Cursor
922 Select Case oTextRange.Target
924 bMove = .gotoStartOfWord(False)
925 If bMove Then
926 For i = 1 To Abs(oTextRange.Offset)
927 If sSign = "+" Then bMove = .gotoNextWord(False) Else bMove = .gotoPreviousWord(False)
929 If Not bMove Then Exit For
931 Else
932 bMove = .goLeft(1, False) ' Additional trial to bypass some locks (tabs, list items, ... ?)
933 If Not bMove Then Exit For
934 End If
935 Next i
936 End If
937 ' Cursor is always at the start of a word, move it when necessary
938 If Not oTextRange.StartPoint And oTextRange.EndPoint Then
939 .gotoEndOfWord(False)
940 ElseIf oTextRange.StartPoint = oTextRange.EndPoint Then
941 .gotoEndOfWord(True)
942 End If
944 bMove = .gotoStartOfSentence(False)
945 If bMove Then
946 For i = 1 To Abs(oTextRange.Offset)
947 If sSign = "+" Then bMove = .gotoNextSentence(False) Else bMove = .gotoPreviousSentence(False)
949 If .isEndOfParagraph() Then bMove = .goRight(1, False)
950 Else
951 bMove = .goLeft(1, False) ' Additional trial to bypass some locks (tabs, list items, ... ?)
952 If .isStartOfParagraph() Then bMove = .goLeft(1, False)
953 End If
954 If Not bMove Then Exit For
955 Next i
956 End If
957 ' Cursor is always at the start of a sentence, move it when necessary
958 If Not oTextRange.StartPoint And oTextRange.EndPoint Then
959 .gotoEndOfSentence(False)
960 ElseIf oTextRange.StartPoint = oTextRange.EndPoint Then
961 .gotoEndOfSentence(True)
962 End If
964 bMove = .gotoStartOfParagraph(False)
965 If bMove Then
966 For i = 1 To Abs(oTextRange.Offset)
967 If sSign = "+" Then bMove = .gotoNextParagraph(False) Else bMove = .gotoPreviousParagraph(False)
969 If .isEndOfParagraph() Then bMove = .goRight(1, False)
970 Else
971 bMove = .goLeft(1, False) ' Additional trial to bypass some locks (tabs, list items, ... ?)
972 If .isStartOfParagraph() Then bMove = .goLeft(1, False)
973 End If
974 If Not bMove Then Exit For
975 Next i
976 End If
977 ' Cursor is always at the start of a Paragraph, move it when necessary
978 If Not oTextRange.StartPoint And oTextRange.EndPoint Then
979 .gotoEndOfParagraph(False)
980 ElseIf oTextRange.StartPoint = oTextRange.EndPoint Then
981 .gotoEndOfParagraph(True)
982 End If
983 End Select
984 End With
985 End If
987 ' Bookmarks, Fields, Frames, Sections
988 Case oStr.IsRegex(psTextRange, "\|?\s*(BOOKMARK|FIELD|FRAME|SECTION)!([\w\s]+|'[^']+'|""[^""]+"")\|?")
998 End If
1000 ' Identify section or frame or bookmark or field by its name
1002 If .EndPoint Then sString = Left(sString, Len(sString) - 1)
1003 sLeft1 = Left(sString, 1)
1004 If (sLeft1 = """" Or sLeft1 = "'") And Len(sString) > 2 Then .TargetName = Trim(Mid(sString, 2, Len(sString) - 2)) Else .TargetName = Trim(sString)
1005 Select Case .Target
1009 If Not oColl.hasByName(.TargetName) Then .TargetName = Replace(.TargetName, ".User.", ".SetExpression.")
1012 End Select
1014 If Not ScriptForge.SF_Utils._Validate(.TargetName, .Target, V_STRING, vNames, True) Then GoTo Finally
1015 Set .TargetObject = oColl.getByName(.TargetName)
1017 ' Set text, anchor and cursor: order varies depending on target
1018 Select Case .Target
1020 If .Target = "Field" Then Set .Anchor = .TargetObject.DependentTextFields(0).Anchor Else Set .Anchor = .TargetObject.Anchor
1021 If .StartPoint And Not .EndPoint Then
1022 Set .Anchor = .Anchor.Start
1023 ElseIf Not .StartPoint And .EndPoint Then
1024 Set .Anchor = .Anchor.End
1025 End If
1026 Set .Text = .Anchor.Text
1027 Set .Cursor = .Text.createTextCursorByRange(.Anchor)
1029 Set .Text = .TargetObject.Start.Text
1030 Set .Anchor = .Text.Anchor
1031 Set .Cursor = .Text.createTextCursor()
1032 If .StartPoint And Not .EndPoint Then
1033 .Cursor.gotoStart(False)
1034 ElseIf Not .StartPoint And .EndPoint Then
1035 .Cursor.gotoEnd(False)
1036 Else
1037 .Cursor.gotoStart(False)
1038 .Cursor.gotoEnd(True)
1039 End If
1040 Case Else
1041 End Select
1043 ' Body
1045 Set .Text = _Component.Text
1046 Set .Anchor = .Text.Start
1047 Set .Cursor = .Text.createTextCursor()
1048 If .StartPoint And Not .EndPoint Then
1049 .Cursor.gotoStart(False)
1050 ElseIf Not .StartPoint And .EndPoint Then
1051 Set .Anchor = .Text.End
1052 .Cursor.gotoEnd(False)
1053 Else
1054 .Cursor.gotoStart(False)
1055 .Cursor.gotoEnd(True)
1056 End If
1058 ' Table cell
1059 Case oStr.IsRegex(psTextRange, "\|?\s*TABLE!([\w\s]+|'[^']+'|""[^""]+"")![\s]*[A-Za-z]+[1-9][0-9]*\s*\|?")
1061 ' Identify table by its name
1063 sLeft1 = Left(sString, 1)
1064 If (sLeft1 = """" Or sLeft1 = "'") And Len(sString) > 2 Then .TargetName = Trim(Mid(sString, 2, Len(sString) - 2)) Else .TargetName = Trim(sString)
1065 Set oColl = _Component.getTextTables()
1066 vNames = oColl.getElementNames()
1067 If Not ScriptForge.SF_Utils._Validate(.TargetName, .Target, V_STRING, vNames, True) Then GoTo Finally
1068 Set oItem = oColl.getByName(.TargetName)
1070 ' Set text, anchor and cursor
1071 Set .TargetObject = oItem.getCellByName(.TargetCell)
1072 If IsNull(.TargetObject) Then GoTo CatchRange ' The given range is out of the scope of the table
1073 Set .Text = .TargetObject.Text
1074 Set .Anchor = .Text.Start
1075 Set .Cursor = .Text.createTextCursor()
1076 If .StartPoint And Not .EndPoint Then
1077 .Cursor.gotoStart(False)
1078 ElseIf Not .StartPoint And .EndPoint Then
1079 Set .Anchor = .Text.End
1080 .Cursor.gotoEnd(False)
1081 Else
1082 .Cursor.gotoStart(False)
1083 .Cursor.gotoEnd(True)
1084 End If
1086 Case Else
1087 GoTo CatchRange
1088 End Select
1090 ' Determine Location if not yet done
1091 If .Location = "" And Not IsNull(.Text) Then
1092 Select Case .Text.ImplementationName
1099 Case Else : .Location = .Text.ImplementationName
1100 End Select
1101 End If
1103 End With
1105 Finally:
1106 Set _ParseRange = oTextRange
1107 Exit Function
1108 CatchError:
1109 ScriptForge.SF_Exception.Clear()
1110 CatchRange:
1113 GoTo Finally
1114 End Function ' SFDocuments.SF_Writer._ParseRange
1116 REM -----------------------------------------------------------------------------
1117 Private Function _PropertyGet(Optional ByVal psProperty As String _
1118 , Optional ByVal pvArg As Variant _
1119 ) As Variant
1120 ''' Return the value of the named property
1121 ''' Args:
1122 ''' psProperty: the name of the property
1124 Dim oFieldMasters As Object ' SwXTextFieldMasters
1125 Dim vMasters As Variant ' Array of SwXTextFieldMasters
1126 Dim oMaster As Object ' A single SwXTextFieldMasters
1127 Dim sField As String ' A text field full name
1128 Dim vFieldNames As Variant ' Array of field names as strings
1129 Dim cstThisSub As String
1130 Const cstSubArgs = ""
1132 _PropertyGet = False
1135 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1136 If Not _IsStillAlive() Then GoTo Finally
1138 Select Case UCase(psProperty)
1140 _PropertyGet = _Component.getBookmarks().getElementNames()
1142 _PropertyGet = _Component.CurrentSelection
1144 vFieldNames = Array()
1145 Set oFieldMasters = _Component.getTextFieldMasters()
1146 vMasters = oFieldMasters.getElementNames()
1147 For Each sField In vMasters
1148 If ScriptForge.SF_String.StartsWith(sField, "com.sun.star.text.fieldmaster.User") Then
1149 Set oMaster = oFieldMasters.getByName(sField)
1150 vFieldNames = ScriptForge.SF_Array.InsertSorted(vFieldNames, oMaster.Name, CaseSensitive := True)
1151 ElseIf ScriptForge.SF_String.StartsWith(sField, "com.sun.star.text.fieldmaster.SetExpression") Then
1152 Set oMaster = oFieldMasters.getByName(sField)
1153 If oMaster.SubType = com.sun.star.text.SetVariableType.VAR Then
1154 vFieldNames = ScriptForge.SF_Array.InsertSorted(vFieldNames, oMaster.Name, CaseSensitive := True)
1155 End If
1156 End If
1157 Next sField
1158 _PropertyGet = vFieldNames
1160 _PropertyGet = _Component.getTextFrames().getElementNames()
1161 Case Else
1162 _PropertyGet = Null
1163 End Select
1165 Finally:
1166 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1167 Exit Function
1168 End Function ' SFDocuments.SF_Writer._PropertyGet
1170 REM -----------------------------------------------------------------------------
1171 Private Function _Repr() As String
1172 ''' Convert the SF_Writer instance to a readable string, typically for debugging purposes (DebugPrint ...)
1173 ''' Args:
1174 ''' Return:
1179 End Function ' SFDocuments.SF_Writer._Repr
1181 REM ============================================ END OF SFDOCUMENTS.SF_WRITER
1182 </script:module>