modprint.bas

AddPrintPreviewtoVBV2 增加打印预览的功能

        With in_obj_Graphics(i)
            Call PrintPicture2(.Picture, .Left, .Top, .Width, .Height)
        End With
    Next i
End Sub

Private Sub PrintFields(in_obj_Fields As DataFields)
    Dim i As Integer

    For i = 1 To in_obj_Fields.Count
        With in_obj_Fields(i)
            Call PrintFontName(.FontName)
            Call PrintFontSize(.FontSize)
            Call PrintFontBold(.FontBold)
            Call PrintFontItalic(.FontItalic)
            Call PrintForeColor(.ForeColor)
            Call PrintCurrentX(.Left)
            Call PrintCurrentY(.Top)
            Call PrintPrint(.DataMember, .Alignment, .MultiLine, .Width, .Height)
        End With
    Next i
End Sub

Private Sub PrintLabels(in_obj_Labels As Labels, Optional in_obj_Page As Page = Nothing)
    Dim str_Temp    As String
    Dim i           As Integer

    For i = 1 To in_obj_Labels.Count
        With in_obj_Labels(i)
            Call PrintFontName(.FontName)
            Call PrintFontSize(.FontSize)
            Call PrintFontBold(.FontBold)
            Call PrintFontItalic(.FontItalic)
            Call PrintFontUnderline(.FontUnderline)
            Call PrintForeColor(.ForeColor)
            Call PrintCurrentX(.Left)
            Call PrintCurrentY(.Top)

            If InStr(.Caption, "{fn:PageNumber()}") <> 0 And Not in_obj_Page Is Nothing Then
                str_Temp = Mid(.Caption, 1, InStr(.Caption, "{fn:PageNumber()}") - 1)
                str_Temp = str_Temp & in_obj_Page.PageNumber & Mid(.Caption, InStr(.Caption, "{fn:PageNumber()}") + Len("{fn:PageNumber()}"))
                Call PrintPrint(str_Temp, .Alignment, .MultiLine, .Width, .Height)

            Else
                Call PrintPrint(.Caption, .Alignment, .MultiLine, .Width, .Height)

            End If
        End With
    Next i
End Sub

