www.pudn.com > 考勤管理系统源码(VB含串口接口程序).zip > modPrint.bas

Attribute VB_Name = "modPrint" 
Option Explicit 
Private Const ColDistance = 400 
Private Const RowDistance = 150 
Private Totalwidth As Long 
Private FixedX As Long 
Private FixedY As Long 
Private LinesPerPage As Integer 
Private Lineheight As Integer 
Private Curx As Long 
Private Cury As Long 
Private LineStartx As Long 
Private LineStarty As Long 
Private LineEndy As Long 
Private MaxColWidth As Long 
'区别于PrintGridNormal： 它打印时题头为第一列而不是第一行 
'Title: 标题， 将被醒目打印 
'GridToPrint: 待打印的 Grid 控件名称, 注意必须是 MSFlexGrid 控件 
'SubTitle: 附加标题 
Public Sub PrintGridRoutate(Title As String, Gridtoprint As MSFlexGrid, SubTitle As String) 
On Error GoTo PrinTErr 
If MsgBox("请准备好打印机，单击[确定]开始打印...", vbExclamation + vbOKCancel, "准备打印") = vbOK Then 
    Dim T_str As String 
    Dim P As Integer 
    Dim i As Integer 
    Dim j As Integer 
    Dim k As Integer 
    Dim StartRow As Long 
    Dim EndRow As Long 
    Dim L As Integer 
    'Printer.PaperSize = 9 'A4纸 210 x 297 毫米 
    P = 0 
    With Gridtoprint 
        StartRow = 1 
        EndRow = .Rows - 1 
        i = 0 
        Printer.Orientation = 1 
        LinesPerPage = 3 
        For k = 0 To EndRow - StartRow 
            If (k Mod LinesPerPage) = 0 Then 
'                Call PrintTitleRoutate(Gridtoprint, Title, SubTitle) 
            End If 
            Cury = FixedY 
            .row = k + StartRow 
            Printer.CurrentY = Cury 
            For j = 0 To .Cols - 1 
                If .ColWidth(j) <> 0 Then 
                    .col = j 
                    Printer.CurrentX = Curx 
                    Printer.Print .Text 
                    Cury = Printer.CurrentY + RowDistance * 2 
                    Printer.CurrentY = Cury 
                End If 
            Next j 
            Curx = Curx + ColDistance * 1.5 + MaxColWidth 
            Cury = Printer.CurrentY + Lineheight 
            i = i + 1 
            If i = LinesPerPage Then 
                i = 0 
                P = P + 1 
                T_str = "第" & P & "/" & (EndRow - StartRow + 1) \ LinesPerPage + 1 & "页" 
                Call PrintFooter(FixedX, Cury, T_str) 
                Call PrintTableRoutate(Gridtoprint, Gridtoprint.Cols) 
                Printer.EndDoc 
                Printer.Orientation = 1 
                LinesPerPage = 3 
            End If 
        Next k 
    End With 
    P = P + 1 
    T_str = "第" & P & "/" & (EndRow - StartRow + 1) \ LinesPerPage + 1 & "页" 
    Call PrintFooter(FixedX, Cury, T_str) 
    Call PrintTableRoutate(Gridtoprint, Gridtoprint.Cols) 
    Printer.EndDoc 
End If 
Exit Sub 
PrinTErr: 
    On Error GoTo 0 
    Call MsgBox("打印机未准备好或有故障!", vbCritical + vbOKOnly, "错误") 
    Printer.KillDoc 
End Sub 
 
