其他数据库

开发平台：
Visual Basic

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

						