Not a Member Yet,
Click here to Register
How do you like the new design?

ID: 428
Viewed: 2737
Added: Aug 19, 2002
Snippet uploaded by: snippet
Written By: Andrew Gray
Demo: Sorry, no demo

User Rated at: 0 Stars
Rate This:

Thank you for your vote. Please wait...

It appears you already voted for this snippet

It appears your vote value was empty

Task: Prints out the contents of a text box, complete with font, alignment, wrapping and margins - without using the Windows API.

Highlight all by clicking in box
'no declarations

Highlight All
' Written by Andrew Gray, on 5 March 2001, under VB 6.
' Home page:
' E-mail:

' Please contact me with any comments or problem reports.
' This code is public domain - use it in whatever way you wish.
' However, I can't accept responsibility for it.

Public Function PrintText(TextBox As Control, ByVal LeftMargin As Double, ByVal RightMargin As Double, ByVal TopMargin As Double, ByVal BottomMargin As Double, ByVal PrintSelectedOnly As Boolean) As Boolean
' Prints the contents of a text box.
' Returns True on success; False on failure.

' TextBox
' Reference to a text box (e.g. Text1)
' LeftMargin, RightMargin, TopMargin, BottomMargin
' Amount of space to leave around the page
' (units depend upon the printer's ScaleMode)
' PrintSelectedOnly
' Set to True to print just the selected text;
' False to print the entire contents of the text box

Dim PrintAreaWidth#
Dim StartPara&, EndPara&
Dim SpaceFound&, TabFound&, TryBreak&, LineBreak&
Dim TextToPrint$, ParaText$, PrintLine$

' Abandon the function if an error occurs
On Error GoTo PrintText_Err

' Put the text to be printed in TextToPrint$
TextToPrint$ = IIf(PrintSelectedOnly, TextBox.SelText, TextBox.Text)
If TextToPrint$ = "" Then Exit Function

' Calculate the maximum width of a line of text
PrintAreaWidth# = Printer.ScaleWidth - LeftMargin - RightMargin

' Check that the margins are sensible
' (taking the current paper size into consideration)
If PrintAreaWidth# <= 0 Then Exit Function
If Printer.ScaleHeight - TopMargin - BottomMargin <= 0 Then Exit Function

' Set printer font to the same as the text box's
Printer.Font.Name = TextBox.Font.Name
Printer.Font.Bold = TextBox.Font.Bold
Printer.Font.Charset = TextBox.Font.Charset
Printer.Font.Italic = TextBox.Font.Italic
Printer.Font.Size = TextBox.Font.Size
Printer.Font.Strikethrough = TextBox.Font.Strikethrough
Printer.Font.Underline = TextBox.Font.Underline
Printer.Font.Weight = TextBox.Font.Weight

' Start printing at the top margin, unless the printing
' position is already further down the page
If Printer.CurrentY < TopMargin Then Printer.CurrentY = TopMargin

StartPara& = 1
' Get each paragraph of text in turn
EndPara& = InStr(StartPara&, TextToPrint$, vbCrLf)
If EndPara& = 0 Then EndPara& = Len(TextToPrint$) + 1
ParaText$ = Mid$(TextToPrint$, StartPara&, EndPara& - StartPara&)

If ParaText$ <> "" Then
' Work out how much of the paragraph will fit
' across the page before it has to be wrapped...

' First of all, try breaking the paragraph at a
' space or a tab
TryBreak& = 0
LineBreak& = 0
SpaceFound& = InStr(TryBreak& + 1, ParaText$, " ")
TabFound& = InStr(TryBreak& + 1, ParaText$, vbTab)
TryBreak& = IIf(TabFound& > 0 And TabFound& < SpaceFound&, TabFound&, SpaceFound&)
If TryBreak& = 0 Then TryBreak& = Len(ParaText$) + 1
If Printer.TextWidth(Left$(ParaText$, TryBreak& - 1)) <= PrintAreaWidth# Then
LineBreak& = TryBreak&
Exit Do
End If
Loop Until TryBreak& > Len(ParaText$)

' If there is no space or tab (just one long word
' taking up the whole line), break the word anywhere
If LineBreak& = 0 Then
For TryBreak& = 1 To Len(ParaText$)
If Printer.TextWidth(Left$(ParaText$, TryBreak& - 1)) > PrintAreaWidth# Then
LineBreak& = TryBreak& - 1
Exit For
End If
Next TryBreak&
' In the unlikely event that one huge character
' fills the width of the page, print it anyway,
' otherwise an infinite loop will occur
If LineBreak& = 0 Then LineBreak& = 1
End If

' Store the line to be printed in PrintLine$,
' leave the rest of the paragraph in ParaText$
PrintLine$ = Left$(ParaText$, LineBreak&)
If LineBreak& > Len(ParaText$) Then
ParaText$ = ""
ParaText$ = LTrim$(Mid$(ParaText$, LineBreak&))
End If
' Print an empty line if necessary
PrintLine$ = ""
End If

' If line won't fit onto this page, start a new page
If Printer.CurrentY + Printer.TextHeight(PrintLine$) > Printer.ScaleHeight - BottomMargin Then
Printer.CurrentY = TopMargin
End If

' Set the horizontal printing position to the
' appropriate place, depending upon the text alignment
Select Case TextBox.Alignment
Case vbLeftJustify
Printer.CurrentX = LeftMargin
Case vbRightJustify
Printer.CurrentX = Printer.ScaleWidth - RightMargin - Printer.TextWidth(PrintLine$)
Case vbCenter
Printer.CurrentX = LeftMargin + (PrintAreaWidth# - Printer.TextWidth(PrintLine$)) / 2
End Select

' Print the line
Printer.Print PrintLine$

' Continue printing lines until the entire paragraph
' of text has been printed
Loop Until ParaText$ = ""

' Continue printing paragraphs until the entire piece
' of text has been printed
StartPara& = EndPara& + 2
Loop Until EndPara& > Len(TextToPrint$)

' Send the document to the printer

' Function successful
PrintText = True

End Function;

Subject: printing a textbox contents
[ Reply ]
Comment By: A.E.H. on 07th of August 2004 05:58 PM


Please completely fill out the form below if you want to review this snippet. All reviews are subject to validation.

Replying to a Comment...

Adding your comment. Please wait...

Thanks for adding your comment!. After further review it will be added.

There was a problem adding your comment. Please try again.

Please complete all the fields in the form before sending.

© 2002 - 2017 All Rights Reserved. Conditions