784 lines
No EOL
28 KiB
XML
784 lines
No EOL
28 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 markval13
|
|
|
|
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
|
|
statusIndicator.end()
|
|
Exit sub
|
|
EndIf
|
|
Dim FileName As String
|
|
FileName = getCharsInFont(targetFontName)
|
|
statusIndicator.end()
|
|
If FileName <> "" Then
|
|
openReport(FileName)
|
|
EndIf
|
|
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)
|
|
If element.supportsService("com.sun.star.drawing.Text") Then
|
|
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 Len(thisPortion.String) > 0 Then
|
|
fontName = thisPortion.CharFontName
|
|
If NOT fontIsAlreadyFound(fontNames, fontName) Then
|
|
AddToArray(fontNames, fontName)
|
|
EndIf
|
|
EndIf
|
|
Wend
|
|
EndIf
|
|
Wend
|
|
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) > -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
|
|
|
|
Function getCharsInFont(fontName As String) 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 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("com.sun.star.drawing.Text") Then
|
|
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)
|
|
AddToArray(pageNums(), i + 1)
|
|
EndIf
|
|
Next k
|
|
EndIf
|
|
Wend
|
|
EndIf
|
|
Wend
|
|
EndIf
|
|
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> " & getTranslation("charFirstPage") & " " & pageNums(i) & "<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><head><title>" & getTranslation("symbolsInFontHeading") & " "& fontName & "</title></head><body><h2>" & getTranslation("symbolsInFontHeading") & " "& fontName &":</h2>"&resultString &"</body></html>"
|
|
Close #n
|
|
getCharsInFont = FileName
|
|
Exit Function
|
|
|
|
Else
|
|
MsgBox getTranslation("symbolsInFontNotFound1") & " " & fontName & " " & getTranslation("symbolsInFontNotFound2")
|
|
getCharsInFont = ""
|
|
Exit Function
|
|
EndIf
|
|
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("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
|
|
</script:module> |