cleanandvalidate/Redaction/Validation.xba
2021-10-25 21:08:07 +02:00

1212 lines
No EOL
42 KiB
XML
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Validation" script:language="StarBasic">Sub markval31
End Sub
Sub validateButton
Dim badFootnoteSigns As Boolean
Dim badGraphics As Boolean
Dim badSectionsInTables As Boolean
Dim badHeadingsInFootnotes As Boolean
Dim outlinePageStylesReport As String
Dim badHeadingsInTables As Boolean
Dim badText As Boolean
Dim needExtendedInfo As Boolean
Dim config As Object
Dim needFixColoredText As Boolean
Dim brokenCharBackTransparent As Boolean
config = initRedactionConfiguration()
Dim statusIndicator as Object
statusIndicator = ThisComponent.getCurrentController.statusIndicator
statusIndicator.Start(getTranslation(&quot;validationStarted&quot;),100)
badFootnoteSigns = noteSignsCheck()
statusIndicator.setValue(10)
badGraphics = checkGraphics()
badText = findBadCharacters()
needFixColoredText = findColoredBackgroundInDoc()
statusIndicator.setValue(20)
badSectionsInTables = checkSectionsInTables()
statusIndicator.setValue(30)
badHeadingsInFootnotes = checkNotesOutline()
statusIndicator.setValue(40)
outlinePageStylesReport = checkHeadingsInHeadersFooters()
statusIndicator.setValue(50)
badHeadingsInTables = checkHeadingsInTextTables()
statusIndicator.setValue(60)
If outlinePageStylesReport &lt;&gt; &quot;&quot; Then
MsgBox outlinePageStylesReport
EndIf
If config.getPropertyValue(&quot;complexity&quot;) = &quot;makerUp&quot; then
needExtendedInfo = true
Else
needExtendedInfo = false
EndIf
brokenCharBackTransparent = hasbrokenCharBackTransparent()
If (brokenCharBackTransparent) Then
MsgBox getTranslation(&quot;invalidParagraphFormattingFound&quot;)
EndIf
numberingsErros = printNumberingSymbols(needExtendedInfo)
statusIndicator.setValue(80)
If brokenCharBackTransparent OR needFixColoredText OR numberingsErros OR badText OR badFootnoteSigns OR badGraphics Or badHeadingsInFootnotes Or badSectionsInTables OR badHeadingsInTables OR outlinePageStylesReport &lt;&gt; &quot;&quot; Then
MsgBox getTranslation(&quot;validationWarning&quot;)
Else
MsgBox getTranslation(&quot;validationSuccess&quot;)
EndIf
statusIndicator.end()
End Sub
Function checkGraphics() As Boolean
Dim drawPages As Object
Dim count as Integer
Dim draw As Object
Dim shapeType As String
Dim embeededObject As Object
drawPages = ThisComponent.DrawPage
Dim i As Long
Dim badDrawings() As Object
Dim badFrames() As Object
count = drawPages.getCount()
For i = 0 to count - 1
draw = drawPages.getByIndex(i)
shapeType = draw.ShapeType
If InStr(shapeType,&quot;com.sun.star.drawing&quot;) = 1 Then
addToArray(badDrawings, draw.Anchor)
EndIf
If InStr(shapeType,&quot;FrameShape&quot;) = 1 Then
If draw.supportsService(&quot;com.sun.star.text.TextEmbeddedObject&quot;) Then
embeededObject = draw.getEmbeddedObject()
If IsNull(embeededObject) Then
addToArray(badFrames, draw.Anchor)
Else
If Not embeededObject.supportsService(&quot;com.sun.star.formula.FormulaProperties&quot;) Then
addToArray(badFrames, draw.Anchor)
Else
&apos;Formula
EndIf
EndIf
EndIf
EndIf
Next i
checkGraphics = false
If UBound(badDrawings) &gt; -1 Then
startNavigatorDialog(getTranslation(&quot;validationBadDrawings&quot;) &amp; (UBound(badDrawings) + 1) &amp; getTranslation(&quot;validationExcerptNotSuitable&quot;),badDrawings)
checkGraphics = true
EndIf
If UBound(badFrames) &gt; -1 Then
startNavigatorDialog(getTranslation(&quot;validationBadEmbeededObjects&quot;) &amp; (UBound(badFrames) + 1) &amp; getTranslation(&quot;validationExcerptNotSuitable&quot;),badFrames)
checkGraphics = true
EndIf
End Function
Private Sub fixDOI
StartTracking
replaceCharsInDOI
StopTracking
End Sub
Sub replaceCharsInDOI
AskAndReplace(&quot;(?&lt;=DOI[0-9. /XVI:ХOО?-]{1,50})[Х]{1,5}&quot;,&quot;X&quot;)
AskAndReplace(&quot;(?&lt;=DOI[0-9. /XVI:ХOО?-]{1,50})[OО]{1,5}&quot;,&quot;0&quot;)
AskAndReplace(&quot;(?&lt;=DOI[0-9. /XVI:ХOО?-]{1,50})[‒–—−]{1,5}&quot;,&quot;-&quot;)
End sub
Private Function noteSignsCheck() As Boolean
Dim footnotes As Object
Dim footnote As Object
Dim endnote As Object
Dim endnotes As Object
Dim count as Integer
Dim charNum as Long
Dim char As Long
Dim label As String
Dim result As String
Dim founds() As Object
noteSignsCheck = false
result = &quot;&quot;
footnotes = ThisComponent.Footnotes
endnotes = ThisComponent.Endnotes
count = footnotes.getCount
Dim i As Integer
Dim j As Integer
For i = 0 to count-1
footnote = footnotes.getByIndex(i)
label = footnote.Label
charNum = Len(label)
For j = 1 to charNum
char = Asc(Right(Left(label,j),1))
If char &gt;= 57344 AND char &lt;= 63743 Then
addToArray(founds,footnote.Anchor)
&apos;result = result &amp; getTranslation(&quot;validateFootnotes1&quot;) &amp; &quot; &quot; &amp; Chr(char) &amp; &quot; &quot; &amp; getTranslation(&quot;validateFootnotes2&quot;) &amp; &quot; &quot; &amp; i &amp; &quot; &quot; &amp; getTranslation(&quot;validateFootnotes3&quot;) &amp; chr(10)
End If
Next j
Next i
count = endnotes.getCount
For i = 0 to count-1
endnote = endnotes.getByIndex(i)
label = endnote.Label
charNum = Len(label)
For j = 1 to charNum
char = Asc(Right(Left(label,j),1))
If char &gt;= 57344 AND char &lt;= 63743 Then
addToArray(founds,endnote.Anchor)
&apos;result = result &amp; getTranslation(&quot;validateFootnotes1&quot;) &amp; &quot; &quot; &amp; Chr(char) &amp; &quot; &quot; &amp; getTranslation(&quot;validateEndnotes1&quot;) &amp; &quot; &quot; &amp; i &amp; &quot; &quot; &amp; getTranslation(&quot;validateFootnotes3&quot;) &amp; chr(10)
End If
Next j
Next i
If (UBound(founds) &gt; -1) Then
noteSignsCheck = true
MsgBox(getTranslation(&quot;validationBadFootnotesSymbolsNotification&quot;))
startNavigatorDialog(getTranslation(&quot;badNoteSings&quot;),founds)
EndIf
&apos;noteSignsCheck = result
End Function
Function checkNotesOutline As Boolean
Dim footNotes As Object
Dim endNotes As Object
Dim x As Long
Dim aNote As Object
Dim oEnum As Object
Dim oCurPar As Object
&apos; Dim result As String
Dim founds() As Object
&apos; result = &quot;&quot;
footNotes = thisComponent.footNotes
endNotes = thisComponent.EndNotes
for x = 0 to footNotes.Count -1
aNote = footNotes.getByIndex(x)
aNote.Anchor.CharStyleName=&quot;Footnote anchor&quot;
oEnum = aNote.Text.createEnumeration()
Do While oEnum.hasMoreElements()
oCurPar = oEnum.nextElement()
If oCurPar.OutlineLevel &gt; 0 Then
addToArray(founds,oCurPar)
&apos; result = result &amp; getTranslation(&quot;validateFootnotes2&quot;) &amp; &quot; &quot; &amp; x &amp; &quot; &quot; &amp; getTranslation(&quot;setOutlineLevel&quot;) &amp; &quot; &quot; &amp; oCurPar.OutlineLevel &amp; chr(10)
EndIf
Loop
Next
for x = 0 to endNotes.Count -1
aNote = endNotes.getByIndex(x)
aNote.Anchor.CharStyleName=&quot;Footnote anchor&quot;
oEnum = aNote.Text.createEnumeration()
Do While oEnum.hasMoreElements()
oCurPar = oEnum.nextElement()
If oCurPar.OutlineLevel &gt; 0 Then
addToArray(founds,oCurPar)
&apos; result = result &amp; getTranslation(&quot;validateEndnotes1&quot;) &amp; &quot; &quot; &amp; x &amp; &quot; &quot; &amp; getTranslation(&quot;setOutlineLevel&quot;) &amp; &quot; &quot; &amp; oCurPar.OutlineLevel &amp; chr(10)
EndIf
Loop
Next
If (UBound(founds) &gt; -1) Then
startNavigatorDialog(getTranslation(&quot;badHeadingsInFootnotes&quot;),founds)
checkNotesOutline = true
Else
checkNotesOutline = false
EndIf
End Function
Function checkSectionsInTables As Boolean
Dim x As Integer
Dim oEnum As Object
&apos;Dim result As String
Dim sections As Object
Dim section As Object
Dim anchor As Object
Dim anchorText As Object
Dim badSections() As Object
result = &quot;&quot;
sections = thisComponent.TextSections
for x = 0 to sections.Count -1
section = sections.getByIndex(x)
anchor = section.getAnchor()
anchorText = anchor.getText()
If anchorText.supportsService(&quot;com.sun.star.text.CellProperties&quot;) Then
addToArray(badSections(),anchor)
&apos;result = result &amp; getTranslation(&quot;section&quot;) &amp; &quot; &quot; &amp; section.Name &amp; &quot; &quot; &amp; getTranslation(&quot;isInTable&quot;) &amp; chr(10)
EndIf
Next
If (UBound(badSections) &gt; -1) Then
checkSectionsInTables = true
startNavigatorDialog(getTranslation(&quot;badSectionsInTables&quot;),badSections)
Else
checkSectionsInTables = false
EndIf
End Function
Function checkHeadingsInHeadersFooters As String
Dim result As String
Dim count As Integer
Dim oStyle As Object
Dim i As Integer
result = &quot;&quot;
Dim pageStyles As Object
pageStyles = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
count = pageStyles.count - 1
For i = 0 to count
oStyle = pageStyles.getByIndex(i)
If oStyle.isInUse Then
If oStyle.HeaderIsOn Then
If oStyle.HeaderIsShared Then
If isHeadingsInText(oStyle.HeaderText) Then
result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inHeader&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName() &amp; chr(10)
EndIf
Else
If isHeadingsInText(oStyle.HeaderTextLeft) Then
result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inHeader&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName() &amp; chr(10)
EndIf
If isHeadingsInText(oStyle.HeaderTextRight) Then
result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inHeader&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName() &amp; chr(10)
EndIf
EndIf
If NOT oStyle.FirstIsShared Then
If isHeadingsInText(oStyle.HeaderTextFirst) Then
result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inHeader&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName() &amp; chr(10)
EndIf
EndIf
EndIf
If oStyle.FooterIsOn Then
If oStyle.FooterIsShared Then
If isHeadingsInText(oStyle.FooterText) Then
result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inFooter&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName() &amp; chr(10)
EndIf
Else
If isHeadingsInText(oStyle.FooterTextLeft) Then
result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inFooter&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName() &amp; chr(10)
EndIf
If isHeadingsInText(oStyle.FooterTextRight) Then
result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inFooter&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName() &amp; chr(10)
EndIf
EndIf
If NOT oStyle.FirstIsShared Then
If isHeadingsInText(oStyle.FooterTextFirst) Then
result = result &amp; getTranslation(&quot;foundHeadingIn&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inFooter&quot;) &amp; &quot; &quot; &amp; getTranslation(&quot;inPageStyle&quot;) &amp; &quot; &quot; &amp; oStyle.getName() &amp; chr(10)
EndIf
EndIf
EndIf
EndIf
Next i
checkHeadingsInHeadersFooters = result
End Function
Function checkHeadingsInTextTables() As Boolean
Dim enum1Element As Object
Dim enum1 As Object
Dim enum2 As Object
Dim thisPortion As Object
Dim footnoteText As Object
Dim label As String
Dim labelNum As Integer
Dim i As Integer
Dim count As Integer
Dim cell As Object
Dim cellText As Object
Dim firstCellName As String
Dim founds() As Object
enum1 = ThisComponent.Text.createEnumeration
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
firstCellName = enum1Element.getCellByPosition(0,0).cellName
cellNames = enum1Element.cellNames
For i = LBound(cellNames) To Ubound(cellNames)
cell = enum1Element.getCellByName(cellNames(i))
cellText = cell.getText()
If cellNames(i) = firstCellName Then
addHeadingNotFirstInText(cellText,founds)
Else
addHeadingsInText(cellText,founds)
EndIf
Next i
EndIf
Wend
If (UBound(founds) &gt; -1) Then
checkHeadingsInTextTables = true
startNavigatorDialog(getTranslation(&quot;badHeadingsInTables&quot;),founds)
Else
checkHeadingsInTextTables = false
EndIf
End Function
Sub addHeadingNotFirstInText(oText As Object, founds() As Object)
Dim enum1Element As Object
Dim enum1 As Object
Dim enum2 As Object
Dim thisPortion As Object
Dim footnoteText As Object
Dim label As String
Dim labelNum As Integer
Dim i As Integer
Dim count As Integer
Dim cell As Object
Dim cellText As Object
Dim first As Boolean
first = true
enum1 = oText.createEnumeration
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
If Not first Then
If enum1Element.OutlineLevel &gt; 0 Then
addToArray(founds,enum1Element)
EndIf
EndIf
ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
cellNames = enum1Element.cellNames
For i = LBound(cellNames) To Ubound(cellNames)
cell = enum1Element.getCellByName(cellNames(i))
cellText = cell.getText()
addHeadingsInText(cellText,founds)
Next i
EndIf
first = false
Wend
End Sub
Sub addHeadingsInText(oText As Object, founds() As Object)
Dim enum1Element As Object
Dim enum1 As Object
Dim enum2 As Object
Dim thisPortion As Object
Dim footnoteText As Object
Dim label As String
Dim labelNum As Integer
Dim i As Integer
Dim count As Integer
Dim cell As Object
Dim cellText As Object
enum1 = oText.Text.createEnumeration
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
If enum1Element.OutlineLevel &gt; 0 Then
addToArray(founds,enum1Element)
EndIf
ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
cellNames = enum1Element.cellNames
For i = LBound(cellNames) To Ubound(cellNames)
cell = enum1Element.getCellByName(cellNames(i))
cellText = cell.getText()
addHeadingsInText(cellText,founds)
Next i
EndIf
Wend
End Sub
Function isHeadingNotFirstInText(oText As Object) As Boolean
Dim enum1Element As Object
Dim enum1 As Object
Dim enum2 As Object
Dim thisPortion As Object
Dim footnoteText As Object
Dim label As String
Dim labelNum As Integer
Dim i As Integer
Dim count As Integer
Dim cell As Object
Dim cellText As Object
Dim first As Boolean
first = true
enum1 = oText.createEnumeration
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
If Not first Then
If enum1Element.OutlineLevel &gt; 0 Then
isHeadingNotFirstInText = true
Exit Function
EndIf
EndIf
ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
cellNames = enum1Element.cellNames
For i = LBound(cellNames) To Ubound(cellNames)
cell = enum1Element.getCellByName(cellNames(i))
cellText = cell.getText()
If isHeadingsInText(cellText) Then
isHeadingNotFirstInText = true
Exit Function
EndIf
Next i
EndIf
first = false
Wend
isHeadingNotFirstInText = false
End Function
Function isHeadingsInText(oText As Object) As Boolean
Dim enum1Element As Object
Dim enum1 As Object
Dim enum2 As Object
Dim thisPortion As Object
Dim footnoteText As Object
Dim label As String
Dim labelNum As Integer
Dim i As Integer
Dim count As Integer
Dim cell As Object
Dim cellText As Object
enum1 = oText.Text.createEnumeration
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
If enum1Element.OutlineLevel &gt; 0 Then
isHeadingsInText = true
Exit Function
EndIf
ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
cellNames = enum1Element.cellNames
For i = LBound(cellNames) To Ubound(cellNames)
cell = enum1Element.getCellByName(cellNames(i))
cellText = cell.getText()
If isHeadingsInText(cellText) Then
isHeadingsInText = true
Exit Function
EndIf
Next i
EndIf
Wend
isHeadingsInText = false
End Function
Function hasBrokenCharBackTransparent As Boolean
Dim footNotes As Object
Dim endNotes As Object
Dim i As Long
Dim oStyles As Object
Dim pageStyles As Object
Dim pageStyle As Object
hasBrokenCharBackTransparent = isManualCharBackTransparentInTextParas(ThisComponent.Text)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
footNotes = ThisComponent.FootNotes
For i = 0 to footNotes.getCount - 1
hasBrokenCharBackTransparent = isManualCharBackTransparentInTextParas(footNotes.getByIndex(i).Text)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
Next i
endNotes = thisComponent.footNotes
For i = 0 to footNotes.Count -1
hasBrokenCharBackTransparent = isManualCharBackTransparentInTextParas(endNotes.getByIndex(i).Text)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
Next i
oStyles = ThisComponent.StyleFamilies
pageStyles = oStyles.getByName(oStyles.elementNames(2))
For i = 0 to pageStyles.Count -1
pageStyle = pageStyles.getByIndex(i)
If Not IsEmpty(pageStyle.FooterText) Then
hasBrokenCharBackTransparent = isManualCharBackTransparentInTextParas(pageStyle.FooterText)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.FooterTextFirst) Then
hasBrokenCharBackTransparent = isManualCharBackTransparentInTextParas(pageStyle.FooterTextFirst)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.FooterTextRight) Then
hasBrokenCharBackTransparent = isManualCharBackTransparentInTextParas(pageStyle.FooterTextRight)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.FooterTextLeft) Then
hasBrokenCharBackTransparent = isManualCharBackTransparentInTextParas(pageStyle.FooterTextLeft)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.HeaderText) Then
hasBrokenCharBackTransparent = isManualCharBackTransparentInTextParas(pageStyle.HeaderText)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.HeaderTextFirst) Then
hasBrokenCharBackTransparent = isManualCharBackTransparentInTextParas(pageStyle.HeaderTextFirst)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.HeaderTextRight) Then
hasBrokenCharBackTransparent = isManualCharBackTransparentInTextParas(pageStyle.HeaderTextRight)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.HeaderTextLeft) Then
hasBrokenCharBackTransparent = isManualCharBackTransparentInTextParas(pageStyle.HeaderTextLeft)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
Next i
End Function
Function isManualCharBackTransparent(para As Object) As Boolean
Dim styleName As String
Dim paraStyles As Object
isManualCharBackTransparent = false
If para.CharBackTransparent = false Then
styleName = para.ParaStyleName
paraStyles = ThisComponent.StyleFamilies.getByName(&quot;ParagraphStyles&quot;)
paraStyle = paraStyles.GetByName(styleName)
If paraStyle.CharBackTransparent = true Then
isManualCharBackTransparent = true
EndIf
EndIf
End Function
Function isManualCharBackTransparentInTextParas(oText As Object) As Boolean
Dim enum1Element As Object
Dim enum1 As Object
Dim enum2 As Object
Dim thisPortion As Object
Dim footnoteText As Object
Dim label As String
Dim labelNum As Integer
Dim i As Integer
Dim count As Integer
Dim cell As Object
Dim cellText As Object
enum1 = oText.Text.createEnumeration
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
If isManualCharBackTransparent(enum1Element) Then
isManualCharBackTransparentInTextParas = true
Exit Function
EndIf
ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
cellNames = enum1Element.cellNames
For i = LBound(cellNames) To Ubound(cellNames)
cell = enum1Element.getCellByName(cellNames(i))
cellText = cell.getText()
If isManualCharBackTransparentInTextParas(cellText) Then
isManualCharBackTransparentInTextParas = true
Exit Function
EndIf
Next i
EndIf
Wend
isManualCharBackTransparentInTextParas = false
End Function
Function printNumberingSymbols(needExtendedInfo) As Boolean
Dim families As Object
Dim numStyles As Object
Dim numStyle As Object
Dim numRules As Object
Dim numRule As Object
Dim prop As Object
Dim enum1 As Object
Dim enum1Element As Object
Dim fontProp As Object
Dim fontName As String
Dim result As String
Dim resultBad As String
Dim excerpt As String
Dim exLength As Integer
Dim report As String
Dim k As Integer
printNumberingSymbols = false
families = ThisComponent.StyleFamilies
numStyles = families.getByName(&quot;NumberingStyles&quot;)
result = &quot;&quot;
resultBad = &quot;&quot;
enum1 = ThisComponent.Text.createEnumeration
Do While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
If NOT IsMissing(enum1Element.NumberingRules) AND NOT IsEmpty(enum1Element.NumberingRules) Then
numRules = enum1Element.NumberingRules
If numRules.hasElements Then
numRule = numRules.getByIndex(enum1Element.NumberingLevel)
fontName = &quot;&quot;
fontChar = &quot;&quot;
For k = 0 To Ubound(numRule)
prop = numRule(k)
If prop.Name = &quot;BulletFont&quot; Then
fontName = prop.Value.Name
EndIf
If prop.Name = &quot;BulletChar&quot; Then
fontChar = prop.Value
EndIf
Next k
exLength = 15
excerpt = enum1Element.String
If Len(excerpt) &lt; exLength Then
exLength = Len(excerpt)
EndIf
If fontChar &lt;&gt; &quot;&quot; Then
tmp = numRules.Name &amp;&quot; &quot;&amp; getTranslation(&quot;validateNumberingLevel&quot;) &amp;&quot; &quot; &amp; (j + 1) &amp; &quot; &quot; &amp; getTranslation(&quot;validateNumberingFont&quot;) &amp; &quot; &quot; &amp; fontName &amp; &quot; &quot; &amp; getTranslation(&quot;validateNumberingSymbol&quot;) &amp; &quot; &quot; &amp; fontChar &amp; &quot; (&quot; &amp; Hex(Asc(fontChar)) &amp; &quot;) &quot;&amp; Left(excerpt,exLength) &amp; chr(10)
If Asc(fontChar) &gt; 57344 AND Asc(fontChar) &lt; 63743 Then
resultBad = resultBad &amp; tmp
ElseIf fontName &lt;&gt; &quot;IPH Astra Serif&quot; _
AND fontName &lt;&gt; &quot;OpenSymbol&quot; _
AND fontName &lt;&gt; &quot;IPH Lib Serif&quot; _
AND fontName &lt;&gt; &quot;IPH Lib Sans&quot; _
AND fontName &lt;&gt; &quot;Liberation Serif&quot; _
AND fontName &lt;&gt; &quot;Liberation Sans&quot; _
AND needExtendedInfo Then
result = result &amp; tmp
EndIf
EndIf
EndIf
EndIf
EndIf
Loop
report = &quot;&quot;
If result = &quot;&quot; AND resultBad = &quot;&quot; Then
Exit Function
Else
printNumberingSymbols = true
If resultBad &lt;&gt; &quot;&quot; Then
report = getTranslation(&quot;validateNumberingsReportSymbols&quot;) &amp; chr(10) &amp; resultBad
EndIf
If result &lt;&gt; &quot;&quot; Then
report = report &amp; getTranslation(&quot;validateNumberingsReportFonts&quot;) &amp; &quot; &quot;&amp; chr(10)&amp; result
EndIf
EndIf
MsgBox report
End Function
Private Sub showTrackedChanges
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
dispatcher.executeDispatch(document, &quot;.uno:AcceptTrackedChanges&quot;, &quot;&quot;, 0, Array())
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = &quot;ShowTrackedChanges&quot;
args2(0).Value = true
dispatcher.executeDispatch(document, &quot;.uno:ShowTrackedChanges&quot;, &quot;&quot;, 0, args2())
end Sub
Private Sub StartTracking
Dim dispatcher As Object
Dim document As Object
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
document = ThisComponent.CurrentController.Frame
dim trackProperties(0) as new com.sun.star.beans.PropertyValue
trackProperties(0).Name = &quot;TrackChanges&quot;
trackProperties(0).Value = true
dispatcher.executeDispatch(document, &quot;.uno:TrackChanges&quot;, &quot;&quot;, 0, trackProperties())
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = &quot;ShowTrackedChanges&quot;
args1(0).Value = true
dispatcher.executeDispatch(document, &quot;.uno:ShowTrackedChanges&quot;, &quot;&quot;, 0, args1())
End Sub
Private Sub StopTracking
Dim dispatcher As Object
Dim document As Object
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
document = ThisComponent.CurrentController.Frame
Dim trackProperties(0) as new com.sun.star.beans.PropertyValue
trackProperties(0).Name = &quot;TrackChanges&quot;
trackProperties(0).Value = false
dispatcher.executeDispatch(document, &quot;.uno:TrackChanges&quot;, &quot;&quot;, 0, trackProperties())
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = &quot;ShowTrackedChanges&quot;
args1(0).Value = true
dispatcher.executeDispatch(document, &quot;.uno:ShowTrackedChanges&quot;, &quot;&quot;, 0, args1())
End Sub
Dim fontDialog As Object
Sub fontReportButton
Dim fontNames() As String
Dim listBox As Object
Dim description As Object
Dim statusIndicator as Object
statusIndicator = ThisComponent.getCurrentController.statusIndicator
statusIndicator.Start(getTranslation(&quot;fontReportInProgress&quot;),100)
fontNames = getODGFontNames()
DialogLibraries.LoadLibrary(&quot;Redaction&quot;)
fontDialog = CreateUnoDialog( DialogLibraries.Redaction.ChooseFontname )
listBox = fontDialog.getControl(&quot;fontList&quot;)
listBox.addItems(fontNames , 0)
fontDialog.Title = getTranslation(&quot;chooseFontNameDialogTitle&quot;)
description = fontDialog.getControl(&quot;description&quot;)
description.SetText(getTranslation(&quot;chooseFontNameDialogDescription&quot;))
statusIndicator.setValue(50)
fontDialog.Execute()
Dim targetFontName As String
targetFontName = fontDialog.model.Tag
If targetFontName=&quot;0&quot; or targetFontName=&quot;&quot; Then
statusIndicator.end()
Exit sub
EndIf
Dim FileName As String
getCharsInFont(targetFontName)
statusIndicator.end()
End Sub
Sub onSelectFont(oEvent)
fontDialog.endExecute()
fontDialog.model.Tag = oEvent.ActionCommand
End Sub
Function getODGFontNames() As Variant
&apos;Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
Dim fontNames() As String
Dim pages As Object
Dim pageCount As Long
Dim page As Object
Dim elementCount As Long
Dim groupCount As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim element As Object
Dim elementText As Object
Dim groupElement As Object
Dim enum1 As Object
Dim enum1Element As Object
Dim enum2 As Object
Dim thisPortion As Object
Dim fontChar As Long
Dim fontName As String
pages = ThisComponent.getDrawPages()
pagesCount = pages.getCount()
For i = 0 To pagesCount - 1
page = pages.getByIndex(i)
elementCount = page.getCount()
For j = 0 To elementCount - 1
element = page.getByIndex(j)
If element.supportsService(&quot;com.sun.star.drawing.Text&quot;) Then
elementText = element.getText()
enum1 = elementText.createEnumeration()
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
enum2 = enum1Element.createEnumeration
While enum2.hasMoreElements
thisPortion = enum2.nextElement
If Len(thisPortion.String) &gt; 0 Then
fontName = thisPortion.CharFontName
If NOT fontIsAlreadyFound(fontNames, fontName) Then
AddToArray(fontNames, fontName)
EndIf
EndIf
Wend
EndIf
Wend
EndIf
If element.supportsService(&quot;com.sun.star.drawing.GroupShape&quot;) Then
groupCount = element.getCount()
For k = 0 To groupCount - 1
groupElement = element.getByIndex(k)
If groupElement.supportsService(&quot;com.sun.star.drawing.Text&quot;) Then
elementText = groupElement.getText()
enum1 = elementText.createEnumeration()
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
enum2 = enum1Element.createEnumeration
While enum2.hasMoreElements
thisPortion = enum2.nextElement
If Len(thisPortion.String) &gt; 0 Then
fontName = thisPortion.CharFontName
If NOT fontIsAlreadyFound(fontNames, fontName) Then
AddToArray(fontNames, fontName)
EndIf
EndIf
Wend
EndIf
Wend
EndIf
Next k
EndIf
Next j
Next i
getODGFontNames = fontNames
End Function
Function fontIsAlreadyFound(fontNames() As String, proposeName As String) As Boolean
If IsEmpty(fontNames) Then
fontIsAlreadyFound = false
Exit Function
EndIf
If getIndex(fontNames(), proposeName) &gt; -1 Then
fontIsAlreadyFound = True
Exit Function
EndIf
fontIsAlreadyFound = False
End Function
Function IsInArray(array, content)
IsInArray = false
For i = LBound(array) To UBound(array)
inArr = array(i)
If inArr = content Then
IsInArray = true
EndIf
Next i
End Function
Function getIndex(array As variant, value As variant) As Integer
Dim id As Integer
Dim nRight As Integer
Dim nLen As Integer
id = 0
nRight = uBound(array)
nLen = len(value)
while id &lt;= nRight
If array(id) = value Then
getIndex = id
exit Function
Else
id = id + 1
end if
wend
getIndex = -1
End Function
Sub addToArray(xArray(),vNextElement)
Dim iUB As Integer
Dim iLB As Integer
iLB = lBound(xArray())
iUB = uBound(xArray())
If iLB &gt; iUB then
iUB = iLB
redim xArray(iLB To iUB)
Else
iUB = iUB +1
redim preserve xArray(iLB To iUB)
Endif
xArray(iUB) = vNextElement
End Sub
Sub getCharsInFont(fontName As String)
Dim resultArray() As String
Dim pageNums() As Long
Dim firstPages() As Long
Dim resultString As String
Dim pages As Object
Dim pageCount As Long
Dim page As Object
Dim elementCount As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim element As Object
Dim elementText As Object
Dim enum1 As Object
Dim enum1Element As Object
Dim enum2 As Object
Dim thisPortion As Object
Dim fontChar As String
Dim groupCount As Long
Dim groupElement As Object
Dim charString As String
Dim charNum As Long
pages = ThisComponent.getDrawPages()
pagesCount = pages.getCount()
For i = 0 To pagesCount - 1
page = pages.getByIndex(i)
elementCount = page.getCount()
For j = 0 To elementCount - 1
element = page.getByIndex(j)
If element.supportsService(&quot;com.sun.star.drawing.Text&quot;) Then
elementText = element.getText()
enum1 = elementText.createEnumeration()
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
enum2 = enum1Element.createEnumeration
While enum2.hasMoreElements
thisPortion = enum2.nextElement
If thisPortion.CharFontName = fontName Then
resultString = thisPortion.String
For k = 0 To Len(resultString) - 1
charString = Mid(resultString,k+1,1)
charNum = Asc(charString)
fontChar = Hex(charNum)
If NOT IsInArray(resultArray,fontChar) Then
AddToArray(resultArray(), fontChar)
AddToArray(pageNums(), i + 1)
EndIf
Next k
EndIf
Wend
EndIf
Wend
EndIf
If element.supportsService(&quot;com.sun.star.drawing.GroupShape&quot;) Then
groupCount = element.getCount()
For k = 0 To groupCount - 1
groupElement = element.getByIndex(k)
If groupElement.supportsService(&quot;com.sun.star.drawing.Text&quot;) Then
elementText = groupElement.getText()
enum1 = elementText.createEnumeration()
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
enum2 = enum1Element.createEnumeration
While enum2.hasMoreElements
thisPortion = enum2.nextElement
If thisPortion.CharFontName = fontName Then
resultString = thisPortion.String
For k = 0 To Len(resultString) - 1
fontChar = Hex(Asc(Mid(resultString,k+1,1)))
If NOT IsInArray(resultArray,fontChar) Then
AddToArray(resultArray(), fontChar)
AddToArray(pageNums(), i + 1)
EndIf
Next k
EndIf
Wend
EndIf
Wend
EndIf
Next k
EndIf
Next j
Next i
If resultString &lt;&gt; &quot;&quot; Then
Dim newDocCursor As Object
Dim newDoc As Object
newDoc = starDesktop.loadComponentFromURL(&quot;private:factory/swriter&quot;, &quot;_blank&quot;, 0, Array())
newDocCursor = newDoc.getCurrentController().getViewCursor()
newDocCursor.String = getTranslation(&quot;symbolsInFontHeading&quot;) &amp; &quot; &quot; &amp; fontName
newDocCursor.ParaStyleName = &quot;Heading 1&quot;
newDocCursor.collapseToEnd()
newDocCursor.Text.insertControlCharacter(newDocCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
For i = LBound(resultArray) To UBound(resultArray)
newDocCursor.ParaStyleName = &quot;Text body&quot;
newDocCursor.String = &quot;https://unicode-table.com/ru/&quot; &amp; resultArray(i)
newDocCursor.HyperLinkURL = &quot;https://unicode-table.com/ru/&quot; &amp; resultArray(i)
newDocCursor.collapseToEnd()
newDocCursor.String = &quot; &quot; &amp; getTranslation(&quot;charFirstPage&quot;) &amp; &quot; &quot; &amp; pageNums(i)
newDocCursor.collapseToEnd()
newDocCursor.Text.insertControlCharacter(newDocCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
Next i
Exit Sub
Else
MsgBox getTranslation(&quot;symbolsInFontNotFound1&quot;) &amp; &quot; &quot; &amp; fontName &amp; &quot; &quot; &amp; getTranslation(&quot;symbolsInFontNotFound2&quot;)
EndIf
End Sub
Function findBadCharacters() As Boolean
Dim founds As Object
Dim foundObjects() As Object
founds = findInDoc(&quot;[\uE000-\uF8FF]+&quot;)
findBadCharacters = false
If founds.count &lt;&gt; 0 Then
&apos;MsgBox getTranslation(&quot;validationBadSymbolsNotification&quot;)
foundObjects = convertXIndexAccessToArray(founds)
startNavigatorDialog(getTranslation(&quot;badSymbols&quot;),foundObjects)
findBadCharacters = true
EndIf
End Function
Function findColoredBackgroundInDoc() As Boolean
Dim founds As Object
Dim sDesc As Object
Dim foundObjects() As Object
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
SrchAttributes(0).Name = &quot;CharBackTransparent&quot;
SrchAttributes(0).Value = False
sDesc = Thiscomponent.createSearchDescriptor()
sDesc.SearchAll = true
sDesc.ValueSearch = false
sDesc.SearchRegularExpression = true
sDesc.searchStyles = true
sDesc.SetSearchAttributes(SrchAttributes())
founds = Thiscomponent.findAll(sDesc)
findColoredBackgroundInDoc = false
If founds.count &lt;&gt; 0 Then
MsgBox getTranslation(&quot;foundColoredTextMessage&quot;)
foundObjects = convertXIndexAccessToArray(founds)
startNavigatorDialog(getTranslation(&quot;coloredTextDescription&quot;),foundObjects)
findColoredBackgroundInDoc = true
EndIf
End Function
Sub startNavigatorDialog(objectsDescription As String,foundObjects() As Object)
Dim dialog As Object
Dim leftImageURL As String
Dim rightImageURL As String
Dim curNum As Long
Dim maxNum As Long
Dim found As Object
waitingForDialog = true
maxNum = UBound(foundObjects)
dialog = notModalDialog(&quot;Navigator&quot;)
dialog.getControl(&quot;found&quot;).SetText(getTranslation(&quot;navigatorFound&quot;) &amp; CStr(maxNum+1))
curNum = 0
found = foundObjects(curNum)
dialog.getControl(&quot;current&quot;).SetText(CStr(curNum+1))
dialog.getControl(&quot;description&quot;).SetText(objectsDescription)
&apos; dialog.getControl(&quot;cancel&quot;).Label = getTranslation(&quot;buttonCancel&quot;)
dialog.getControl(&quot;close&quot;).Label = getTranslation(&quot;buttonClose&quot;)
leftImageURL = convertToURL(getExtensionPath() &amp; &quot;/images/left-navigator.svg&quot;)
rightImageURL = convertToURL(getExtensionPath() &amp; &quot;/images/right-navigator.svg&quot;)
dialog.getControl(&quot;prev&quot;).model.imageURL = leftImageURL
&apos;dialog.getControl(&quot;prev&quot;).model.ScaleMode = 2
dialog.getControl(&quot;next&quot;).model.imageURL = rightImageURL
&apos;dialog.getControl(&quot;next&quot;).model.ScaleMode = 2
dialog.setvisible(true)
&apos;select first found &apos;
&apos;not using view cursor as if shape was prevously selected runtime exception will appear
Thiscomponent.CurrentController.select(found)
Do While waitingForDialog
If dialog.getControl(&quot;close&quot;).model.state = 1 then
exit Do
EndIf
If dialog.getControl(&quot;prev&quot;).model.state = 1 then
curNum = getPrevFound(curNum, maxNum)
found = foundObjects(curNum)
Thiscomponent.CurrentController.select(found)
dialog.getControl(&quot;current&quot;).SetText(CStr(curNum+1))
dialog.getControl(&quot;prev&quot;).model.state = 0
EndIf
If dialog.getControl(&quot;next&quot;).model.state = 1 then
curNum = getNextFound(curNum, maxNum)
found = foundObjects(curNum)
Thiscomponent.CurrentController.select(found)
dialog.getControl(&quot;current&quot;).SetText(CStr(curNum+1))
dialog.getControl(&quot;next&quot;).model.state = 0
EndIf
wait (100)
Loop
dialog.dispose
End Sub
Function convertXIndexAccessToArray(founds As Object) As Variant
Dim i As Integer
Dim maxNum As Integer
Dim arrayOfObjects() As Object
maxNum = founds.count - 1
For i = 0 To maxNum
addToArray(arrayOfObjects,founds.getByIndex(i))
Next i
convertXIndexAccessToArray = arrayOfObjects
End Function
Function getNextFound(curNum As Long, max As Long) As Long
If curNum &lt; max Then
getNextFound = curNum + 1
Else
getNextFound = 0
EndIf
End Function
Function getPrevFound(curNum As Long, max As Long) As Long
If curNum = 0 Then
getPrevFound = max
Else
getPrevFound = curNum - 1
EndIf
End Function
Function getExtensionPath() As String
Dim extensionIdentifier As String
Dim pip As Object
extensionIdentifier = &quot;pro.litvinovg.Redaction&quot;
pip = GetDefaultContext.getByName(&quot;/singletons/com.sun.star.deployment.PackageInformationProvider&quot;)
getExtensionPath = pip.getPackageLocation(extensionIdentifier)
End Function
Function notModalDialog(dialogName As String) As Variant
Dim windowProvider As Object
Dim containerWindow As Object
Dim handler As Object
Dim dialogUrl As String
Dim dialog As Object
containerWindow = ThisComponent.getCurrentController().getFrame().getContainerWindow()
dialogUrl = &quot;vnd.sun.star.script:Redaction.&quot; &amp; dialogName &amp; &quot;?location=application&quot;
windowProvider = CreateUnoService(&quot;com.sun.star.awt.ContainerWindowProvider&quot;)
dialog = windowProvider.createContainerWindow(dialogUrl, &quot;&quot;, containerWindow, handler)
notModalDialog = dialog
End Function
sub openReport(fileName As String)
dim document as object
dim dispatcher as object
Dim path As String
Dim tmpName As String
Dim oldName As String
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = &quot;URL&quot;
args1(0).Value = fileName
args1(1).Name = &quot;FilterName&quot;
args1(1).Value = &quot;HTML (StarWriter)&quot;
dispatcher.executeDispatch(document, &quot;.uno:Open&quot;, &quot;&quot;, 0, args1())
If FileExists(tmpName) Then
Kill(tmpName)
End If
End Sub
Function isInDoc(searchString As String) As Boolean
Dim founds As Variant
founds = findInDoc(searchString)
If founds.count &lt;&gt; 0 Then
isInDoc = true
Else
isInDoc = false
EndIf
End Function
Function findInDoc(searchString As String) As Variant
Dim founds As Object
Dim sDesc As Object
Dim srch(0) as new com.sun.star.beans.PropertyValue
sDesc = Thiscomponent.createSearchDescriptor()
sDesc.SearchAll = true
sDesc.ValueSearch = false
sDesc.SearchStyles = false
sDesc.SearchCaseSensitive = true
sDesc.SearchRegularExpression = true
sDesc.SearchString = searchString
founds = Thiscomponent.findAll(sDesc)
findInDoc = founds
End Function
</script:module>