modprint.bas

AddPrintPreviewtoVBV2 增加打印预览的功能

            End If

        ElseIf in_int_Alignment = 2 Then    'Center
            If m_pic_Page.TextWidth(in_str_String) > in_sng_Width And Not in_bool_MultiLine 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)) / 2)
                m_pic_Page.Print str_Temp

            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.CurrentX = m_pic_Page.CurrentX + ((in_sng_Width - m_pic_Page.TextWidth(in_str_String)) / 2)
                m_pic_Page.Print in_str_String

            End If

        Else
            'ERROR
        End If
    End If

    Exit Sub

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

Public Sub PrintLine( _
    in_sng_X1 As Single, _
    in_sng_Y1 As Single, _
    in_sng_X2 As Single, _
    in_sng_Y2 As Single)

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

    If g_bool_SendToPrinter Then
        Printer.Line (in_sng_X1 - m_sng_LRGap, in_sng_Y1 - m_sng_TBGap)-(in_sng_X2 - m_sng_LRGap, in_sng_Y2 - m_sng_TBGap)
    Else
        m_pic_Page.Line (in_sng_X1, in_sng_Y1)-(in_sng_X2, in_sng_Y2)
    End If

    Exit Sub

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

Public Sub PrintBox( _
    in_sng_Left As Single, _
    in_sng_Top As Single, _
    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

    If g_bool_SendToPrinter Then
        Printer.FillStyle = vbFSSolid
        Printer.Print ""
        Printer.FillStyle = vbFSTransparent
        Printer.Line (in_sng_Left - m_sng_LRGap, in_sng_Top - m_sng_TBGap)-(in_sng_Left + in_sng_Width - m_sng_LRGap, in_sng_Top + in_sng_Height - m_sng_TBGap), , B
    Else
        m_pic_Page.Line (in_sng_Left, in_sng_Top)-(in_sng_Left + in_sng_Width, in_sng_Top + in_sng_Height), , B
    End If

    Exit Sub

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

Public Sub PrintFilledBox( _
    in_sng_Left As Single, _
    in_sng_Top As Single, _
    in_sng_Width As Single, _
    in_sng_Height As Single, _
    in_lng_color As Long)

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

    If g_bool_SendToPrinter Then
        Printer.Line (in_sng_Left - m_sng_LRGap, in_sng_Top - m_sng_TBGap)-(in_sng_Left + in_sng_Width - m_sng_LRGap, in_sng_Top + in_sng_Height - m_sng_TBGap), in_lng_color, BF
    Else
        m_pic_Page.Line (in_sng_Left, in_sng_Top)-(in_sng_Left + in_sng_Width, in_sng_Top + in_sng_Height), in_lng_color, BF
    End If

    Exit Sub

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

Public Sub PrintCircle(in_sng_Left As Single, in_sng_Top As Single, in_sng_Radius)
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.Circle (in_sng_Left - m_sng_LRGap, in_sng_Top - m_sng_TBGap), in_sng_Radius
    Else
        m_pic_Page.Circle (in_sng_Left, in_sng_Top), in_sng_Radius
    End If

    Exit Sub

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

Public Sub PrintNewPage()
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Call Printer.NewPage
    Else
        Call m_pic_Page.Cls
    End If

    Exit Sub

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

Public Sub PrintPicture( _
    in_ctl_PicSource As Control, _
    ByVal in_lng_Left As Long, _
    ByVal in_lng_Top As Long, _
    ByVal in_lng_Width As Long, _
    ByVal in_lng_Height As Long)

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

    ' Picture Box should have autoredraw = False, ScaleMode = Pixel
    ' Also can have visible=false, Autosize = true
    Dim typ_BITMAPINFO  As BITMAPINFO
    Dim lng_DesthDC     As Long
    Dim lng_hMem        As Long
    Dim lng_lpBits      As Long
    Dim lng_hResult     As Long

    ' Precaution:
    If in_lng_Left < m_sng_LRGap Or in_lng_Top < m_sng_TBGap Then Exit Sub
    If in_lng_Width < 0 Or in_lng_Height < 0 Then Exit Sub
    If in_lng_Width + in_lng_Left > m_sng_PgWidth - m_sng_LRGap Then Exit Sub
    If in_lng_Height + in_lng_Top > m_sng_PgHeight - m_sng_TBGap Then Exit Sub

    in_ctl_PicSource.ScaleMode = vbPixels
    in_ctl_PicSource.AutoRedraw = False
    in_ctl_PicSource.Visible = False
    in_ctl_PicSource.AutoSize = True

    If g_bool_SendToPrinter Then
        Printer.ScaleMode = vbPixels

        ' Calculate size in pixels:
        in_lng_Left = ((in_lng_Left - m_sng_LRGap) * 1440) / Printer.TwipsPerPixelX
        in_lng_Top = ((in_lng_Top - m_sng_TBGap) * 1440) / Printer.TwipsPerPixelY
        in_lng_Width = (in_lng_Width * 1440) / Printer.TwipsPerPixelX
        in_lng_Height = (in_lng_Height * 1440) / Printer.TwipsPerPixelY
        Printer.Print "";
        lng_DesthDC = Printer.hdc
    Else
        m_pic_Page.Scale
        m_pic_Page.ScaleMode = vbPixels

        ' Calculate size in pixels:
        in_lng_Left = ((in_lng_Left * 1440) / Screen.TwipsPerPixelX) * m_sng_Ratio
        in_lng_Top = ((in_lng_Top * 1440) / Screen.TwipsPerPixelY) * m_sng_Ratio
        in_lng_Width = ((in_lng_Width * 1440) / Screen.TwipsPerPixelX) * m_sng_Ratio
        in_lng_Height = ((in_lng_Height * 1440) / Screen.TwipsPerPixelY) * m_sng_Ratio
        lng_DesthDC = m_pic_Page.hdc
    End If

    typ_BITMAPINFO.bmiHeader.biSize = 40
    typ_BITMAPINFO.bmiHeader.biWidth = in_ctl_PicSource.ScaleWidth
    typ_BITMAPINFO.bmiHeader.biHeight = in_ctl_PicSource.ScaleHeight
    typ_BITMAPINFO.bmiHeader.biPlanes = 1
    typ_BITMAPINFO.bmiHeader.biBitCount = 8
    typ_BITMAPINFO.bmiHeader.biCompression = BI_RGB

    ' Enter the following two lines as one, single line:
    lng_hMem = GlobalAlloc(GMEM_MOVEABLE, (CLng(in_ctl_PicSource.ScaleWidth + 3) \ 4) * 4 * in_ctl_PicSource.ScaleHeight)    'DWORD ALIGNED
    lng_lpBits = GlobalLock(lng_hMem)

    ' Enter the following two lines as one, single line:
    lng_hResult = GetDIBits(in_ctl_PicSource.hdc, in_ctl_PicSource.Image, 0, in_ctl_PicSource.ScaleHeight, lng_lpBits, typ_BITMAPINFO, DIB_RGB_COLORS)
    If lng_hResult <> 0 Then
        ' Enter the following two lines as one, single line:
        lng_hResult = StretchDIBits(lng_DesthDC, in_lng_Left, in_lng_Top, in_lng_Width, in_lng_Height, 0, 0, in_ctl_PicSource.ScaleWidth, in_ctl_PicSource.ScaleHeight, lng_lpBits, typ_BITMAPINFO, DIB_RGB_COLORS, SRCCOPY)
    End If

    lng_hResult = GlobalUnlock(lng_hMem)
    lng_hResult = GlobalFree(lng_hMem)

    If g_bool_SendToPrinter Then
        Printer.ScaleMode = m_int_ScaleMode
    Else
        m_pic_Page.ScaleMode = m_int_ScaleMode
        m_pic_Page.Scale (0, 0)-(m_sng_PgWidth, m_sng_PgHeight)
    End If

    Exit Sub

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

Public Sub PrintPicture2( _
    in_pic_PicSource As Picture, _
    ByVal in_sng_Left As Single, _
    ByVal in_sng_Top As Single, _
    ByVal in_sng_Width As Single, _
    ByVal in_sng_Height)

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

    If g_bool_SendToPrinter Then
        Printer.ScaleMode = vbPixels

        ' Calculate size in pixels:
        in_sng_Left = (in_sng_Left - m_sng_LRGap) / Printer.TwipsPerPixelX
        in_sng_Top = (in_sng_Top - m_sng_TBGap) / Printer.TwipsPerPixelY
        in_sng_Width = in_sng_Width / Printer.TwipsPerPixelX
        in_sng_Height = in_sng_Height / Printer.TwipsPerPixelY
        Printer.Print "";
    End If

    If g_bool_SendToPrinter Then
        Call Printer.PaintPicture(in_pic_PicSource, in_sng_Left, in_sng_Top, in_sng_Width, in_sng_Height, , , , , vbSrcCopy)
        Printer.ScaleMode = m_int_ScaleMode
    Else
        On Error Resume Next
        Call m_pic_Page.PaintPicture(in_pic_PicSource, in_sng_Left, in_sng_Top, in_sng_Width, in_sng_Height, , , , , vbSrcCopy)
    End If

    Exit Sub

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

Public Sub PrintEndDoc()
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    If g_bool_SendToPrinter Then
        Printer.EndDoc
        Printer.ScaleMode = m_int_PrevScaleMode
    Else
        m_pic_Page.ScaleMode = m_int_PrevScaleMode
    End If

    Exit Sub

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

Public Function PrintByPage(in_obj_Page As Page, Optional EndDoc As Boolean = True) As Boolean
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    Dim i As Integer

    With in_obj_Page
        'Set local page object
        Set m_pic_Page = .PrinterObject
        'Initiate Page
        Call PrintStartDoc(.PaperWidth, .PaperHeight)
        'Header
        With in_obj_Page.Header
            Call PrintShapes(.Shapes)
            Call PrintGraphics(.Graphics)
            Call PrintLabels(.Labels)
        End With
        'Document
        Call PrintShapes(.Shapes)
        Call PrintGraphics(.Graphics)
        Call PrintFields(.Fields)
        Call PrintLabels(.Labels)
        'Footer
        With in_obj_Page.Footer
            Call PrintShapes(.Shapes)
            Call PrintGraphics(.Graphics)
            Call PrintLabels(.Labels, in_obj_Page)
        End With
        'Finalize Page
        If EndDoc Then Call PrintEndDoc
    End With

    PrintByPage = True

    Exit Function

Err_Handler:
    PrintByPage = False
    Call Err.Raise(Err.Number, App.Title & " - PrintByPage", Err.Description)
End Function

Private Sub PrintShapes(in_obj_Shapes As Shapes)
    Dim i As Integer

    For i = 1 To in_obj_Shapes.Count
        With in_obj_Shapes(i)
            Call PrintForeColor(.BorderColor)
            Call PrintDrawStyle(.BorderStyle)
            Call PrintDrawWidth(.BorderWidth)

            Select Case .Shape
                Case stRectangle, stSquare
                    Call PrintBox(.Left, .Top, .Width, .Height)
                Case stOval
                Case stCircle
                Case stRoundedRectangle
                Case stRoundedSquare
                Case stLine
                    Call PrintLine(.X1, .Y1, .X2, .Y2)
            End Select
        End With
    Next i
End Sub

Private Sub PrintGraphics(in_obj_Graphics As Graphics)
    Dim i As Integer

    For i = 1 To in_obj_Graphics.Count