mdlprint1.bas

利用VB编写的一个完整的酒店管理程序,支持双数据库!

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