Font symbols report

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

View file

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Configuration" script:language="StarBasic" script:moduleType="normal">Public Const redactionExtensionName As String = &quot;cleanAndValidate&quot; <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Configuration" script:language="StarBasic" script:moduleType="normal">Public Const redactionExtensionName As String = &quot;cleanAndValidate&quot;
Public Const redactionExtensionVersion = &quot;0.9.1&quot; Public Const redactionExtensionVersion = &quot;0.9.2&quot;
Function initRedactionConfiguration() Function initRedactionConfiguration()
On Error Goto exceptionHandler On Error Goto exceptionHandler
Dim regFactory As Object Dim regFactory As Object

View file

@ -242,6 +242,21 @@ Function getRussian(identifier As String) As String
Case &quot;chooseFontNameDialogDescription&quot; Case &quot;chooseFontNameDialogDescription&quot;
getRussian = &quot;Дважды кликните левой клавишей мыши на имя шрифта&quot; getRussian = &quot;Дважды кликните левой клавишей мыши на имя шрифта&quot;
Exit Function Exit Function
Case &quot;fontReportInProgress&quot;
getRussian = &quot;Составление отчёта о шрифте. Пожалуйста, подождите.&quot;
Exit Function
Case &quot;symbolsInFontHeading&quot;
getRussian = &quot;Символы в шрифте&quot;
Exit Function
Case &quot;symbolsInFontNotFound1&quot;
getRussian = &quot;Символов в шрифте&quot;
Exit Function
Case &quot;symbolsInFontNotFound2&quot;
getRussian = &quot;найдено не было.&quot;
Exit Function
Case &quot;charFirstPage&quot;
getRussian = &quot;Найден на стр.&quot;
Exit Function
Case Else Case Else
getRussian = &quot;Перевод не найден&quot; getRussian = &quot;Перевод не найден&quot;
End Select End Select
@ -466,6 +481,21 @@ Function getEnglish(identifier As String) As String
Case &quot;chooseFontNameDialogDescription&quot; Case &quot;chooseFontNameDialogDescription&quot;
getEnglish = &quot;Double-click the font name with the left mouse button.&quot; getEnglish = &quot;Double-click the font name with the left mouse button.&quot;
Exit Function Exit Function
Case &quot;fontReportInProgress&quot;
getEnglish = &quot;Preparing report. Please wait.&quot;
Exit Function
Case &quot;symbolsInFontHeading&quot;
getEnglish = &quot;Characters in font&quot;
Exit Function
Case &quot;symbolsInFontNotFound1&quot;
getEnglish = &quot;No characters in font&quot;
Exit Function
Case &quot;symbolsInFontNotFound2&quot;
getEnglish = &quot;found.&quot;
Exit Function
Case &quot;charFirstPage&quot;
getEnglish = &quot;Found on page&quot;
Exit Function
Case Else Case Else
getEnglish = &quot;No translation&quot; getEnglish = &quot;No translation&quot;
End Select End Select
@ -689,6 +719,21 @@ Function getCroatian(identifier As String) As String
Case &quot;chooseFontNameDialogDescription&quot; Case &quot;chooseFontNameDialogDescription&quot;
getCroatian = &quot;Dvaput kliknite naziv fonta lijevom tipkom miša.&quot; getCroatian = &quot;Dvaput kliknite naziv fonta lijevom tipkom miša.&quot;
Exit Function Exit Function
Case &quot;fontReportInProgress&quot;
getCroatian = &quot;Izvještavanje o fontu. Molimo pričekajte.&quot;
Exit Function
Case &quot;symbolsInFontHeading&quot;
getCroatian = &quot;Znakovi fonta&quot;
Exit Function
Case &quot;symbolsInFontNotFound1&quot;
getCroatian = &quot;Znakovi fonta&quot;
Exit Function
Case &quot;symbolsInFontNotFound2&quot;
getCroatian = &quot;nije pronađeno&quot;
Exit Function
Case &quot;charFirstPage&quot;
getCroatian = &quot;Pronađeno na stranici&quot;
Exit Function
Case Else Case Else
getCroatian = &quot;No translation&quot; getCroatian = &quot;No translation&quot;
End Select End Select
@ -912,6 +957,21 @@ Function getSerbian(identifier As String) As String
Case &quot;chooseFontNameDialogDescription&quot; Case &quot;chooseFontNameDialogDescription&quot;
getSerbian = &quot;Двапут кликните на назив фонта левим дугметом миша.&quot; getSerbian = &quot;Двапут кликните на назив фонта левим дугметом миша.&quot;
Exit Function Exit Function
Case &quot;fontReportInProgress&quot;
getSerbian = &quot;Припрема извештаја. Сачекајте.&quot;
Exit Function
Case &quot;symbolsInFontHeading&quot;
getSerbian = &quot;Знакови фонта&quot;
Exit Function
Case &quot;symbolsInFontNotFound1&quot;
getSerbian = &quot;Знакови фонта&quot;
Exit Function
Case &quot;symbolsInFontNotFound2&quot;
getSerbian = &quot;није пронађено&quot;
Exit Function
Case &quot;charFirstPage&quot;
getSerbian = &quot;Пронађено на страници&quot;
Exit Function
Case Else Case Else
getSerbian = &quot;No translation&quot; getSerbian = &quot;No translation&quot;
End Select End Select
@ -1135,6 +1195,21 @@ Function getBosnian(identifier As String) As String
Case &quot;chooseFontNameDialogDescription&quot; Case &quot;chooseFontNameDialogDescription&quot;
getBosnian = &quot;Dvaput kliknite naziv fonta lijevom tipkom miša.&quot; getBosnian = &quot;Dvaput kliknite naziv fonta lijevom tipkom miša.&quot;
Exit Function Exit Function
Case &quot;fontReportInProgress&quot;
getBosnian = &quot;Izvještavanje o fontu. Molimo pričekajte.&quot;
Exit Function
Case &quot;symbolsInFontHeading&quot;
getBosnian = &quot;Znakovi fonta&quot;
Exit Function
Case &quot;symbolsInFontNotFound1&quot;
getBosnian = &quot;Znakovi fonta&quot;
Exit Function
Case &quot;symbolsInFontNotFound2&quot;
getBosnian = &quot;nije pronađeno&quot;
Exit Function
Case &quot;charFirstPage&quot;
getBosnian = &quot;Pronađeno na stranici&quot;
Exit Function
Case Else Case Else
getBosnian = &quot;No translation&quot; getBosnian = &quot;No translation&quot;
End Select End Select