'区别于PrintTitleRoutate： 它打印时题头为第一行而不是第一列 
Private Sub PrintTitleNormal(Gridtoprint As MSFlexGrid, Title As String, SubTitle As String) 
Dim j As Integer 
On Error GoTo PrinTErr 
    Title = Trim(Title) 
    Printer.FontSize = 16 
    Totalwidth = 0 
    For j = 0 To Gridtoprint.Cols - 1 
        If Gridtoprint.ColWidth(j) <> 0 Then 
            Gridtoprint.col = j 
            Totalwidth = Totalwidth + Gridtoprint.ColWidth(j) + ColDistance 
        End If 
    Next j 
    FixedX = (Printer.Width - Totalwidth) \ 2 
    FixedX = IIf(FixedX > 500, FixedX - 200, FixedX) 
    Curx = (Printer.Width - Len(Title) * Printer.FontSize * 20.2) \ 2 
    Cury = 1000 
    Printer.CurrentX = Curx 
    Printer.CurrentY = Cury 
    Printer.Print Title 
    Printer.FontSize = 10 
    Lineheight = RowDistance + Printer.FontSize * 20.2 
    Gridtoprint.row = 0 
    Curx = FixedX 
    Cury = Cury + 1000 
    LineStartx = FixedX - ColDistance \ 2 
    LineStarty = Cury - RowDistance \ 2 
    If SubTitle <> "" Then 
        Printer.CurrentX = Curx 
        Printer.CurrentY = Cury - RowDistance - Printer.FontSize * 20.2 
        Printer.Print SubTitle 
    End If 
    Printer.CurrentX = Curx 
    Dim OldFontSize As Single 
    OldFontSize = Printer.FontSize 
    Printer.FontSize = 11 
    Printer.Font.Bold = True 
    For j = 0 To Gridtoprint.Cols - 1 
        If Gridtoprint.ColWidth(j) <> 0 Then 
            Gridtoprint.col = j 
            Printer.CurrentY = Cury 
            Printer.Print Gridtoprint.Text 
            Curx = Curx + Gridtoprint.ColWidth(j) + ColDistance 
            Printer.CurrentX = Curx 
        End If 
    Next j 
    Printer.Font.Bold = False 
    Printer.FontSize = OldFontSize 
Exit Sub 
PrinTErr: 
    On Error GoTo 0 
    Call MsgBox("打印机未准备好或有故障!", vbCritical + vbOKOnly, "错误") 
    Printer.KillDoc 
End Sub 
 
Private Sub PrintFooter(X As Long, Y As Long, MyStr As String) 
On Error GoTo PrinTErr 
    Printer.CurrentX = X 
    Printer.CurrentY = Y 
    Printer.Print "打印时间：" & Format(Date, "yyyy-mm-dd") & "   " & Format(Time, "hh:mm:ss") 
    Printer.CurrentX = X + Totalwidth - Printer.FontSize * 10.1 * LenB(MyStr) 
    Printer.CurrentY = Y 
    Printer.Print MyStr 
Exit Sub 
PrinTErr: 
    On Error GoTo 0 
    Call MsgBox("打印机未准备好或有故障!", vbCritical + vbOKOnly, "错误") 
    Printer.KillDoc 
End Sub 
 
Private Sub PrintTableRoutate(Gridtoprint As Control, R As Integer) 
Dim L As Integer 
Dim TableRowCol As Long 
On Error GoTo PrinTErr 
    TableRowCol = LineStarty 
    For L = 0 To R 
        Printer.Line (LineStartx, TableRowCol)-(LineStartx + Totalwidth, TableRowCol) 
        TableRowCol = TableRowCol + Lineheight 
    Next L 
    Printer.Line (LineStartx, TableRowCol)-(LineStartx + Totalwidth, TableRowCol) 
    LineEndy = TableRowCol 
    TableRowCol = LineStartx 
    Printer.Line (TableRowCol, LineStarty)-(TableRowCol, LineEndy) 
    TableRowCol = TableRowCol + Totalwidth - 3 * MaxColWidth - ColDistance * 3 
    For L = 0 To 3 
        Printer.Line (TableRowCol, LineStarty)-(TableRowCol, LineEndy) 
        TableRowCol = TableRowCol + ColDistance + MaxColWidth 
    Next L 
Exit Sub 
PrinTErr: 
    On Error GoTo 0 
    Call MsgBox("打印机未准备好或有故障!", vbCritical + vbOKOnly, "错误") 
    Printer.KillDoc 
