làm thế nào để in văn bản trong VB6 với justified

Người đăng: Tốt đỏ 5/10/09

(Trích từ http://www.andreavb.com/tip070002.html) 


Option Explicit

Public Sub PrintLine(Text As String, SpaceWidth As Single, Target As Object)
    'Print a justified line to the Target object
    Dim i As Integer
    Dim cx As Single
    Dim OldBold As Boolean
    Dim OldUnderLine As Boolean
    Dim OldItalic As Boolean
    Static FontBold As Boolean
    Static FontUnderLine As Boolean
    Static FontItalic As Boolean

    OldBold = Target.FontBold
    OldUnderLine = Target.FontUnderLine
    OldItalic = Target.FontItalic
    Target.FontBold = FontBold
    Target.FontUnderLine = FontUnderLine
    Target.FontItalic = FontItalic
    cx = 0
    For i = 1 To Len(Text)
        Select Case Mid(Text, i, 1)
        Case Chr(1)
            Target.FontBold = True
        Case Chr(2)
            Target.FontBold = False
        Case Chr(3)
            Target.FontUnderLine = True
        Case Chr(4)
            Target.FontUnderLine = False
        Case Chr(5)
            Target.FontItalic = True
        Case Chr(6)
            Target.FontItalic = False
        Case " "
            cx = cx + SpaceWidth
            Target.CurrentX = cx
        Case Else
            Target.Print Mid(Text, i, 1);
            cx = cx + Target.TextWidth(Mid(Text, i, 1))
        End Select
    Next
    FontBold = Target.FontBold
    FontUnderLine = Target.FontUnderLine
    FontItalic = Target.FontItalic
    Target.FontBold = OldBold
    Target.FontUnderLine = OldUnderLine
    Target.FontItalic = OldItalic
End Sub

Public Sub PrintJust(Text As String, Target As Object)
    'Parse the text string and print justified lines to the Target Object
    Dim i As Long
    Dim WordWidth As Long
    Dim NumWords As Long
    Dim LineWidth As Long
    Dim StartLine As Long
    Dim StopLine As Long
    Dim SpaceW As Long

    'Verify the type of Target Object : only Printers or Pictures
    If Not TypeOf Target Is Printer And Not TypeOf Target Is Picture Then
        Exit Sub
    End If
    If Trim(Text) = "" Then
        Target.Print
        Exit Sub
    End If
    Text = Replace(Text, "", Chr(1), 1, -1, vbTextCompare)
    Text = Replace(Text, "", Chr(2), 1, -1, vbTextCompare)
    Text = Replace(Text, "", Chr(3), 1, -1, vbTextCompare)
    Text = Replace(Text, "", Chr(4), 1, -1, vbTextCompare)
    Text = Replace(Text, "", Chr(5), 1, -1, vbTextCompare)
    Text = Replace(Text, "", Chr(6), 1, -1, vbTextCompare)
    Target.FontBold = False
    Target.FontItalic = False
    Target.FontUnderLine = False
    LineWidth = 0
    WordWidth = 0
    NumWords = 0
    StartLine = 1
    SpaceW = 0
    i = 1
    Do While StartLine <= Len(Text)
        Select Case Mid(Text, i, 1)
        Case Chr(1)
            Target.FontBold = True
        Case Chr(2)
            Target.FontBold = False
        Case Chr(3)
            Target.FontUnderLine = True
        Case Chr(4)
            Target.FontUnderLine = False
        Case Chr(5)
            Target.FontItalic = True
        Case Chr(6)
            Target.FontItalic = False
        Case " ", ""
            SpaceW = SpaceW + Target.TextWidth(" ")
            If LineWidth + WordWidth + SpaceW > Target.ScaleWidth Then
                If NumWords > 0 Then
                    PrintLine Mid(Text, StartLine, StopLine - StartLine + 1), _
                    (Target.ScaleWidth - LineWidth) / (NumWords - 1), Target
                Else
                    PrintLine Mid(Text, StartLine, StopLine - StartLine + 1), 0, Target
                End If
                Target.Print
                StartLine = StopLine + 2
                LineWidth = 0
                NumWords = 0
                SpaceW = 0
            End If
            StopLine = i - 1
            LineWidth = LineWidth + WordWidth
            NumWords = NumWords + 1
            WordWidth = 0
        Case Else
            WordWidth = WordWidth + Target.TextWidth(Mid(Text, i, 1))
        End Select
        i = i + 1
    Loop
    Target.FontBold = False
    Target.FontItalic = False
    Target.FontUnderLine = False
    PrintLine "", 0, Target
End Sub
Usage
'Usage: Create a Form with a Picture Box and add this code...
Private Sub Picture1_Click()
    Dim Var As String

    Picture1.Cls
    Var = "This Code allow you to send Justified text to a Printer or a Picture Box, you can use HTML Tags 



to speficy Bold Style, Italic Style or UnderLine Style...Hope you will enjoy with this code!! Bye Bye."
    Call PrintJust(Var, Picture1)
    Call PrintJust("", Picture1)
    Call PrintJust("Hello,", Picture1)
    Call PrintJust(" ", Picture1)
    Var = "Yesterday, All my troubles seemed so far away, Now it looks as though they´re here to stay, Oh I believe in Yesterday. Suddenly, I´m not half the man I used to be, There´s a shadow hanging over me, Oh yesterday came suddenly. Why she had to go I don´t know she wouldn´t say I said something wrong, now I long for yesterday. Yesterday, Love was such an easy game to play, Now I need a place to hide away, Oh I believe in vesterday, mm mm mm mm mm"
    Call PrintJust(Var, Picture1)
    Call PrintJust("", Picture1) 'Put a line to separate
    Call PrintJust("Any text put as Sub argument is output justified. To change the output to printer, just change 'picture1' to 'printer' in 'PrintJust' Sub argument.", Picture1)
End Sub

Private Sub Form_Resize()
    Picture1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub

| edit post

0 nhận xét

Đăng nhận xét