printmodule.bas

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

                If nFromPage > nEndPage Then
                    Exit Do
                ElseIf Not .EOF Then
                    PrintObj.NewPage
                End If
            Else
                frmVisualPrint.SetPageCount = TotalPage
                Exit Do
            End If
        Loop
    End With
    
    If PrintObj Is Printer Then
        PrintObj.EndDoc
    End If
    PrintRs.Close
    
    Exit Function
ErrorHandler:
    If Err.Description <> "" Then
        MsgBox Err.Description
    End If
    If PrintObj Is Printer Then
        PrintObj.KillDoc
    End If
    PrintRs.Close
End Function

Function Printfrm(frmData As Form, PrintObj As Object, iniSection As String, bIsNeedSum As Boolean)
    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, PrintYDiv As Integer

    Dim Tot_Printer_Width_Orig, Tot_Printer_Height As Integer
    Dim XDivLeft As Integer, YDivTop As Integer
    Dim mmToPoints As Single, ShowRate As Single
    Dim XDivLoop As Integer, YDivLoop As Integer
    Dim XDivSpace As Integer, YDivSpace As Integer
    Dim nWidth As Integer, sTemp As String

    Dim RegionWidth As Integer, RegionHeight As Integer
    Dim XRate As Single, YRate As Single
    Dim NetHeight As Integer, NetTop As Integer
    
    XDivSpace = 10 'mm
    YDivSpace = 10 'mm
    ShowRate = 1
    mmToPoints = 2.835
    PrintObj.ScaleMode = vbPoints

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

    On Error GoTo ErrorHandler              ' 设置错误处理程序
    PrintObj.FontName = "宋体"
    Tot_Printer_Width_Orig = PrintObj.ScaleWidth - Left_Margin - Right_margin
    Tot_Printer_Height = PrintObj.ScaleHeight - Bottom_margin
    
    RegionWidth = Tot_Printer_Width_Orig / PrintXDiv
    RegionHeight = Tot_Printer_Height / PrintYDiv
    XRate = frmData.ScaleWidth / RegionWidth
    For XDivLoop = 1 To PrintXDiv
        XDivLeft = Left_Margin + (XDivLoop - 1) * (RegionWidth + XDivSpace)
        For YDivLoop = 1 To PrintYDiv
            YDivTop = Top_Margin + (YDivLoop - 1) * (RegionHeight + YDivSpace)
            PrintObj.FontSize = UnitSize
            PrintObj.Font.Underline = True
            nWidth = PrintObj.TextWidth(m_sUnitName) / 2 '得到字体的一半宽度
            PrintObj.CurrentX = XDivLeft + RegionWidth / 2 - nWidth
            PrintObj.CurrentY = YDivTop + 3
            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 = XDivLeft + RegionWidth / 2 - nWidth
            PrintObj.Font.Bold = True
            PrintObj.Print sTemp;
            PrintObj.Font.Bold = False
            PrintObj.Print
            PrintObj.CurrentY = PrintObj.CurrentY + 3
            
            PrintObj.Font.Size = TextSize
            NetTop = PrintObj.CurrentY
            NetHeight = Top_Margin + YDivLoop * (RegionHeight + YDivSpace) - PrintObj.CurrentY
            YRate = frmData.ScaleHeight / NetHeight
            
            frmData.PrintThisForm PrintObj, XDivLeft, RegionWidth, NetHeight, Row_Height
        Next
    Next
    If PrintObj Is Printer Then
        PrintObj.EndDoc
    End If
    
    Exit Function
ErrorHandler:
    If Err.Description <> "" Then
        MsgBox Err.Description
    End If
    If PrintObj Is Printer Then
        PrintObj.KillDoc
    End If
End Function

Public Function GetFromToEndPageNo(ByRef sRangeInfo As String, ByRef nFromPage As Integer, ByRef nEndPage As Integer)
    Dim nPos As Integer, nCommaPos As Integer, nTemp As Integer
    Dim sTemp As String
    
    nCommaPos = InStr(1, sRangeInfo, ",")
    nPos = InStr(1, sRangeInfo, "-")
    
    If nCommaPos = 0 And nPos = 0 Then
        nFromPage = Val(sRangeInfo)
        nEndPage = Val(sRangeInfo)
        sRangeInfo = ""
    Else
        If nCommaPos > 0 And (nCommaPos < nPos Or nPos = 0) Then
            nFromPage = Val(Left(sRangeInfo, nCommaPos - 1))
            nEndPage = Val(Left(sRangeInfo, nCommaPos - 1))
            sRangeInfo = Mid(sRangeInfo, nCommaPos + 1)
        Else     'If nPos > 0 And (nPos < nCommaPos Or nCommaPos = 0) Then
            nFromPage = Val(Left(sRangeInfo, nPos - 1))
            sRangeInfo = Mid(sRangeInfo, nPos + 1)
            
            nCommaPos = InStr(1, sRangeInfo, ",")
            If nCommaPos > 0 Then
                nEndPage = Val(Left(sRangeInfo, nCommaPos - 1))
                sRangeInfo = Mid(sRangeInfo, nCommaPos + 1)
            Else
                nEndPage = Val(sRangeInfo)
                sRangeInfo = ""
            End If
        End If
    End If
    
    If nFromPage > nEndPage Then
        nTemp = nFromPage
        nFromPage = nEndPage
        nEndPage = nTemp
    End If
    
    If nFromPage = 0 Then
        nFromPage = 1
    End If
    If nEndPage = 0 Then
        nEndPage = 1
    End If
End Function

Public Function InPrintColList(ByVal sPrintColList As String, nCurCol As Integer) As Boolean
    InPrintColList = False
    Dim nPos As Integer
    Do Until sPrintColList = ""
        nPos = InStr(1, sPrintColList, ",")
        If nPos > 0 Then
            If Val(Mid(sPrintColList, 1, nPos - 1)) = nCurCol Then
                InPrintColList = True
                Exit Function
            End If
            sPrintColList = Mid(sPrintColList, nPos + 1)
        Else
            If Val(sPrintColList) = nCurCol Then
                InPrintColList = True
                Exit Function
            End If
            sPrintColList = ""
        End If
    Loop
End Function
Sub PrintString(PrintObj As Object, ByVal sParse As String, ByVal sinLeft As Single, ByVal sinTop As Single, ByVal sinWidth As Single, ByVal sinHeight As Single, bMargin As Boolean, Optional sType As String = 0)
Dim nWidth As Single, nHeight As Single
nWidth = PrintObj.TextWidth(sParse)
nHeight = PrintObj.TextHeight(sParse)

If bMargin Then
    PrintObj.Line (sinLeft, sinTop)-(sinLeft + sinWidth, sinTop + sinHeight), , B
End If
sType = UCase(sType)
If sType = "CUR" Then '居中
    PrintObj.CurrentX = sinLeft + (sinWidth - nWidth) / 2
ElseIf sType = "LEFT" Then '居左
    PrintObj.CurrentX = sinLeft
Else                  '居右
    PrintObj.CurrentX = sinLeft + sinWidth - nWidth
End If

PrintObj.CurrentY = sinTop + (sinHeight - nHeight) / 2
PrintObj.Print sParse

End Sub