Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools

How to Print Full Justified Text

Total Hit ( 2543)

Rate this article:     Poor     Excellent 

 Submit Your Question/Comment about this article

Rating


 


Module

Click here to copy the following block
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, "<b>", Chr(1), 1, -1, vbTextCompare)
  Text = Replace(Text, "</b>", Chr(2), 1, -1, vbTextCompare)
  Text = Replace(Text, "<u>", Chr(3), 1, -1, vbTextCompare)
  Text = Replace(Text, "</u>", Chr(4), 1, -1, vbTextCompare)
  Text = Replace(Text, "<i>", Chr(5), 1, -1, vbTextCompare)
  Text = Replace(Text, "</i>", 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 <b>Bold Style</b>, <i>Italic Style</i> or <u>UnderLine Style</u>...Hope you will enjoy with this code!! Bye Bye."
  Call PrintJust(Var, Picture1)
  Call PrintJust("", Picture1)
  Call PrintJust("Hello,", Picture1)
  Call PrintJust(" ", Picture1)
  Var = "<b>Yesterday</b>, All my troubles seemed so far away, Now it looks as though they´re here to stay, Oh I believe in Yesterday. <i>Suddenly, I´m not half the man I used to be, There´s a shadow hanging over me, Oh yesterday came suddenly</i>. Why she had to go I don´t know she wouldn´t say I said something wrong, now I long for yesterday. <b><i>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</i></b>"
  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 <b>'picture1'</b> to <b>'printer'</b> in <i>'PrintJust'</i> Sub argument.", Picture1)
End Sub

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


Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.