litvinovg/epublishing
1
0
Fork 0
Code Issues Pull requests Projects Releases 33 Packages Wiki Activity Actions
epublishing/ePublishing/Hyphenations.xba

356 lines
10 KiB
Text
Raw Normal View History

Initial
2020-03-12 13:01:19 +01:00
<?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="Hyphenations" script:language="StarBasic">sub markHyph1
End sub
Sub convertHyphInDoc()
Dim statusIndicator as Object
statusIndicator = ThisComponent.getCurrentController.StatusIndicator
statusIndicator.Start(&quot;Конвертация переносов, подождите&quot;,10)
AcceptAllTrackedChanges
convertHyphInText(ThisComponent.Text)
&apos; Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
statusIndicator.Start(&quot;Конвертация переносов, подождите&quot;,70)
allNotes = ThisComponent.FootNotes
For x = 0 to allNotes.Count -1
aNote = allNotes.getByIndex(x)
convertHyphInText(aNote.Text)
Next
&apos;disableAutoHyph()
statusIndicator.end()
MsgBox &quot;Конвертация переносов успешно завершена.&quot;
End Sub
sub disableAutoHyph()
Dim propertySetInfo As Object
Dim oPositionOfMatch As Long
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(&quot;ParaIsHyphenation&quot;) Then
oStyle.ParaIsHyphenation = false
EndIf
Next
End Sub
Sub convertHyphInText(textElement)
Dim enum1Element As Object
Dim enum1 As Object
Dim i As Integer
Dim cell As Object
enum1 = textElement.createEnumeration()
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
convertParaHyphens(enum1Element)
ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) 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
Sub convertParaHyphens(para)
Dim lineEnd As String
Dim autoHyphens() As Object
Dim autoBreaks() As Object
Dim lineNumbers() As Integer
Dim charNum as Integer
Dim lineLength As Integer
Dim i As Integer
&apos;No hyphenation needed
If para.ParaIsHyphenation = false Then
Exit Sub
EndIf
vCurs = ThisComponent.currentController.getViewCursor()
vCurs.goToRange(para.Anchor,false)
tCurs = vCurs.Text.createTextCursorByRange(vCurs)
tCurs.goToStartOfParagraph(false)
vCurs.goToRange(tCurs,false)
i = 0
Do While NOT tCurs.isEndOfParagraph() OR NOT tCurs.isStartOfParagraph()
vCurs.gotoEndOfLine(true)
lineLength = Len(vCurs.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) &gt; 0 Then
charNum = Asc(nextChar)
If charNum &gt; 767 AND charNum &lt; 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)
&apos;replaceHyphen(tCurs,vCurs)
ElseIf needLineBreak(lastChar,newChar) Then
addToArray(autoBreaks(),tCurs.Text.createTextCursorByRange(tCurs))
EndIf
tCurs.goRight(1,false)
vCurs.goToRange(tCurs,false)
Loop
If Ubound(autoBreaks) &lt;&gt; -1 Then
For i = 0 To (Ubound(autoBreaks))
insertBreak(autoBreaks(i))
Next i
EndIf
para.ParaIsHyphenation = false
If Ubound(autoHyphens) &lt;&gt; -1 Then
For i = 0 To (Ubound(autoHyphens))
replaceHyphen(autoHyphens(i),lineNumbers(i))
Next i
EndIf
End Sub
Sub insertBreak(tCursor As Object)
&apos;U+200B Zero length space
tCursor.String = &quot;​&quot;
End Sub
Function getPrevChar(tCurs As Object)
tCurs.goLeft(1,true)
getPrevChar = tCurs.getString()
tCurs.goRight(1,false)
End Function
Function getNextChar(tCurs As Object)
tCurs.goRight(1,true)
getNextChar = tCurs.getString()
tCurs.goLeft(1,false)
End Function
Sub replaceHyphen(tCurs As Object,lineNumber As Integer)
Dim curLineNum As Integer
Dim vCurs As Object
Dim tLine As Object
vCurs = ThisComponent.currentController.getViewCursor()
&apos;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 &gt; lineNumber Then
compressLine(tCurs)
Else
stretchLine(tCurs)
EndIf
EndIf
If vCurs.isAtEndOfLine() = false AND vCurs.isAtStartOfLine() = false Then
MsgBox &quot;Конвертация переносов не выполнена. Алгоритм нуждается в доработке. Обратитесь к разработчику.&quot;
Stop
EndIf
End Sub
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 &gt;= 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)
EndIf
vCurs.goToRange(tCurs,false)
kerning = 10
tLine.CharKerning = kerning
If lineLength &gt; 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 &lt; -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 &lt; -15 Then
Exit Do
EndIf
Loop
EndIf
End Sub
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 &gt; 15 Then
Exit Do
EndIf
Loop
End Sub
Function getParaLineNumber(vCursor As Object)
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
Function needLineBreak(before,after)
needLineBreak = false
If before = &quot;/&quot; Then
If after &lt;&gt; &quot; &quot; AND after &lt;&gt; 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
Function needHyphen(before As String, after As String,lineLength As Integer)
Dim charNumBefore as Integer
Dim charNumAfter as Integer
needHyphen = true
If lineLength &lt; 2 Then
needHyphen = false
EndIf
&apos;MsgBox Asc(newChar)
&apos;Both are numbers
If Len(before) &gt; 0 Then
charNumBefore = Asc(before)
If charNumBefore &gt; 47 AND charNumBefore &lt; 58 Then
If Len(after) &gt; 0 Then
charNumAfter = Asc(after)
If charNumAfter &gt; 47 AND charNumAfter &lt; 58 Then
needHyphen = false
EndIf
EndIf
EndIf
EndIf
Select Case before
Case &quot; &quot;
needHyphen = false
&apos;U+002D Hyphen minus
Case &quot;-&quot;
needHyphen = false
&apos;U+2010 Hyphen
Case &quot;‐&quot;
needHyphen = false
Case &quot;­&quot;
needHyphen = false
&apos;U+2014 Em dash
Case &quot;—&quot;
needHyphen = false
&apos;U+2013 En dash
Case &quot;–&quot;
needHyphen = false
&apos;U+2012 Figure Dash
Case &quot;‒&quot;
needHyphen = false
Case &quot;…&quot;
needHyphen = false
Case &quot;/&quot;
needHyphen = false
End Select
Select Case after
Case &quot; &quot;
needHyphen = false
Case &quot;-&quot;
needHyphen = false
Case &quot;­&quot;
needHyphen = false
&apos;newline U+000A
Case Chr(10)
needHyphen = false
End Select
End Function
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(&quot;com.sun.star.frame.DispatchHelper&quot;)
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, &quot;.uno:AcceptAllTrackedChanges&quot;, &quot;&quot;, 0, Array())
end sub
</script:module>
Reference in a new issue Copy permalink