diff options
Diffstat (limited to 'wizards/source/sfdocuments/SF_Document.xba')
| -rw-r--r-- | wizards/source/sfdocuments/SF_Document.xba | 457 |
1 files changed, 457 insertions, 0 deletions
diff --git a/wizards/source/sfdocuments/SF_Document.xba b/wizards/source/sfdocuments/SF_Document.xba index 209834999c3b..917dd1ea58a9 100644 --- a/wizards/source/sfdocuments/SF_Document.xba +++ b/wizards/source/sfdocuments/SF_Document.xba @@ -60,6 +60,8 @@ Private Const DOCUMENTREADONLYERROR = "DOCUMENTREADONLYERROR" Private Const FORMDEADERROR = "FORMDEADERROR" +Private Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" + REM ============================================================= PRIVATE MEMBERS Private [Me] As Object @@ -84,6 +86,20 @@ Private _CustomProperties As Object ' Dictionary of custom properties ' Cache for static toolbar descriptions Private _Toolbars As Object ' SF_Dictionary instance to hold toolbars stored in application or in document +' Style descriptor +Type StyleDescriptor + Family As Object + StyleName As String + DisplayName As String + IsUsed As Boolean + BuiltIn As Boolean + Category As String + ParentStyle As String + XStyle As Object +End Type + +Private _StyleFamilies As Variant ' Array of available style families + REM ============================================================ MODULE CONSTANTS Const ISDOCFORM = 1 ' Form is stored in a Writer document @@ -107,6 +123,7 @@ Private Sub Class_Initialize() Set _DocumentProperties = Nothing Set _CustomProperties = Nothing Set _Toolbars = Nothing + _StyleFamilies = Array() End Sub ' SFDocuments.SF_Document Constructor REM ----------------------------------------------------------------------------- @@ -345,6 +362,12 @@ Property Get Readonly() As Boolean End Property ' SFDocuments.SF_Document.Readonly REM ----------------------------------------------------------------------------- +Property Get StyleFamilies() As Variant +''' Returns the list of available style families, as an array of strings + StyleFamilies = _PropertyGet("StyleFamilies") +End Property ' SFDocuments.SF_Document.StyleFamilies + +REM ----------------------------------------------------------------------------- Property Get Subject() As Variant ''' Returns the updatable document property Subject Subject = _PropertyGet("Subject") @@ -565,6 +588,62 @@ Catch: End Function ' SFDocuments.SF_Document.CreateMenu REM ----------------------------------------------------------------------------- +Public Sub DeleteStyles(Optional ByVal Family As Variant _ + , Optional ByRef StylesList As Variant _ + ) +''' Delete a single style or an array of styles given by their name(s) +''' within a specific styles family. +''' Only user-defined styles may be deleted. Built-in styles are ignored. +''' Args: +''' Family: one of the style families present in the actual document, as a case-sensitive string +''' StylesList: a single style name as a string or an array of style names. +''' The style names may be localized or not. +''' The StylesList is typically the output of the execution of a Styles() method. +''' Returns: +''' Examples: +''' ' Remove all inised styles +''' Const family = "ParagraphStyles" +''' doc.DeleteStyles(family, doc.Styles(family, Used := False, UserDefined := True)) + +Dim oFamily As Object ' Style names container +Dim vStylesList As Variant ' Alias of StylesList +Dim sStyle As String ' A single style name +Const cstThisSub = "SFDocuments.Document.DeleteStyles" +Const cstSubArgs = "Family, StylesList" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames() + If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally + If IsArray(StylesList) Then + If Not ScriptForge.SF_Utils._ValidateArray(StylesList, "StylesList", 1, V_STRING, True) Then GoTo Finally + Else + If Not ScriptForge.SF_Utils._Validate(StylesList, "StylesList", V_STRING) Then GoTo Finally + End If + End If + +Try: + Set oFamily = _GetStyleFamily(Family) + If Not IsNull(oFamily) Then + With oFamily + If Not IsArray(StylesList) Then vStylesList = Array(StylesList) Else vStylesList = StylesList + For Each sStyle In vStylesList + If .hasByName(sStyle) Then .removeByName(sStyle) + Next sStyle + End With + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' SFDocuments.SF_Document.DeleteStyles + +REM ----------------------------------------------------------------------------- Public Sub Echo(Optional ByVal EchoOn As Variant _ , Optional ByVal Hourglass As Variant _ ) @@ -778,7 +857,9 @@ Public Function Methods() As Variant , "CloseDocument" _ , "CreateMenu" _ , "Echo" _ + , "DeleteStyles" _ , "ExportAsPDF" _ + , "ImportStylesFromFile" _ , "PrintOut" _ , "RemoveMenu" _ , "RunCommand" _ @@ -786,6 +867,9 @@ Public Function Methods() As Variant , "SaveAs" _ , "SaveCopyAs" _ , "SetPrinter" _ + , "Styles" _ + , "Toolbars" _ + , "XStyle" _ ) End Function ' SFDocuments.SF_Document.Methods @@ -866,6 +950,7 @@ Public Function Properties() As Variant , "IsWriter" _ , "Keywords" _ , "Readonly" _ + , "StyleFamilies" _ , "Subject" _ , "Title" _ , "XComponent" _ @@ -1386,6 +1471,123 @@ Catch: End Function ' SFDocuments.SF_Document.SetProperty REM ----------------------------------------------------------------------------- +Public Function Styles(Optional ByVal Family As Variant _ + , Optional ByVal NamePattern As variant _ + , Optional ByVal Used As variant _ + , Optional ByVal UserDefined As Variant _ + , Optional ByVal ParentStyle As Variant _ + , Optional ByVal Category As Variant _ + ) As Variant +''' Returns an array of style names matching the filters given in argument +''' Args: +''' Family: one of the style families present in the actual document, as a case-sensitive string +''' NamePattern: a filter on the style names, as a case-sensitive string pattern +''' Admitted wildcard are: the "?" represents any single character +''' the "*" represents zero, one, or multiple characters +''' The names include the internal and localized names. +''' Used: when True, the style must be used in the document +''' When absent, the argument is ignored. +''' UserDefined: when True, the style must have been added by the user, either in the document or its template +''' When absent, the argument is ignored. +''' ParentStyle: when present, only the children of the given, localized or not, parent style name are retained +''' Category: a case-insensitive string: TEXT, CHAPTER, LIST, INDEX, EXTRA, HTML +''' For their respective meanings, read https://api.libreoffice.org/docs/idl/ref/namespacecom_1_1sun_1_1star_1_1style_1_1ParagraphStyleCategory.html +''' The argument is ignored when the Family is not = "ParagraphStyles". +''' Returns: +''' An array of style localized names +''' An error is raised when the Family does not exist. +''' The returned array may be empty. +''' Example: +''' Dim vStyles As Variant +''' vStyles = doc.Styles("ParagraphStyles") ' All styles in the family +''' vStyles = doc.Styles("ParagraphStyles", "H*") ' Heading, Heading 1, ... +''' vStyles = doc.Styles("ParagraphStyles", Used := False, UserDefined := True) +''' ' All user-defined styles that are not used +''' vStyles = doc.Styles("ParagraphStyles", ParentStyle := "Standard") +''' ' All styles dervived from the "Default Paragraph Style" + +Dim vStyles As Variant ' Return value +Dim sStyle As String ' A single style name +Dim oFamily As Object ' Style names container +Dim oStyle As Object ' _StyleDescriptor +Dim oParentStyle As Object ' _StyleDescriptor +Dim bValid As Boolean ' When True, a given style passes the filter +Dim i As Integer +Const cstCategories = "TEXT,CHAPTER,LIST,INDEX,EXTRA,HTML" + +Const cstThisSub = "SFDocuments.Document.Styles" +Const cstSubArgs = "Family, [NamePattern=""*""], [Used=True|False], [UserDefined=True|False], ParentStyle = """"" _ + & ", [Category=""""|""TEXT""|""CHAPTER""|""LIST""|""INDEX""|""EXTRA""|""HTML""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vStyles = Array() + +Check: + If IsMissing(NamePattern) Or IsEmpty(NamePattern) Then NamePattern = "" + If IsMissing(Used) Then Used = Empty + If IsMissing(UserDefined) Then UserDefined = Empty + If IsMissing(ParentStyle) Or IsEmpty(ParentStyle) Then ParentStyle = "" + If IsMissing(Category) Or IsEmpty(Category) Then Category = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames() + If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(NamePattern, "NamePattern", V_STRING) Then GoTo Finally + If Not IsEmpty(Used) Then + If Not ScriptForge.SF_Utils._Validate(Used, "Used", ScriptForge.V_BOOLEAN) Then GoTo Finally + End If + If Not IsEmpty(UserDefined) Then + If Not ScriptForge.SF_Utils._Validate(UserDefined, "UserDefined", ScriptForge.V_BOOLEAN) Then GoTo Finally + End If + If Not ScriptForge.SF_Utils._Validate(ParentStyle, "ParentStyle", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Category, "Category", V_STRING, Split("," & cstCategories, ",")) Then GoTo Finally + End If + +Try: + Set oFamily = _GetStyleFamily(Family) + If Not IsNull(oFamily) Then + ' Load it with the complete list of styles in the family + vStyles = oFamily.getElementNames() + ' Scan the list and retain those passing the filter + For i = 0 To UBound(vStyles) + With oStyle + sStyle = vStyles(i) + Set oStyle = _GetStyle(oFamily, sStyle) + If Not IsNull(oStyle) Then + ' Pattern ? + bValid = ( Len(NamePattern) = 0 ) + If Not bValid Then bValid = ScriptForge.SF_String.IsLike(.DisplayName, NamePattern, CaseSensitive := True) + ' Used ? + If bValid And Not IsEmpty(Used) Then bValid = ( Used = .IsUsed ) + ' User defined ? + If bValid And Not IsEmpty(UserDefined) Then bValid = ( UserDefined = Not .BuiltIn ) + ' Parent style ? + If bValid And Len(ParentStyle) > 0 Then + Set oParentStyle = _GetStyle(oFamily, .ParentStyle) + bValid = Not IsNull(oParentStyle) ' The child has a parent + If bValid Then bValid = ( ParentStyle = oParentStyle.DisplayName Or ParentStyle = oParentStyle.StyleName) + End If + ' Category ? + If bValid And Len(Category) > 0 Then bValid = ( UCase(Category) = .Category ) + If bValid Then vStyles(i) = .DisplayName Else vStyles(i) = "" + Else + vStyles(i) = "" + End If + End With + Next i + ' Reject when not valid + vStyles = ScriptForge.SF_Array.TrimArray(vStyles) + End If + +Finally: + Styles = vStyles + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.Styles + +REM ----------------------------------------------------------------------------- Public Function Toolbars(Optional ByVal ToolbarName As Variant) As Variant ''' Returns either a list of the available toolbar names in the actual document ''' or a Toolbar object instance. @@ -1428,6 +1630,55 @@ Catch: GoTo Finally End Function ' SFDocuments.SF_Document.Toolbars +REM ----------------------------------------------------------------------------- +Public Function XStyle(Optional ByVal Family As Variant _ + , Optional ByVal StyleName As variant _ + ) As Object +''' Returns a com.sun.star.style.Style UNO object corresponding with the arguments +''' Args: +''' Family: one of the style families present in the actual document, as a not case-sensitive string +''' StyleName: one of the styles present in the given family, as a case-sensitive string +''' The StyleName may be localized or not. +''' Returns: +''' A com.sun.star.style.XStyle UNO object or one of its descendants, +''' like com.sun.star.style.CellStyle or com.sun.star.style.ParagraphStyle etc. +''' An error is raised when the Family does not exist. +''' Nothing is returned when the StyleName does not exist in the given Family. +''' Example: +''' Dim oStyle As Object +''' Set oStyle = doc.XStyle("ParagraphStyle", "Heading 2") + +Dim oXStyle As Object ' Return value +Dim oFamily As Object ' Style names container + +Const cstThisSub = "SFDocuments.Document.XStyle" +Const cstSubArgs = "Family, StyleName" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oXStyle = Nothing + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames() + If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(StyleName, "StyleName", V_STRING) Then GoTo Finally + End If + +Try: + Set oFamily = _GetStyleFamily(Family) + If Not IsNull(oFamily) Then + If oFamily.hasByName(StyleName) Then Set oXStyle = oFamily.getByName(StyleName) + End If + +Finally: + Set XStyle = oXStyle + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.XStyle + REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- @@ -1503,6 +1754,209 @@ Finally: End Function ' SFDocuments.SF_Document._GetFilterNames REM ----------------------------------------------------------------------------- +Private Function _GetStyle(ByRef poFamily As Object _ + , Optional ByVal pvDisplayName As Variant _ + , Optional ByVal pvStyleIndex As Variant _ + ) As Object +''' Returns the style descriptor of the style passed as argument in the given family +''' Args: +''' poFamily: a com.sun.star.container.XNameContainer/XStyleFamily object +''' pvDisplayName: case-sensitive string, localized style name as visible in the user interface +''' pvStyleIndex: index of the style in the family, as an integer +''' Exactly 1 out of the last 2 arguments must be supplied +''' Returns: +''' A StyleDescriptor object or Nothing + +Dim oStyleDescriptor ' Return value +Dim oStyle As Object ' com.sun.star.style.XStyle and variants +Dim bFound As Boolean ' When True, the style has been found in the family +Dim vCategories As Variant ' Array of category constants +Dim iCategory As Integer ' Index of vCategories +Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") +Dim i As Integer + +Const cstCAT0 = "TEXT" ' is applied to styles that are used for common text +Const cstCAT1 = "CHAPTER" ' is applied to styles that are used as headings +Const cstCAT2 = "LIST" ' is applied to styles that used in numberings and lists +Const cstCAT3 = "INDEX" ' is applied to styles that are used in indexes +Const cstCAT4 = "EXTRA" ' is applied to styles that are used in special regions like headers, footers, and footnote text +Const cstCAT5 = "HTML" ' is applied to styles that are used to support HTML +Const cstCAT = cstCAT0 & "," & cstCAT1 & "," & cstCAT2 & "," & cstCAT3 & "," & cstCAT4 & "," & cstCAT5 + + On Local Error GoTo Catch + Set oStyleDescriptor = Nothing + +Check: + If IsNull(poFamily) Then HoTo Vatch + If IsMissing(pvDisplayName) Or IsEmpty(pvDisplayName) Then pvDisplayName = "" + If IsMissing(pvStyleIndex) Or IsEmpty(pvStyleIndex) Then pvStyleIndex = -1 +Try: + ' Find style corresponding with the given display name + With poFamily + If Len(pvDisplayName) > 0 Then + bFound = .hasByName(pvDisplayName) ' hasByName searches both for Name and DisplayName attributes here + If bFound Then Set oStyle = .getByName(pvDisplayName) Else GoTo Catch + ElseIf pvStyleIndex >= 0 And pvStyleIndex < .Count Then + Set oStyle = .getByIndex(pvStyleIndex) + Else + GoTo Catch ' Should not happen + End If + End With + + ' Setup the style descriptor + Set oStyleDescriptor = New StyleDescriptor + With oStyleDescriptor + Set .Family = poFamily + .StyleName = oStyle.Name + .DisplayName = oStyle.DisplayName + .IsUsed = oStyle.isInUse + .BuiltIn = Not oStyle.isUserDefined() + .Category = "" + If oSession.HasUnoProperty(oStyle, "Category") Then + vCategories = Split(cstCAT, ",") + iCategory = oStyle.Category + If iCategory >= 0 And iCategory <= UBound(vCategories) Then .Category = vCategories(iCategory) + End If + .ParentStyle = oStyle.ParentStyle + Set .XStyle = oStyle + End With + +Finally: + Set _GetStyle = oStyleDescriptor + Exit Function +Catch: + Set oStyleDescriptor = Nothing + GoTo Finally +End Function ' SFDocuments.SF_Document._GetStyle + +REM ----------------------------------------------------------------------------- +Private Function _GetStyleFamily(ByVal psFamilyName As String) As Object +''' Returns the style names container corresponding with the argument +''' Args: +''' psFamilyName: CellStyles, CharacterStyles, FrameStyles, GraphicsStyles, ListStyles, +''' NumberingStyles, PageStyles, ParagraphStyles, TableStyles +''' Returns: +''' A com.sun.star.container.XNameContainer/XStyleFamily object or Nothing + +Dim oFamily As Object ' Return value +Dim oFamilies As Object ' com.sun.star.container.XNameAccess +Dim iIndex As Integer ' Index in vFamilies of the given argument + + On Local Error GoTo Catch + Set oFamily = Nothing + +Try: + Set oFamilies = _Component.getStyleFamilies() + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = oFamilies.getElementNames() + ' oFamilies.hasByName()/getByName() not used here to admit not case-sensitive family names + iIndex = ScriptForge.SF_Array.IndexOf(_StyleFamilies, psFamilyName, CaseSensitive := False) + If iIndex >= 0 Then Set oFamily = oFamilies.getByName(_StyleFamilies(iIndex)) + +Finally: + Set _GetStyleFamily = oFamily + Exit Function +Catch: + Set oFamily = Nothing + GoTo Finally +End Function ' SFDocuments.SF_Document._GetStyleFamily + +REM ----------------------------------------------------------------------------- +Public Sub _ImportStylesFromFile(Optional FileName As Variant _ + , Optional ByRef Families As Variant _ + , Optional ByVal Overwrite As variant _ + ) As Variant +''' Load all the styles belonging to one or more style families from a closed file +''' into the actual document. The actual document must be a Calc or a Writer document. +''' Are always imported together: +''' ParagraphStyles and CharacterStyles +''' NumberingStyles and ListStyles +''' Args: +''' FileName: the file from which to load the styles in the FileSystem notation. +''' The file is presumed to be of the same document type as the actual document +''' Families: one of the style families present in the actual document, as a case-sensitive string +''' or an array of such strings. Default = all families +''' Overwrite: when True, the actual styles may be overwritten. Defailt = False +''' Returns: +''' Exceptions: +''' UNKNOWNFILEERROR The fiven file name does not exist +''' Example: +''' oDoc.ImportStylesFromFile("C:\...\abc.odt", Families := "ParagraphStyles", Overwrite := True) + +Dim vFamilies As Variant ' Alias of Families +Dim oFamilies As Object ' com.sun.star.container.XNameAccess +Dim vOptions As Variant ' Array of property values +Dim bAll As Boolean ' When True, ALL style families are considered +Dim sName As String ' A single name in vOptions +Dim FSO As Object : Set FSO = ScriptForge.SF_FileSystem +Dim i As Integer +Const cstThisSub = "SFDocuments.Document.ImportStylesFromFile" +Const cstSubArgs = "FileName, [Families], [Overwrite=False]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(Families) Or IsEmpty(Families) Then Families = "" + If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False + + Set oFamilies = _Component.getStyleFamilies() + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = oFamilies.getElementNames() + + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName", False) Then GoTo Finally + If IsArray(Families) Then + If Not ScriptForge.SF_Utils._ValidateArray(Families, "Families", 1, V_STRING, True) Then GoTo Finally + Else + If Not ScriptForge.SF_Utils._Validate(Families, "Families", V_STRING, ScriptForge.SF_Array.Append(_StyleFamilies, "")) Then GoTo Finally + End If + If Not ScriptForge.SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally + End If + + If Not FSO.FileExists(FileName) Then GoTo CatchNotExists + If IsArray(Families) Then + vFamilies = Families + Else + bAll = ( Len(Families) = 0 ) ' When Families is absent (= ""), all families should be considered + vFamilies = Array(Families) + End If + +Try: + With ScriptForge.SF_Utils + Set vOptions = _Component.getStyleFamilies().getStyleLoaderOptions + ' By default, all style families are imported (True) + If Not bAll Then + For i = 0 To UBound(vOptions) + vOptions(i).Value = False + Next i + For i = LBound(vFamilies) To UBound(vFamilies) + Select Case UCase(vFamilies(i)) + Case "PARAGRAPHSTYLES", "CHARACTERSTYLES" : sName = "TextStyles" + Case "FRAMESTYLES" : sName = "FrameStyles" + Case "PAGESTYLES" : sName = "PageStyles" + Case "NUMBERINGSTYLES", "LISTSTYLES" : sName = "NumberingStyles" + Case "CELLSTYLES" : sName = "PageStyles" + Case Else : sName = "" + End Select + If Len(sName) > 0 Then Set vOptions = ._SetPropertyValue(vOptions, "Load" & sName, True) + Next i + End If + vOptions = ._SetPropertyValue(vOptions, "OverwriteStyles", Overwrite) + End With + + ' Finally, import + oFamilies.loadStylesFromURL(FSO._ConvertToUrl(FileName), vOptions) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +CatchNotExists: + SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName) + GoTo Finally +End Sub ' SFDocuments.SF_Document._ImportStylesFromFile + +REM ----------------------------------------------------------------------------- Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _ , Optional ByVal pbError As Boolean _ ) As Boolean @@ -1640,6 +2094,9 @@ Const cstSubArgs = "" _PropertyGet = Join(_Component.DocumentProperties.Keywords, ", ") Case "Readonly" _PropertyGet = _Component.isReadonly() + Case "StyleFamilies" + If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames() + _PropertyGet = _StyleFamilies Case "Subject" _PropertyGet = _Component.DocumentProperties.Subject Case "Title" |