/ Snippet Library - View Code

Visual Basic / Printing / Printing Textbox

Snippet details

ID: 428

Viewed: 1266

Added: 2002-08-19

Version:

Snippets in this catagory
Show Printable Version

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

General Details

Snippet uploaded by: snippet

Email : webmaster@snippetlibrary.com

Snippet By: Andrew Gray

Snippet By:	Andrew Gray
Declarations
Highlight All'no declarations
Code
Highlight All' Written by Andrew Gray, on 5 March 2001, under VB 6. ' Home page: http://www.andrewgray.com ' E-mail: aj.gray@mail.com ' 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. ' PARAMETERS: ' 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 Do ' 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&) Do 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 Do 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& Else 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$ = "" Else ParaText$ = LTrim$(Mid$(ParaText$, LineBreak&)) End If Else ' 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.NewPage 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 Printer.EndDoc ' Function successful PrintText = True PrintText_Err: End Function

Subject: printing a textbox contents

Comment By: A.E.H. on Sun 08th 2004f August 2004 02:58:16 AM

Nice