printmodule.bas

针对农资系统的管理模式而开发的业务部门与财务部门的转账模式和过程

Attribute VB_Name = "PrintModule"
Option Explicit

Function PrintTable(PrintGrd As Object, IniPrintRs As Recordset, frmData As Form, PrintAll As Boolean, PrintObj As Object, bPrintSum As Boolean, Optional nFromPage As Integer, Optional nEndPage As Integer)
    Dim CaptionSize As Integer, TextSize As Integer, UnitSize As Integer, Row_Height As Integer
    Dim Top_Margin As Integer, Left_Margin As Integer, Right_margin As Integer, Bottom_margin As Integer
    Dim PrintXDiv As Integer, PrintColList As String
    
    Dim PrintRs As Recordset, nPrintRow As Integer
    Dim nTotalRow As Integer, nTotalCol As Integer
    Dim TotalPage As Integer, TotalRecordCount As Integer, bFirstPage As Boolean
    Dim Tot_Printer_Height As Integer, Tot_Disp_Width As Integer, Tot_Printer_Width_Orig As Integer
    
    Dim aHeader() As String, aPrint() As Boolean, aWidth() As Integer, aLeft() As Integer, aAlign() As Integer
    Static grd_top As Integer, grd_bott As Integer

    Dim XDivLeft As Integer, XdivWidth As Integer
    Dim mmToPoints As Single ', ShowRate As Single
    Dim XDivLoop As Integer, XDivSpace As Integer

    Dim nWidth As Integer, nHeight As Integer
    Dim sTemp As String, i As Integer

    'ShowRate = 1.25
    XDivSpace = 2 '2mm
    If IniPrintRs Is Nothing Then
        MsgBox "没有可供打印的数据！", 48, "提示："
        Exit Function
    End If
    mmToPoints = 2.835
    PrintObj.ScaleMode = vbPoints

    If Not PrintObj Is Printer Then
        PrintObj.Width = Printer.ScaleWidth * ShowRate
        PrintObj.Height = Printer.ScaleHeight * ShowRate
        PrintObj.ScaleWidth = Printer.ScaleWidth
        PrintObj.ScaleHeight = Printer.ScaleHeight
    End If
    
    TextSize = GetPrivateSetting(frmData.Caption, "TextSize", 11) * ShowRate
    CaptionSize = GetPrivateSetting(frmData.Caption, "CaptionSize", 20) * ShowRate
    Row_Height = GetPrivateSetting(frmData.Caption, "RowHeight", 6) * mmToPoints
    UnitSize = GetPrivateSetting(frmData.Caption, "UnitSize", 11) * ShowRate
    PrintColList = GetPrivateSetting(frmData.Caption, "PrintColList", "")
    PrintXDiv = GetPrivateSetting(frmData.Caption, "PrintXdiv", 1)
    
    Right_margin = GetPrivateSetting(frmData.Caption, "PrintRight", 0) * mmToPoints
    Bottom_margin = GetPrivateSetting(frmData.Caption, "PrintBottom", 0) * mmToPoints
    Left_Margin = PrintObj.ScaleLeft + GetPrivateSetting(frmData.Caption, "Printleft", 0) * mmToPoints
    Top_Margin = PrintObj.ScaleTop + GetPrivateSetting(frmData.Caption, "Printtop", 0) * mmToPoints

    Set PrintRs = IniPrintRs.Clone
    If PrintRs.EOF And PrintRs.BOF Or PrintColList = "" Then
        MsgBox "没有可供打印的数据！", 48, "提示："
        Exit Function
    Else
        PrintRs.MoveLast
        PrintRs.MoveFirst
        TotalRecordCount = PrintRs.RecordCount
    End If
    
    On Error GoTo ErrorHandler              ' 设置错误处理程序
    PrintObj.FontName = "宋体"
    
    nTotalCol = PrintGrd.Columns.Count
    ReDim aHeader(nTotalCol), aWidth(nTotalCol), aLeft(nTotalCol), aPrint(nTotalCol), aAlign(nTotalCol)

    Tot_Disp_Width = 0
    Tot_Printer_Width_Orig = PrintObj.ScaleWidth - Left_Margin - Right_margin
    Tot_Printer_Height = PrintObj.ScaleHeight - Bottom_margin
    
    For i = 0 To nTotalCol - 1
        aPrint(i) = InPrintColList(PrintColList, i)
        If aPrint(i) Then
            aHeader(i) = PrintGrd.Columns(i).Caption
            Dim myPos As Integer
            myPos = InStr(aHeader(i), Chr(13))
            If myPos > 0 Then
                aHeader(i) = Mid(aHeader(i), 1, myPos - 1) + Mid(aHeader(i), myPos + 1)
            End If
            aWidth(i) = PrintGrd.Columns(i).Width
            aAlign(i) = PrintGrd.Columns(i).Alignment
            Tot_Disp_Width = aWidth(i) + Tot_Disp_Width '计算整体显示宽度
        End If
    Next
    
    XdivWidth = 0
    If Tot_Disp_Width = 0 Then
        GoTo ErrorHandler:
    End If
    For i = 0 To nTotalCol - 1
        aWidth(i) = aWidth(i) * ((Tot_Printer_Width_Orig - XDivSpace * (PrintXDiv - 1)) / (Tot_Disp_Width * PrintXDiv))
        aLeft(i) = XdivWidth
        XdivWidth = XdivWidth + aWidth(i)
    Next
    
    Dim bAlreadyPrintSum As Boolean
    bAlreadyPrintSum = False
    bFirstPage = True
    With PrintRs
        Do Until .EOF()
            PrintObj.FontSize = UnitSize
            PrintObj.CurrentY = Top_Margin
            PrintObj.FontUnderline = True

            nWidth = PrintObj.TextWidth(m_sUnitName) / 2 '得到字体的一半宽度
            PrintObj.CurrentX = Left_Margin + Tot_Printer_Width_Orig / 2 - nWidth
            PrintObj.Print m_sUnitName;
            PrintObj.Print
            PrintObj.CurrentY = PrintObj.CurrentY + 3
            PrintObj.FontSize = CaptionSize
            PrintObj.Font.Underline = False

            sTemp = frmData.PrintCaption
            nWidth = PrintObj.TextWidth(sTemp) / 2  '得到字体的一半宽度
            PrintObj.CurrentX = Left_Margin + Tot_Printer_Width_Orig / 2 - nWidth
            PrintObj.Font.Bold = True
            PrintObj.Print sTemp;
            PrintObj.Font.Bold = False
            PrintObj.Print
            PrintObj.CurrentY = PrintObj.CurrentY + 3
            PrintObj.Font.Size = TextSize
            frmData.PrintHeader PrintObj, Left_Margin, Tot_Printer_Width_Orig

            PrintObj.Print
            PrintObj.CurrentY = PrintObj.CurrentY + 3
            PrintObj.Font.Size = TextSize
            
            If bFirstPage Then
                If ShowRate = 1 Then grd_top = PrintObj.CurrentY
                grd_bott = Tot_Printer_Height - Row_Height * frmData.RowTailCount()
                nTotalRow = Int((grd_bott - grd_top) / Row_Height)
               
                If nTotalRow <= 1 Then
                    MsgBox "打印纸张太小, 无法完成打印!", vbOKOnly + vbInformation, "提示:"
                    GoTo ErrorHandler:
                End If
                grd_bott = nTotalRow * Row_Height + grd_top
                TotalPage = Int((TotalRecordCount + (nTotalRow - 1) * PrintXDiv - 1) / ((nTotalRow - 1) * PrintXDiv))
                If PrintAll Then
                    nFromPage = 1
                    nEndPage = TotalPage
                Else
                    If nFromPage > TotalPage Then
                        nFromPage = TotalPage
                    End If
                    If nEndPage > TotalPage Then
                        nEndPage = TotalPage
                    End If
                    .Move ((nFromPage - 1) * (nTotalRow - 1) * PrintXDiv)
                End If
                bFirstPage = False
            End If
            
            For XDivLoop = 1 To PrintXDiv
                XDivLeft = Left_Margin + (XDivLoop - 1) * (XdivWidth + XDivSpace)
                nPrintRow = 0
                Do While Not (.EOF Or nPrintRow = nTotalRow - 1)
                    For i = 0 To nTotalCol - 1
                        If aPrint(i) = True Then
                            If PrintGrd.Columns(i).NumberFormat = "" Then
                                sTemp = IIf(IsNull(PrintRs.Fields(i).Value), "", PrintRs.Fields(i).Value)
                            Else
                                sTemp = Format(PrintRs.Fields(i).Value, PrintGrd.Columns(i).NumberFormat)
                            End If
                            nWidth = PrintObj.TextWidth(sTemp)
                            nHeight = PrintObj.TextHeight(sTemp) / 2 '得到字体的一半高度
                            
                            If aAlign(i) = 0 Then
                                PrintObj.CurrentX = XDivLeft + aLeft(i) + 1
                            Else
                                PrintObj.CurrentX = XDivLeft + aLeft(i) + aWidth(i) - nWidth - 1
                            End If
                            PrintObj.CurrentY = grd_top + (nPrintRow + 1) * Row_Height + (Row_Height / 2) - nHeight
                            PrintObj.Print sTemp
                        End If
                    Next
                    .MoveNext
                    nPrintRow = nPrintRow + 1
                Loop
                
                For i = 0 To nTotalCol - 1
                    If aPrint(i) Then
                        sTemp = Trim(aHeader(i))
                        nWidth = PrintObj.TextWidth(sTemp) / 2
                        nHeight = PrintObj.TextHeight(sTemp) / 2
                        
                        PrintObj.CurrentX = XDivLeft + aLeft(i) + aWidth(i) / 2 - nWidth
                        PrintObj.CurrentY = grd_top + Row_Height / 2 - nHeight
                        PrintObj.Print sTemp
                    End If
                    PrintObj.Line (XDivLeft + aLeft(i), grd_top)-(XDivLeft + aLeft(i), grd_top + Row_Height * nTotalRow)
                Next
                PrintObj.Line (XDivLeft + XdivWidth, grd_top)-(XDivLeft + XdivWidth, grd_top + Row_Height * nTotalRow)
                For i = 0 To nTotalRow
                    PrintObj.Line (XDivLeft, grd_top + i * Row_Height)-(XDivLeft + XdivWidth, grd_top + i * Row_Height)
                Next
                
                If bPrintSum Then
                    frmData.PrintTailSum PrintObj, XDivLeft, XdivWidth, Tot_Printer_Height, Row_Height, aPrint, aLeft, aWidth, grd_bott, .EOF And Not bAlreadyPrintSum
                    If .EOF Then
                        bAlreadyPrintSum = True
                    End If
                End If
            Next
            
            frmData.PrintTail PrintObj, Left_Margin, Tot_Printer_Width_Orig, Tot_Printer_Height, Row_Height, nFromPage, TotalPage
            
            nFromPage = nFromPage + 1
            If PrintObj Is Printer Then