View file

@ -1,6 +1,6 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <!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 End Sub
@ -562,10 +562,15 @@ Sub fontReportButton
Dim targetFontName As String Dim targetFontName As String
targetFontName = fontDialog.model.Tag targetFontName = fontDialog.model.Tag
If targetFontName=&quot;0&quot; or targetFontName=&quot;&quot; Then If targetFontName=&quot;0&quot; or targetFontName=&quot;&quot; Then
statusIndicator.end()
Exit sub Exit sub
EndIf EndIf
getCharsInFont(targetFontName) Dim FileName As String
FileName = getCharsInFont(targetFontName)
statusIndicator.end() statusIndicator.end()
If FileName &lt;&gt; &quot;&quot; Then
openReport(FileName)
EndIf
End Sub End Sub
Sub onSelectFont(oEvent) Sub onSelectFont(oEvent)
@ -605,10 +610,12 @@ Function getODGFontNames() As Variant
enum2 = enum1Element.createEnumeration enum2 = enum1Element.createEnumeration
While enum2.hasMoreElements While enum2.hasMoreElements
thisPortion = enum2.nextElement thisPortion = enum2.nextElement
If Len(thisPortion.String) &gt; 0 Then
fontName = thisPortion.CharFontName fontName = thisPortion.CharFontName
If NOT fontIsAlreadyFound(fontNames, fontName) Then If NOT fontIsAlreadyFound(fontNames, fontName) Then
AddToArray(fontNames, fontName) AddToArray(fontNames, fontName)
EndIf EndIf
EndIf
Wend Wend
EndIf EndIf
Wend Wend
@ -673,8 +680,9 @@ Sub addToArray(xArray(),vNextElement)
xArray(iUB) = vNextElement xArray(iUB) = vNextElement
End Sub End Sub
Sub getCharsInFont(fontName As String) Function getCharsInFont(fontName As String) As String
Dim resultArray() As String Dim resultArray() As String
Dim pageNums() As Long
Dim firstPages() As Long Dim firstPages() As Long
Dim resultString As String Dim resultString As String
Dim pages As Object Dim pages As Object
@ -712,6 +720,7 @@ Sub getCharsInFont(fontName As String)
fontChar = Hex(Asc(Mid(resultString,k+1,1))) fontChar = Hex(Asc(Mid(resultString,k+1,1)))
If NOT IsInArray(resultArray,fontChar) Then If NOT IsInArray(resultArray,fontChar) Then
AddToArray(resultArray(), fontChar) AddToArray(resultArray(), fontChar)
AddToArray(pageNums(), i + 1)
EndIf EndIf
Next k Next k
EndIf EndIf
@ -722,7 +731,7 @@ Sub getCharsInFont(fontName As String)
Next i Next i
resultString = &quot;&quot; resultString = &quot;&quot;
For i = LBound(resultArray) To UBound(resultArray) 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 Next i
If resultString &lt;&gt; &quot;&quot; Then 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; FileName = path &amp; &quot;/symbolsInFont&quot; &amp; fontName &amp; &quot;.html&quot;
n = FreeFile() &apos;Next free file number n = FreeFile() &apos;Next free file number
Open FileName For Output Access Read Write As #n &apos;Open for read/write 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 Close #n
MsgBox &quot;Отчёт о найденных символах в шрифте &quot;&amp; fontName &amp;&quot; можно открыть в &quot; &amp; FileName getCharsInFont = FileName
Exit Function
Else Else
MsgBox &quot;Символов в шрифте &quot; &amp; fontName &amp; &quot; найдено не было&quot; 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 If
End Sub End Sub
</script:module> </script:module>

View file

@ -1,4 +1,4 @@
def releaseVersion = "0.9.1" def releaseVersion = "0.9.2"
task oxt(type: Zip) { task oxt(type: Zip) {
dependsOn = [ 'setVersion','setVersionInBasicCode' ] dependsOn = [ 'setVersion','setVersionInBasicCode' ]
from './' from './'

View file

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?> <?xml version="1.0" encoding="UTF-8" standalone="no"?>
<description xmlns="http://openoffice.org/extensions/description/2006" xmlns:dep="http://openoffice.org/extensions/description/2006" xmlns:xlink="http://www.w3.org/1999/xlink"> <description xmlns="http://openoffice.org/extensions/description/2006" xmlns:dep="http://openoffice.org/extensions/description/2006" xmlns:xlink="http://www.w3.org/1999/xlink">
<identifier value="pro.litvinovg.Redaction"/> <identifier value="pro.litvinovg.Redaction"/>
<version value="0.9.1"/> <version value="0.9.2"/>
<platform value="all"/> <platform value="all"/>
<display-name> <display-name>
<name lang="en">Cleaning and validation documents for publishing in html and epub with pagination</name> <name lang="en">Cleaning and validation documents for publishing in html and epub with pagination</name>

Binary file not shown.