epublishing/ePublishing/Archive.xba

<?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 archMark9

End Sub

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(&quot;com.sun.star.frame.DispatchHelper&quot;)
	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=&quot;Footnote anchor&quot;
	  oEnum = aNote.Text.createEnumeration()
	  Do While oEnum.hasMoreElements()
	    oCurPar = oEnum.nextElement()
	    oCurPar.ParaStyleName = &quot;Footnote&quot;
	  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(&quot;bidirectLinkSuggestion&quot;)
	  Exit Sub
	End If
	oSelections = ThisComponent.getCurrentSelection()
	If IsNull(oSelections) Then 
	  MsgBox getTranslation(&quot;bidirectLinkSuggestion&quot;)
	  Exit Sub
	End If
	objectsCount = oSelections.getCount() - 1
	If objectsCount &lt; 2 OR objectsCount &gt; 2 Then
	  MsgBox getTranslation(&quot;bidirectLinkSuggestion&quot;)
	  Exit Sub	
	End If
	
	oAnchor1 = oSelections.getByIndex(1)
	oAnchor2 = oSelections.getByIndex(2)
	oAnchor1Name = RND_String()
	oAnchor2Name = RND_String()
	createAnchor(oAnchor1,oAnchor1Name)
	createAnchor(oAnchor2,oAnchor2Name)
	createLink(oAnchor1,oAnchor1.String,oAnchor2Name)
	createLink(oAnchor2,oAnchor2.String,oAnchor1Name)
End Sub

Sub createAnchor(targetRange as Object,anchorName as String)
	dim oViewCursor as object
	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	oViewCursor = ThisComponent.CurrentController.getViewCursor()
	oViewCursor.gotoRange(targetRange,false)
	dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = &quot;Bookmark&quot;
	args1(0).Value = anchorName
	dispatcher.executeDispatch(document, &quot;.uno:InsertBookmark&quot;, &quot;&quot;, 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(&quot;com.sun.star.frame.DispatchHelper&quot;)
	oViewCursor = ThisComponent.CurrentController.getViewCursor()
	oViewCursor.gotoRange(targetRange,false)
	dim args2(4) as new com.sun.star.beans.PropertyValue
	args2(0).Name = &quot;Hyperlink.Text&quot;
	args2(0).Value = linkName
	args2(1).Name = &quot;Hyperlink.URL&quot;
	args2(1).Value = &quot;#&quot;+linkURL
	args2(2).Name = &quot;Hyperlink.Target&quot;
	args2(2).Value = &quot;&quot;
	args2(3).Name = &quot;Hyperlink.Name&quot;
	args2(3).Value = linkName
	args2(4).Name = &quot;Hyperlink.Type&quot;
	args2(4).Value = 1
	dispatcher.executeDispatch(document, &quot;.uno:SetHyperlink&quot;, &quot;&quot;, 0, args2())
End Sub

Function RND_String
	Dim OutputString As String
	Dim TempString As String
	Dim i as Long

	OutputString=&quot;&quot;
	randomize
	
	For i = 1 to 20
	  Select Case i
	    Case 5, 8, 11, 14
		  OutputString=OutputString+&quot;-&quot;
		Case Else
		  TempString=Hex(int(rnd*256))
		  If len(TempString) &lt; 2 Then 
		    TempString=TempString+&quot;0&quot;
		  EndIf
		  OutputString=OutputString+TempString
		End Select
	next i
		
	RND_String = OutputString
End Function


sub convertIndesignPageBreaks
	Dim description As String
	description = getTranslation(&quot;convertIndesignPageBreaksConfirmation&quot;)
	If NOT confirm(description) Then
		Exit Sub
	EndIf
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	oViewCursor = thisComponent.getCurrentController.getViewCursor
	oViewCursor.jumpToFirstPage
	Dim args(0) as new com.sun.star.beans.PropertyValue
	
	rem Turn off tracking changes to prevent infinite
	args(0).Name = &quot;TrackChanges&quot;
	args(0).Value = false
	dispatcher.executeDispatch(document, &quot;.uno:TrackChanges&quot;, &quot;&quot;, 0, args())
	
	Dim oSearch
	Dim oTextCursor 
	Dim lineIndent
	Dim firstLowercase As Boolean
	Dim charNum As Long
	Dim character As String
	firstLowercase = false

	oSearch = ThisComponent.createSearchDescriptor()
	oSearch.SearchString = &quot;---XYXYX---&quot;
	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)
		  oTextCursor.goRight(1,true)
		  oTextCursor.String = &quot;&quot;
		  oTextCursor.BreakType = com.sun.star.style.BreakType.PAGE_BEFORE

  		  &apos;check first character
		  oTextCursor.goRight(1,true)
		  If (isLowerCase(oTextCursor.getString())) Then
		  	oTextCursor.ParaFirstLineIndent = 0
		  	firstLowercase = true 	
		  End If
  	      &apos;check last character
		  oTextCursor.goLeft(2,false)
		  oTextCursor.goLeft(1,true)	  
		  character = oTextCursor.getString()
		  If (character = &quot; &quot;) Then
		  	oTextCursor.String=&quot;&quot;
		  	adjustLastLine(oTextCursor)
		  	adjustFirstLine(oTextCursor)
		  EndIf		  
		  If (isLowerCase(character)) Then
		  	If firstLowercase Then
		  		oTextCursor.collapseToEnd()
			  	oTextCursor.setString(&quot;-&quot;)
			  	oTextCursor.collapseToEnd()
  			  	adjustLastLine(oTextCursor)
				adjustFirstLine(oTextCursor)
		  	EndIf
		  End If
		  oFound = ThisComponent.findNext(oFound.End, oSearch)
	Loop
	MsgBox getTranslation(&quot;convertIndesignPageBreaksFinish&quot;)
