Binaryworld - How to Print Full Justified Text ... [ VB -> Printing ]

Module

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

Click here to copy the following block

'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