diff --git a/Redaction/ChooseFontname.xdl b/Redaction/ChooseFontname.xdl new file mode 100644 index 0000000..c6ab297 --- /dev/null +++ b/Redaction/ChooseFontname.xdl @@ -0,0 +1,10 @@ + + + + + + + + + + \ No newline at end of file diff --git a/Redaction/Translations.xba b/Redaction/Translations.xba index 876b519..a303c0b 100644 --- a/Redaction/Translations.xba +++ b/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 diff --git a/Redaction/Validation.xba b/Redaction/Validation.xba index f3b8411..211e9a9 100644 --- a/Redaction/Validation.xba +++ b/Redaction/Validation.xba @@ -1,6 +1,6 @@ -Sub markval10 +Sub markval11 End Sub @@ -539,4 +539,210 @@ Private Sub StopTracking 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 + \ No newline at end of file diff --git a/Redaction/dialog.xlb b/Redaction/dialog.xlb index 3f33e13..bb3cd32 100644 --- a/Redaction/dialog.xlb +++ b/Redaction/dialog.xlb @@ -5,4 +5,5 @@ + \ No newline at end of file diff --git a/translations.ods b/translations.ods index 647e815..026d3b3 100644 Binary files a/translations.ods and b/translations.ods differ