2019-10-16 15:42:48 +03:00
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
2021-06-07 01:49:50 +02:00
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Validation" script:language="StarBasic">Sub markval27
2019-10-16 15:42:48 +03:00
End Sub
2021-06-06 21:51:13 +02:00
2019-10-17 18:48:22 +03:00
2019-10-16 16:17:28 +03:00
Sub validateButton
2019-10-17 18:48:22 +03:00
Dim footnotesReport As String
Dim graphicsReport As String
2020-07-06 09:43:46 +02:00
Dim sectionsReport As String
2020-07-06 11:06:41 +02:00
Dim outlinePageStylesReport As String
2020-07-03 16:48:29 +02:00
Dim outlineInNotesReport As String
2020-07-06 11:39:01 +02:00
Dim oulineInTablesReport As String
2019-10-17 18:48:22 +03:00
Dim badText As Boolean
Dim badNumberings As Boolean
2020-03-06 17:37:35 +01:00
Dim needExtendedInfo As Boolean
2020-07-03 16:48:29 +02:00
Dim config As Object
2021-06-04 22:28:27 +02:00
Dim needFixColoredText As Boolean
2021-06-06 13:15:27 +02:00
Dim brokenCharBackTransparent As Boolean
2020-07-03 16:48:29 +02:00
config = initRedactionConfiguration()
2020-07-06 11:49:35 +02:00
Dim statusIndicator as Object
statusIndicator = ThisComponent.getCurrentController.statusIndicator
statusIndicator.Start(getTranslation("validationStarted"),100)
2019-10-17 18:48:22 +03:00
badText = false
badNumberings = false
2020-07-03 15:47:47 +02:00
footnotesReport = noteSingsCheck
2020-07-06 11:49:35 +02:00
statusIndicator.setValue(10)
2019-10-17 18:48:22 +03:00
graphicsReport = checkGraphics
2020-07-06 11:49:35 +02:00
statusIndicator.setValue(20)
2020-07-06 09:43:46 +02:00
sectionsReport = checkSectionsInTables
2020-07-06 11:49:35 +02:00
statusIndicator.setValue(30)
2020-07-03 16:48:29 +02:00
outlineInNotesReport = checkNotesOutline()
2020-07-06 11:49:35 +02:00
statusIndicator.setValue(40)
2020-07-06 11:06:41 +02:00
outlinePageStylesReport = checkHeadingsInHeadersFooters
2020-07-06 11:49:35 +02:00
statusIndicator.setValue(50)
2020-07-06 11:39:01 +02:00
oulineInTablesReport = checkHeadingsInTextTables
2020-07-06 11:49:35 +02:00
statusIndicator.setValue(60)
2020-07-03 16:48:29 +02:00
If outlineInNotesReport <> "" Then
MsgBox outlineInNotesReport
2019-10-17 18:48:22 +03:00
EndIf
2020-07-06 11:39:01 +02:00
If oulineInTablesReport <> "" Then
MsgBox oulineInTablesReport
EndIf
2020-07-06 11:06:41 +02:00
If outlinePageStylesReport <> "" Then
MsgBox outlinePageStylesReport
EndIf
2020-07-03 16:48:29 +02:00
If footnotesReport <> "" Then
MsgBox footnotesReport
EndIf
2019-10-17 18:48:22 +03:00
If graphicsReport <> "" Then
2020-07-03 16:48:29 +02:00
MsgBox graphicsReport
2019-10-17 18:48:22 +03:00
EndIf
2020-07-06 09:43:46 +02:00
If sectionsReport <> "" Then
MsgBox sectionsReport
EndIf
2021-06-06 21:51:13 +02:00
badText = findBadCharacters
2020-03-06 17:37:35 +01:00
If config.getPropertyValue("complexity") = "makerUp" then
needExtendedInfo = true
Else
needExtendedInfo = false
EndIf
2021-06-06 13:15:27 +02:00
brokenCharBackTransparent = hasbrokenCharBackTransparent
If (brokenCharBackTransparent) Then
MsgBox getTranslation("invalidParagraphFormattingFound")
EndIf
2021-06-04 22:28:27 +02:00
needFixColoredText = findColoredBackgroundInDoc
2021-05-29 14:32:18 +02:00
numberingsErros = printNumberingSymbols(needExtendedInfo)
2020-07-06 11:49:35 +02:00
statusIndicator.setValue(80)
2021-06-06 13:15:27 +02:00
If brokenCharBackTransparent OR needFixColoredText OR numberingsErros OR badText OR badNumberings OR footnotesReport <> "" OR graphicsReport <> "" Or outlineInNotesReport <> "" Or sectionsReport <> "" OR oulineInTablesReport <> "" OR outlinePageStylesReport <> "" Then
2020-05-04 15:52:04 +02:00
MsgBox getTranslation("validationWarning")
2021-06-06 21:51:13 +02:00
2019-10-17 18:48:22 +03:00
Else
2020-05-04 15:52:04 +02:00
MsgBox getTranslation("validationSuccess")
2019-10-17 18:48:22 +03:00
EndIf
2020-07-06 11:49:35 +02:00
statusIndicator.end()
2019-10-17 00:31:08 +03:00
End Sub
2020-03-21 11:55:13 +01:00
Private Function checkGraphics() As String
2019-10-17 18:48:22 +03:00
Dim drawPages As Object
Dim count as Integer
Dim draw As Object
Dim result As String
2019-10-18 18:56:22 +03:00
result = ""
2019-10-17 18:48:22 +03:00
Dim shapeType As String
2019-10-18 18:56:22 +03:00
Dim embeededObject As Object
Dim badFrame As Long
badFrame = 0
2019-10-17 18:48:22 +03:00
Dim drawingN As Long
drawingN = 0
drawPages = ThisComponent.DrawPage
2020-03-21 12:37:32 +01:00
Dim i As Integer
2019-10-17 18:48:22 +03:00
count = drawPages.getCount()
For i = 0 to count-1
draw = drawPages.getByIndex(i)
shapeType = draw.ShapeType
If InStr(shapeType,"com.sun.star.drawing") = 1 Then
drawingN = drawingN + 1
EndIf
2019-10-18 18:56:22 +03:00
If InStr(shapeType,"FrameShape") = 1 Then
2019-10-21 13:25:47 +03:00
If draw.supportsService("com.sun.star.text.TextEmbeddedObject") Then
embeededObject = draw.getEmbeddedObject()
2020-01-13 16:08:46 +01:00
If IsNull(embeededObject) Then
2019-10-21 13:25:47 +03:00
badFrame = badFrame + 1
Else
2020-01-13 16:08:46 +01:00
If Not embeededObject.supportsService("com.sun.star.formula.FormulaProperties") Then
badFrame = badFrame + 1
Else
'Formula
EndIf
2019-10-21 13:25:47 +03:00
EndIf
2019-10-18 18:56:22 +03:00
EndIf
EndIf
2019-10-17 18:48:22 +03:00
Next i
If drawingN <> 0 Then
2020-05-04 15:52:04 +02:00
result = result & getTranslation("validationBadDrawings") & drawingN & getTranslation("validationExcerptNotSuitable") & chr(10)
2019-10-18 18:56:22 +03:00
EndIf
If badFrame <> 0 Then
2020-05-04 15:52:04 +02:00
result = result & getTranslation("validationBadEmbeededObjects") & badFrame & getTranslation("validationExcerptNotSuitable") & chr(10)
2019-10-17 18:48:22 +03:00
EndIf
checkGraphics = result
End Function
2020-12-09 12:00:05 +01:00
Private Sub fixDOI
StartTracking
replaceCharsInDOI
StopTracking
End Sub
Sub replaceCharsInDOI
AskAndReplace("(?<=DOI[0-9. /XVI:‒ – − Х О Х
AskAndReplace("(?<=DOI[0-9. /XVI:‒ – − Х О О
AskAndReplace("(?<=DOI[0-9. /XVI:‒ – − Х О
End sub
2020-07-03 15:47:47 +02:00
Private Function noteSingsCheck() As String
2019-10-17 00:31:08 +03:00
Dim footnotes As Object
2020-07-03 15:47:47 +02:00
Dim footnote As Object
Dim endnote As Object
Dim endnotes As Object
2019-10-17 00:31:08 +03:00
Dim count as Integer
Dim charNum as Long
Dim char As Long
Dim label As String
Dim result As String
result = ""
2020-07-03 15:47:47 +02:00
footnotes = ThisComponent.footnotes
endnotes = ThisComponent.Footnotes
2019-10-17 00:31:08 +03:00
count = footnotes.getCount
2020-03-21 12:37:32 +01:00
Dim i As Integer
Dim j As Integer
2019-10-17 00:31:08 +03:00
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 >= 57344 AND char <= 63743 then
2020-05-04 15:52:04 +02:00
result = result & getTranslation("validateFootnotes1") & " " & Chr(char) & " " & getTranslation("validateFootnotes2") & " " & i & " " & getTranslation("validateFootnotes3") & chr(10)
2019-10-17 00:31:08 +03:00
End If
Next j
Next i
2020-07-03 15:47:47 +02:00
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 >= 57344 AND char <= 63743 then
2020-07-03 16:13:34 +02:00
result = result & getTranslation("validateFootnotes1") & " " & Chr(char) & " " & getTranslation("validateEndnotes1") & " " & i & " " & getTranslation("validateFootnotes3") & chr(10)
2020-07-03 15:47:47 +02:00
End If
Next j
Next i
noteSingsCheck = result
2019-10-17 18:48:22 +03:00
End Function
2019-10-16 15:42:48 +03:00
2020-07-03 16:48:29 +02:00
Function checkNotesOutline As String
Dim oDescriptor As Object
Dim footNotes As Object
2020-07-06 09:43:46 +02:00
Dim endNotes As Object
2020-07-03 16:48:29 +02:00
Dim x As Integer
Dim aNote As Object
Dim oEnum As Object
Dim oCurPar As Object
Dim result As String
result = ""
footNotes = thisComponent.footNotes
2020-07-03 16:58:00 +02:00
endNotes = thisComponent.EndNotes
2020-07-03 16:48:29 +02:00
for x = 0 to footNotes.Count -1
aNote = footNotes.getByIndex(x)
aNote.Anchor.CharStyleName="Footnote anchor"
oEnum = aNote.Text.createEnumeration()
Do While oEnum.hasMoreElements()
oCurPar = oEnum.nextElement()
If oCurPar.OutlineLevel > 0 Then
result = result & getTranslation("validateFootnotes2") & " " & x & " " & getTranslation("setOutlineLevel") & " " & oCurPar.OutlineLevel & chr(10)
EndIf
Loop
Next
for x = 0 to endNotes.Count -1
aNote = endNotes.getByIndex(x)
aNote.Anchor.CharStyleName="Footnote anchor"
oEnum = aNote.Text.createEnumeration()
Do While oEnum.hasMoreElements()
oCurPar = oEnum.nextElement()
If oCurPar.OutlineLevel > 0 Then
result = result & getTranslation("validateEndnotes1") & " " & x & " " & getTranslation("setOutlineLevel") & " " & oCurPar.OutlineLevel & chr(10)
EndIf
Loop
Next
checkNotesOutline = result
End Function
2020-07-06 09:43:46 +02:00
Function checkSectionsInTables As String
Dim x As Integer
Dim oEnum As Object
Dim result As String
Dim sections As Object
Dim section As Object
Dim anchor As Object
Dim anchorText As Object
result = ""
sections = thisComponent.TextSections
for x = 0 to sections.Count -1
section = sections.getByIndex(x)
anchor = section.getAnchor()
anchorText = anchor.getText()
If anchorText.supportsService("com.sun.star.text.CellProperties") Then
result = result & getTranslation("section") & " " & section.Name & " " & getTranslation("isInTable") & chr(10)
EndIf
Next
checkSectionsInTables = result
End Function
2020-07-06 11:06:41 +02:00
Function checkHeadingsInHeadersFooters As String
Dim result As String
Dim count As Integer
Dim oStyle As Object
Dim i As Integer
result = ""
Dim pageStyles As Object
pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles")
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 & getTranslation("foundHeadingIn") & " " & getTranslation("inHeader") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10)
EndIf
Else
If isHeadingsInText(oStyle.HeaderTextLeft) Then
result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inHeader") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10)
EndIf
If isHeadingsInText(oStyle.HeaderTextRight) Then
result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inHeader") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10)
EndIf
EndIf
If NOT oStyle.FirstIsShared Then
If isHeadingsInText(oStyle.HeaderTextFirst) Then
result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inHeader") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10)
EndIf
EndIf
EndIf
If oStyle.FooterIsOn Then
If oStyle.FooterIsShared Then
If isHeadingsInText(oStyle.FooterText) Then
result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inFooter") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10)
EndIf
Else
If isHeadingsInText(oStyle.FooterTextLeft) Then
result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inFooter") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10)
EndIf
If isHeadingsInText(oStyle.FooterTextRight) Then
result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inFooter") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10)
EndIf
EndIf
If NOT oStyle.FirstIsShared Then
If isHeadingsInText(oStyle.FooterTextFirst) Then
result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inFooter") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10)
EndIf
EndIf
EndIf
EndIf
Next i
checkHeadingsInHeadersFooters = result
End Function
2021-06-06 13:15:27 +02:00
Function checkHeadingsInTextTables() As String
2020-07-06 11:39:01 +02:00
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 result As String
result = ""
enum1 = ThisComponent.Text.createEnumeration
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService("com.sun.star.text.TextTable") 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
If isHeadingNotFirstInText(cellText) Then
result = result & getTranslation("foundHeadingIn") & " " & getTranslation("table") & " " & enum1Element.TableName & chr(10)
EndIf
Else
If isHeadingsInText(cellText) Then
result = result & getTranslation("foundHeadingIn") & " " & getTranslation("table") & " " & enum1Element.TableName & chr(10)
EndIf
EndIf
Next i
EndIf
Wend
checkHeadingsInTextTables = result
End Function
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("com.sun.star.text.Paragraph") Then
If Not first Then
If enum1Element.OutlineLevel > 0 Then
isHeadingNotFirstInText = true
Exit Function
EndIf
EndIf
ElseIf enum1Element.supportsService("com.sun.star.text.TextTable") 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
2020-07-06 11:06:41 +02:00
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("com.sun.star.text.Paragraph") Then
If enum1Element.OutlineLevel > 0 Then
isHeadingsInText = true
Exit Function
EndIf
ElseIf enum1Element.supportsService("com.sun.star.text.TextTable") 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
2021-06-06 13:15:27 +02:00
Function hasBrokenCharBackTransparent As Boolean
Dim foonNotes As Object
Dim endNotes As Object
Dim i As Integer
Dim oStyles As Object
Dim pageStyles As Object
Dim pageStyle As Object
hasBrokenCharBackTransparent = isBackColorInText(ThisComponent.Text)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
footNotes = thisComponent.footNotes
For i = 0 to footNotes.Count -1
hasBrokenCharBackTransparent = isBackColorInText(footNotes.getByIndex(i).Text)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
Next i
endNotes = thisComponent.footNotes
For i = 0 to footNotes.Count -1
hasBrokenCharBackTransparent = isBackColorInText(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 = isBackColorInText(pageStyle.FooterText)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.FooterTextFirst) Then
hasBrokenCharBackTransparent = isBackColorInText(pageStyle.FooterTextFirst)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.FooterTextRight) Then
hasBrokenCharBackTransparent = isBackColorInText(pageStyle.FooterTextRight)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.FooterTextLeft) Then
hasBrokenCharBackTransparent = isBackColorInText(pageStyle.FooterTextLeft)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.HeaderText) Then
hasBrokenCharBackTransparent = isBackColorInText(pageStyle.HeaderText)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.HeaderTextFirst) Then
hasBrokenCharBackTransparent = isBackColorInText(pageStyle.HeaderTextFirst)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.HeaderTextRight) Then
hasBrokenCharBackTransparent = isBackColorInText(pageStyle.HeaderTextRight)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
If Not IsEmpty(pageStyle.HeaderTextLeft) Then
hasBrokenCharBackTransparent = isBackColorInText(pageStyle.HeaderTextLeft)
If (hasBrokenCharBackTransparent) Then
Exit Function
EndIf
EndIf
Next i
End Function
Function isBackColorInText(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("com.sun.star.text.Paragraph") Then
If enum1Element.CharBackTransparent = false Then
isBackColorInText = true
Exit Function
EndIf
ElseIf enum1Element.supportsService("com.sun.star.text.TextTable") Then
cellNames = enum1Element.cellNames
For i = LBound(cellNames) To Ubound(cellNames)
cell = enum1Element.getCellByName(cellNames(i))
cellText = cell.getText()
If isBackColorInText(cellText) Then
isBackColorInText = true
Exit Function
EndIf
Next i
EndIf
Wend
isBackColorInText = false
End Function
2021-05-29 14:32:18 +02:00
Function printNumberingSymbols(needExtendedInfo) As Boolean
2020-03-06 17:37:35 +01:00
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
2020-03-21 12:37:32 +01:00
Dim excerpt As String
Dim exLength As Integer
Dim report As String
Dim k As Integer
2021-05-29 14:32:18 +02:00
printNumberingSymbols = false
2020-03-06 17:37:35 +01:00
families = ThisComponent.StyleFamilies
numStyles = families.getByName("NumberingStyles")
result = ""
resultBad = ""
enum1 = ThisComponent.Text.createEnumeration
Do While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService("com.sun.star.text.Paragraph") 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 = ""
fontChar = ""
For k = 0 To Ubound(numRule)
prop = numRule(k)
If prop.Name = "BulletFont" Then
fontName = prop.Value.Name
EndIf
If prop.Name = "BulletChar" Then
fontChar = prop.Value
EndIf
Next k
exLength = 15
excerpt = enum1Element.String
If Len(excerpt) < exLength Then
exLength = Len(excerpt)
EndIf
2020-03-18 22:14:07 +01:00
If fontChar <> "" Then
2021-05-29 14:32:18 +02:00
tmp = numRules.Name &" "& getTranslation("validateNumberingLevel") &" " & (j + 1) & " " & getTranslation("validateNumberingFont") & " " & fontName & " " & getTranslation("validateNumberingSymbol") & " " & fontChar & " (" & Hex(Asc(fontChar)) & ") "& Left(excerpt,exLength) & chr(10)
2020-03-18 22:14:07 +01:00
If Asc(fontChar) > 57344 AND Asc(fontChar) < 63743 Then
resultBad = resultBad & tmp
ElseIf fontName <> "IPH Astra Serif" _
AND fontName <> "OpenSymbol" _
AND fontName <> "IPH Lib Serif" _
AND fontName <> "IPH Lib Sans" _
AND fontName <> "Liberation Serif" _
AND fontName <> "Liberation Sans" _
AND needExtendedInfo Then
result = result & tmp
EndIf
2020-03-06 17:37:35 +01:00
EndIf
EndIf
EndIf
EndIf
Loop
2020-03-21 12:37:32 +01:00
2020-03-06 17:37:35 +01:00
report = ""
If result = "" AND resultBad = "" Then
2021-05-29 14:32:18 +02:00
Exit Function
Else
printNumberingSymbols = true
2020-03-06 17:37:35 +01:00
If resultBad <> "" Then
2020-05-04 15:52:04 +02:00
report = getTranslation("validateNumberingsReportSymbols") & chr(10) & resultBad
2020-03-06 17:37:35 +01:00
EndIf
If result <> "" Then
2020-05-04 15:52:04 +02:00
report = report & getTranslation("validateNumberingsReportFonts") & " "& chr(10)& result
2020-03-06 17:37:35 +01:00
EndIf
EndIf
MsgBox report
2021-05-29 14:32:18 +02:00
End Function
2020-03-06 17:37:35 +01:00
2019-10-17 00:31:08 +03:00
Private Sub showTrackedChanges
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:AcceptTrackedChanges", "", 0, Array())
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ShowTrackedChanges"
args2(0).Value = true
dispatcher.executeDispatch(document, ".uno:ShowTrackedChanges", "", 0, args2())
end Sub
Private Sub StartTracking
2020-03-21 12:37:32 +01:00
Dim dispatcher As Object
Dim document As Object
2019-10-17 00:31:08 +03:00
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
document = ThisComponent.CurrentController.Frame
dim trackProperties(0) as new com.sun.star.beans.PropertyValue
trackProperties(0).Name = "TrackChanges"
trackProperties(0).Value = true
dispatcher.executeDispatch(document, ".uno:TrackChanges", "", 0, trackProperties())
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ShowTrackedChanges"
args1(0).Value = true
dispatcher.executeDispatch(document, ".uno:ShowTrackedChanges", "", 0, args1())
End Sub
Private Sub StopTracking
2020-03-21 12:37:32 +01:00
Dim dispatcher As Object
Dim document As Object
2019-10-17 00:31:08 +03:00
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
document = ThisComponent.CurrentController.Frame
2020-03-21 12:37:32 +01:00
Dim trackProperties(0) as new com.sun.star.beans.PropertyValue
2019-10-17 00:31:08 +03:00
trackProperties(0).Name = "TrackChanges"
trackProperties(0).Value = false
dispatcher.executeDispatch(document, ".uno:TrackChanges", "", 0, trackProperties())
2020-03-21 12:37:32 +01:00
Dim args1(0) as new com.sun.star.beans.PropertyValue
2019-10-17 00:31:08 +03:00
args1(0).Name = "ShowTrackedChanges"
args1(0).Value = true
dispatcher.executeDispatch(document, ".uno:ShowTrackedChanges", "", 0, args1())
End Sub
2020-04-23 14:15:18 +02:00
2020-07-12 14:55:40 +02:00
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("fontReportInProgress"),100)
fontNames = getODGFontNames()
DialogLibraries.LoadLibrary("Redaction")
fontDialog = CreateUnoDialog( DialogLibraries.Redaction.ChooseFontname )
listBox = fontDialog.getControl("fontList")
listBox.addItems(fontNames , 0)
fontDialog.Title = getTranslation("chooseFontNameDialogTitle")
description = fontDialog.getControl("description")
description.SetText(getTranslation("chooseFontNameDialogDescription"))
statusIndicator.setValue(50)
fontDialog.Execute()
Dim targetFontName As String
targetFontName = fontDialog.model.Tag
If targetFontName="0" or targetFontName="" Then
2020-07-12 16:34:42 +02:00
statusIndicator.end()
2020-07-12 14:55:40 +02:00
Exit sub
EndIf
2020-07-12 16:34:42 +02:00
Dim FileName As String
FileName = getCharsInFont(targetFontName)
2020-07-12 14:55:40 +02:00
statusIndicator.end()
2020-07-12 16:34:42 +02:00
If FileName <> "" Then
openReport(FileName)
EndIf
2020-07-12 14:55:40 +02:00
End Sub
Sub onSelectFont(oEvent)
fontDialog.endExecute()
fontDialog.model.Tag = oEvent.ActionCommand
End Sub
Function getODGFontNames() As Variant
2020-07-26 12:46:10 +02:00
'Globalscope.BasicLibraries.LoadLibrary( "MRILib" )
2020-07-12 14:55:40 +02:00
Dim fontNames() As String
Dim pages As Object
Dim pageCount As Long
Dim page As Object
Dim elementCount As Long
2020-07-26 12:46:10 +02:00
Dim groupCount As Long
2020-07-12 14:55:40 +02:00
Dim i As Long
Dim j As Long
Dim k As Long
Dim element As Object
Dim elementText As Object
2020-07-26 12:46:10 +02:00
Dim groupElement As Object
2020-07-12 14:55:40 +02:00
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)
2020-07-26 11:21:47 +02:00
If element.supportsService("com.sun.star.drawing.Text") Then
elementText = element.getText()
enum1 = elementText.createEnumeration()
While enum1.hasMoreElements
2020-07-12 14:55:40 +02:00
enum1Element = enum1.nextElement
If enum1Element.supportsService("com.sun.star.text.Paragraph") Then
enum2 = enum1Element.createEnumeration
While enum2.hasMoreElements
thisPortion = enum2.nextElement
2020-07-12 16:34:42 +02:00
If Len(thisPortion.String) > 0 Then
fontName = thisPortion.CharFontName
If NOT fontIsAlreadyFound(fontNames, fontName) Then
2020-07-12 14:55:40 +02:00
AddToArray(fontNames, fontName)
2020-07-12 16:34:42 +02:00
EndIf
2020-07-12 14:55:40 +02:00
EndIf
Wend
EndIf
2020-07-26 11:21:47 +02:00
Wend
2020-07-26 12:46:10 +02:00
EndIf
If element.supportsService("com.sun.star.drawing.GroupShape") Then
groupCount = element.getCount()
For k = 0 To groupCount - 1
groupElement = element.getByIndex(k)
If groupElement.supportsService("com.sun.star.drawing.Text") Then
elementText = groupElement.getText()
enum1 = elementText.createEnumeration()
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService("com.sun.star.text.Paragraph") Then
enum2 = enum1Element.createEnumeration
While enum2.hasMoreElements
thisPortion = enum2.nextElement
If Len(thisPortion.String) > 0 Then
fontName = thisPortion.CharFontName
If NOT fontIsAlreadyFound(fontNames, fontName) Then
AddToArray(fontNames, fontName)
EndIf
EndIf
Wend
EndIf
Wend
EndIf
Next k
EndIf
2020-07-12 14:55:40 +02:00
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) > -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 <= 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 > 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
2020-07-12 16:34:42 +02:00
Function getCharsInFont(fontName As String) As String
2020-07-12 14:55:40 +02:00
Dim resultArray() As String
2020-07-12 16:34:42 +02:00
Dim pageNums() As Long
2020-07-12 14:55:40 +02:00
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
2020-11-07 20:27:10 +01:00
Dim fontChar As String
2020-07-26 12:46:10 +02:00
Dim groupCount As Long
Dim groupElement As Object
2020-11-07 20:27:10 +01:00
Dim charString As String
Dim charNum As Long
2020-07-12 14:55:40 +02:00
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)
2020-07-26 11:21:47 +02:00
If element.supportsService("com.sun.star.drawing.Text") Then
elementText = element.getText()
enum1 = elementText.createEnumeration()
While enum1.hasMoreElements
2020-07-12 14:55:40 +02:00
enum1Element = enum1.nextElement
If enum1Element.supportsService("com.sun.star.text.Paragraph") 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
2020-11-07 20:27:10 +01:00
charString = Mid(resultString,k+1,1)
charNum = Asc(charString)
fontChar = Hex(charNum)
2020-07-12 14:55:40 +02:00
If NOT IsInArray(resultArray,fontChar) Then
AddToArray(resultArray(), fontChar)
2020-07-12 16:34:42 +02:00
AddToArray(pageNums(), i + 1)
2020-07-12 14:55:40 +02:00
EndIf
Next k
EndIf
Wend
EndIf
2020-07-26 11:21:47 +02:00
Wend
2020-07-26 12:46:10 +02:00
EndIf
If element.supportsService("com.sun.star.drawing.GroupShape") Then
groupCount = element.getCount()
For k = 0 To groupCount - 1
groupElement = element.getByIndex(k)
If groupElement.supportsService("com.sun.star.drawing.Text") Then
elementText = groupElement.getText()
enum1 = elementText.createEnumeration()
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService("com.sun.star.text.Paragraph") 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
2020-07-12 14:55:40 +02:00
Next j
Next i
resultString = ""
For i = LBound(resultArray) To UBound(resultArray)
2020-07-12 16:34:42 +02:00
resultString = resultString & "<a href='https://unicode-table.com/ru/" & resultArray(i) & "'" & ">https://unicode-table.com/ru/" & resultArray(i) & "</a> " & getTranslation("charFirstPage") & " " & pageNums(i) & "<br>" & Chr(10)
2020-07-12 14:55:40 +02:00
Next i
If resultString <> "" Then
'MsgBox "Символы в шрифте "& fontName &Chr(10)&resultString
Dim FileName As String 'Holds the file name
Dim n As Integer 'Holds the file number
Dim f As Integer 'Index variable
Dim s As String 'Temporary string for input
2020-11-07 22:25:12 +01:00
Dim fileaccess As Object
Dim outtextstream As Object
Dim out As Object
2020-07-12 14:55:40 +02:00
Dim sTemp$
GlobalScope.BasicLibraries.loadLibrary("Tools")
path=DirectoryNameoutofPath(ThisComponent.getURL(),"/")
FileName = path & "/symbolsInFont" & fontName & ".html"
2020-11-07 22:25:12 +01:00
'n = FreeFile() 'Next free file number
'Open FileName For Output Access Read Write As #n 'Open for read/write
fileaccess = createUnoService ("com.sun.star.ucb.SimpleFileAccess")
outtextstream = createUnoService ("com.sun.star.io.TextOutputStream")
outtextstream.setEncoding( "UTF-8" )
out = fileaccess.openFileWrite( FileName )
outtextstream.setOutputStream( out )
outtextstream.writeString( "<html><head><title>" & getTranslation("symbolsInFontHeading") & " "& fontName & "</title></head><body><h2>" & getTranslation("symbolsInFontHeading") & " "& fontName &":</h2>"&resultString &"</body></html>" )
outtextstream.closeOutput()
2020-07-12 16:34:42 +02:00
getCharsInFont = FileName
Exit Function
2020-07-12 14:55:40 +02:00
Else
2020-07-12 16:34:42 +02:00
MsgBox getTranslation("symbolsInFontNotFound1") & " " & fontName & " " & getTranslation("symbolsInFontNotFound2")
getCharsInFont = ""
Exit Function
2020-07-12 14:55:40 +02:00
EndIf
2020-07-12 16:34:42 +02:00
End Function
2021-06-06 21:51:13 +02:00
Function findBadCharacters() As Boolean
Dim founds As Object
2021-06-07 01:49:50 +02:00
Dim foundObjects() As Object
2021-06-06 22:26:53 +02:00
founds = findInDoc("[\uE000-\uF8FF]+")
2021-06-06 21:51:13 +02:00
findBadCharacters = false
If founds.count <> 0 Then
MsgBox getTranslation("validationBadSymbolsNotification")
2021-06-07 01:49:50 +02:00
foundObjects = convertXIndexAccessToArray(founds)
startNavigatorDialog(getTranslation("badSymbols"),foundObjects)
2021-06-06 21:51:13 +02:00
findBadCharacters = true
EndIf
End Function
2021-06-04 22:28:27 +02:00
Function findColoredBackgroundInDoc() As Boolean
2021-06-04 20:42:13 +02:00
Dim founds As Object
Dim sDesc As Object
2021-06-07 01:49:50 +02:00
Dim foundObjects() As Object
2021-06-04 20:42:13 +02:00
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
SrchAttributes(0).Name = "CharBackTransparent"
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)
2021-06-04 22:28:27 +02:00
findColoredBackgroundInDoc = false
2021-06-04 20:42:13 +02:00
If founds.count <> 0 Then
2021-06-04 22:28:27 +02:00
MsgBox getTranslation("foundColoredTextMessage")
2021-06-07 01:49:50 +02:00
foundObjects = convertXIndexAccessToArray(founds)
startNavigatorDialog(getTranslation("coloredTextDescription"),foundObjects)
2021-06-04 22:28:27 +02:00
findColoredBackgroundInDoc = true
2021-06-04 20:42:13 +02:00
EndIf
2021-06-04 22:28:27 +02:00
End Function
2021-06-04 20:42:13 +02:00
2021-06-07 01:49:50 +02:00
Sub startNavigatorDialog(objectsDescription As String,foundObjects() As Object)
2021-06-04 20:42:13 +02:00
Dim dialog As Object
Dim leftImageURL As String
Dim rightImageURL As String
2021-06-04 22:28:27 +02:00
Dim curNum As Long
Dim maxNum As Long
Dim found As Object
Dim oViewCursor As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
2021-06-04 20:42:13 +02:00
waitingForDialog = true
2021-06-07 01:49:50 +02:00
maxNum = UBound(foundObjects)
2021-06-04 20:42:13 +02:00
dialog = notModalDialog("Navigator")
2021-06-04 22:28:27 +02:00
dialog.getControl("found").SetText(getTranslation("navigatorFound") & CStr(maxNum+1))
curNum = 0
2021-06-07 01:49:50 +02:00
found = foundObjects(curNum)
2021-06-04 22:28:27 +02:00
dialog.getControl("current").SetText(CStr(curNum+1))
dialog.getControl("description").SetText(objectsDescription)
2021-06-04 20:42:13 +02:00
' dialog.getControl("cancel").Label = getTranslation("buttonCancel")
dialog.getControl("close").Label = getTranslation("buttonClose")
leftImageURL = convertToURL(getExtensionPath() & "/images/left-navigator.svg")
rightImageURL = convertToURL(getExtensionPath() & "/images/right-navigator.svg")
dialog.getControl("prev").model.imageURL = leftImageURL
'dialog.getControl("prev").model.ScaleMode = 2
dialog.getControl("next").model.imageURL = rightImageURL
'dialog.getControl("next").model.ScaleMode = 2
dialog.setvisible(true)
2021-06-04 22:28:27 +02:00
oViewCursor.goToRange(found,false)
2021-06-04 20:42:13 +02:00
Do While waitingForDialog
If dialog.getControl("close").model.state = 1 then
exit Do
EndIf
If dialog.getControl("prev").model.state = 1 then
2021-06-04 22:28:27 +02:00
curNum = getPrevFound(curNum, maxNum)
2021-06-07 01:49:50 +02:00
found = foundObjects(curNum)
2021-06-04 22:28:27 +02:00
oViewCursor.goToRange(found,false)
dialog.getControl("current").SetText(CStr(curNum+1))
dialog.getControl("prev").model.state = 0
2021-06-04 20:42:13 +02:00
EndIf
If dialog.getControl("next").model.state = 1 then
2021-06-04 22:28:27 +02:00
curNum = getNextFound(curNum, maxNum)
2021-06-07 01:49:50 +02:00
found = foundObjects(curNum)
2021-06-04 22:28:27 +02:00
oViewCursor.goToRange(found,false)
dialog.getControl("current").SetText(CStr(curNum+1))
dialog.getControl("next").model.state = 0
2021-06-04 20:42:13 +02:00
EndIf
wait (100)
Loop
dialog.dispose
End Sub
2021-06-07 01:49:50 +02:00
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
2021-06-04 22:28:27 +02:00
Function getNextFound(curNum As Long, max As Long) As Long
If curNum < 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
2021-06-04 20:42:13 +02:00
Function getExtensionPath() As String
Dim extensionIdentifier As String
Dim pip As Object
extensionIdentifier = "pro.litvinovg.Redaction"
pip = GetDefaultContext.getByName("/singletons/com.sun.star.deployment.PackageInformationProvider")
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 = "vnd.sun.star.script:Redaction." & dialogName & "?location=application"
windowProvider = CreateUnoService("com.sun.star.awt.ContainerWindowProvider")
dialog = windowProvider.createContainerWindow(dialogUrl, "", containerWindow, handler)
notModalDialog = dialog
End Function
2020-07-12 14:55:40 +02:00
2020-07-12 16:34:42 +02:00
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("com.sun.star.frame.DispatchHelper")
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "URL"
args1(0).Value = fileName
args1(1).Name = "FilterName"
args1(1).Value = "HTML (StarWriter)"
dispatcher.executeDispatch(document, ".uno:Open", "", 0, args1())
If FileExists(tmpName) Then
Kill(tmpName)
End If
End Sub
2021-06-06 21:51:13 +02:00
Function isInDoc(searchString As String) As Boolean
Dim founds As Variant
founds = findInDoc(searchString)
If founds.count <> 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
2021-06-06 22:26:53 +02:00
</script:module>