Private Sub PrintMultiLineString( _
    in_obj_m_pic_Page As Object, _
    in_str_String As String, _
    in_sng_Width As Single, _
    in_sng_Height As Single, _
    in_int_Alignment As Integer)

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

    Dim str_ary_Words()     As String
    Dim str_Chr             As String
    Dim str_Word            As String
    Dim str_Line            As String
    Dim i                   As Integer
    Dim bool_Submit         As Boolean
    Dim bool_Space          As Boolean
    Dim sng_Height          As Single
    Dim sng_CurrentX        As Single
    Dim sng_CurrentY        As Single
    Dim int_Line            As Integer
    Dim sng_TextHeight      As Single
    Dim bool_End            As Boolean

    ReDim str_ary_Words(0)
    i = 1

    Do While i <= Len(in_str_String)
        str_Chr = Mid(in_str_String, i, 1)

        If str_Chr = Chr(32) Then bool_Space = True Else bool_Space = False

        If bool_Submit <> bool_Space And str_Word <> "" Then
            bool_Submit = bool_Space
            ReDim Preserve str_ary_Words(UBound(str_ary_Words()) + 1)
            str_ary_Words(UBound(str_ary_Words())) = str_Word
            str_Word = str_Chr

        ElseIf i = Len(in_str_String) Then
            str_Word = str_Word & str_Chr
            ReDim Preserve str_ary_Words(UBound(str_ary_Words()) + 1)
            str_ary_Words(UBound(str_ary_Words())) = str_Word

        Else
            str_Word = str_Word & str_Chr

        End If

        i = i + 1
    Loop

    sng_CurrentX = in_obj_m_pic_Page.CurrentX
    sng_CurrentY = in_obj_m_pic_Page.CurrentY
    sng_TextHeight = in_obj_m_pic_Page.TextHeight("Vincent")
    int_Line = 1

    For i = 1 To UBound(str_ary_Words())
        str_Line = str_Line + str_ary_Words(i)
        If i = UBound(str_ary_Words()) And Not bool_End Then bool_End = True

        If in_obj_m_pic_Page.TextWidth(str_Line) > in_sng_Width And Not bool_End Then
            str_Line = Mid(str_Line, 1, Len(str_Line) - Len(str_ary_Words(i)))

            If str_Line <> "" Then
                If in_int_Alignment = 0 Then    'Left
                    in_obj_m_pic_Page.CurrentX = sng_CurrentX
                    in_obj_m_pic_Page.Print str_Line

                ElseIf in_int_Alignment = 1 Then    'Right
                    in_obj_m_pic_Page.CurrentX = sng_CurrentX + (in_sng_Width - in_obj_m_pic_Page.TextWidth(str_Line))
                    in_obj_m_pic_Page.Print str_Line

                ElseIf in_int_Alignment = 2 Then    'Center
                    in_obj_m_pic_Page.CurrentX = sng_CurrentX + ((in_sng_Width - in_obj_m_pic_Page.TextWidth(str_Line)) / 2)
                    in_obj_m_pic_Page.Print str_Line

                End If

                in_obj_m_pic_Page.CurrentY = sng_CurrentY + sng_TextHeight * int_Line
                sng_Height = sng_Height + sng_TextHeight

                If (sng_Height + sng_TextHeight) > in_sng_Height Then Exit For

                int_Line = int_Line + 1
                str_Line = ""

                If i = UBound(str_ary_Words()) Then bool_End = True
                i = i - 1
            Else
                str_Line = str_ary_Words(i)

                Do While (str_Line <> "" Or sng_Height < in_sng_Height)
                    str_Word = SizeString(in_obj_m_pic_Page, str_Line, in_sng_Width)

                    If in_int_Alignment = 0 Then    'Left
                        in_obj_m_pic_Page.CurrentX = sng_CurrentX
                        in_obj_m_pic_Page.Print str_Word

                    ElseIf in_int_Alignment = 1 Then    'Right
                        in_obj_m_pic_Page.CurrentX = sng_CurrentX + (in_sng_Width - in_obj_m_pic_Page.TextWidth(str_Word))
                        in_obj_m_pic_Page.Print str_Word

                    ElseIf in_int_Alignment = 2 Then    'Center
                        in_obj_m_pic_Page.CurrentX = sng_CurrentX + ((in_sng_Width - in_obj_m_pic_Page.TextWidth(str_Word)) / 2)
                        in_obj_m_pic_Page.Print str_Word

                    End If

                    in_obj_m_pic_Page.CurrentY = sng_CurrentY + sng_TextHeight * int_Line
                    sng_Height = sng_Height + sng_TextHeight

                    If (sng_Height + sng_TextHeight) > in_sng_Height Then Exit For

                    str_Line = Mid(str_Line, Len(str_Word) + 1)
                    int_Line = int_Line + 1

                    If in_obj_m_pic_Page.TextWidth(str_Line) < in_sng_Width Then Exit Do
                Loop

            End If

        ElseIf i = UBound(str_ary_Words()) And in_obj_m_pic_Page.TextWidth(str_Line) < in_sng_Width Then

            If in_int_Alignment = 0 Then    'Left
                in_obj_m_pic_Page.CurrentX = sng_CurrentX
                in_obj_m_pic_Page.Print str_Line

            ElseIf in_int_Alignment = 1 Then    'Right
                in_obj_m_pic_Page.CurrentX = sng_CurrentX + (in_sng_Width - in_obj_m_pic_Page.TextWidth(str_Line))
                in_obj_m_pic_Page.Print str_Line

            ElseIf in_int_Alignment = 2 Then    'Center
                in_obj_m_pic_Page.CurrentX = sng_CurrentX + ((in_sng_Width - in_obj_m_pic_Page.TextWidth(str_Line)) / 2)
                in_obj_m_pic_Page.Print str_Line

            End If

        ElseIf i = UBound(str_ary_Words()) And in_obj_m_pic_Page.TextWidth(str_Line) > in_sng_Width Then
            str_Line = Mid(str_Line, 1, Len(str_Line) - Len(str_ary_Words(i)))

            If str_Line <> "" Then

                If in_int_Alignment = 0 Then    'Left
                    in_obj_m_pic_Page.CurrentX = sng_CurrentX
                    in_obj_m_pic_Page.Print str_Line

                ElseIf in_int_Alignment = 1 Then    'Right
                    in_obj_m_pic_Page.CurrentX = sng_CurrentX + (in_sng_Width - in_obj_m_pic_Page.TextWidth(str_Line))
                    in_obj_m_pic_Page.Print str_Line

                ElseIf in_int_Alignment = 2 Then    'Center
                    in_obj_m_pic_Page.CurrentX = sng_CurrentX + ((in_sng_Width - in_obj_m_pic_Page.TextWidth(str_Line)) / 2)
                    in_obj_m_pic_Page.Print str_Line

                End If

                in_obj_m_pic_Page.CurrentY = sng_CurrentY + sng_TextHeight * int_Line
                sng_Height = sng_Height + sng_TextHeight

                If (sng_Height + sng_TextHeight) > in_sng_Height Then Exit For

                int_Line = int_Line + 1
                str_Line = ""

                If i = UBound(str_ary_Words()) Then bool_End = True
                i = i - 1
            Else
                str_Line = str_ary_Words(i)

                Do While (str_Line <> "" Or sng_Height < in_sng_Height)
                    str_Word = SizeString(in_obj_m_pic_Page, str_Line, in_sng_Width)

                    If in_int_Alignment = 0 Then    'Left
                        in_obj_m_pic_Page.CurrentX = sng_CurrentX
                        in_obj_m_pic_Page.Print str_Word

                    ElseIf in_int_Alignment = 1 Then    'Right
                        in_obj_m_pic_Page.CurrentX = sng_CurrentX + (in_sng_Width - in_obj_m_pic_Page.TextWidth(str_Word))
                        in_obj_m_pic_Page.Print str_Word

                    ElseIf in_int_Alignment = 2 Then    'Center
                        in_obj_m_pic_Page.CurrentX = sng_CurrentX + ((in_sng_Width - in_obj_m_pic_Page.TextWidth(str_Word)) / 2)
                        in_obj_m_pic_Page.Print str_Word

                    End If

                    in_obj_m_pic_Page.CurrentY = sng_CurrentY + sng_TextHeight * int_Line
                    sng_Height = sng_Height + sng_TextHeight
                    str_Line = Mid(str_Line, Len(str_Word) + 1)
                    int_Line = int_Line + 1

                Loop
            End If
        End If
    Next i

    Exit Sub

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

