748 lines
No EOL
26 KiB
XML
748 lines
No EOL
26 KiB
XML
<?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 markval11
|
||
|
||
End Sub
|
||
|
||
Private Function isInDoc(searchString As String) As Boolean
|
||
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.SearchRegularExpression = true
|
||
sDesc.SearchString = searchString
|
||
founds = Thiscomponent.findAll(sDesc)
|
||
If founds.count <> 0 Then
|
||
isInDoc = true
|
||
Else
|
||
isInDoc = false
|
||
EndIf
|
||
End Function
|
||
|
||
Sub validateButton
|
||
Dim footnotesReport As String
|
||
Dim graphicsReport As String
|
||
Dim sectionsReport As String
|
||
Dim outlinePageStylesReport As String
|
||
Dim outlineInNotesReport As String
|
||
Dim oulineInTablesReport As String
|
||
Dim badText As Boolean
|
||
Dim badNumberings As Boolean
|
||
Dim needExtendedInfo As Boolean
|
||
Dim config As Object
|
||
config = initRedactionConfiguration()
|
||
|
||
Dim statusIndicator as Object
|
||
statusIndicator = ThisComponent.getCurrentController.statusIndicator
|
||
statusIndicator.Start(getTranslation("validationStarted"),100)
|
||
|
||
badText = false
|
||
badNumberings = false
|
||
footnotesReport = noteSingsCheck
|
||
statusIndicator.setValue(10)
|
||
graphicsReport = checkGraphics
|
||
statusIndicator.setValue(20)
|
||
sectionsReport = checkSectionsInTables
|
||
statusIndicator.setValue(30)
|
||
outlineInNotesReport = checkNotesOutline()
|
||
statusIndicator.setValue(40)
|
||
outlinePageStylesReport = checkHeadingsInHeadersFooters
|
||
statusIndicator.setValue(50)
|
||
oulineInTablesReport = checkHeadingsInTextTables
|
||
statusIndicator.setValue(60)
|
||
If outlineInNotesReport <> "" Then
|
||
MsgBox outlineInNotesReport
|
||
EndIf
|
||
If oulineInTablesReport <> "" Then
|
||
MsgBox oulineInTablesReport
|
||
EndIf
|
||
If outlinePageStylesReport <> "" Then
|
||
MsgBox outlinePageStylesReport
|
||
EndIf
|
||
|
||
If footnotesReport <> "" Then
|
||
MsgBox footnotesReport
|
||
EndIf
|
||
If graphicsReport <> "" Then
|
||
MsgBox graphicsReport
|
||
EndIf
|
||
If sectionsReport <> "" Then
|
||
MsgBox sectionsReport
|
||
EndIf
|
||
If isInDoc("[\uE000-\uF8FF]") Then
|
||
badText = true
|
||
EndIf
|
||
|
||
If config.getPropertyValue("complexity") = "makerUp" then
|
||
needExtendedInfo = true
|
||
Else
|
||
needExtendedInfo = false
|
||
EndIf
|
||
|
||
printNumberingSymbols(needExtendedInfo)
|
||
statusIndicator.setValue(80)
|
||
If badText OR badNumberings OR footnotesReport <> "" OR graphicsReport <> "" Or outlineInNotesReport <> "" Or sectionsReport <> "" OR oulineInTablesReport <> "" OR outlinePageStylesReport <> "" Then
|
||
MsgBox getTranslation("validationWarning")
|
||
If badText Then
|
||
MsgBox getTranslation("validationBadSymbolsNotification")
|
||
removeBadCharacters
|
||
EndIf
|
||
Else
|
||
MsgBox getTranslation("validationSuccess")
|
||
EndIf
|
||
statusIndicator.end()
|
||
End Sub
|
||
|
||
Private Function checkGraphics() As String
|
||
Dim drawPages As Object
|
||
Dim count as Integer
|
||
Dim draw As Object
|
||
Dim result As String
|
||
result = ""
|
||
Dim shapeType As String
|
||
Dim embeededObject As Object
|
||
Dim badFrame As Long
|
||
badFrame = 0
|
||
Dim drawingN As Long
|
||
drawingN = 0
|
||
drawPages = ThisComponent.DrawPage
|
||
Dim i As Integer
|
||
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
|
||
If InStr(shapeType,"FrameShape") = 1 Then
|
||
If draw.supportsService("com.sun.star.text.TextEmbeddedObject") Then
|
||
embeededObject = draw.getEmbeddedObject()
|
||
If IsNull(embeededObject) Then
|
||
badFrame = badFrame + 1
|
||
Else
|
||
If Not embeededObject.supportsService("com.sun.star.formula.FormulaProperties") Then
|
||
badFrame = badFrame + 1
|
||
Else
|
||
'Formula
|
||
EndIf
|
||
EndIf
|
||
EndIf
|
||
EndIf
|
||
Next i
|
||
If drawingN <> 0 Then
|
||
result = result & getTranslation("validationBadDrawings") & drawingN & getTranslation("validationExcerptNotSuitable") & chr(10)
|
||
EndIf
|
||
If badFrame <> 0 Then
|
||
result = result & getTranslation("validationBadEmbeededObjects") & badFrame & getTranslation("validationExcerptNotSuitable") & chr(10)
|
||
EndIf
|
||
checkGraphics = result
|
||
End Function
|
||
|
||
Private Sub removeBadCharacters
|
||
StartTracking
|
||
AskAndReplace("[\uE000-\uF8FF]+","")
|
||
StopTracking
|
||
showTrackedChanges
|
||
End Sub
|
||
|
||
Private Function noteSingsCheck() As String
|
||
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
|
||
result = ""
|
||
footnotes = ThisComponent.footnotes
|
||
endnotes = ThisComponent.Footnotes
|
||
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 >= 57344 AND char <= 63743 then
|
||
result = result & getTranslation("validateFootnotes1") & " " & Chr(char) & " " & getTranslation("validateFootnotes2") & " " & i & " " & getTranslation("validateFootnotes3") & 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 >= 57344 AND char <= 63743 then
|
||
result = result & getTranslation("validateFootnotes1") & " " & Chr(char) & " " & getTranslation("validateEndnotes1") & " " & i & " " & getTranslation("validateFootnotes3") & chr(10)
|
||
End If
|
||
Next j
|
||
Next i
|
||
noteSingsCheck = result
|
||
End Function
|
||
|
||
Function checkNotesOutline As String
|
||
Dim oDescriptor As Object
|
||
Dim footNotes As Object
|
||
Dim endNotes As Object
|
||
Dim x As Integer
|
||
Dim aNote As Object
|
||
Dim oEnum As Object
|
||
Dim oCurPar As Object
|
||
Dim result As String
|
||
result = ""
|
||
footNotes = thisComponent.footNotes
|
||
endNotes = thisComponent.EndNotes
|
||
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
|
||
|
||
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
|
||
|
||
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
|
||
|
||
Function checkHeadingsInTextTables(oText As Object) As String
|
||
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
|
||
|
||
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
|
||
|
||
Private Sub printNumberingSymbols(needExtendedInfo)
|
||
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
|
||
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
|
||
If fontChar <> "" Then
|
||
tmp = getTranslation("validateNumberingLevel") &" " & (j + 1) & " " & getTranslation("validateNumberingFont") & " " & fontName & " " & getTranslation("validateNumberingSymbol") & " " & fontChar & " (" & Hex(Asc(fontChar)) & ") "& Left(excerpt,exLength) & chr(10)
|
||
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
|
||
EndIf
|
||
EndIf
|
||
EndIf
|
||
EndIf
|
||
Loop
|
||
|
||
report = ""
|
||
If result = "" AND resultBad = "" Then
|
||
Exit sub
|
||
Else
|
||
If resultBad <> "" Then
|
||
report = getTranslation("validateNumberingsReportSymbols") & chr(10) & resultBad
|
||
EndIf
|
||
If result <> "" Then
|
||
report = report & getTranslation("validateNumberingsReportFonts") & " "& chr(10)& result
|
||
EndIf
|
||
EndIf
|
||
MsgBox report
|
||
End Sub
|
||
|
||
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
|
||
Dim dispatcher As Object
|
||
Dim document As Object
|
||
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
|
||
Dim dispatcher As Object
|
||
Dim document As Object
|
||
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 = false
|
||
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
|
||
|
||
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
|
||
Exit sub
|
||
EndIf
|
||
getCharsInFont(targetFontName)
|
||
statusIndicator.end()
|
||
End Sub
|
||
|
||
Sub onSelectFont(oEvent)
|
||
fontDialog.endExecute()
|
||
fontDialog.model.Tag = oEvent.ActionCommand
|
||
End Sub
|
||
|
||
Function getODGFontNames() As Variant
|
||
Dim fontNames() 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 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)
|
||
elementText = element.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
|
||
fontName = thisPortion.CharFontName
|
||
If NOT fontIsAlreadyFound(fontNames, fontName) Then
|
||
AddToArray(fontNames, fontName)
|
||
EndIf
|
||
Wend
|
||
EndIf
|
||
Wend
|
||
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
|
||
|
||
Sub getCharsInFont(fontName As String)
|
||
Dim resultArray() As String
|
||
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 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)
|
||
elementText = element.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)
|
||
EndIf
|
||
Next k
|
||
EndIf
|
||
Wend
|
||
EndIf
|
||
Wend
|
||
Next j
|
||
Next i
|
||
resultString = ""
|
||
For i = LBound(resultArray) To UBound(resultArray)
|
||
resultString = resultString & "<a href='https://unicode-table.com/ru/" & resultArray(i) & "'" & ">https://unicode-table.com/ru/" & resultArray(i) & "</a><br>" & Chr(10)
|
||
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
|
||
Dim sTemp$
|
||
GlobalScope.BasicLibraries.loadLibrary("Tools")
|
||
path=DirectoryNameoutofPath(ThisComponent.getURL(),"/")
|
||
FileName = path & "/symbolsInFont" & fontName & ".html"
|
||
n = FreeFile() 'Next free file number
|
||
Open FileName For Output Access Read Write As #n 'Open for read/write
|
||
Print #n, "<html><body><p>Symbols in font "& fontName &":</p>"&resultString &"</body><html>"
|
||
Close #n
|
||
MsgBox "Отчёт о найденных символах в шрифте "& fontName &" можно открыть в " & FileName
|
||
Else
|
||
MsgBox "Символов в шрифте " & fontName & " найдено не было"
|
||
EndIf
|
||
End Sub
|
||
|
||
</script:module> |