多个跨页自动行高列
普通用户可以跳过本节的内容。
请先打开CaseStyudy目录下的文件"PDFCreator示例.Table"再运行本节的示例代码。
有的时候，自动行高列可能有多个，例如下图的"备注"和"教育经历"两列均为自动行高列，均需要跨页绘制：
要实现任意多个跨页自动行高列，就需要改写drawRow方法，原来的tAutoIndex和firstChar参数变为tAutoIndexes和firstChars数组，用于指定多个自动行高列。
另外增加了一个isRepeated参数，用于判断是否是重绘制：
Dim
drawRow =
Function(dr
As
DataRow, tFields()
As
String,
tWidths()
As
Integer,
tRect
As
RectangleF, tAutoIndexes()
As
Integer,
firstChars()
As
Integer,
isRepeated
As
Boolean)
'代码
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("微软雅黑",
12)
'数据单元格字体
'绘制文本的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过程，tAutoIndexes为自动行高列的索引位置，firstChars为自动行高列的内容起始位置,isRepeated表示是否是重复绘制
Dim
drawRow =
Function(dr
As
DataRow, tFields()
As
String,
tWidths()
As
Integer,
tRect
As
RectangleF, tAutoIndexes()
As
Integer,
firstChars()
As
Integer,
isRepeated
As
Boolean)
Dim
height
As
Double
= 0
For
c
As
Integer
= 0
To
tFields.Length - 1
'根据自动行高列和其他列，计算出最大行高
Dim
tAutoIndex
As
Integer
= Array.IndexOf(tAutoIndexes, c)
'获得该列在tAutoIndexes中的位置，如果tAutoIndexes不包括该列，则返回-1
If
tAutoIndex >= 0
Then
'如果是自动行高列
height = Math.Max( pdc.MeasureString(dr(tFields(c)), fontData,
tWidths(c) - 6, sf, firstChars(tAutoIndex)).Height , height)
Else
'如果不是
height = Math.Max( pdc.MeasureString(dr(tFields(c)), fontData,
tWidths(c) - 6).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
'逐个列绘制
Dim
tAutoIndex
As
Integer
= Array.IndexOf(tAutoIndexes, c)'获得该列在tAutoIndexes中的位置，如果tAutoIndexes不包括该列，则返回-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
tAutoIndex >= 0
Then
'如果是自动行高列
sf.LineAlignment = StringAlignment.Near
Dim
content
As
String
= dr(tFields(c))
firstChars(tAutoIndex) = pdc.DrawString(content, fontData,
Color.Black, rectContent, firstChars(tAutoIndex), sf)
'绘制单元格内容
If
firstChars(tAutoIndex) < content.Length
Then
'重复绘制的时候，可能前面会有不必要的空行，下面的代码用于去掉这些空行
content = content.Substring(firstChars(tAutoIndex))
firstChars(tAutoIndex) = firstChars(tAutoIndex) +
(content.Length - content.TrimStart(vbcr, vblf).Length)
End
If
Else
'如果是普通列
sf.LineAlignment = StringAlignment.Center
If
isRepeated =
False
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)
'移动到下一个内容的起始位置
For
idx
As
Integer
= 0
To
tAutoIndexes.Count - 1
If
firstChars(idx) < Len(dr(tFields(tAutoIndexes(idx))))
Then
'如果有剩余内容
tRect = drawRow.Invoke(dr, tfields, twidths, tRect, tAutoIndexes,
firstChars,
True)
'绘制剩余内容，isRepeated为True，表示这是重复绘制
Exit
For
End
If
Next
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, 159, 159 }
'各列宽度，单位为磅
rectRow = drawHeader.Invoke(fields, widths, rectRow)
'绘制列标题
For
Each
r
As
Row
In
Tables("员工").Rows
'逐行绘制
'下面的代码用于绘制行，指定第3列(备注列)和第四列(教育经历)为自动行高列，isRepeated为False，表示这是第一次绘制该行：
rectRow = drawRow.Invoke(r.DataRow, fields, widths, rectRow, {2, 3}, {0, 0},
False)
Next
pdc.Save(file)
'保存文件
Process.Start(file)
'打开文件