End Sub 
 
 
'区别于PrintRoutate:  它打印时题头为第一行而不是第一列 
'Title: 标题， 将被醒目打印 
'GridToPrint: 代打印的 Grid 控件名称, 注意必须是 Grid 控件 
'myOrientation: 决定输出是纵向还是横向, 1:纵向, 2:横向 
'SubTitle: 附加标题 
Public Sub PrintGridNormal(Title As String, Gridtoprint As MSFlexGrid, myOrientation As Integer, SubTitle As String, Optional IsHasLine As Boolean = True) 
On Error GoTo PrinTErr 
If MsgBox("请准备好打印机，单击[确定]开始打印...", vbInformation + vbOKCancel, "准备打印") = vbOK Then 
    Dim T_str As String 
    Dim P As Integer 
    Dim i As Integer 
    Dim j As Integer 
    Dim k As Integer 
    Dim StartRow As Long 
    Dim EndRow As Long 
    Dim L As Integer 
    'Printer.PaperSize = 9 'A4纸 210 x 297 毫米 
    P = 0 
    With Gridtoprint 
        StartRow = 1 
        EndRow = .Rows - 1 
        i = 0 
        Printer.Orientation = myOrientation 
        LinesPerPage = IIf(myOrientation = 1, 38, 24) 
        'ShowProgress 0, EndRow - StartRow 
        For k = 0 To EndRow - StartRow 
            If (k Mod LinesPerPage) = 0 Then 
                Call PrintTitleNormal(Gridtoprint, Title, SubTitle) 
            End If 
            Cury = Printer.CurrentY + RowDistance 
            Curx = FixedX 
            .row = k + StartRow 
            Printer.CurrentX = Curx 
            For j = 0 To .Cols - 1 
                If .ColWidth(j) <> 0 Then 
                    .col = j 
                    Printer.CurrentY = Cury 
                    Printer.Print .Text 
                    Curx = Curx + .ColWidth(j) + ColDistance 
                    Printer.CurrentX = Curx 
                End If 
            Next j 
            Cury = Printer.CurrentY + RowDistance 
            i = i + 1 
            If i = LinesPerPage Then 
                LineEndy = Printer.CurrentY + RowDistance \ 2 
                i = 0 
                P = P + 1 
                T_str = "第" & P & "/" & (EndRow - StartRow + 1) \ LinesPerPage + 1 & "页" 
                Call PrintFooter(FixedX, Cury, T_str) 
                If IsHasLine Then 
                    Call PrintTable(Gridtoprint, LinesPerPage) 
                End If 
                Printer.EndDoc 
                Printer.Orientation = myOrientation 
                LinesPerPage = IIf(myOrientation = 1, 38, 24) 
            End If 
           ' Progress.ProgressBar1.Value = k 
        Next k 
    End With 
    LineEndy = Printer.CurrentY + RowDistance \ 2 
    P = P + 1 
    T_str = "第" & P & "/" & (EndRow - StartRow + 1) \ LinesPerPage + 1 & "页" 
    Call PrintFooter(FixedX, Cury, T_str) 
    If IsHasLine Then 
        Call PrintTable(Gridtoprint, (EndRow - StartRow + 1) Mod LinesPerPage) 
    End If 
    Printer.EndDoc 
    'Progress.Hide 
End If 
Exit Sub 
PrinTErr: 
    On Error GoTo 0 
    Call MsgBox("打印机未准备好或有故障!", vbCritical + vbOKOnly, "错误") 
    Printer.KillDoc 
End Sub 
 
Private Sub PrintTable(Gridtoprint As MSFlexGrid, R As Integer) 
Dim L As Integer 
Dim TableRowCol As Long 
On Error GoTo PrinTErr 
    TableRowCol = LineStarty 
    For L = 0 To R 
        Printer.Line (LineStartx, TableRowCol)-(LineStartx + Totalwidth, TableRowCol) 
        TableRowCol = TableRowCol + Lineheight 
    Next L 
    Printer.Line (LineStartx, TableRowCol)-(LineStartx + Totalwidth, TableRowCol) 
    LineEndy = TableRowCol 
    TableRowCol = LineStartx 
    For L = 0 To Gridtoprint.Cols - 1 
        If Gridtoprint.ColWidth(L) <> 0 Then 
            Printer.Line (TableRowCol, LineStarty)-(TableRowCol, LineEndy) 
            TableRowCol = TableRowCol + ColDistance + Gridtoprint.ColWidth(L) 
        End If 
    Next L 
    Printer.Line (TableRowCol, LineStarty)-(TableRowCol, LineEndy) 
Exit Sub 
PrinTErr: 
    On Error GoTo 0 
    Call MsgBox("打印机未准备好或有故障!", vbCritical + vbOKOnly, "错误") 
    Printer.KillDoc 
End Sub