打印关联表之二
请先打开CaseStyudy目录下的文件"PDFCreator示例.Table"再运行本节的示例代码。
出库表和出库明细表通过出库单号建立了关联，其中出库表为父表，出库明细表为子表。
本节的任务还是用PDFCreator打印一个出库单：
上一节我们已经完成了这个任务，其中来自出库表表的数据采用了手工定位的方式，过程清晰易懂。
但有的场景，来自主表(这里是出库表)的内容很多，如果继续采用手工定位的方式，工作量会随内容的增加而同比增加，且后续需要改变布局的时候，需要调整大量的代码。
所以这一节提供了另一种方式，这个方式不会因为布局的变动和内容的增加而修改代码，这个方式我们之前讲过，参考：合并单元格实战
整个出库单的内容可以当做一个表格来处理：
这个表格的数据来自两个数据表，前三行和最后一行来自出库表，中间的数据来自于出库明细表。
所以我们可以将出库单的打印拆分成两个任务，一部分来自出库表，一部分来自出库明细表，其中来自出库表的部分为：
只需在打印该表格的最后一行之前，先打印出库明细，即可完成任务，如此一来，我们的思路就清晰了 ，步骤为：
1、参考合并单元格实战，打印上图的四行表格。
2、在打印上图表格的最后一行(第四行)之前，插入打印出库明细的代码，参考：打印数据表
不过还有一个问题，在上图的表格中，不同的单元格字体不同，水平对齐方式也不同。
单元格的水平对齐方式，我们当然可以新增一个二维数组来表示之，但是这次我采用不同的方式，在定义表示单元格的二维数组时，加上前缀符号表示单元格的对齐方式，
"<"表示左对齐，">"表示右对齐，"="表示居中对齐。
示例
因为同时要实现合并单元格和打印数据表，所以代码有点长，前面的代码是原样从打印数据表这一节复制过来的，后半节的代码因为要通过二维数组指定单元格对齐方式，所以在合并单元格这一节的基础上有所调整。
考虑到这个代码是通用的，以后类似的打印需求都可以用下面的代码完成，所以还是值得花点时间消化的：
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过程，注意这里有变动，首先不需要填充背景了，其次字体颜色改为黑色
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
cells(, )
As
String
= {
{"=1,6",
0, 0, 0, 0, 0},
{"<1,6",
0, 0, 0, 0, 0},
{"<1,2",
"0",
"=1,2",
"0",
">1,2",
"0"},
{"<1,3",
"0",
"0",
">1,3",
"0",
"0"}
}
Dim
contents(,)
As
String
=
{
{"湛江辉迅出库单",
"",
"",
"",
"",
""},
{"出库单号:"
& pr("出库单编号"),
"",
"",
"",
"",
""},
{"领用部门:"
& pr("领用部门"),
"",
"出库日期:"
& pr("出库日期"),
"",
"领料人:"
& pr("领料人"),
""},
{"库管员:"
& pr("库管员"),
"",
"",
"合计:"
& pr("数量"),
"",
""}
}
Dim
fields()
As
String
= {"商品代码",
"商品名称",
"规格",
"单位",
"数量",
"备注"}
'来自出库明细的列
Dim
Widths()
As
Integer
= {78, 78, 78, 78, 78, 78}
'列宽
Dim
Heights()
As
Double
= {25, 20, 20, 20}
'行高，第一行为出库单标题，比其他行高一点
Dim
rect
As
RectangleF = rectPage
'rect将传递给所有用于绘制的lambda过程的tRect参数，相当于一个位置游标，始终都在动态变化中
For
r
As
Integer
= 0
To
cells.GetLength(0) - 1
'逐行绘制
If
r = 3
Then
'在打印第四行之前
，先打印出库明细
rect = drawHeader.Invoke(fields, Widths, rect)
For
Each
cr
As
DataRow
In
pr.GetChildRows("出库明细")
'逐行绘制
rect = drawRow.Invoke(cr, fields, widths, rect)
'绘制行
Next
End
If
For
c
As
Integer
= 0
To
cells.GetLength(1) - 1
'逐一绘制这行的单元格
Dim
ifo
As
String
= cells(r, c)
If
ifo =
"0"
Then
'0
不绘制单元格
Else
Dim
align
As
String
= ifo.Substring(0, 1).Trim()
Select
Case
align
'设置水平对齐方式
Case
"<"
sf.Alignment = StringAlignment.Near
Case
">"
sf.Alignment = StringAlignment.Far
Case
"="
sf.Alignment = StringAlignment.Center
End
Select
ifo = ifo.Substring(1)
If
ifo =
"1"
Then
'1正常绘制
rect.Height = Heights(r)
rect.Width = Widths(c)
Else
'n,m为合并单元格
Dim
cellHeight
As
Double
= 0
Dim
cellWidth
As
Double
= 0
Dim
vls()
As
String
= ifo.Split(",")
Dim
rowCount
As
Integer
=
CInt(vls(0))
'合并行数
Dim
colCount
As
Integer
=
CInt(vls(1))
'合并列数
For
mr
As
Integer
= r
To
r + rowCount - 1
'根据合并行数计算单元格高度
cellHeight = cellHeight + Heights(mr)
Next
For
mc
As
Integer
= c
To
c + colCount - 1
'根据合并列数计算单元格宽度
cellWidth = cellWidth + Widths(mc)
Next
rect.Height = cellHeight
rect.Width = cellWidth
End
If
Dim
content
As
String
= contents(r, c)
If
content >
""
Then
Dim
rectContent
As
RectangleF = rect
Dim
cellFont
As
Font = fontData
If
r = 0
Then
'第一行是标题，字体加大加粗
cellFont =
New
Font("微软雅黑",
16, fontstyle.Bold)
End
If
rectContent.Inflate( - 3, - 3)
'单元格内容边距为3磅
pdc.DrawString(content, cellFont, color.Black, rectContent, sf)
'绘制单元格文本
End
If
'pdc.DrawRectangle(pens.Black, rect) '绘制单元格
End
If
rect.Offset(Widths(c), 0)
'右移一列
Next
rect.Offset(0, Heights(r))
'下移一行
rect.X = rectPage.X
'单元格回到水平初始位置，准备绘制下一行
Next
pdc.Save(file)
'保存文件
Process.Start(file)
'打开文件