Private Function SizeString( _
    in_obj_m_pic_Page As Object, _
    in_str_String As String, _
    in_sng_Width As Single _
    ) As String

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

    Dim str_Temp    As String
    Dim i           As Integer: i = 1

    If in_obj_m_pic_Page.TextWidth(in_str_String) > in_sng_Width Then
        Do While in_obj_m_pic_Page.TextWidth(str_Temp & " ") < in_sng_Width
            str_Temp = str_Temp & Mid(in_str_String, i, 1)
            i = i + 1
        Loop
        SizeString = str_Temp
    Else
        SizeString = in_str_String
    End If

    Exit Function

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

Private Function ConvertPixelsToTwipsX(x As Long) As Long
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    Dim lng_hDC As Long
    Dim lng_hWnd As Long
    Dim lng_RetVal As Long
    Dim lng_XPIXELSPERINCH As Long

    '' Retrieve the current number of pixels per inch, which is
    '' resolution-dependent.
    lng_hDC = GetDC(0)
    lng_XPIXELSPERINCH = GetDeviceCaps(lng_hDC, LOGPIXELSX)
    lng_RetVal = ReleaseDC(0, lng_hDC)

    '' Compute and return the measurements in twips.
    ConvertPixelsToTwipsX = (x / lng_XPIXELSPERINCH) * TWIPSPERINCH

    Exit Function

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

Private Function ConvertPixelsToTwipsY(Y As Long) As Long
    #If RunErrHandler = 1 Then
        On Error GoTo Err_Handler
    #Else
        On Error GoTo 0
    #End If

    Dim lng_hDC As Long
    Dim lng_hWnd As Long
    Dim lng_RetVal As Long
    Dim lng_YPIXELSPERINCH As Long

    ' Retrieve the current number of pixels per inch, which is
    ' resolution-dependent.
    lng_hDC = GetDC(0)
    lng_YPIXELSPERINCH = GetDeviceCaps(lng_hDC, LOGPIXELSY)
    lng_RetVal = ReleaseDC(0, lng_hDC)

    ' Compute and return the measurements in twips.
    ConvertPixelsToTwipsY = (Y / lng_YPIXELSPERINCH) * TWIPSPERINCH

    Exit Function

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