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