modprint.bas

AddPrintPreviewtoVBV2 增加打印预览的功能

Attribute VB_Name = "modPrint"
Option Explicit

'===============================================
' PUBLIC DECLARATIONS
'===============================================
Global g_bool_SendToPrinter     As Boolean

'===============================================
' PRIVATE DECLARATIONS
'===============================================
Private m_pic_Page              As PictureBox
Private m_int_PrevScaleMode     As Integer
Private m_sng_Ratio             As Single    'The size m_sng_Ratio between the actual page and
'the print preview object
Private m_sng_LRGap             As Single    'Size of the non-printable area on printer
Private m_sng_TBGap             As Single

'The actual paper size (8.5 x 11 normally):
Private m_sng_PgWidth           As Single
Private m_sng_PgHeight          As Single

Private Const m_int_ScaleMode   As Integer = vbTwips    'Scale Object to Printer's printable area
Private Const TWIPSPERINCH = 1440

Public Sub PrintStartDoc( _
    in_sng_PaperWidth As Single, _
    in_sng_PaperHeight As Single)

    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    Dim int_PrinterScaleMode    As Integer
    Dim sng_HeightRatio         As Single
    Dim sng_WidthRatio          As Single

    ' Set the physical page size:
    m_sng_PgWidth = in_sng_PaperWidth
    m_sng_PgHeight = in_sng_PaperHeight

    ' Find the size of the non-printable area on the printer to
    ' use to offset coordinates. These formulas assume the
    ' non-printable area is centered on the page:
    int_PrinterScaleMode = Printer.ScaleMode
    Printer.ScaleMode = m_int_ScaleMode
    m_sng_LRGap = (m_sng_PgWidth - Printer.ScaleWidth) / 2
    m_sng_TBGap = (m_sng_PgHeight - Printer.ScaleHeight) / 2
    Printer.ScaleMode = int_PrinterScaleMode

    ' Initialize printer or preview object:
    If g_bool_SendToPrinter Then
        m_int_PrevScaleMode = Printer.ScaleMode
        Printer.ScaleMode = m_int_ScaleMode
        Printer.Print "";
    Else
        ' Scale Object to Printer's printable area:
        m_int_PrevScaleMode = Printer.ScaleMode
        m_pic_Page.ScaleMode = m_int_ScaleMode

        ' Compare the height and with ratios to determine the
        ' m_sng_Ratio to use and how to size the picture box:
        sng_HeightRatio = m_pic_Page.ScaleHeight / m_sng_PgHeight
        sng_WidthRatio = m_pic_Page.ScaleWidth / m_sng_PgWidth

        If sng_HeightRatio < sng_WidthRatio Then
            m_sng_Ratio = sng_HeightRatio
        Else
            m_sng_Ratio = sng_WidthRatio
        End If

        ' Set default properties of picture box to match printer
        ' There are many that you could add here:
        m_pic_Page.Scale (0, 0)-(m_sng_PgWidth, m_sng_PgHeight)
        On Error Resume Next    'Printer font might not exist
        m_pic_Page.FontName = Printer.FontName
        If Err Then Call Err.Clear
        m_pic_Page.FontSize = Printer.FontSize * m_sng_Ratio
        m_pic_Page.ForeColor = Printer.ForeColor
        Call m_pic_Page.Cls
    End If

    Exit Sub

Err_Handler:
    Call Err.Raise(Err.Number, App.Title & " - PrintStartDoc", Err.Description)
End Sub

Public Sub PrintCurrentX(in_sng_Val As Single)
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.CurrentX = in_sng_Val - m_sng_LRGap
    Else
        m_pic_Page.CurrentX = in_sng_Val
    End If

    Exit Sub

Err_Handler:
    Call Err.Raise(Err.Number, App.Title & " - PrintCurrentX", Err.Description)
End Sub

Public Sub PrintCurrentY(in_sng_Val As Single)
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.CurrentY = in_sng_Val - m_sng_TBGap
    Else
        m_pic_Page.CurrentY = in_sng_Val
    End If

    Exit Sub

Err_Handler:
    Call Err.Raise(Err.Number, App.Title & " - PrintCurrentY", Err.Description)
End Sub

Public Sub PrintDrawWidth(in_lng_Val As Long)
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.DrawWidth = (ConvertPixelsToTwipsX(in_lng_Val) / 10) * in_lng_Val
    Else
        m_pic_Page.DrawWidth = m_pic_Page.ScaleX(in_lng_Val, vbPixels, vbPoints)
    End If

    Exit Sub

Err_Handler:
    Call Err.Raise(Err.Number, App.Title & " - PrintDrawWidth", Err.Description)
End Sub

Public Sub PrintDrawStyle(in_int_Val As Integer)
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.DrawStyle = in_int_Val
    Else
        m_pic_Page.DrawStyle = in_int_Val
    End If

    Exit Sub

Err_Handler:
    Call Err.Raise(Err.Number, App.Title & " - PrintDrawStyle", Err.Description)
End Sub

Public Sub PrintFontBold(in_bool_Val As Boolean)
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.FontBold = in_bool_Val
    Else
        m_pic_Page.FontBold = in_bool_Val
    End If

    Exit Sub

Err_Handler:
    Call Err.Raise(Err.Number, App.Title & " - PrintFontBold", Err.Description)
