litvinovg/epublishing
1
0
Fork 0
Code Issues Pull requests Projects Releases 33 Packages Wiki Activity Actions
epublishing/ePublishing/TOCLinks.xba

242 lines
No EOL
7.8 KiB
XML
Raw Blame History

<?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>
Reference in a new issue View git blame Copy permalink