end Sub

Sub adjustLastLine(oTextCursor)
  	oTextCursor.ParaAdjust = 2
  	oTextCursor.ParaLastLineAdjust = 2
  	balancePara(oTextCursor)
End Sub

Sub adjustFirstLine(oTextCursor)
  	oTextCursor.goRight(1,false)
   	oTextCursor.ParaFirstLineIndent = 0
End Sub


Function isLowerCase(character)
	If (character = &quot;&quot;) Then
	  charNum = ASC(&quot;&quot;+0)
	Else
	  charNum = ASC(character)
	End If
    If ((charNum &gt; 1071 AND charNum &lt; 1104) Or (charNum &gt; 60 AND charNum &lt; 123)) Then
  	  isLowerCase = true
  	  Exit Function
    EndIf
    isLowerCase = false
End Function

Sub balancePara(Optional targetPara As Object)
&apos;	Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
	Dim oViewCursor As Object
	Dim oTextCursor As Object
	Dim oPara As Object
	Dim oParaStart As Object
	Dim oParaEnd As Object
	Dim paraLen As Integer
	Dim lineCount As Integer
	Dim initialLineCount As Integer
	Dim lineLen As Integer
	Dim mathExpect As Integer
	Dim minLastLineLength As Integer
	paraLen = 0
	lineLen = 0
	minLastLineLength = 0
	initialLineCount = 0
	
	oViewCursor = ThisComponent.CurrentController.getViewCursor()
	If NOT IsMissing(targetPara) Then
		oViewCursor.goToRange(targetPara, false)
	EndIf

	oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
	oPara = oViewCursor.Text.createTextCursorByRange(oViewCursor)
	&apos;Go to start of para
	oTextCursor.gotoStartOfParagraph(false)
	&apos;Get start position
	oParaStart = oTextCursor.getStart()
	&apos;Go to end of para
	oTextCursor.gotoEndOfParagraph(false)
	&apos;Get end position
	oParaEnd = oTextCursor.getEnd()
	&apos;return Text cursor to start
	oTextCursor.goToRange(oParaStart,false)
	&apos;oPara is full para cursor
	oPara.goToRange(oParaStart,false)
	oPara.goToRange(oParaEnd,true)
	
	Do
		&apos;Not first iteration
		If minLastLineLength &lt;&gt; 0 Then
			If oPara.CharKerning &lt; 30 Then
					If(IsEmpty(oPara.CharKerning)) Then 
						oPara.CharKerning = 0
					Else 	
						oPara.CharKerning = oPara.CharKerning + 2
					End If
			Else
				&apos;Failed to balance para
				Exit Sub
			EndIf
		EndIf
		
		oViewCursor.goToRange(oParaStart,false)
		oTextCursor.goToRange(oParaStart,false)
		lineCount = 0
		While NOT oTextCursor.isEndOfParagraph()
			oViewCursor.gotoEndOfLine(true)
			oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
			lineLen = Len(oTextCursor.getString())
			paraLen = paraLen +  lineLen
			lineCount = lineCount + 1
			oViewCursor.collapseToEnd()
		Wend
		&apos;set initial line count
		If initialLineCount = 0 Then
			initialLineCount = lineCount
		ElseIf lineCount &gt; initialLineCount Then
		&apos;Undo last iteration as line overflow happened.
		&apos;And exit
			If(IsEmpty(oPara.CharKerning)) Then 
				oPara.CharKerning = 0
			Else 	
				oPara.CharKerning = oPara.CharKerning - 2
			End If
			Exit sub
		EndIf
		mathExpect =  paraLen / lineCount
		minLastLineLength = mathExpect * 0.9
	Loop Until minLastLineLength &lt; lineLen
	
