litvinovg/cleanandvalidate
1
0
Fork 0
Code Issues 4 Pull requests Projects Releases 50 Packages Wiki Activity Actions

Font symbols report

Browse source
This commit is contained in:
Georgy Litvinov 2020-07-12 16:34:42 +02:00
parent 81ea41e5c9
commit 7ab49f99e3
6 changed files with 122 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

56
Redaction/Validation.xba
View file

@ -1,6 +1,6 @@
<?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
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Validation" script:language="StarBasic">Sub markval12
End Sub
@ -562,10 +562,15 @@ Sub fontReportButton
Dim targetFontName As String
targetFontName = fontDialog.model.Tag
If targetFontName=&quot;0&quot; or targetFontName=&quot;&quot; Then
statusIndicator.end()
Exit sub
EndIf
getCharsInFont(targetFontName)
Dim FileName As String
FileName = getCharsInFont(targetFontName)
statusIndicator.end()
If FileName &lt;&gt; &quot;&quot; Then
openReport(FileName)
EndIf
End Sub
Sub onSelectFont(oEvent)
@ -605,9 +610,11 @@ Function getODGFontNames() As Variant
enum2 = enum1Element.createEnumeration
While enum2.hasMoreElements
thisPortion = enum2.nextElement
fontName = thisPortion.CharFontName
If NOT fontIsAlreadyFound(fontNames, fontName) Then
If Len(thisPortion.String) &gt; 0 Then
fontName = thisPortion.CharFontName
If NOT fontIsAlreadyFound(fontNames, fontName) Then
AddToArray(fontNames, fontName)
EndIf
EndIf
Wend
EndIf
@ -673,8 +680,9 @@ Sub addToArray(xArray(),vNextElement)
xArray(iUB) = vNextElement
End Sub
Sub getCharsInFont(fontName As String)
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
@ -712,6 +720,7 @@ Sub getCharsInFont(fontName As String)
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
@ -722,7 +731,7 @@ Sub getCharsInFont(fontName As String)
Next i
resultString = &quot;&quot;
For i = LBound(resultArray) To UBound(resultArray)
resultString = resultString &amp; &quot;&lt;a href=&apos;https://unicode-table.com/ru/&quot; &amp; resultArray(i) &amp; &quot;&apos;&quot; &amp; &quot;&gt;https://unicode-table.com/ru/&quot; &amp; resultArray(i) &amp; &quot;&lt;/a&gt;&lt;br&gt;&quot; &amp; Chr(10)
resultString = resultString &amp; &quot;&lt;a href=&apos;https://unicode-table.com/ru/&quot; &amp; resultArray(i) &amp; &quot;&apos;&quot; &amp; &quot;&gt;https://unicode-table.com/ru/&quot; &amp; resultArray(i) &amp; &quot;&lt;/a&gt; &quot; &amp; getTranslation(&quot;charFirstPage&quot;) &amp; &quot; &quot; &amp; pageNums(i) &amp; &quot;&lt;br&gt;&quot; &amp; Chr(10)
Next i
If resultString &lt;&gt; &quot;&quot; Then
@ -737,12 +746,35 @@ Sub getCharsInFont(fontName As String)
FileName = path &amp; &quot;/symbolsInFont&quot; &amp; fontName &amp; &quot;.html&quot;
n = FreeFile() &apos;Next free file number
Open FileName For Output Access Read Write As #n &apos;Open for read/write
Print #n, &quot;&lt;html&gt;&lt;body&gt;&lt;p&gt;Symbols in font &quot;&amp; fontName &amp;&quot;:&lt;/p&gt;&quot;&amp;resultString &amp;&quot;&lt;/body&gt;&lt;html&gt;&quot;
Print #n, &quot;&lt;html&gt;&lt;head&gt;&lt;title&gt;&quot; &amp; getTranslation(&quot;symbolsInFontHeading&quot;) &amp; &quot; &quot;&amp; fontName &amp; &quot;&lt;/title&gt;&lt;/head&gt;&lt;body&gt;&lt;h2&gt;&quot; &amp; getTranslation(&quot;symbolsInFontHeading&quot;) &amp; &quot; &quot;&amp; fontName &amp;&quot;:&lt;/h2&gt;&quot;&amp;resultString &amp;&quot;&lt;/body&gt;&lt;/html&gt;&quot;
Close #n
MsgBox &quot;Отчёт о найденных символах в шрифте &quot;&amp; fontName &amp;&quot; можно открыть в &quot; &amp; FileName
Else
MsgBox &quot;Символов в шрифте &quot; &amp; fontName &amp; &quot; найдено не было&quot;
EndIf
End Sub
getCharsInFont = FileName
Exit Function
Else
MsgBox getTranslation(&quot;symbolsInFontNotFound1&quot;) &amp; &quot; &quot; &amp; fontName &amp; &quot; &quot; &amp; getTranslation(&quot;symbolsInFontNotFound2&quot;)
getCharsInFont = &quot;&quot;
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(&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
</script:module>