epublishing/ePublishing/TOCLinks.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="TOCLinks" script:language="StarBasic" script:moduleType="normal">Sub makeOutlineLinks
	Dim oViewCursor As Object
	Dim i As Integer
	oViewCursor = ThisComponent.CurrentController.getViewCursor()
	oViewCursor.jumpToFirstPage()
	For i = 1 To 10
		makeLinksWithLevel(i)
	Next i
	MsgBox (getTranslation(&quot;OutlineLinksFinished&quot;))
End Sub


Sub makeLinksWithLevel(level)

	Dim heading() As Object
	Dim outline() As Object
	Dim oAnchor1Name As String
	Dim oAnchor2Name As String
	Dim message As String
	Dim i As Integer
	heading = getHeadingWithLevel(level)
	outline = getOutlineWithLevel(level)
	If  Ubound(heading) &lt;&gt; -1 AND Ubound(outline) &lt;&gt; -1 Then
		If (Ubound(outline) + 1) MOD (Ubound(heading) + 1 )  = 0 Then
			For i = 0 To (Ubound(outline))
				oAnchor2Name = &quot;Outline &quot; + level + &quot;.&quot; + (i Mod (Ubound(heading) + 1))
				If i &lt;= Ubound(heading) Then
					createAnchor(heading(i Mod (Ubound(heading) + 1)),oAnchor2Name)
				EndIf
				createLink(outline(i),&quot;&quot;,oAnchor2Name)
			Next i
		Else 
			message =  getTranslation(&quot;TOCErrorContentsNotMatchHeadings1&quot;) &amp; &quot; &quot; &amp; level &amp; &quot; (&quot; &amp; (Ubound(outline)+1) &amp;&quot;) &quot; &amp; _
		  			   getTranslation(&quot;TOCErrorContentsNotMatchHeadings2&quot;)  &amp; &quot; &quot; &amp; level &amp; &quot; &quot; &amp; _
		  			   getTranslation(&quot;TOCErrorContentsNotMatchHeadings3&quot;) &amp; &quot; (&quot; &amp; (Ubound(heading)+1) &amp; &quot;)&quot;
			showTOCLinksDialog(message, heading(), outline() )
		EndIf	
	ElseIf Ubound(outline) = -1 Then
&apos;		MsgBox (getTranslation(&quot;TOCErrorNoContents1&quot;) &amp; &quot; &quot; &amp; level &amp; &quot; &quot; &amp; getTranslation(&quot;TOCErrorNoContents2&quot;))
	ElseIf Ubound(heading) = -1 Then
		MsgBox getTranslation(&quot;TOCErrorNoHeadings1&quot;) &amp; &quot; &quot; &amp; level &amp; &quot; &quot; &amp; getTranslation(&quot;TOCErrorNoHeadings2&quot;)
	EndIf
	
End Sub

Function getHeadingWithLevel(curNum)
	Dim enum1Element As Object
	Dim enum1 As Object
	Dim enum2 As Object
	Dim thisPortion As Object
	Dim footnoteText As Object
	Dim label As String
	Dim labelNum As Integer
	Dim i As Integer
	Dim count As Integer
	Dim cell As Object
	Dim cellEnum As Object
	Dim cellEnum2 As Object
	Dim headingPar() As Object
	enum1 = ThisComponent.Text.createEnumeration
	While enum1.hasMoreElements
		enum1Element = enum1.nextElement
		If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
			If enum1Element.OutlineLevel = curNum Then
				 addToArray(headingPar(),enum1Element)
			EndIf
			
		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))
				cellEnum = cell.getText().createEnumeration()
				While cellEnum.hasMoreElements 
					cellEnumElement = cellEnum.nextElement
					If cellEnumElement.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
						If cellEnumElement.OutlineLevel = curNum Then
				 			addToArray(headingPar(),cellEnumElement)
						EndIf
			
					EndIf
				Wend
		    Next i

		EndIf
	Wend 
	getHeadingWithLevel = headingPar()
End Function

Function getOutlineWithLevel(curNum)

	Dim enum1Element As Object
	Dim enum1 As Object
	Dim enum2 As Object
	Dim thisPortion As Object
	Dim footnoteText As Object
	Dim label As String
	Dim labelNum As Integer
	Dim i As Integer
	Dim count As Integer
	Dim cell As Object
	Dim cellEnum As Object
	Dim cellEnum2 As Object
	Dim par() As Object
	Dim parName As String
	Dim cellEnumElement As Object
	parName = &quot;Contents &quot; + curNum
	enum1 = ThisComponent.Text.createEnumeration
	While enum1.hasMoreElements
		enum1Element = enum1.nextElement
		If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
			If enum1Element.ParaStyleName = parName Then
				 addToArray(par(),enum1Element)
			EndIf
			
		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))
				cellEnum = cell.getText().createEnumeration()
				While cellEnum.hasMoreElements 
					cellEnumElement = cellEnum.nextElement
					If cellEnumElement.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
						If cellEnumElement.ParaStyleName = parName Then
				 			addToArray(par(),cellEnumElement)
						EndIf
			
					EndIf
				Wend
		    Next i
		Else 
		EndIf
	Wend 
	getOutlineWithLevel = par()
