feat: provide more info if headings linking with TOC gone wrong

This commit is contained in:
Georgy Litvinov 2021-10-19 23:02:41 +02:00
parent 82dc861e82
commit 05041fc38b
5 changed files with 169 additions and 15 deletions

View file

@ -18,6 +18,7 @@ Sub makeLinksWithLevel(level)
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)
@ -31,7 +32,10 @@ Sub makeLinksWithLevel(level)
createLink(outline(i),"",oAnchor2Name)
Next i
Else
MsgBox getTranslation("TOCErrorContentsNotMatchHeadings1") & " " & level & " (" & (Ubound(outline)+1) & getTranslation("TOCErrorContentsNotMatchHeadings2") & " " & level & " " & getTranslation("TOCErrorContentsNotMatchHeadings3") & (Ubound(heading)+1) & ")"
message = getTranslation("TOCErrorContentsNotMatchHeadings1") & " " & level & " (" & (Ubound(outline)+1) &") " & _
getTranslation("TOCErrorContentsNotMatchHeadings2") & " " & level & " " & _
getTranslation("TOCErrorContentsNotMatchHeadings3") & " (" & (Ubound(heading)+1) & ")"
showTOCLinksDialog(message, heading(), outline() )
EndIf
ElseIf Ubound(outline) = -1 Then
' MsgBox (getTranslation("TOCErrorNoContents1") & " " & level & " " & getTranslation("TOCErrorNoContents2"))
@ -131,6 +135,93 @@ Function getOutlineWithLevel(curNum)
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 i As Integer
Dim j As Integer
Dim outlineCell As String
Dim headingCell As String
DialogLibraries.LoadLibrary("ePublishing")
pDialog = CreateUnoDialog( DialogLibraries.ePublishing.toc_links )
'grid = pDialog.getControl("grid")
grid = pDialog.Model.createInstance("com.sun.star.awt.grid.UnoControlGridModel")
grid.Name = "tocGrid"
grid.ShowColumnHeader = True
grid.ShowRowHeader = false
grid.VScroll = true
grid.Sizeable = true
grid.Step = 0
oColumnModel = createUnoService( "com.sun.star.awt.grid.DefaultGridColumnModel")
tocColumn = createUnoService( "com.sun.star.awt.grid.GridColumn")
tocColumn.Title = getTranslation("tocItemText")
tocColumn.ColumnWidth = 100
tocColumn.Resizeable = true
'tocColumn.Flexibility = true
oColumnModel.addColumn( tocColumn )
headingsColumn = createUnoService( "com.sun.star.awt.grid.GridColumn")
headingsColumn.Title = getTranslation("headingItemText")
headingsColumn.ColumnWidth = 100
headingsColumn.Resizeable = true
'headingsColumn.Flexibility = true
oColumnModel.addColumn( headingsColumn )
grid.ColumnModel = oColumnModel
'grid.Sizeable = False
'gridStep = 0
oDataModel = createUnoService( "com.sun.star.awt.grid.DefaultGridDataModel")
If Ubound(outline) > 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 > Ubound(outline) Then
outlineCell = ""
Else
outlineCell = outline(i).getString()
EndIf
oDataModel.addRow ( i+1 , Array(outlineCell, headingCell) )
Next i
EndIf
grid.GridDataModel = oDataModel
oGridControl = createUnoService("com.sun.star.awt.grid.UnoControlGrid")
oGridControl.setModel(grid)
pDialog.addControl("gridtab", oGridControl)
oGridControl.setPosSize(10,40,850,550, 15)
pDialog.getControl("Ok").Label = getTranslation("buttonOk")
pDialog.getControl("message").SetText(message)
pDialog.Title = getTranslation("tocDialogLabel")
pDialog.Execute()
pDialog.dispose()
End Sub
Sub addToArray(xArray(),vNextElement)
Dim iUB As Integer
Dim iLB As Integer
@ -146,4 +237,4 @@ Sub addToArray(xArray(),vNextElement)
xArray(iUB) = vNextElement
End Sub
</script:module>
</script:module>