完美的跨页自动行高

请先打开CaseStyudy目录下的文件"PDFCreator示例.Table"再运行本节的示例代码。

上一节的跨页自动行高，可以满足绝大多数场合的需要。

有些特殊情况可能会出问题，假定表中除了自动行高列，还有其他列的内容比较长，那么可能会出现3种问题：

1、如果某一行的自动行高列的内容长度小于其他列，那么其他列可能无法被完整绘制出来。

2、如果跨页之后，剩余内容的长度小于其他列，那么其他列可能无法在重复行完整绘制出。

3、如果跨页位置恰好是换行，那么重复绘制的时候会凭空出现一个空行，因为首次绘制的时候，为了避免结尾出现空行，不会绘制结尾的换行符，所以导致剩余内容的开始位置成了换行符， 凭空出现了一个空行：

要解决这个问题：

1、首先在DrawRow中计算行高的时候，不仅要根据自动行高列的内容计算，还要根据其他列的内容计算，然后取最大值即可：

Dim height As Double = 0
For c As Integer = 0 To tFields.Length - 1 '根据自动行高列和其他列，计算出最大行高
    If c = tAutoIndex Then
        height = Math.Max( pdc.MeasureString(dr(tAutoField), fontData, tAutoFieldWidth - 6, sf, firstChar).Height , height)
    Else
        Height = Math.Max( pdc.MeasureString(dr(tFields(c)), fontData, tWidths(c) - 6, sf).Height, Height)
    End If
Next
　

2、获得自动行高列的剩余内容的起始位置(firstChar)后，判断剩余内容的开始位置是否 有换行符号，如果是的，则firstChar往后移动：
Dim content As String = dr(tFields(c))
firstChar = pdc.DrawString(content, fontData, Color.Black, rectContent, firstChar, sf) '绘制单元格内容
If firstChar < content.Length Then '如果有剩余内容
    content = content.Substring(firstChar) '获取剩余内容
    firstChar = firstChar + (content.Length - content.TrimStart(vbcr, vblf).Length) '排除掉剩余内容开始位置的换行符号
End If

示例

下面是完整的代码，可以在命令窗口测试执行，

Dim file As String = "c:\temp\test.pdf"
Dim pdc As New PDFCreator()
Dim rectPage As RectangleF = pdc.PageRectangle
rectPage.Inflate( - 72, - 72)
Dim sf As New StringFormat
sf.LineAlignment = StringAlignment.Center '单元格内容垂直居中
Dim rowHeight As Integer = 20 '行高为20磅
Dim fontHeader As New Font("微软雅黑", 12, fontstyle.Bold) '列标题字体
Dim fontData As New Font("微软雅黑", 10) '数据单元格字体
 
'绘制文本的lambda过程
Dim drawText =
Function(tText As String, tFont As Font, tAlignment As StringAlignment, tRect As RectangleF)
    Dim tsf As New StringFormat
    tsf.Alignment = tAlignment '设置对齐方式
    tRect.Height = pdc.MeasureString(tText, tFont, trect.Width).Height '测量文本高度，并赋值给tRect
    If tRect.Bottom > rectPage.Bottom Then '如果剩余空间不够
        pdc.NewPage() '则另起一页
        tRect.Y = rectPage.Y '定位到页首
    End If
    tRect.Height = pdc.MeasureString(tText, tfont, trect.Width, tsf).Height '将矩形高度设置为文本高度
    pdc.DrawString(tText, tFont, color.Black, tRect, tsf) '绘制文本
    tRect.Offset(0, trect.Height) '移到下一个内容的起始位置
    Return tRect '返回tRec
End Function  

'绘制列标题的lambda过程，tFields为列名，tWidths为列宽，tRect为列标题所在的矩形局域
Dim drawHeader =
Function(tFields() As String, tWidths() As Integer, tRect As RectangleF)
    tRect.Height = rowHeight '设置行高
    If tRect.Bottom > rectPage.Bottom Then '如果剩余空间不够
        pdc.NewPage() '则另起一页
        tRect.Y = rectPage.Y ''定位到页首
    End If
    Dim rectBorder = tRect 'rectBorder为单元格边框矩形
    sf.Alignment = StringAlignment.Center '列标题水平居中
    For c As Integer = 0 To tFields.Length - 1 '逐个绘制标题
        rectBorder.Width = tWidths(c) '设置列宽
        pdc.DrawRectangle(pens.DarkGray, rectBorder) '绘制单元格边框
        pdc.FillRectangle(Color.Gray, rectBorder) '填充背景
        Dim rectContent As RectangleF = rectBorder '列标题内容矩形
        rectContent.Inflate( - 3, - 3) '单元格边距为3磅
        pdc.DrawString(tFields(c), fontHeader, Color.White, rectContent, sf) '绘制单元格内容(列标题)
        rectBorder.Offset(rectBorder.Width, 0) '将rectBorder右移到下一个列标题位置
    Next
    tRect.Offset(0, tRect.Height) '移动到下一个内容的起始位置
    Return tRect '返回rect
End Function  