End Function


Sub showTOCLinksDialog(message As String, heading() As Object, outline() As Object)
	Dim pDialog As Object	
    Dim grid As Object
    Dim headingsColumn As Object
    Dim tocColumn As Object
    Dim oGridControl As Object
    Dim oColumnModel As Object
    Dim oDataModel As Object
    Dim rect As Object
    Dim i As Integer
    Dim j As Integer
    Dim outlineCell As String
    Dim headingCell As String
    DialogLibraries.LoadLibrary(&quot;ePublishing&quot;)
    pDialog = CreateUnoDialog( DialogLibraries.ePublishing.toc_links )
 
	&apos;grid = pDialog.getControl(&quot;grid&quot;)
	grid = pDialog.Model.createInstance(&quot;com.sun.star.awt.grid.UnoControlGridModel&quot;)
	grid.Name = &quot;tocGrid&quot;
	grid.ShowColumnHeader = True
    grid.ShowRowHeader = True
	grid.VScroll = true
	grid.Sizeable = true
	grid.Step = 0
	
	oColumnModel = createUnoService( &quot;com.sun.star.awt.grid.DefaultGridColumnModel&quot;)
 
	tocColumn = createUnoService( &quot;com.sun.star.awt.grid.GridColumn&quot;)
	tocColumn.Title = getTranslation(&quot;tocItemText&quot;)
	tocColumn.ColumnWidth = 100
	tocColumn.Resizeable = true
    &apos;tocColumn.Flexibility = true
	
	oColumnModel.addColumn( tocColumn )
	
	headingsColumn = createUnoService( &quot;com.sun.star.awt.grid.GridColumn&quot;)
	headingsColumn.Title = getTranslation(&quot;headingItemText&quot;)
	headingsColumn.ColumnWidth = 100
	headingsColumn.Resizeable = true
	&apos;headingsColumn.Flexibility = true
	
	oColumnModel.addColumn( headingsColumn )

	grid.ColumnModel = oColumnModel
	&apos;grid.Sizeable = False
    &apos;gridStep = 0
    
	oDataModel = createUnoService( &quot;com.sun.star.awt.grid.DefaultGridDataModel&quot;)
	If  Ubound(outline) &gt;  Ubound(heading) Then
		For i = 0 To (Ubound(outline))
			outlineCell = outline(i).getString()
			j = i MOD (Ubound(heading) + 1) 
			headingCell = heading(j).getString()
			oDataModel.addRow ( i+1 , Array(outlineCell, headingCell) )
		Next 
	Else
		For i = 0 To (Ubound(heading))
			headingCell = heading(i).getString()
			If i &gt; Ubound(outline) Then
				outlineCell = &quot;&quot;
			Else 
				outlineCell = outline(i).getString()
			EndIf
			oDataModel.addRow ( i+1 , Array(outlineCell, headingCell) )
		Next i
	EndIf
	grid.GridDataModel = oDataModel
	
	oGridControl = createUnoService(&quot;com.sun.star.awt.grid.UnoControlGrid&quot;)
	oGridControl.setModel(grid)   
	pDialog.addControl(&quot;gridtab&quot;, oGridControl)
	rect = pDialog.getPosSize()
	oGridControl.setPosSize(10,60,rect.Width - 20,rect.Height - 120, com.sun.star.awt.PosSize.POSSIZE)
	
	

	
	pDialog.getControl(&quot;Ok&quot;).Label = getTranslation(&quot;buttonOk&quot;)
	pDialog.getControl(&quot;message&quot;).SetText(message)
    pDialog.Title = getTranslation(&quot;tocDialogLabel&quot;)
	pDialog.Execute()
    pDialog.dispose()
End Sub





Sub addToArray(xArray(),vNextElement)
	Dim iUB As Integer
	Dim iLB As Integer
	iLB = lBound(xArray())
	iUB = uBound(xArray())
	If iLB &gt; iUB then
	   iUB = iLB
	   redim xArray(iLB To iUB)
	Else
	   iUB = iUB +1
	   redim preserve xArray(iLB To iUB)
	Endif
	xArray(iUB) = vNextElement
End Sub

</script:module>