Attribute VB_Name = "mdlPrint1"
'FIXIT: 使用 Option Explicit 可以避免隐式创建 Variant 类型的变量 FixIT90210ae-R383-H1984
Dim PageLeft As Single
Dim PageTop As Single
Private Type printtext
caption As String
X As Single
y As Single
strfont As String
strsize As Integer
End Type
Private Type cell
x1 As Single
y1 As Single
x2 As Single
y2 As Single
LineWidth As Integer
str As printtext
End Type
Public Type PageSetting
sngPageLeft As Single
sngPageTop As Single
sngPageWidth As Single
sngPageHeight As Single
sngDirect As Single '打印方向
End Type
Public Sub PrintPage(myPage As PageSetting, _
strTitle As String, strHead1 As String, _
strHead2 As String, strHead3 As String, _
Grid As MSFlexGrid, Gridcols As String, _
RowsHeight As Single, LineWidth As Integer)
Const HeadHeight = 6
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.ScaleMode = 6
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.Orientation = myPage.sngDirect '打印方向
PageLeft = myPage.sngPageLeft
PageTop = myPage.sngPageTop
'PageLeft = 0
'PageTop = 0
Dim AllPages As Long '总页数
Dim RowsPerPage As Long '每页表格行的数量
Dim PerPages As Long '每页的循环变量
Const GridLeft = 0
Const GridTop = 15 + HeadHeight * 2
RowsPerPage = Int((myPage.sngPageHeight - GridTop - RowsHeight - 15) / RowsHeight) '计算每页的表格行数不包括列头
AllPages = Int((Grid.Rows - 1 + 0.1) / RowsPerPage) + 1
'--计算列宽
Dim ScaleWidth As Single '表格总宽 计算比例时用
Dim mycols() As String '存储要打印的列的一维数组
mycols = Split(Gridcols, ",")
Dim MyColX(20) As Single '每一列左右坐标，第0列是mycolx(0)-mycolx(1)
MyColX(0) = 0
For i = 0 To UBound(mycols)
'FIXIT: Visual Basic .NET 中不支持在运行时更改 "ColWidth(i)" FixIT90210ae-R8024-R57265
ScaleWidth = ScaleWidth + Grid.ColWidth(i)
MyColX(i + 1) = ScaleWidth
Next i
For PerPages = 1 To AllPages '每页循环
'--计算标题的左边
Dim titleLonger As Long '-标题共长多少字节
Dim titleLeft As Single
titleLonger = LenB(strTitle)
titleLeft = (myPage.sngPageWidth - titleLonger * 4) / 2
'--打印标题
printCellOut 0, 0, 0, 0, 0, titleLeft, 0, strTitle, "宋体", 18
'--打印头1
printCellOut 0, 0, 0, 0, 0, 0, 15, strHead1, "", 12
'--打印头2
printCellOut 0, 0, 0, 0, 0, 0, 15 + HeadHeight, strHead2, "", 12
'--计算右对齐的左边
Dim HeadLeft3 As Single
HeadLeft3 = myPage.sngPageWidth - (LenB(strHead3) * 2)
'--打印头3
printCellOut 0, 0, 0, 0, 0, HeadLeft3, 15 + HeadHeight, strHead3, "", 12
'--打印表格（0，28）
'FIXIT: 用早期绑定的数据类型声明 "NowCol" FixIT90210ae-R1672-R1B8ZE
Dim NowCol, NowRow As Long
'-打印列头
NowRow = 0
For NowCol = 0 To UBound(mycols)
printCellOut GridLeft + (MyColX(NowCol) / ScaleWidth * myPage.sngPageWidth), GridTop + RowsHeight * NowRow, _
GridLeft + (MyColX(NowCol + 1) / ScaleWidth * myPage.sngPageWidth), GridTop + RowsHeight * (NowRow + 1), _
LineWidth, GridLeft + (MyColX(NowCol) / ScaleWidth * myPage.sngPageWidth) + 2, GridTop + RowsHeight * NowRow + 2, _
Grid.TextMatrix(NowRow, mycols(NowCol)), "宋体", 8
Next NowCol
'-打印表格主体
For NowRow = 1 To RowsPerPage
If Not (NowRow + (PerPages - 1) * RowsPerPage) > Grid.Rows - 1 Then
For NowCol = 0 To UBound(mycols)
printCellOut GridLeft + (MyColX(NowCol) / ScaleWidth * myPage.sngPageWidth), GridTop + RowsHeight * NowRow, _
GridLeft + (MyColX(NowCol + 1) / ScaleWidth * myPage.sngPageWidth), GridTop + RowsHeight * (NowRow + 1), _
LineWidth, GridLeft + (MyColX(NowCol) / ScaleWidth * myPage.sngPageWidth) + 2, GridTop + RowsHeight * NowRow + 2, _
Grid.TextMatrix(NowRow + (PerPages - 1) * RowsPerPage, mycols(NowCol)), "宋体", 8
Next NowCol
End If
Next NowRow
'打印页码
printCellOut 0, 0, 0, 0, 0, (myPage.sngPageWidth - 12) / 2, GridTop + RowsHeight * (NowRow + 1) + 2, "第" + CStr(PerPages) + "页", "", 12
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.EndDoc
Next PerPages
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.Orientation = myPage.sngDirect
MsgBox "打印完成! ", vbInformation, "Hello"
End Sub
Private Sub printcell(prncell As cell)
On Error GoTo err1
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.ScaleMode = 6
If Not prncell.LineWidth = 0 Then
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.DrawWidth = prncell.LineWidth
End If
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
If Not Printer.FillColor = 0 Then
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.Line (prncell.x1, prncell.y1)-(prncell.x2, prncell.y2), , BF
Else
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.FillStyle = 1
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.Line (prncell.x1, prncell.y1)-(prncell.x2, prncell.y2), , B
End If
If prncell.str.strfont = "" Then
prncell.str.strfont = "宋体"
End If
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.Font = prncell.str.strfont
If prncell.str.strsize = 0 Then
prncell.str.strsize = 12
End If
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.FontSize = prncell.str.strsize
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.CurrentX = prncell.str.X
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.CurrentY = prncell.str.y
'FIXIT: 升级向导未将 Printer 对象和 Printers 集合升级到 Visual Basic .NET。 FixIT90210ae-R5481-H1984
Printer.Print prncell.str.caption
Exit Sub
err1:
MsgBox "打印报表错误：" & Err.Description, vbExclamation, "hello!"
End Sub
Private Sub printCellOut(x1 As Single, y1 As Single, x2 As Single, y2 As Single _
, LineWidth As Integer, _
strx As Single, stry As Single, _
strcaption As String, strfont As String, _
strsize As Integer)
Dim printWords As cell
printWords.x1 = x1 + PageLeft
printWords.y1 = y1 + PageTop
printWords.x2 = x2 + PageLeft
printWords.y2 = y2 + PageTop
printWords.LineWidth = LineWidth
printWords.str.X = strx + PageLeft
printWords.str.y = stry + PageTop
printWords.str.caption = strcaption
printWords.str.strfont = strfont
printWords.str.strsize = strsize
If printWords.x2 < 0 Then
printWords.x2 = 0
End If
If printWords.x1 < 0 Then
printWords.x1 = 0
End If
If printWords.y1 < 0 Then
printWords.y1 = 0
End If
If printWords.y2 < 0 Then
printWords.y2 = 0
End If
If printWords.str.X < 0 Then
printWords.str.X = 0
End If
If printWords.str.y < 0 Then
printWords.str.y = 0
End If
printcell printWords
End Sub
