fix: improved paragraph balance macro

This commit is contained in:
Georgy Litvinov 2021-08-24 10:45:47 +02:00
parent 8785038720
commit ab552a70db

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="Archive" script:language="StarBasic" script:moduleType="normal">Sub archMark22 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Archive" script:language="StarBasic" script:moduleType="normal">Sub archMark23
End Sub End Sub
@ -519,7 +519,7 @@ Sub balancePara(targetPara As Object)
initialLineCount = getParaLinesCount(paraLines) initialLineCount = getParaLinesCount(paraLines)
lineLen = getParaLineLength(paraLines, 0) lineLen = getParaLineLength(paraLines, 0)
medianLen = calculateMedianParaLen(oPara) medianLen = calculateMedianParaLen(oPara)
minLastLineLength = medianLen * 0.89 minLastLineLength = medianLen * 0.93
If Not IsEmpty(oPara.CharKerning) Then If Not IsEmpty(oPara.CharKerning) Then
initialCharKerning = oPara.CharKerning initialCharKerning = oPara.CharKerning
@ -531,64 +531,59 @@ Sub balancePara(targetPara As Object)
Exit sub Exit sub
EndIf EndIf
Do While lastLineIsNotBalanced(lineLen, minLastLineLength) And Not (decreaseKerningFailed And increaseKerningFailed) Do While lastLineIsNotBalanced(lineLen, minLastLineLength)
If NOT decreaseKerningFailed Then
decreaseCharKerning(oPara) decreaseCharKerning(oPara)
EndIf
If decreaseKerningFailed AND NOT increaseKerningFailed Then
increaseCharKerning(oPara)
EndIf
paraLines = getParaLines(oPara) paraLines = getParaLines(oPara)
lineCount = getParaLinesCount(paraLines) lineCount = getParaLinesCount(paraLines)
lineLen = getParaLineLength(paraLines,0) lineLen = getParaLineLength(paraLines,0)
If (lineCount &gt; initialLineCount) Then If (lineCount &lt; initialLineCount ) OR (oPara.CharKerning &lt; -15) Then
MsgBox oPara.CharKerning
increaseKerningFailed = true
oPara.CharKerning = initialCharKerning
EndIf
If (lineCount = initialLineCount - 1 ) Then
&apos;Tightened last line but it is still smaller than we need &apos;Tightened last line but it is still smaller than we need
decreaseKerningFailed = true fallBackSuccess = tryExpandPrevLines(oPara, minLastLineLength)
fallBackSuccess = tryExpandPrevLine(oPara, minLastLineLength) If Not fallBackSuccess Then
If fallBackSuccess Then
Exit Sub
EndIf
&apos;Fall back to initial values
MsgBox oPara.CharKerning
oPara.CharKerning = initialCharKerning oPara.CharKerning = initialCharKerning
EndIf EndIf
If (oPara.CharKerning &gt; 50) Then Exit Do
MsgBox oPara.CharKerning
increaseKerningFailed = true
oPara.CharKerning = initialCharKerning
EndIf
If (oPara.CharKerning &lt; -15) Then
decreaseKerningFailed = true
MsgBox oPara.CharKerning
oPara.CharKerning = initialCharKerning
EndIf EndIf
Loop Loop
MsgBox oPara.CharKerning oViewCursor.collapseToEnd()
End Sub End Sub
Function tryExpandPrevLine(oPara As Object, minLastLineLength As Integer) As Boolean Function tryExpandPrevLines(oPara As Object, minLastLineLength As Integer) As Boolean
Dim lineCount As Integer Dim lineCount As Integer
Dim initialLineCount As Integer Dim initialLineCount As Integer
Dim paraLine As Object
Dim lineNum As Integer
Dim failedLines() As Integer
paraLines = getParaLines(oPara) paraLines = getParaLines(oPara)
lineLen = getParaLineLength(paraLines,0) lineLen = getParaLineLength(paraLines,0)
initialLineCount = getParaLinesCount(paraLines) initialLineCount = getParaLinesCount(paraLines)
lineCount = initialLineCount lineCount = initialLineCount
lineNum = 0
Do While lineCount = initialLineCount And lastLineIsNotBalanced(lineLen, minLastLineLength) Do While lineCount = initialLineCount And lastLineIsNotBalanced(lineLen, minLastLineLength)
increaseCharKerning(paraLines(UBound(paraLines)- 1)) If (lineNum + 1 &lt; lineCount And Not IsInArray(failedLines, lineNum + 1)) Then
lineNum = lineNum + 1
EndIf
paraLine = paraLines(UBound(paraLines) - lineNum)
increaseCharKerning(paraLine)
paraLines = getParaLines(oPara) paraLines = getParaLines(oPara)
lineCount = getParaLinesCount(paraLines) lineCount = getParaLinesCount(paraLines)
lineLen = getParaLineLength(paraLines,0) lineLen = getParaLineLength(paraLines,0)
If lineNum &gt; 1 And (lineCount &lt;&gt; initialLineCount Or paraLine.CharKerning &gt; 20) Then
AddToArray(failedLines, lineNum)
decreaseCharKerning(paraLine)
paraLines = getParaLines(oPara)
lineCount = getParaLinesCount(paraLines)
lineLen = getParaLineLength(paraLines,0)
lineNum = 0
ElseIf lineNum = 1 And paraLine.CharKerning &gt; 20 Then
tryExpandPrevLines = false
Exit Function
EndIf
Loop Loop
If Not lastLineIsNotBalanced(lineLen, minLastLineLength) And lineCount = initialLineCount Then If Not lastLineIsNotBalanced(lineLen, minLastLineLength) And lineCount = initialLineCount Then
tryExpandPrevLine = true tryExpandPrevLines = true
MsgBox paraLines(UBound(paraLines)- 1).CharKerning
Else Else
tryExpandPrevLine = false tryExpandPrevLines = false
EndIf EndIf
End Function End Function