End Sub


Sub convertBookmarksToFootnotes()
	Dim description As String
	description = getTranslation(&quot;convertIndesignFoonotesConfirmation&quot;)
	If NOT confirm(description) Then
		Exit Sub
	EndIf

	Dim bookmarks as Object
	Dim bookmarkName 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 = &quot;footnote-&quot;
	backLinkSuffix = &quot;-backlink&quot;
	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 = &quot;&quot;
			backwardLink = &quot;&quot;
			If InStr(bookmarkName, backLinkSuffix) &gt; 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(&quot;convertIndesignFootnotesFinish&quot;)
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
		&apos;If msgbox( &quot;NO SuCH LINK&quot;, 36 ) = 6 Then Stop
	EndIf	
	forward = bookmarks.getByName(forwardLink)
	backward = bookmarks.getByName(backwardLink)
	oViewCursor.goToRange(forward.Anchor,false)
	footNoteSign = oViewCursor.getString()
	backspace
	backspace
	SendRM
	oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
	oTextCursor.gotoEndOfParagraph(false)
	oTextCursor.gotoStartOfParagraph(true)
	oViewCursor.goToRange(oTextCursor,true)
	unoCut()
	SendRM
	oViewCursor.goToRange(backward.Anchor,false)
	backspace
	createFootnote
	unoPaste()
	oViewCursor.getText.setLabel(footNoteSign)
	forward.dispose()
	backward.dispose()
End sub


sub unoCut
	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dispatcher.executeDispatch(document, &quot;.uno:Cut&quot;, &quot;&quot;, 0, Array())
end sub

sub unoPaste
	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dispatcher.executeDispatch(document, &quot;.uno:Paste&quot;, &quot;&quot;, 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(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dispatcher.executeDispatch(document, &quot;.uno:InsertFootnote&quot;, &quot;&quot;, 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 oldStyle As Object
    dim newStyleName 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(&quot;ePublishing&quot;)
    oDialog = CreateUnoDialog( DialogLibraries.ePublishing.replaceParaStyle )
    listBox = oDialog.getControl(&quot;ListBox1&quot;)
    listBox.addItems(sortedDPSN , 0)
    oDialog.Title = getTranslation(&quot;replaceParaStyleDialogTitle&quot;)
    oDialog.Execute()
    newStyleName = oDialog.model.Tag
    If newStyleName=&quot;0&quot; or newStyleName=&quot;&quot; Then
        Exit sub
    EndIf
    foundIndex = getIndex(displayParaStyleNames, newStyleName)
    &apos;set style system name instead of display name
	newStyleName = paraStyleNames(foundIndex)
 
    If newStyleName = oldStyleName Then
        MsgBox getTranslation(&quot;replaceParaStyleStylesEqualsNotification&quot;)
        Exit sub
    EndIf

    If oldStyleName &lt;&gt; &quot;&quot; Then
	    oldStyle = paraStyles.getByName(oldStyleName)
	    If NOT oldStyle.isUserDefined Then
        	MsgBox getTranslation(&quot;replaceParaStyleCurrentStyleIsStandard&quot;)
    	    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(&quot;com.sun.star.text.Paragraph&quot;) Then
			If enum1Element.ParaStyleName &lt;&gt; newStyleName  Then
			    oldStyle = paraStyles.getByName(enum1Element.ParaStyleName)
			    oldStyle.ParentStyle = newStyleName
			    paraStyles.removeByName(enum1Element.ParaStyleName)
			EndIf
		EndIf
	Wend
	

End Sub

Function getIndex(a, v)
	Dim id As Integer
	Dim nRight As Integer
	Dim nLen As Integer
	id = 0
	nRight = uBound(a)
	nLen = len(v)
	while id &lt;= nRight
       if a(id) = v 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)
	 
	&apos; compute largest increment
	n = Ub - Lb + 1
	h = 1
	If n &gt; 14 then
	  do while h &lt; n
	    h = 3 * h + 1
	  loop
	  h = h \ 3
	  h = h \ 3
	End If
	Do While h &gt; 0
	  For i = Lb + h to Ub
	    t = mArray(i)
	    For j = i - h to Lb step -h
	      If strComp(mArray(j), t, 0) &lt; 1 then
	        Exit For
	      EndIf
	      mArray(j + h) = mArray(j)
	    Next j
	    mArray(j + h) = t
	  Next i
	  h = h \ 3
	Loop
End Sub
</script:module>