Analyze PDF

Redaction/ChooseFontname.xdl

@@ -0,0 +1,10 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
+<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="ChooseFontname" dlg:left="154" dlg:top="60" dlg:width="229" dlg:height="190" dlg:closeable="true" dlg:moveable="true">
+ <dlg:bulletinboard>
+  <dlg:menulist dlg:id="fontList" dlg:tab-index="0" dlg:left="2" dlg:top="32" dlg:width="225" dlg:height="156">
+   <script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Redaction.Validation.onSelectFont?language=Basic&amp;location=application" script:language="Script"/>
+  </dlg:menulist>
+  <dlg:text dlg:id="description" dlg:tab-index="1" dlg:left="2" dlg:top="4" dlg:width="225" dlg:height="24" dlg:value="dialog description"/>
+ </dlg:bulletinboard>
+</dlg:window>

Redaction/Translations.xba

@@ -236,6 +236,12 @@ Function getRussian(identifier As String) As String
       Case "validationStarted"
         getRussian = "Осуществляется проверка"
         Exit Function
+      Case "chooseFontNameDialogTitle"
+         getRussian = "Выбор шрифта для создания отчёта."
+         Exit Function
+      Case "chooseFontNameDialogDescription"
+         getRussian = "Дважды кликните левой клавишей мыши на имя шрифта"
+         Exit Function
 	  Case Else
 	    getRussian = "Перевод не найден"
 	End Select  
@@ -454,6 +460,12 @@ Function getEnglish(identifier As String) As String
       Case "validationStarted"
         getEnglish = "Validation in progess"
         Exit Function
+      Case "chooseFontNameDialogTitle"
+         getEnglish = "Select a font to create a report."
+         Exit Function
+      Case "chooseFontNameDialogDescription"
+         getEnglish = "Double-click the font name with the left mouse button."
+         Exit Function
 	  Case Else
 	    getEnglish = "No translation"
 	End Select  
@@ -671,6 +683,12 @@ Function getCroatian(identifier As String) As String
       Case "validationStarted"
         getCroatian = "Provjera u tijeku"
         Exit Function
+      Case "chooseFontNameDialogTitle"
+         getCroatian = "Odaberite font za stvaranje izvješća."
+         Exit Function
+      Case "chooseFontNameDialogDescription"
+         getCroatian = "Dvaput kliknite naziv fonta lijevom tipkom miša."
+         Exit Function
       Case Else
 	    getCroatian = "No translation"
 	End Select  
@@ -888,6 +906,12 @@ Function getSerbian(identifier As String) As String
       Case "validationStarted"
         getSerbian = "Провера у тијеку"
         Exit Function
+      Case "chooseFontNameDialogTitle"
+         getSerbian = "Изаберите фонт да бисте направили извештај."
+         Exit Function
+      Case "chooseFontNameDialogDescription"
+         getSerbian = "Двапут кликните на назив фонта левим дугметом миша."
+         Exit Function
       Case Else
 	    getSerbian = "No translation"
 	End Select  
@@ -1105,6 +1129,12 @@ Function getBosnian(identifier As String) As String
       Case "validationStarted"
         getBosnian = "Provjera u tijeku"
         Exit Function
+      Case "chooseFontNameDialogTitle"
+         getBosnian = "Odaberite font za stvaranje izvješća."
+         Exit Function
+      Case "chooseFontNameDialogDescription"
+         getBosnian = "Dvaput kliknite naziv fonta lijevom tipkom miša."
+         Exit Function
       Case Else
 	    getBosnian = "No translation"
 	End Select  

Redaction/Validation.xba

@@ -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 markval10
+<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Validation" script:language="StarBasic">Sub markval11
 
 End Sub
 
@@ -539,4 +539,210 @@ Private Sub StopTracking
 	dispatcher.executeDispatch(document, &quot;.uno:ShowTrackedChanges&quot;, &quot;&quot;, 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(&quot;fontReportInProgress&quot;),100)
+	
+	fontNames = getODGFontNames()
+    DialogLibraries.LoadLibrary(&quot;Redaction&quot;)
+    fontDialog = CreateUnoDialog( DialogLibraries.Redaction.ChooseFontname )
+    listBox = fontDialog.getControl(&quot;fontList&quot;)
+    listBox.addItems(fontNames , 0)
+    fontDialog.Title = getTranslation(&quot;chooseFontNameDialogTitle&quot;)
+    description = fontDialog.getControl(&quot;description&quot;)
+    description.SetText(getTranslation(&quot;chooseFontNameDialogDescription&quot;))
+   	statusIndicator.setValue(50)
+    fontDialog.Execute()
+    Dim targetFontName As String
+    targetFontName = fontDialog.model.Tag
+    If targetFontName=&quot;0&quot; or targetFontName=&quot;&quot; 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(&quot;com.sun.star.text.Paragraph&quot;) 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) &gt; -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 &lt;= 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 &gt; 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(&quot;com.sun.star.text.Paragraph&quot;) 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 = &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)
+	Next i
+	
+	If resultString &lt;&gt; &quot;&quot; Then
+		&apos;MsgBox &quot;Символы в шрифте &quot;&amp; fontName &amp;Chr(10)&amp;resultString
+		Dim FileName As String		&apos;Holds the file name
+		Dim n As Integer		&apos;Holds the file number
+		Dim f As Integer		&apos;Index variable
+		Dim s As String		&apos;Temporary string for input
+		Dim sTemp$
+		GlobalScope.BasicLibraries.loadLibrary(&quot;Tools&quot;)
+		path=DirectoryNameoutofPath(ThisComponent.getURL(),&quot;/&quot;)
+		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;
+		Close #n
+		MsgBox &quot;Отчёт о найденных символах в шрифте &quot;&amp; fontName &amp;&quot; можно открыть в &quot; &amp; FileName
+	Else
+		MsgBox &quot;Символов в шрифте &quot; &amp; fontName &amp; &quot; найдено не было&quot;
+	EndIf
+End Sub
+
 </script:module>

Redaction/dialog.xlb

@@ -5,4 +5,5 @@
  <library:element library:name="CleaningDialog"/>
  <library:element library:name="NoStyleFile"/>
  <library:element library:name="StartQuietCleaning"/>
+ <library:element library:name="ChooseFontname"/>
 </library:library>