请先打开CaseStyudy目录下的文件"PDFCreator示例.Table"后再运行本节的示例代码。
这一节继续打印数据表，在上一节的基础上提出了更高的要求，要求按照客户分组汇总：
分组汇总
请先打开CaseStyudy目录下的文件"PDFCreator示例.Table"后再运行本节的示例代码。
这一节继续打印数据表，在上一节的基础上提出了更高的要求，要求按照客户分组汇总：
这个绘制的思路是一样，首先也是指定要绘制的列名和列宽：
Dim
fields()
As
String
= {"日期",
"产品",
"雇员",
"单价",
"数量",
"金额"}
'要绘制的列
Dim
Widths()
As
Integer
= {78, 78, 78, 78, 78, 78}
'各列宽度，单位为磅
由于多了小计行，所以要指定小计行各单元格的宽度：
Dim
totalWidths()
As
Integer
= {312, 78, 78}
'小计行各单元格宽，前4列合并78*4
= 312，后面两列正常宽度
然后我们需要增加一个绘制小计行的lambda过程，这个过程就三个参数，分别指各单元格的宽度和值，以及绘制区域：
Dim
drawTotal =
Function(tWidths()
As
Integer,
tValues()
As
String,
tRect
As
RectangleF)
'代码
End
Function
所以这个drawTotal并非只能用于绘制小计行，实际上可以用于绘制任何行。
当我们需要绘制小计行的时候，只需:
'小计行三个单元格的值分别为字符串"小计"、数量合计和金额合计：
Dim
totalValues()
As
String
= {"小计",
DataTables("订单").Compute("sum(数量)",
flt), DataTables("订单").Compute("sum(金额)",
flt)}
rect = drawTotal.Invoke(totalWidths, totalValues, rect)
示例
所以分类汇总打印数据，并没有什么特别的，下面是完整的代码，请在命令窗口测试执行：
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为改行所在的矩形局域
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
drawTotal =
Function(tWidths()
As
Integer,
tValues()
As
String,
tRect
As
RectangleF)
tRect.Height = rowHeight
'设置行高
If
tRect.Bottom > rectPage.Bottom
Then
'如果剩余空间不够
pdc.NewPage()
'则另起一页
tRect.Y = rectPage.Y
'定位到页首
End
If
Dim
rectBorder = tRect
'单元格边框矩形
For
c
As
Integer
= 0
To
tWidths.Length - 1
'逐个列绘制
rectBorder.Width = tWidths(c)
'设置列宽
pdc.DrawRectangle(pens.DarkGray, rectBorder)
'绘制单元格边框
Dim
rectContent
As
RectangleF = rectBorder
'内容矩形
rectContent.Inflate( - 3, - 3)
'单元格边距为3磅
If
tValues(c) >
""
Then
If
isNumeric( tValues(c))
Then
sf.Alignment = StringAlignment.Far
'数值靠右对齐
Else
sf.Alignment = StringAlignment.Near
'其他靠左对齐
End
If
pdc.DrawString(tValues(c), fontData, Color.Black, rectContent, sf)
'绘制单元格内容
End
If
rectBorder.Offset(rectBorder.Width, 0)
''将rectBorder右移到下一个单元格位置
Next
tRect.Offset(0, tRect.Height)
'移动到下一个内容的起始位置
Return
tRect
'返回rect
End
Function
'调用lambda过程按客户分组打印订单表
Dim
rect
As
RectangleF = rectPage
'rectRow将传递给所有用于绘制的lambda过程的tRect参数，相当于一个位置游标，始终都在动态变化中
rect = drawText.Invoke("2009年1月订单数据",
New
Font("微软雅黑",
16, fontstyle.Bold), StringAlignment.Center, rect)
'文档标题
rect.Offset(0, 20)
'表标题下方20磅位置开始绘制后续内容
Dim
fields()
As
String
= {"日期",
"产品",
"雇员",
"单价",
"数量",
"金额"}
'要绘制的列
Dim
Widths()
As
Integer
= {78, 78, 78, 78, 78, 78}
'各列宽度，单位为磅
Dim
totalWidths()
As
Integer
= {312, 78, 78}
'小计行各单元格宽，前4列合并78*4
= 312，后面两列正常宽度
For
Each
Customer
As
String
In
DataTables("订单").GetValues("客户")
rect = drawText.Invoke(Customer,
New
Font("微软雅黑",
12), StringAlignment.Near, rect)
'绘制客户名称
rect.Offset(0, 5)
'下移5磅绘制后续内容
rect = drawHeader.Invoke(fields, widths, rect)
'绘制列标题
Dim
flt
As
String
= CExp("客户='{0}'
And 日期
>= #2009-1-1# And
日期
<= #2009-1-31#",
Customer)
For
Each
r
As
DataRow
In
DataTables("订单").Select(flt)
'逐行绘制
rect = drawRow.Invoke(r, fields, widths, rect)
'绘制行
Next
'小计行三个单元格的值分别为字符串"小计"、数量合计和金额合计：
Dim
totalValues()
As
String
= {"小计 "
&
Customer,
DataTables("订单").Compute("sum(数量)",
flt), DataTables("订单").Compute("sum(金额)",
flt)}
rect = drawTotal.Invoke(totalWidths, totalValues, rect)
rect.Offset(0, 15)
'下移15磅绘制后续内容
Next
pdc.Save(file)
'保存文件
Process.Start(file)
'打开文件