改进drawText过程

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

前面几节示例的lambda过程drawText用于绘制文本，这个过程有一个不足，就是只考虑了单行文本。

如果表格和表格之间存在多行文本，而多行文本就存在需跨页绘制的可能，原来的drawText过程已经不能满足要求了，需要改进。

改进的原理参考：跨页文本测量

下面是改进后的drawText，可以在多个表格之间跨页绘制长文本，请仔细体会：

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 = tRect.Height + (rectPage.Bottom - tRect.Bottom) '剩余空间全部分配给tRect
    If trect.Height <= 0 Then '如果没有剩余空间
        pdc.NewPage() '则另起一页
        tRect = rectPage
    End If
    Dim nextChar As Integer '定义一个变量，用于记录开始绘制字符的位置，默认为0 ，也就是从第一个字符开始绘制
    While nextChar < tText.Length - 1 '如果还有剩余字符没有绘制
        Dim firstChar = nextChar '用于记录每次绘制的开始位置
        nextChar = pdc.DrawString(tText, tFont, color.Black, tRect, nextChar, tsf) '注意DrawString返回的就是未绘制内容的第一个的位置
        If nextChar < tText.Length - 1 Then '如果还有剩余字符没有绘制
            pdc.NewPage() '则另起一页
            tRect = rectPage
        Else '如果已经绘制完毕
            tRect.Height = pdc.MeasureString(tText, tFont, trect.Width, tsf, firstChar).Height
            tRect.Offset(0, trect.Height) '移到下一个内容的起始位置
        End If
    End While
    Return tRect '返回tRect
End Function  

示例

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

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 = tRect.Height + (rectPage.Bottom - tRect.Bottom) '剩余空间全部分配给tRect
    If trect.Height <= 0 Then '如果没有剩余空间
        pdc.NewPage() '则另起一页
        tRect = rectPage
    End If
    Dim nextChar As Integer '定义一个变量，用于记录开始绘制字符的位置，默认为0 ，也就是从第一个字符开始绘制
    While nextChar < tText.Length - 1 '如果还有剩余字符没有绘制
        Dim firstChar = nextChar '用于记录每次绘制的开始位置
        nextChar = pdc.DrawString(tText, tFont, color.Black, tRect, nextChar, tsf) '注意DrawString返回的就是未绘制内容的第一个的位置
        If nextChar < tText.Length - 1 Then '如果还有剩余字符没有绘制
            pdc.NewPage() '则另起一页
            tRect = rectPage
        Else '如果已经绘制完毕
            tRect.Height = pdc.MeasureString(tText, tFont, trect.Width, tsf, firstChar).Height
            tRect.Offset(0, trect.Height) '移到下一个内容的起始位置
        End If
    End While
    Return tRect '返回tRect
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为改行所在的矩形局域
Dim drawRow =
Function(dr As DataRow, tFields() As String, tWidths() As Integer, tRect As RectangleF)
    tRect.Height = rowHeight '设置行高
    If tRect.Bottom > rectPage.Bottom Then '如果剩余空间不够
        pdc.NewPage() '则另起一页
        tRect.Y = rectPage.Y '定位到页首
        tRect = drawHeader.Invoke(tFields, tWidths, 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
        pdc.DrawString(dr(tFields(c)), fontData, Color.Black, rectContent, sf) '绘制单元格内容
        rectBorder.Offset(rectBorder.Width, 0) ''将rectBorder右移到下一个单元格位置
    Next
    tRect.Offset(0, tRect.Height) '移动到下一个内容的起始位置
    Return tRect '返回rect
End Function

'调用lambda过程按客户分组打印订单表
Dim rectRow As RectangleF = rectPage 'rectRow将传递给所有用于绘制的lambda过程的tRect参数，相当于一个位置游标，始终都在动态变化中
rectRow = drawText.Invoke("2009年1月订单数据", New Font("微软雅黑", 16, fontstyle.Bold), StringAlignment.Center, rectRow) '文档标题
rectRow.Offset(0, 20) '表标题下方20磅位置开始绘制后续内容
Dim fields() As String = {"产品", "客户", "单价", "数量", "日期"} '要绘制的列
Dim Widths() As Integer = {80, 80, 80, 80, 148} '各列宽度，单位为磅
For Each Customer As String In DataTables("订单").GetValues("客户")
    Dim tmpString As String = Customer
    For i As Integer = 0 To Rand.Next(50) '生成不定长字符
        tmpString = tmpString & vbCrLf & Customer
    Next
    rectRow = drawText.Invoke(tmpString, New Font("微软雅黑", 12), StringAlignment.Near, rectRow) '绘制不定长字符
    rectRow.Offset(0, 10) '下移10磅绘制后续内容
    rectRow = drawHeader.Invoke(fields, widths, rectRow) '绘制列标题
    For Each r As DataRow In DataTables("订单").Select(CExp("客户='{0}' And 日期 >= #2009-1-1# And 日期 <= #2009-1-31#", Customer)) '逐行绘制
        rectRow = drawRow.Invoke(r, fields, widths, rectRow) '绘制行
    Next
    rectRow.Offset(0, 10) '下移10磅绘制后续内容
Next
pdc.Save(file) '保存文件
Process.Start(file) '打开文件