End Sub

Public Sub PrintFontItalic(in_bool_Val As Boolean)
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.FontItalic = in_bool_Val
    Else
        m_pic_Page.FontItalic = in_bool_Val
    End If

    Exit Sub

Err_Handler:
    Call Err.Raise(Err.Number, App.Title & " - PrintFontItalic", Err.Description)
End Sub

Public Sub PrintFontName(in_str_Val As String)
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.FontName = in_str_Val
    Else
        m_pic_Page.FontName = in_str_Val
    End If

    Exit Sub

Err_Handler:
    Call Err.Raise(Err.Number, App.Title & " - PrintFontName", Err.Description)
End Sub

Public Sub PrintFontSize(in_sng_Val As Single)
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.FontSize = in_sng_Val
    Else
        ' Sized by m_sng_Ratio since Scale method does not effect FontSize:
        m_pic_Page.FontSize = in_sng_Val * m_sng_Ratio
    End If

    Exit Sub

Err_Handler:
    Call Err.Raise(Err.Number, App.Title & " - PrintFontSize", Err.Description)
End Sub

Public Sub PrintFontUnderline(in_bool_Val As Boolean)
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.FontUnderline = in_bool_Val
    Else
        m_pic_Page.FontUnderline = in_bool_Val
    End If

    Exit Sub

Err_Handler:
    Call Err.Raise(Err.Number, App.Title & " - PrintFontSize", Err.Description)
End Sub

Public Sub PrintForeColor(in_lng_Val As Long)
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.ForeColor = in_lng_Val
    Else
        m_pic_Page.ForeColor = in_lng_Val
    End If

    Exit Sub

Err_Handler:
    Call Err.Raise(Err.Number, App.Title & " - PrintForeColor", Err.Description)
End Sub

Public Sub PrintPrint( _
    in_str_String As String, _
    in_int_Alignment As Integer, _
    in_bool_MultiLine As Boolean, _
    in_sng_Width As Single, _
    in_sng_Height As Single)

    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    Dim str_Temp    As String

    If g_bool_SendToPrinter Then
        If in_int_Alignment = 0 Then    'Left
            If Printer.TextWidth(in_str_String) > in_sng_Width And Not in_bool_MultiLine Then
                Printer.Print SizeString(Printer, CStr(in_str_String), CSng(in_sng_Width))

            ElseIf Printer.TextWidth(in_str_String) > in_sng_Width And in_bool_MultiLine Then
                Call PrintMultiLineString(Printer, in_str_String, in_sng_Width, in_sng_Height, in_int_Alignment)

            Else
                Printer.Print in_str_String

            End If

        ElseIf in_int_Alignment = 1 Then    'Right
            If Printer.TextWidth(in_str_String) > in_sng_Width Then
                str_Temp = SizeString(Printer, CStr(in_str_String), CSng(in_sng_Width))
                Printer.CurrentX = Printer.CurrentX + (in_sng_Width - Printer.TextWidth(str_Temp))
                Printer.Print str_Temp

            Else
                Printer.CurrentX = Printer.CurrentX + (in_sng_Width - Printer.TextWidth(in_str_String))
                Printer.Print in_str_String

            End If

        ElseIf in_int_Alignment = 2 Then    'Center
            If Printer.TextWidth(in_str_String) > in_sng_Width And Not in_bool_MultiLine Then
                str_Temp = SizeString(Printer, CStr(in_str_String), CSng(in_sng_Width))
                Printer.CurrentX = Printer.CurrentX + ((in_sng_Width - Printer.TextWidth(str_Temp)) / 2)
                Printer.Print str_Temp

            ElseIf Printer.TextWidth(in_str_String) > in_sng_Width And in_bool_MultiLine Then
                Call PrintMultiLineString(Printer, in_str_String, in_sng_Width, in_sng_Height, in_int_Alignment)

            Else
                Printer.CurrentX = Printer.CurrentX + ((in_sng_Width - Printer.TextWidth(in_str_String)) / 2)
                Printer.Print in_str_String

            End If
        Else
            'ERROR
        End If
    Else
        If in_int_Alignment = 0 Then    'Left
            If m_pic_Page.TextWidth(in_str_String) > in_sng_Width And Not in_bool_MultiLine Then
                m_pic_Page.Print SizeString(m_pic_Page, CStr(in_str_String), CSng(in_sng_Width))

            ElseIf m_pic_Page.TextWidth(in_str_String) > in_sng_Width And in_bool_MultiLine Then
                Call PrintMultiLineString(m_pic_Page, in_str_String, in_sng_Width, in_sng_Height, in_int_Alignment)

            Else
                m_pic_Page.Print in_str_String

            End If

        ElseIf in_int_Alignment = 1 Then    'Right
            If m_pic_Page.TextWidth(in_str_String) > in_sng_Width Then
                str_Temp = SizeString(m_pic_Page, CStr(in_str_String), CSng(in_sng_Width))
                m_pic_Page.CurrentX = m_pic_Page.CurrentX + (in_sng_Width - m_pic_Page.TextWidth(str_Temp))
                m_pic_Page.Print str_Temp

            Else
                m_pic_Page.CurrentX = m_pic_Page.CurrentX + (in_sng_Width - m_pic_Page.TextWidth(in_str_String))
                m_pic_Page.Print in_str_String