Private Sub markHyph4 End sub Private Sub convertHyphInDoc() Dim description As String Dim allNotes As Object dim aNote As Object description = getTranslation("hyphenationConfirmation") If NOT confirm(description) Then Exit Sub EndIf Dim statusIndicator as Object statusIndicator = ThisComponent.getCurrentController.StatusIndicator statusIndicator.Start(getTranslation("hyphenationsInProgress"),10) turnOffTracking AcceptAllTrackedChanges convertHyphInText(ThisComponent.Text) ' Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) statusIndicator.Start(getTranslation("hyphenationsInProgress"),70) allNotes = ThisComponent.FootNotes For x = 0 to allNotes.Count -1 aNote = allNotes.getByIndex(x) convertHyphInText(aNote.Text) Next 'disableAutoHyph() statusIndicator.end() MsgBox getTranslation("hyphenationsSuccess") End Sub Private sub disableAutoHyph() Dim propertySetInfo As Object Dim oPositionOfMatch As Long Dim oFamilies As Object Dim sElements() As String Dim oFamily As Object Dim oStyle As Object Dim j As Integer oFamilies = ThisComponent.StyleFamilies sElements() = oFamilies.getElementNames() oFamily = oFamilies.getByName(sElements(1)) For j = 0 to oFamily.getCount -1 oStyle = oFamily.getByIndex(j) propertySetInfo = oStyle.getPropertySetInfo() If propertySetInfo.hasPropertyByName("ParaIsHyphenation") Then oStyle.ParaIsHyphenation = false EndIf Next End Sub Private Sub convertHyphInText(textElement As Object) Dim enum1Element As Object Dim enum1 As Object Dim i As Integer Dim cell As Object Dim cellNames() As Object Dim cellText As Object enum1 = textElement.createEnumeration() While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then convertParaHyphens(enum1Element) 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() convertHyphInText(cellText) Next i Else EndIf Wend End Sub Private Sub convertParaHyphens(para As Object) Dim lineEnds() As Object Dim autoHyphens() As Object Dim autoBreaks() As Object Dim lineNumbers() As Integer ' Dim lineShifts() As Integer Dim charNum as Integer Dim lineLength As Integer Dim lineCursor As Object Dim i As Integer Dim vCurs As Object Dim tCurs As Object Dim lineCurs As Object Dim lastChar As String Dim nextChar As String 'No hyphenation needed If para.ParaIsHyphenation = false Then Exit Sub EndIf vCurs = ThisComponent.currentController.getViewCursor() vCurs.goToRange(para.Start,false) tCurs = para.Text.createTextCursorByRange(vCurs) tCurs.goToStartOfParagraph(false) vCurs.goToRange(tCurs,false) i = 0 Do While NOT tCurs.isEndOfParagraph() OR NOT tCurs.isStartOfParagraph() vCurs.gotoEndOfLine(false) lineCursor = para.Text.createTextCursorByRange(vCurs.End) lineCursor.goToRange(tCurs,true) lineLength = Len(lineCursor.String) vCurs.collapseToEnd() i = i + 1 tCurs.goToRange(vCurs.End,false) If (tCurs.isEndOfParagraph()) Then Exit Do EndIf lastChar = getPrevChar(tCurs) nextChar = getNextChar(tCurs) If Len(nextChar) > 0 Then charNum = Asc(nextChar) If charNum > 767 AND charNum < 880 THen tCurs.goRight(1,false) lastChar = getPrevChar(tCurs) nextChar = getNextChar(tCurs) EndIf EndIf If needHyphen(lastChar,nextChar,lineLength) Then addToArray(autoHyphens(),tCurs.Text.createTextCursorByRange(tCurs)) addToArray(lineNumbers(),i) ' addToArray(lineShifts(),1) 'replaceHyphen(tCurs,vCurs) ElseIf needLineBreak(lastChar,newChar) Then addToArray(autoBreaks(),tCurs.Text.createTextCursorByRange(tCurs)) ' addToArray(lineShifts(),1) Else ' addToArray(lineShifts(),0) EndIf addToArray(lineEnds(),tCurs.Text.createTextCursorByRange(tCurs)) tCurs.goRight(1,false) vCurs.goToRange(tCurs,false) Loop If Ubound(autoBreaks) <> -1 Then For i = 0 To (Ubound(autoBreaks)) insertBreak(autoBreaks(i)) Next i EndIf para.ParaIsHyphenation = false If Ubound(autoHyphens) <> -1 Then For i = 0 To (Ubound(autoHyphens)) replaceHyphen(autoHyphens(i),lineNumbers(i)) Next i EndIf verifyHyphenation(lineEnds) End Sub Private Sub verifyHyphenation(lineEnds() As Object) Dim i As Integer If Lbound(lineEnds) > Ubound(lineEnds) Then Exit Sub EndIf Dim vCurs As Object vCurs = ThisComponent.currentController.getViewCursor() For i = (Lbound(lineEnds)) To (Ubound(lineEnds)) vCurs.goToRange(lineEnds(i),false) If NOT (vCurs.isAtEndOfLine() OR vCurs.isAtStartOfLine()) Then MsgBox getTranslation("hyphenationsFailed") Stop EndIf Next i ' dim description as String ' description = "Проверка прошла успешно" ' If NOT confirm(description) Then ' Stop ' EndIf End Sub Private Sub insertBreak(tCursor As Object) 'U+200B Zero length space tCursor.String = "​" End Sub Private Function getPrevChar(tCurs As Object) As String tCurs.goLeft(1,true) getPrevChar = tCurs.getString() tCurs.goRight(1,false) End Function Private Function getNextChar(tCurs As Object) As String tCurs.goRight(1,true) getNextChar = tCurs.getString() tCurs.goLeft(1,false) End Function Private Sub replaceHyphen(tCurs As Object,lineNumber As Integer) Dim curLineNum As Integer Dim vCurs As Object Dim tLine As Object vCurs = ThisComponent.currentController.getViewCursor() 'insert soft hyphen character U+00AD tCurs.Text.insertControlCharacter(tCurs.End,com.sun.star.text.ControlCharacter.SOFT_HYPHEN,true) vCurs.goToRange(tCurs.End,false) If vCurs.isAtEndOfLine() = false AND vCurs.isAtStartOfLine() = false Then curLineNum = getParaLineNumber(vCurs) If curLineNum > lineNumber Then compressLine(tCurs) Else stretchLine(tCurs) EndIf EndIf If vCurs.isAtEndOfLine() = false AND vCurs.isAtStartOfLine() = false Then MsgBox getTranslation("hyphenationsFailed") Stop EndIf End Sub Private Sub compressLine(tCurs As Object) Dim vCurs As Object Dim tLine As Object Dim kerning As Integer Dim lineLength As Integer Dim portions As Integer Dim portionSize As Integer Dim textPortions() As Object Dim startPosition As Object Dim tPortion As Object portions = 4 vCurs = ThisComponent.currentController.getViewCursor() vCurs.goToRange(tCurs,false) vCurs.goToStartOfLine(true) vCurs.goLeft(1,true) vCurs.goToStartOfLine(true) tLine = vCurs.Text.createTextCursorByRange(vCurs) lineLength = Len(tLine.String) startPosition = tLine.End If lineLength >= 20 Then portionSize = lineLength/portions For i = 0 To portions - 2 tPortion = vCurs.Text.createTextCursorByRange(startPosition) tPortion.goLeft(portionSize,true) addToArray(textPortions(),tPortion) startPosition = tPortion.End Next i tPortion = vCurs.Text.createTextCursorByRange(startPosition) tPortion.goToRange(tLine.Start,true) addToArray(textPortions(),tPortion) Else addToArray(textPortions(),tLine) EndIf vCurs.goToRange(tCurs,false) kerning = 10 tLine.CharKerning = kerning If lineLength > 8 Then Do While vCurs.isAtEndOfLine() = false AND vCurs.isAtStartOfLine() = false kerning = kerning - 1 For i = (Lbound(textPortions)) To (Ubound(textPortions)) textPortions(i).CharKerning = kerning vCurs.goToRange(tCurs,false) If vCurs.isAtEndOfLine() = true OR vCurs.isAtStartOfLine() = true Then Exit Do EndIf Next i If kerning < -15 Then Exit Do EndIf Loop Else Do While vCurs.isAtEndOfLine() = false AND vCurs.isAtStartOfLine() = false kerning = kerning - 1 tLine.CharKerning = kerning vCurs.goToRange(tCurs,false) If kerning < -15 Then Exit Do EndIf Loop EndIf End Sub Private Sub stretchLine(tCurs As Object) Dim vCurs As Object Dim tLine As Object Dim kerning As Integer vCurs = ThisComponent.currentController.getViewCursor() vCurs.goToRange(tCurs,false) vCurs.goToStartOfLine(true) tLine = vCurs.Text.createTextCursorByRange(vCurs) vCurs.goToRange(tCurs,false) kerning = -10 tLine.CharKerning = kerning Do While vCurs.isAtEndOfLine() = false AND vCurs.isAtStartOfLine() = false kerning = kerning + 1 tLine.CharKerning = kerning vCurs.goToRange(tCurs,false) If tLine.CharKerning > 15 Then Exit Do EndIf Loop End Sub Private Function getParaLineNumber(vCursor As Object) As Integer Dim lineNumber As Integer Dim oSavePosition As Object Dim tCursor As Object oSavePosition = vCursor.Text.createTextCursorByRange(vCursor) tCursor = vCursor.Text.createTextCursorByRange(vCursor) lineNumber = 1 vCursor.gotoStartOfLine(false) tCursor.gotoRange(vCursor,false) Do While NOT tCursor.isStartOfParagraph() vCursor.goLeft(1,false) vCursor.gotoStartOfLine(false) tCursor.gotoRange(vCursor,false) lineNumber = lineNumber + 1 Loop vCursor.goToRange(oSavePosition,false) getParaLineNumber = lineNumber End Function Private Function needLineBreak(before,after) needLineBreak = false If before = "/" Then If after <> " " AND after <> Chr(10) Then needLineBreak = true EndIf EndIf End Function Sub insertLineBreak(tCurs) tCurs.Text.insertControlCharacter(tCurs.End,com.sun.star.text.ControlCharacter.LINE_BREAK,False) End Sub Private Function needHyphen(before As String, after As String,lineLength As Integer) As boolean Dim charNumBefore as Integer Dim charNumAfter as Integer needHyphen = true If lineLength < 2 Then needHyphen = false EndIf 'MsgBox Asc(newChar) 'Both are numbers If Len(before) > 0 Then charNumBefore = Asc(before) If charNumBefore > 47 AND charNumBefore < 58 Then If Len(after) > 0 Then charNumAfter = Asc(after) If charNumAfter > 47 AND charNumAfter < 58 Then needHyphen = false EndIf EndIf EndIf EndIf Select Case before Case " " needHyphen = false 'U+002D Hyphen minus Case "-" needHyphen = false 'U+2010 Hyphen Case "‐" needHyphen = false Case "­" needHyphen = false 'U+2014 Em dash Case "—" needHyphen = false 'U+2013 En dash Case "–" needHyphen = false 'U+2012 Figure Dash Case "‒" needHyphen = false Case "…" needHyphen = false Case "/" needHyphen = false End Select Select Case after Case " " needHyphen = false Case "-" needHyphen = false Case "­" needHyphen = false 'newline U+000A Case Chr(10) needHyphen = false End Select End Function Private sub AcceptAllTrackedChanges rem ---------------------------------------------------------------------- rem define variables dim document as object dim dispatcher as object rem ---------------------------------------------------------------------- rem get access to the document document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") rem ---------------------------------------------------------------------- dispatcher.executeDispatch(document, ".uno:AcceptAllTrackedChanges", "", 0, Array()) End sub Private Sub turnOffTracking document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") Dim args(0) as new com.sun.star.beans.PropertyValue args(0).Name = "TrackChanges" args(0).Value = false dispatcher.executeDispatch(document, ".uno:TrackChanges", "", 0, args()) End Sub Private Function confirm(description) If MsgBox (description, 4) =6 Then confirm = true Else confirm = false EndIf End Function Sub Macro1 End Sub