by Andrew Gray (1 Submission)
Category: Windows System Services
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 3rd May 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Prints out the contents of a text box, complete with font, alignment, wrapping and margins - without using the Windows API.
VBcoders
' Home page: http://www.andrewgray.com
' E-mail: [email protected]
' 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
No comments have been posted about Prints out the contents of a text box, complete with font, alignment, wrapping and margins - withou. Why not be the first to post a comment about Prints out the contents of a text box, complete with font, alignment, wrapping and margins - withou.
