Sub archMark29 End Sub Public Const MAX_CHAR_KERNING = 15 Public Const MIN_CHAR_KERNING = -10 Public Const MIN_SPACING_TO_SHRINK = 500 Sub resetNotesStyle Dim oDescriptor As Object Dim dispatcher As Object Dim x As Integer Dim oViewCursor As Object Dim document As Object Dim allNotes As Object Dim aNote As Object Dim oEnum As Object Dim oCurPar As Object dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") document = ThisComponent.CurrentController.Frame oViewCursor = ThisComponent.CurrentController.getViewCursor() allNotes = thisComponent.FootNotes for x = 0 to allNotes.Count -1 aNote = allNotes.getByIndex(x) aNote.Anchor.CharStyleName="Footnote anchor" oEnum = aNote.Text.createEnumeration() Do While oEnum.hasMoreElements() oCurPar = oEnum.nextElement() oCurPar.ParaStyleName = "Footnote" Loop Next End Sub Sub createBidirectLink Dim oSelections As Object Dim oAnchor1 As Object Dim oAnchor2 As Object Dim oAnchor1Name As String Dim oAnchor2Name As String If IsNull(ThisComponent) Then MsgBox getTranslation("bidirectLinkSuggestion") Exit Sub End If oSelections = ThisComponent.getCurrentSelection() If IsNull(oSelections) Then MsgBox getTranslation("bidirectLinkSuggestion") Exit Sub End If objectsCount = oSelections.getCount() - 1 If objectsCount < 2 OR objectsCount > 2 Then MsgBox getTranslation("bidirectLinkSuggestion") Exit Sub End If oAnchor1 = oSelections.getByIndex(1) oAnchor2 = oSelections.getByIndex(2) If isAnchorEmpty(oAnchor1) Or isAnchorEmpty(oAnchor2) Then MsgBox getTranslation("bidirectLinkSuggestion") Exit Sub EndIf oAnchor1Name = RND_String() oAnchor2Name = RND_String() createAnchor(oAnchor1,oAnchor1Name) createAnchor(oAnchor2,oAnchor2Name) createLink(oAnchor1,oAnchor1.String,oAnchor2Name) createLink(oAnchor2,oAnchor2.String,oAnchor1Name) End Sub Function isAnchorEmpty(anchor As Object) As Boolean Dim anchorName As String anchorName = trim(anchor.String) If Len(anchorName) = 0 Then isAnchorEmpty = true Exit Function EndIf If Len(anchorName) = 1 AND Chr(10) = anchorName Then isAnchorEmpty = true Exit Function EndIf isAnchorEmpty = false End Function Sub disposeBookmark(bookmarkName As String) Dim bookmarks As Object Dim bookmark As Object Dim elementName As String elementName = ThisComponent.Links.ElementNames(6) bookmarks = ThisComponent.Links.getByName(elementName) If bookmarks.hasByName(bookmarkName) Then bookmark = bookmarks.getByName(bookmarkName) bookmark.dispose() EndIf End Sub Sub createAnchor(targetRange as Object,anchorName as String) dim oViewCursor as object dim document as object dim dispatcher as Object disposeBookMark(anchorName) document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.gotoRange(targetRange,false) dim args1(0) as new com.sun.star.beans.PropertyValue args1(0).Name = "Bookmark" args1(0).Value = anchorName dispatcher.executeDispatch(document, ".uno:InsertBookmark", "", 0, args1()) End Sub Sub createLink(targetRange as Object,linkName as String,linkURL as String) dim oViewCursor as object dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.gotoRange(targetRange,false) 'Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) 'Mri oViewCursor oViewCursor.HyperlinkURL = "#" & linkURL oViewCursor.HyperLinkName = linkName 'dim args2(4) as new com.sun.star.beans.PropertyValue 'args2(0).Name = "Hyperlink.Text" 'args2(0).Value = linkName 'args2(1).Name = "Hyperlink.URL" 'args2(1).Value = "#"+linkURL 'args2(2).Name = "Hyperlink.Target" 'args2(2).Value = "" 'args2(3).Name = "Hyperlink.Name" 'args2(3).Value = linkName 'args2(4).Name = "Hyperlink.Type" 'args2(4).Value = 1 'dispatcher.executeDispatch(document, ".uno:SetHyperlink", "", 0, args2()) End Sub Function RND_String Dim OutputString As String Dim TempString As String Dim i as Long OutputString="" randomize For i = 1 to 20 Select Case i Case 5, 8, 11, 14 OutputString=OutputString+"-" Case Else TempString=Hex(int(rnd*256)) If len(TempString) < 2 Then TempString=TempString+"0" EndIf OutputString=OutputString+TempString End Select next i RND_String = OutputString End Function sub convertIndesignPageBreaks Dim description As String Dim pageBreakMarker As String pageBreakMarker = "---XYXYX---" description = getTranslation("convertIndesignPageBreaksConfirmation") If NOT confirm(description) Then Exit Sub EndIf turnOffTracking() setZoomToSpeedUpTasks() balanceFootNotes() Dim oViewCursor As Object oViewCursor = thisComponent.getCurrentController.getViewCursor oViewCursor.jumpToFirstPage Dim oSearch As Object Dim oTextCursor As Object Dim testCurs As Object Dim firstLowercase As Boolean Dim firstBreak As Boolean firstBreak = true Dim charNum As Long Dim prevParaLastCharacter As String Dim oFound As Object Dim pageNumber As Integer Dim prevPageNumber As Integer Dim nextPara As Object Dim prevPara As Object Dim nextParaFirstCharacter As String Dim stringContents As String firstLowercase = false oSearch = ThisComponent.createSearchDescriptor() oSearch.SearchString = pageBreakMarker oSearch.SearchRegularExpression=True oSearch.searchAll=True oFound = ThisComponent.findFirst(oSearch) Do While Not IsNull(oFound) oTextCursor = oFound.Text.createTextCursor() oTextCursor.gotoRange(oFound,false) oTextCursor.gotoStartOfParagraph(false) oTextCursor.gotoEndOfParagraph(true) testCurs = oTextCursor.Text.createTextCursorByRange(oTextCursor.End) testCurs.goRight(1,false) testCurs.gotoEndOfParagraph(true) 'In case two page breaks go together stringContents = testCurs.String If stringContents <> pageBreakMarker Then oTextCursor.goRight(1,true) EndIf oTextCursor.String = "" oTextCursor.BreakType = com.sun.star.style.BreakType.PAGE_BEFORE 'Go to Start of new paragraph to shrink prev page if necessary oViewCursor.goToRange(oTextCursor.End,false) oViewCursor.goLeft(1,false) ' Wait 100 pageNumber = getPageNumber(oTextCursor.Text.createTextCursorByRange(oTextCursor.End)) If firstBreak Then firstBreak = false prevPageNumber = pageNumber EndIf If pageNumber - prevPageNumber > 1 Then shrinkPageContent Wait 100 pageNumber = getPageNumber(oTextCursor.Text.createTextCursorByRange(oTextCursor.End)) EndIf 'check first character oTextCursor.goRight(1,true) nextPara = oTextCursor.End nextParaFirstCharacter = oTextCursor.getString() If (isLowerCase(nextParaFirstCharacter)) Then adjustFirstLine(nextPara) firstLowercase = true End If 'check last character oTextCursor.goLeft(2,false) prevPara = oTextCursor.Start oTextCursor.goLeft(1,true) prevParaLastCharacter = oTextCursor.getString() If (prevParaLastCharacter = " ") Then ' oTextCursor.String="" 'last paragraph adjustLastLine(prevPara) adjustFirstLine(nextPara) EndIf If (isLowerCase(prevParaLastCharacter)) Then If firstLowercase Then oTextCursor.collapseToEnd() oTextCursor.setString("-") oTextCursor.collapseToEnd() adjustLastLine(prevPara) adjustFirstLine(nextPara) EndIf End If 'If pageNumber - prevPageNumber < 2 Then 'stretchPrevPage(prevPara) 'EndIf prevPageNumber = pageNumber oFound = ThisComponent.findNext(oFound.End, oSearch) Loop setUniqPageStyles MsgBox getTranslation("convertIndesignPageBreaksFinish") end Sub Sub configureHeadings configureArchiveHeading1 configureArchiveHeadings() End Sub Sub configureArchiveHeading1 Dim outline1() As Object Dim oViewCursor As Object Dim oSavePosition As Object Dim initPosition As Object Dim initPageNum As Integer fixViewCursor() oViewCursor = thisComponent.getCurrentController.getViewCursor oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) outline1 = getHeadingWithLevel(1) Dim startViewPageNum As Integer Dim pageNumberCursor As Object Dim i As Integer Dim j As Integer For i = LBound(outline1) To UBound(outline1) oViewCursor.goToRange(outline1(i), false) oViewCursor.jumpToEndOfPage() initPosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) initPageNum = oViewcursor.getPage() Do While Not isContentPageChanged(initPosition, initPageNum) AND outline1(i).ParaBottomMargin < 10000 outline1(i).ParaBottomMargin = outline1(i).ParaBottomMargin + 100 Loop Do While isContentPageChanged(initPosition, initPageNum) If outline1(i).ParaBottomMargin < 0 Then Exit Do EndIf outline1(i).ParaBottomMargin = outline1(i).ParaBottomMargin - 100 Loop Next i oViewCursor.goToRange(oSavePosition,false) End Sub Sub configureArchiveHeadings() Dim outline1() As Object Dim oViewCursor As Object Dim initPosition As Object Dim initPageNum As Integer Dim savePosition As Object fixViewCursor() oViewCursor = thisComponent.getCurrentController.getViewCursor savePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) Dim pageNumberCursor As Object Dim i As Integer Dim j As Integer Dim initialPageCount As Integer initialPageCount = ThisComponent.currentController.pageCount For j = 2 To 10 outline1 = getHeadingWithLevel(j) For i = LBound(outline1) To UBound(outline1) If outline1(i).BreakType <> 4 Then oViewCursor.goToRange(outline1(i), false) oViewCursor.jumpToEndOfPage() initPosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) initPageNum = oViewcursor.getPage() Do While Not isContentPageChanged(initPosition, initPageNum) outline1(i).ParaTopMargin = outline1(i).ParaTopMargin + 100 If (outline1(i).ParaTopMargin > outline1(i).ParaBottomMargin) Then Exit Do EndIf Loop Do While isContentPageChanged(initPosition, initPageNum) If outline1(i).ParaBottomMargin < 0 Then Exit Do EndIf outline1(i).ParaTopMargin = outline1(i).ParaTopMargin - 100 Loop EndIf Next i Next j oViewCursor.goToRange(savePosition,false) End Sub Sub stretchPrevPage() 'Assumption hard breaks at start of stretching page and at start of next page Dim pageCount As Integer Dim curViewPageNum As Integer Dim startViewPageNum As Integer Dim successOperation As Boolean Dim paragraphs() As Object Dim outline1() As Object Dim outline2() As Object initialPageCount = thiscomponent.currentController.pageCount Dim oViewCursor As Object Dim textCursor As Object Dim pageNumberCursor As Object Dim oSavePosition As Object Dim pageStartPosition As Object Dim i As Integer Dim curPara As Object oViewCursor = thisComponent.getCurrentController.getViewCursor oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'oViewCursor.goToStartOfLine(false) pageNumberCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) pageNumberCursor.goToStartOfWord(false) 'Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) 'MRI pageNumberCursor oViewCursor.jumpToStartOfPage() startViewPageNum = getPageNumber(pageNumberCursor) textCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) Do While oViewCursor.getPage() = startViewPageNum curPara = textCursor.textParagraph If curPara.outlineLevel = 1 Then addToArray(outline1, curPara) ElseIf curPara.outlineLevel = 2 Then addToArray(outline2, curPara) Else addToArray(paragraphs, curPara) EndIf successOperation = textCursor.goToNextParagraph(false) If NOT successOperation Then Exit Do EndIf oViewCursor.goToRange(textCursor,false) Loop If UBound(outline1) > -1 Then Do While startViewPageNum = getPageNumber(pageNumberCursor) For i = LBound(outline1) To UBound(outline1) outline1(i).ParaTopMargin = outline1(i).ParaTopMargin + 100 Next i Loop For i = LBound(outline1) To UBound(outline1) If outline1(i).ParaTopMargin >= 100 Then outline1(i).ParaTopMargin = outline1(i).ParaTopMargin - 100 EndIf Next i Exit Sub EndIf If UBound(outline2) > -1 Then Do While startViewPageNum = getPageNumber(pageNumberCursor) For i = LBound(outline2) To UBound(outline2) outline2(i).ParaTopMargin = outline2(i).ParaTopMargin + 100 If outline2(i).ParaTopMargin > outline2(i).ParaBottomMargin Then Exit Do EndIf Next i Loop For i = LBound(outline2) To UBound(outline2) If outline2(i).ParaTopMargin >= 100 Then outline2(i).ParaTopMargin = outline2(i).ParaTopMargin - 100 EndIf Next i Exit Sub EndIf 'Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) 'Mri curPara Dim paraLineSpacing As Object Dim tmpPageNum As Integer tmpPageNum = getPageNumber(pageNumberCursor) If UBound(paragraphs) > -1 Then Dim iterations As Integer iterations = 0 Do While startViewPageNum = getPageNumber(pageNumberCursor) For i = LBound(paragraphs) To UBound(paragraphs) paraLineSpacing = paragraphs(i).paraLineSpacing paraLineSpacing.Height = paraLineSpacing.Height + 5 paragraphs(i).paraLineSpacing = paraLineSpacing Next i iterations = iterations + 1 If iterations > 4 Then Exit Do EndIf tmpPageNum = getPageNumber(pageNumberCursor) Loop For i = LBound(paragraphs) To UBound(paragraphs) paraLineSpacing = paragraphs(i).paraLineSpacing paraLineSpacing.Height = paraLineSpacing.Height - 5 paragraphs(i).paraLineSpacing = paraLineSpacing Next i Exit Sub EndIf oViewCursor.goToRange(oSavePosition,false) End Sub Sub balanceCurParaLastLine() Dim oViewCursor As Object Dim oTextCursor As Object Dim paraEnd As Object Dim success As Boolean Dim adjustType As Integer fixViewCursor() oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.ParaIsHyphenation = true success = balanceParaTail(oViewCursor.Start, false) End Sub Sub adjustLastLineCurPara() Dim oViewCursor As Object Dim oTextCursor As Object Dim paraEnd As Object Dim success As Boolean Dim adjustType As Integer Dim hyph As Boolean fixViewCursor() oViewCursor = ThisComponent.CurrentController.getViewCursor() oTextCursor = oViewCursor.Text.CreateTextCursorByRange(oViewCursor) paraEnd = getParaEnd(oTextCursor) oTextCursor.goToRange(paraEnd,false) oTextCursor.goLeft(1,true) If (oTextCursor.String = " ") Then oTextCursor.String = "" EndIf adjustType = oTextCursor.ParaAdjust hyph = oTextCursor.ParaIsHyphenation oTextCursor.ParaIsHyphenation = true success = balanceParaTail(oTextCursor.Start, true) If success And adjustType = 2 Then oTextCursor.ParaLastLineAdjust = 2 Else oTextCursor.ParaIsHyphenation = hyph EndIf End Sub Sub balanceFootNotes() Dim allNotes As Object Dim aNote As Object Dim x As Long allNotes = ThisComponent.FootNotes For x = 0 to allNotes.Count -1 aNote = allNotes.getByIndex(x) balanceFootNote(aNote) Next End Sub Sub balanceFootNote(textElement As Object) Dim enum1Element As Object Dim enum1 As Object Dim oViewCursor As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() enum1 = textElement.createEnumeration() While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then oViewCursor.goToRange(enum1Element,false) balanceCurParaLastLine() EndIf Wend End Sub Sub adjustLastLine(anchor As Object) Dim oViewCursor As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.goToRange(anchor,false) adjustLastLineCurPara() End Sub Sub adjustFirstLine(anchor As Object) anchor.ParaFirstLineIndent = 0 End Sub Function isLowerCase(character As String) As Boolean Dim charNum As Long If (character = "") Then charNum = ASC(""+0) Else charNum = ASC(character) End If If ((charNum > 1071 AND charNum < 1120) Or (charNum > 96 AND charNum < 123)) Then isLowerCase = true Exit Function EndIf isLowerCase = false End Function Function balanceParaTail(targetPara As Object, strictMode As Boolean) As Boolean Dim oViewCursor As Object Dim oTextCursor As Object Dim oContent As Object Dim oContentStart As Object Dim oContentEnd As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.goToRange(targetPara, false) oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) oContentStart = getParaStart(oTextCursor) oContentEnd = getParaEnd(oTextCursor) oContent = getParaSelected(oContentStart,oContentEnd) balanceParaTail = balanceContentTail(oContent, strictMode) End Function Function balanceContentTail(oContent As Object, strictMode As Boolean) As Boolean ' Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) balanceContentTail = false Dim oViewCursor As Object Dim paraLen As Integer Dim lineCount As Integer Dim initialLineCount As Integer Dim lineLen As Integer Dim initialLineLen As Integer Dim minLastLineLength As Integer Dim medianLen As Integer Dim paraLines() As Object Dim fallBackSuccess As Boolean fallBackSuccess = false oViewCursor = ThisComponent.CurrentController.getViewCursor() paraLen = Len(oContent.String) paraLines = getContentLines(oContent) initialLineCount = getParaLinesCount(paraLines) lineLen = getParaLineLength(paraLines, 0) initialLineLen = lineLen medianLen = calculateMedianParaLen(oContent) minLastLineLength = medianLen * 0.93 If Not IsEmpty(oContent.CharKerning) Then initialCharKerning = oContent.CharKerning Else initialCharKerning = 0 End If If initialLineCount < 2 Then Exit Function EndIf Do While lastLineIsNotBalanced(lineLen, minLastLineLength) decreaseCharKerning(oContent) paraLines = getContentLines(oContent) lineCount = getParaLinesCount(paraLines) lineLen = getParaLineLength(paraLines,0) If (lineCount < initialLineCount ) OR (oContent.CharKerning < MIN_CHAR_KERNING) Then 'Tightened last line but it is still smaller than we need fallBackSuccess = tryExpandPrevLines(oContent, minLastLineLength) If Not fallBackSuccess Then If strictMode Then oContent.CharKerning = initialCharKerning balanceContentTail = false Else paraLines = getContentLines(oContent) lineLen = getParaLineLength(paraLines,0) If (lineLen < initialLineLen) Then oContent.CharKerning = initialCharKerning balanceContentTail = false Else balanceContentTail = true EndIf EndIf oViewCursor.collapseToEnd() Exit Function EndIf Exit Do EndIf Loop oViewCursor.collapseToEnd() balanceContentTail = true End Function Function shrinkContentWithKerning(oContent As Object) As Boolean ' Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) shrinkContentWithKerning = false Dim paraLen As Integer Dim lineCount As Integer Dim saveLineCount As Integer Dim initialLineCount As Integer Dim contentLines() As Object Dim kerningValue As Integer contentLines = getContentLines(oContent) initialLineCount = getParaLinesCount(contentLines) saveLineCount = initialLineCount If Not IsEmpty(oContent.CharKerning) Then initialCharKerning = oContent.CharKerning Else initialCharKerning = 0 End If kerningValue = initialCharKerning 'Reduce kerning is useless if content is less than 2 lines long If initialLineCount < 2 Then Exit Function EndIf Do While oContent.CharKerning > MIN_CHAR_KERNING decreaseCharKerning(oContent) contentLines = getContentLines(oContent) lineCount = getParaLinesCount(contentLines) If lineCount < saveLineCount Then kerningValue = oContent.CharKerning saveLineCount = lineCount EndIf Loop 'If decrease kerning didn't reduce lines then retreat to latest value that changed lines count If kerningValue <> oContent.CharKerning Then oContent.CharKerning = kerningValue EndIf If initialCharKerning <> kerningValue Then shrinkContentWithKerning = true EndIf End Function Function tryExpandPrevLines(oPara As Object, minLastLineLength As Integer) As Boolean Dim lineCount As Integer Dim finishLineCount As Integer Dim initialLineCount As Integer Dim paraLine As Object Dim finishLastline As Object Dim lineNum As Integer Dim failedLines() As Integer Dim lastLineCharKerning As Integer Dim paraLines() As Object Dim lineCharKerning As Integer paraLines = getContentLines(oPara) lineLen = getParaLineLength(paraLines,0) initialLineCount = getParaLinesCount(paraLines) lineCount = initialLineCount lineNum = 0 Do While lineCount = initialLineCount And lastLineIsNotBalanced(lineLen, minLastLineLength) If (lineNum + 1 < lineCount And Not IsInArray(failedLines, lineNum + 1)) Then lineNum = lineNum + 1 EndIf paraLine = paraLines(UBound(paraLines) - lineNum) increaseCharKerning(paraLine) paraLines = getContentLines(oPara) lineCount = getParaLinesCount(paraLines) lineLen = getParaLineLength(paraLines,0) If lineNum > 1 And (lineCount <> initialLineCount Or paraLine.CharKerning > MAX_CHAR_KERNING) Then AddToArray(failedLines, lineNum) lineCharKerning = decreaseCharKerning(paraLine) paraLines = getContentLines(oPara) lineCount = getParaLinesCount(paraLines) If lineCount > initialLineCount Then Do While lineCount > initialLineCount And lineCharKerning > MIN_CHAR_KERNING lineCharKerning = decreaseCharKerning(paraLine) paraLines = getContentLines(oPara) lineCount = getParaLinesCount(paraLines) Loop EndIf lineLen = getParaLineLength(paraLines,0) lineNum = 0 ElseIf lineNum = 1 And paraLine.CharKerning > MAX_CHAR_KERNING Then tryExpandPrevLines = false Exit Function EndIf Loop If Not lastLineIsNotBalanced(lineLen, minLastLineLength) And lineCount = initialLineCount Then tryExpandPrevLines = true Else tryExpandPrevLines = false EndIf normalizeLastLine(oPara) End Function Sub normalizeLastLine(oPara As Object) Dim lineCount As Integer Dim finishLineCount As Integer Dim initialLineCount As Integer Dim paraLine As Object Dim finishLastline As Object Dim lineNum As Integer Dim failedLines() As Integer Dim lastLineCharKerning As Integer Dim paraLines() As Object Dim oTextCursor As Object oTextCursor = oPara.Text.createTextCursorByRange(oPara) oTextCursor.collapseToEnd() If ( oTextCursor.CharKerning > 0 ) Then Exit Sub EndIf 'increase last line kerning to 0 paraLines = getContentLines(oPara) lineCount = getParaLinesCount(paraLines) finishLineCount = lineCount finishLastline = paraLines(UBound(paraLines)) 'try just set 0 char kerning to last line, reduce kerning if failed lastLineCharKerning = 0 finishLastline.CharKerning = lastLineCharKerning paraLines = getContentLines(oPara) lineCount = getParaLinesCount(paraLines) If lineCount > finishLineCount Then Do While lineCount > finishLineCount AND lastLineCharKerning > MIN_CHAR_KERNING lastLineCharKerning = lastLineCharKerning - 2 finishLastline.CharKerning = lastLineCharKerning paraLines = getContentLines(oPara) lineCount = getParaLinesCount(paraLines) Loop EndIf End Sub Function getParaLinesCount(paraLines() As Object) As Integer getParaLinesCount = UBound(paraLines) + 1 End Function Function getParaLineLength(paraLines() As Object, lineNumber As Integer) As Integer Dim arrIndex As Integer arrIndex = UBound(paraLines) - lineNumber If (arrIndex >= 0) Then getParaLineLength = Len(paraLines(arrIndex).String) Else 'Throw an error? getParaLineLength = 0 EndIf End Function Function getContentLines(oContent As Object) As Variant Dim oTextCursor As Object Dim oViewCursor As Object Dim paraLine As Object Dim paraLines() As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() 'initial value is 1 As paragraph can't be 0 lines long oTextCursor = oContent.Text.createTextCursorByRange(oContent) oTextCursor.collapseToStart() oViewCursor.goToRange(oTextCursor,false) While NOT oTextCursor.isEndOfParagraph() oViewCursor.gotoEndOfLine(true) If (Len(oViewCursor.String) = 0) Then oTextCursor.goToRange(oViewCursor,false) oTextCursor.goRight(1,false) oViewCursor.goToRange(oTextCursor,false) oViewCursor.gotoEndOfLine(true) EndIf If (Len(oViewCursor.String) > 0) Then paraLine = oViewCursor.Text.createTextCursorByRange(oViewCursor) AddToArray(paraLines, paraLine) EndIf oViewCursor.collapseToEnd() oTextCursor.goToRange(oViewCursor,false) Wend getContentLines = paraLines End Function Function decreaseCharKerning(oPara As Object) As Integer Dim initialCharKerning As Integer Dim textExcerpts As Object Dim textExcerpt As Object initialCharKerning = MIN_CHAR_KERNING + 2 If Not (IsEmpty(oPara.CharKerning)) Then initialCharKerning = oPara.CharKerning EndIf If (initialCharKerning >= MIN_CHAR_KERNING) Then oPara.CharKerning = initialCharKerning - 2 EndIf decreaseCharKerning = initialCharKerning - 2 End Function Function increaseCharKerning(oPara As Object) As Integer Dim initialCharKerning As Integer Dim textExcerpts As Object Dim textExcerpt As Object initialCharKerning = MAX_CHAR_KERNING - 2 If Not (IsEmpty(oPara.CharKerning)) Then initialCharKerning = oPara.CharKerning EndIf oPara.CharKerning = initialCharKerning + 2 increaseCharKerning = initialCharKerning + 2 End Function Function lastLineIsNotBalanced(lineLen As Integer,minLastLineLength As Integer) As Boolean lastLineIsNotBalanced = true If lineLen = 0 Then lastLineIsNotBalanced = false Exit Function EndIf If lineLen >= minLastLineLength Then lastLineIsNotBalanced = false EndIf End Function Function getParaStart(oTextCursor As Object) As Object If NOT oTextCursor.isStartOfParagraph() Then oTextCursor.gotoStartOfParagraph(false) EndIf getParaStart = oTextCursor.getStart() End Function Function getParaEnd(oTextCursor As Object) As Object If NOT oTextCursor.isEndOfParagraph() Then oTextCursor.gotoEndOfParagraph(false) EndIf getParaEnd = oTextCursor.getEnd() End Function Function getParaSelected(oParaStart As Object,oParaEnd As Object) As Object Dim oPara As Object oPara = oParaStart.Text.createTextCursorByRange(oParaStart) oPara.goToRange(oParaEnd,true) getParaSelected = oPara End Function Function calculateMedianParaLen(oPara As Object) As Integer Dim oTextCursor As Object Dim oViewCursor As Object Dim lineCount As Integer Dim lineLen As Integer Dim linesLen As Integer linesLen = 0 calculateMedianParaLen = 0 lineCount = 0 lineLen = 0 If (Len (oPara.String) = 0) Then Exit Function EndIf oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.goToRange(oPara, false) oViewCursor.collapseToStart() oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) oParaStart = getParaStart(oTextCursor) oViewCursor.goToRange(oParaStart,false) While NOT oTextCursor.isEndOfParagraph() oViewCursor.gotoEndOfLine(true) lineLen = Len(oViewCursor.getString()) If lineLen > 0 Then linesLen = linesLen + lineLen lineCount = lineCount + 1 oViewCursor.collapseToEnd() oTextCursor.goToRange(oViewCursor,false) Else oTextCursor.goToRange(oViewCursor,false) oTextCursor.goRight(1,false) oViewCursor.goToRange(oTextCursor,false) EndIf Wend If lineCount > 0 Then calculateMedianParaLen = linesLen / lineCount EndIf End Function Sub convertBookmarksToFootnotes() Dim description As String description = getTranslation("convertIndesignFoonotesConfirmation") If NOT confirm(description) Then Exit Sub EndIf Dim bookmarks as Object Dim bookmarkName as String Dim bookmarkNames() As String Dim strStart As Integer Dim linkPrefix As String Dim backLinkSuffix As String Dim backwardLink As String Dim forwardLink As String Dim forward As Object Dim backward As Object linkPrefix = "footnote-" backLinkSuffix = "-backlink" Dim i As Integer bookmarkName = ThisComponent.Links.ElementNames(6) bookmarks = ThisComponent.Links.getByName(bookmarkName) bookmarkNames = bookmarks.getElementNames() For i = LBound(bookmarkNames) To Ubound(bookmarkNames) bookmarkName = bookmarkNames(i) If InStr(bookmarkName, linkPrefix) = 1 Then forwardLink = "" backwardLink = "" If InStr(bookmarkName, backLinkSuffix) > 0 Then forwardLink = Left(bookmarkName,Len(bookmarkName) - Len(backLinkSuffix)) backwardLink = bookmarkName Else forwardLink = bookmarkName backwardLink = bookmarkName + backLinkSuffix EndIf convertLinkToFootnote(forwardLink,backwardLink) EndIf Next i resetNotesStyle MsgBox getTranslation("convertIndesignFootnotesFinish") End Sub Sub convertLinkToFootnote(forwardLink,backwardLink) Dim bookMarkName As String bookmarkName = ThisComponent.Links.ElementNames(6) Dim bookmarks As Object bookmarks = ThisComponent.Links.getByName(bookmarkName) Dim forward As Object Dim backward As Object Dim oViewCursor As Object Dim footNoteSign As String oViewCursor = ThisComponent.CurrentController.getViewCursor() Dim oTextCursor As Object If NOT bookmarks.hasByName(forwardLink) OR NOT bookmarks.hasByName(backwardLink) Then exit sub 'If msgbox( "NO SuCH LINK", 36 ) = 6 Then Stop EndIf forward = bookmarks.getByName(forwardLink) backward = bookmarks.getByName(backwardLink) oViewCursor.goToRange(forward.Anchor,false) footNoteSign = getTextInFootnote oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) oTextCursor.gotoEndOfParagraph(false) oTextCursor.gotoStartOfParagraph(true) oViewCursor.goToRange(oTextCursor,true) unoCut() SendRM oViewCursor.goToRange(backward.Anchor,false) removeFootnoteSignInText createFootnote unoPaste() oViewCursor.getText.setLabel(footNoteSign) forward.dispose() backward.dispose() End Sub Function getTextInFootnote As String Dim oViewCursor As Object Dim oTextCursor As Object Dim character As String getTextInFootnote = "" oViewCursor = ThisComponent.CurrentController.getViewCursor() oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) oTextCursor.goToStartOfParagraph(false) oViewCursor.goToRange(oTextCursor,false) oViewCursor.goRight(1,true) character = oViewCursor.String Do While isLinkCharacter(character) If IsNumeric(character) Then getTextInFootnote = getTextInFootnote & character EndIf oViewCursor.String = "" oViewCursor.goRight(1,true) character = oViewCursor.String Loop If oViewCursor.String = " " Then oViewCursor.String = "" Else oViewCursor.goLeft(1,false) EndIf End Function Sub removeFootnoteSignInText Dim oViewCursor As Object Dim character As String oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.String = "" oViewCursor.goLeft(1,true) character = oViewCursor.String Do While isLinkCharacter(character) oViewCursor.String = "" oViewCursor.goLeft(1,true) character = oViewCursor.String Loop oViewCursor.goRight(1,true) End Sub Function isLinkCharacter(character As String) As Boolean Select Case character Case "[" isLinkCharacter = true Exit Function Case "]" isLinkCharacter = true Exit Function Case "0" isLinkCharacter = true Exit Function Case "1" isLinkCharacter = true Exit Function Case "2" isLinkCharacter = true Exit Function Case "3" isLinkCharacter = true Exit Function Case "4" isLinkCharacter = true Exit Function Case "5" isLinkCharacter = true Exit Function Case "6" isLinkCharacter = true Exit Function Case "7" isLinkCharacter = true Exit Function Case "8" isLinkCharacter = true Exit Function Case "9" isLinkCharacter = true Exit Function Case Else isLinkCharacter = false End Select End Function sub unoCut dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:Cut", "", 0, Array()) end sub sub unoPaste dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array()) end sub sub createFootnote 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") dispatcher.executeDispatch(document, ".uno:InsertFootnote", "", 0, Array()) end Sub Dim oDialog Sub onSelectMenuItem(oEvent) oDialog.endExecute() oDialog.model.Tag = oEvent.ActionCommand End Sub Sub replaceParaStyle dim oldStyleName As String dim oldStyleNameLocalized As String dim oldStyle As Object dim newStyleName As String dim newStyleNameLocalized As String dim paragraphStyles As Object dim userInput As Integer Dim listBox As Object Dim paraStyle As Object Dim oViewCursor As Object Dim enum1 As Object Dim oTextCursor As Object Dim i As Integer oStyles = ThisComponent.StyleFamilies paraStyles = oStyles.getByName(oStyles.elementNames(1)) oViewCursor = ThisComponent.CurrentController.getViewCursor() oldStyleName = oViewCursor.ParaStyleName paraStyleNames = paraStyles.ElementNames Dim displayParaStyleNames(Ubound(paraStyleNames)) Dim sortedDPSN(Ubound(paraStyleNames)) displayParaStyleNames = paraStyleNames Redim Preserve displayParaStyleNames(Ubound(paraStyleNames)) For i = LBound(displayParaStyleNames) To Ubound(displayParaStyleNames) paraStyle = paraStyles.getByName(displayParaStyleNames(i)) displayParaStyleNames(i) = paraStyle.displayName Next i sortedDPSN = displayParaStyleNames Redim Preserve sortedDPSN(Ubound(paraStyleNames)) subShellSort(sortedDPSN) DialogLibraries.LoadLibrary("ePublishing") oDialog = CreateUnoDialog( DialogLibraries.ePublishing.replaceParaStyle ) listBox = oDialog.getControl("ListBox1") listBox.addItems(sortedDPSN , 0) oDialog.Title = getTranslation("replaceParaStyleDialogTitle") oDialog.Execute() newStyleNameLocalized = oDialog.model.Tag If newStyleNameLocalized="0" or newStyleNameLocalized="" Then Exit sub EndIf foundIndex = getIndex(displayParaStyleNames, newStyleNameLocalized) 'set style system name instead of display name newStyleName = paraStyleNames(foundIndex) If newStyleName = oldStyleName Then MsgBox getTranslation("replaceParaStyleStylesEqualsNotification") Exit sub EndIf If oldStyleName <> "" Then oldStyle = paraStyles.getByName(oldStyleName) If NOT oldStyle.isUserDefined Then replaceDefaultParaStyle(getLocalizedParaStyleName(oldStyleName), newStyleNameLocalized) Exit sub EndIf oldStyle.ParentStyle = newStyleName paraStyles.removeByName(oldStyleName) EndIf oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) enum1 = oTextCursor.createEnumeration() While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then If enum1Element.ParaStyleName <> newStyleName Then oldStyle = paraStyles.getByName(enum1Element.ParaStyleName) oldStyle.ParentStyle = newStyleName paraStyles.removeByName(enum1Element.ParaStyleName) EndIf EndIf Wend End Sub Function getLocalizedParaStyleName(styleName as String) As String Dim style As Object Dim styles As Object styles = ThisComponent.StyleFamilies style = styles.getByName(styles.elementNames(1)).getByName(styleName) getLocalizedParaStyleName = style.DisplayName End Function sub replaceDefaultParaStyle(fromStyle As String, toStyle As String) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args1(21) as new com.sun.star.beans.PropertyValue args1(0).Name = "SearchItem.StyleFamily" args1(0).Value = 2 args1(1).Name = "SearchItem.CellType" args1(1).Value = 0 args1(2).Name = "SearchItem.RowDirection" args1(2).Value = true args1(3).Name = "SearchItem.AllTables" args1(3).Value = false args1(4).Name = "SearchItem.SearchFiltered" args1(4).Value = false args1(5).Name = "SearchItem.Backward" args1(5).Value = false args1(6).Name = "SearchItem.Pattern" args1(6).Value = true args1(7).Name = "SearchItem.Content" args1(7).Value = false args1(8).Name = "SearchItem.AsianOptions" args1(8).Value = false args1(9).Name = "SearchItem.AlgorithmType" args1(9).Value = 0 args1(10).Name = "SearchItem.SearchFlags" args1(10).Value = 65536 args1(11).Name = "SearchItem.SearchString" args1(11).Value = fromStyle args1(12).Name = "SearchItem.ReplaceString" args1(12).Value = toStyle args1(13).Name = "SearchItem.Locale" args1(13).Value = 255 args1(14).Name = "SearchItem.ChangedChars" args1(14).Value = 2 args1(15).Name = "SearchItem.DeletedChars" args1(15).Value = 2 args1(16).Name = "SearchItem.InsertedChars" args1(16).Value = 2 args1(17).Name = "SearchItem.TransliterateFlags" args1(17).Value = 1280 args1(18).Name = "SearchItem.Command" args1(18).Value = 3 args1(19).Name = "SearchItem.SearchFormatted" args1(19).Value = false args1(20).Name = "SearchItem.AlgorithmType2" args1(20).Value = 1 args1(21).Name = "Quiet" args1(21).Value = true dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1()) end sub 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 subShellSort(mArray) Dim n As Integer Dim h As Integer Dim i As Integer Dim j As Integer Dim t As String Dim Ub As Integer Dim LB As Integer Lb = lBound(mArray) Ub = uBound(mArray) ' compute largest increment n = Ub - Lb + 1 h = 1 If n > 14 then do while h < n h = 3 * h + 1 loop h = h \ 3 h = h \ 3 End If Do While h > 0 For i = Lb + h to Ub t = mArray(i) For j = i - h to Lb step -h If strComp(mArray(j), t, 0) < 1 then Exit For EndIf mArray(j + h) = mArray(j) Next j mArray(j + h) = t Next i h = h \ 3 Loop End Sub sub setZoomToSpeedUpTasks dim document as object dim dispatcher as object dim args1(2) as new com.sun.star.beans.PropertyValue dim args2(1) as new com.sun.star.beans.PropertyValue document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") args1(0).Name = "Zoom.Value" args1(0).Value = 60 args1(1).Name = "Zoom.ValueSet" args1(1).Value = 28703 args1(2).Name = "Zoom.Type" args1(2).Value = 0 dispatcher.executeDispatch(document, ".uno:Zoom", "", 0, args1()) args2(0).Name = "ViewLayout.Columns" args2(0).Value = 1 args2(1).Name = "ViewLayout.BookMode" args2(1).Value = false dispatcher.executeDispatch(document, ".uno:ViewLayout", "", 0, args2()) end sub