'绘制行的lambda过程，dr为要绘制的DataRow，tFields为列名，tWidths为列宽，tRect为改行所在的矩形局域, tAutoIndex为自动行高列的索引位置，firstChar为绘制该列内容的起始位置
Dim drawRow =
Function(dr As DataRow, tFields() As String, tWidths() As Integer, tRect As RectangleF, tAutoIndex As Integer, firstChar As Integer)
    Dim tAutoField As String = tFields(tAutoIndex) '获取自动行高列
    Dim tAutoFieldWidth As Integer = tWidths(tAutoIndex) '获得自动行高列的宽度
    Dim height As Double = 0
    For c As Integer = 0 To tFields.Length - 1 '根据自动行高列和其他列，计算出最大行高
        If c = tAutoIndex Then
            height = Math.Max( pdc.MeasureString(dr(tAutoField), fontData, tAutoFieldWidth - 6, sf, firstchar).Height , height)
        Else
            Height = Math.Max( pdc.MeasureString(dr(tFields(c)), fontData, tWidths(c) - 6, sf).Height, Height)
        End If
    Next  
    height = Math.Max(height + 6, rowHeight) '假定单元格边距为3磅，所以文本高度加上6磅为行高，最低行高为rowHeight变量指定的默认行高
    tRect.Height = Math.Min( height, rectPage.Bottom - tRect.Top) '行高取测量取测量高度和剩余高度的最小值
    If tRect.Height < rowHeight Then '如果小于最低行高(标准行高)
        pdc.NewPage() '则另起一页
        tRect.Y = rectPage.Y '定位到页首
        tRect = drawHeader.Invoke(tFields, tWidths, tRect) '给新增加的页面绘制列标题
        tRect.Height = Math.Min( height, rectPage.Bottom - tRect.Top) '重新设置tRect的高度为刚刚测量的高度
    End If
    Dim rectBorder = tRect '单元格边框矩形
    For c As Integer = 0 To tFields.Length - 1 '逐个列绘制
        rectBorder.Width = tWidths(c) '设置列宽
        pdc.DrawRectangle(pens.DarkGray, rectBorder) '绘制单元格边框
        Dim rectContent As RectangleF = rectBorder '内容矩形
        rectContent.Inflate( - 3, - 3) '单元格边距为3磅
        If dr.DataTable.DataCols(tFields(c)).IsNumeric Then '如果是数值列
            sf.Alignment = StringAlignment.Far '水平靠右对齐
        Else
            sf.Alignment = StringAlignment.Near '否则居中对齐
        End If
        If tFields(c) = tAutoField Then '如果是自动行高列
            sf.LineAlignment = StringAlignment.Near
            Dim content As String = dr(tFields(c))
            firstChar = pdc.DrawString(content, fontData, Color.Black, rectContent, firstChar, sf) '绘制单元格内容
            If firstChar < content.Length Then '如果有剩余内容
                content = content.Substring(firstChar) '获取剩余内容
                firstChar = firstChar + (content.Length - content.TrimStart(vbcr, vblf).Length) '排除掉剩余内容开始位置的换行符号
            End If
        Else '如果是普通列
            sf.LineAlignment = StringAlignment.Center
            If firstChar = 0 Then '如果是第一次绘制
                pdc.DrawString(dr(tFields(c)), fontData, Color.Black, rectContent, sf)
            Else '如果是重复绘制
                pdc.DrawString(dr(tFields(c)), fontData, Color.Gray, rectContent, sf)
            End If
        End If
        rectBorder.Offset(rectBorder.Width, 0) ''将rectBorder右移到下一个单元格位置
    Next
    tRect.Offset(0, tRect.Height) '移动到下一个内容的起始位置
    If firstChar < Len(dr(tAutoField)) Then '如果自动行高列还有内容未绘制
        tRect = drawRow.Invoke(dr, tfields, twidths, tRect, tAutoIndex, firstChar) '绘制剩余内容，从firstChar开始
    End If
    Return tRect '返回rect
End Function  

'调用lambda过程绘制员工表
Dim rectRow As RectangleF = rectPage 'rectRow将传递给所有用于绘制的lambda过程的tRect参数，相当于一个位置游标，始终都在动态变化中
rectRow = drawText.Invoke("员工表", New Font("黑体", 20, fontstyle.Bold), StringAlignment.Center, rectRow) '文档标题
rectRow.Offset(0, 25) '表标题下方25磅位置开始绘制后续内容(表格)
rectRow.Height = rowHeight '设置行高
Dim fields() As String = {"姓名", "部门", "职务", "办公电话", "备注"} '要绘制的列
Dim Widths() As Integer = {75, 75, 80, 75, 163} '各列宽度，单位为磅
rectRow = drawHeader.Invoke(fields, widths, rectRow) '绘制列标题
For Each r As Row In Tables("员工").Rows '逐行绘制
    rectRow = drawRow.Invoke(r.DataRow, fields, widths, rectRow, 4, 0) '绘制行，指定第5列(备注列)为自动行高列，firstChar默认为0
Next
pdc.Save(file) '保存文件
Process.Start(file) '打开文件

现在重复行的姓名列就能完整显示了，备注列也不会凭空出现空行了：