打印关联表之一

请先打开CaseStyudy目录下的文件"PDFCreator示例.Table"，然后选择"出库表"，再运行本节的示例代码。

出库表和出库明细表通过出库单号建立了关联，其中出库表为父表，出库明细表为子表

本节的任务是打印一个下图所示的出库单，同样的任务我们已经用Excel报表、Word报表和WordCreater实现过，现在尝试用PDFCreator实现：

这个出库单的内容来自于两部分，需要分别采用不同的方式来绘制：

1、来自出库明细表的内容，可以采用打印数据表的方式绘制，代码直接复制过来就能用，唯一变化的是列标题由灰底白字改为白底黑字。

2、来自出库单的部分，可以采用普通的文本测量的方式绘制，但原来的DrawText过程每绘制一个文本，就会自动调整垂直位置，但这里的领用部门、出库日期、库管员在绘制完毕后，需要保持垂直位置不变的情况下绘制下一个内容。

所以我们需要修改一下DrawText过程,增加一个tAutoMove参数，此参数为True，自动调整垂直位置，为False则保持垂直位置不变。

修改后的DrawText过程代码为：

Dim drawText =
Function(tText As String, tFont As Font, tAlignment As StringAlignment, tRect As RectangleF, tAutoMove As Boolean)
    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) '绘制文本
    If tAutoMove Then '如果需要调整垂直位置
        tRect.Offset(0, trect.Height) '移到下一个内容的起始位置
    End If
    Return tRect '返回tRec
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("微软雅黑", 10) '列标题字体
Dim fontData As New Font("微软雅黑", 10) '数据单元格字体
'绘制文本的lambda过程, tAutoMove为新增的参数，默认为True，绘制完成后，自动调整返回值位置，如果不需要调整，请设置为False
Dim drawText =
Function(tText As String, tFont As Font, tAlignment As StringAlignment, tRect As RectangleF, tAutoMove As Boolean)
    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) '绘制文本
    If tAutoMove Then '如果需要调整垂直位置
        tRect.Offset(0, trect.Height) '移到下一个内容的起始位置
    End If
    Return tRect '返回tRec
End Function
'绘制列标题的lambda过程，注意这里有变动，首先不需要填充背景了，其次字体颜色改为黑色
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) '绘制单元格边框
        Dim rectContent As RectangleF = rectBorder '列标题内容矩形
        rectContent.Inflate( - 3, - 3) '单元格边距为3磅
        pdc.DrawString(tFields(c), fontHeader, Color.Black, 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
Dim pr As DataRow = Tables("出库").Current.DataRow
Dim fields() As String = {"商品代码", "商品名称", "规格", "单位", "数量", "备注"} '来自出库明细的列
Dim Widths() As Integer = {78, 78, 78, 78, 78, 78} '各列宽度
Dim rect As RectangleF = rectPage 'rect将传递给所有用于绘制的lambda过程的tRect参数，相当于一个位置游标，始终都在动态变化中
rect = drawText.Invoke("出库单", New Font("微软雅黑", 16, fontstyle.Bold), StringAlignment.Center, rect, True) '文档标题
rect.Offset(0, 15) '标题和其他内容间隔15磅
rect = drawText.Invoke("出库单号：" & pr("出库单编号"), fontData, StringAlignment.Near, rect, True)
rect.Width = rectPage.Width / 3 '领用部门、出库日期和领料人的宽度都是页宽的1/3
rect = drawText.Invoke("领用部门：" & pr("领用部门"), fontData, StringAlignment.Near, rect, False) 'tAutoMove为false，后续内容的垂直位置不变
rect.Offset(rect.Width, 0) '右移1/3页宽
rect = drawText.Invoke("出库日期：" & pr("出库日期"), fontData, StringAlignment.Center, rect, False) 'tAutoMove为false，后续内容的垂直位置不变
rect.Offset(rect.Width, 0) '右移1/3页宽
rect = drawText.Invoke("领料人：" & pr("领料人"), fontData, StringAlignment.Far, rect, True)
rect.X = rectPage.X 'rect的宽度恢复到页宽
rect = drawHeader.Invoke(fields, widths, rect) '绘制表标题
For Each cr As DataRow In pr.GetChildRows("出库明细") '逐行绘制
    rect = drawRow.Invoke(cr, fields, widths, rect) '绘制行
Next
rect.Offset(0, 2)
rect.Width = rectPage.Width / 2 '库管员和合计各占1/2页宽
rect = drawText.Invoke("库管员：" & pr("库管员"), fontData, StringAlignment.Near, rect, False) 'tAutoMove为false，后续内容的垂直位置不变
rect.Offset(rect.Width, 0) '右移1/2页宽
drawText.Invoke("合计：" & pr("数量"), fontData, StringAlignment.Far, rect, True)
pdc.Save(file) '保存文件
Process.Start(file) '打开文件