Printing with formatting in VB.NET

• • Reply

  14 years ago

  by jereme.guenther

  Jereme Guenther

  , United States

  Joined 15 years ago

  A more current version of this code along with an article and helpful discussion thread are available at the following link:

  http://www.sqlservercentral.com/columnists/jGuenther/printinginnet.asp

  Report abuse
• • Reply

  14 years ago

  by nyt1972

  Naveed Alam Tareen

  , Pakistan

  Joined 14 years ago

  I am working on an editor in VB.net using Richtext box and I want Formatted Print/Print Preview.

  How can I use this class, can u tell me please.

  Report abuse
• • Reply

  13 years ago

  by bobmori

  Bob Mori

  , United States

  Joined 13 years ago

  I tried and added Italics, Font Change and Font Size. All work and will share with anyone who would like it. I did have one problem, 10pt fonts would not work. I can us 9 and below and 11 and above but not 10. If anyone has had this problem and solved it, I could use the Help

   

  Here is the new Class

  Public

  Class PrintText

  ' Inherits all the functionality of a PrintDocument

  Inherits Printing.PrintDocument

  ' Private variables to hold default font and text

  Public fntPrintFont As Font

  Private strText As String

  Dim MySplitLine As String()

  Dim varStart As Integer = 0

  Dim varChar As Integer = 0

  Public FontName As String = ""

  Public FontSize As Single = 10

  ' New constructor

  Public Sub New(ByVal Text As String)

  ' Sets the file stream

  MyBase.New()

  varStart = 0

  strText = Text

  MySplitLine = strText.Split(vbCrLf)

  End Sub

  Public Property Text() As String

  Get

  Return strText

  End Get

  Set(ByVal Value As String)

  strText = Value

  MySplitLine = strText.Split(vbCrLf)

  'Breaks up text into separate lines at Carrage Return Line Feeds

  End Set

  End Property

  Protected Overrides Sub OnBeginPrint(ByVal ev As Printing.PrintEventArgs)

  ' Run base code

  MyBase.OnBeginPrint(ev)

  ' Sets the default font

  If fntPrintFont Is Nothing Then

  fntPrintFont =

  New Font("Times New Roman", 12, FontStyle.Regular, GraphicsUnit.Point)

  End If

  End Sub

  Public Property Font() As Font

  ' Allows the user to override the default font

  Get

  Return fntPrintFont

  End Get

  Set(ByVal Value As Font)

  fntPrintFont = Value

  End Set

  End Property

  Protected Overrides Sub OnPrintPage(ByVal e As Printing.PrintPageEventArgs)

  ' Provides the print logic for our document

  ' Run base code

  MyBase.OnPrintPage(e)

  ' Draw the margins (for debugging).

  'e.Graphics.DrawRectangle(Pens.Red, e.MarginBounds)

  Dim the_font As Font = fntPrintFont

  Dim string_format As New StringFormat 'StringFormat must be a parameter of PrintDocument ????

  ' Draw the text left justified,

  ' wrap at words, and don't draw partial lines.

  string_format.Alignment = StringAlignment.Near

  'Near Center or Far must be center and right and left justify

  string_format.FormatFlags = StringFormatFlags.LineLimit

  string_format.Trimming = StringTrimming.Word

  'Break at end of Word ????????

  ' Draw some text.

  Dim ymin As Integer = e.MarginBounds.Top 'e. e defined in sub parameters as Printing.PrintPageEventArg

  'Dim xmin As Integer = e.MarginBounds.Left ' Use to get left margin ???

  Dim layout_rect As RectangleF

  Dim text_size As SizeF

  Dim characters_fitted As Integer

  Dim lines_filled As Integer

  Static i As Integer

  For i = varStart To MySplitLine.GetUpperBound(0)

  ' get ready for the 1 char printing

  Dim smallArray As String(,)

  Dim xmin As Integer = e.MarginBounds.Left

  Dim varWord As RectangleF()

  ReDim varWord(1)

  Dim wordCountForLine As Integer = 0

  ' make sure a space prints if a two vbcrlf's are in a row

  If Trim(Len(MySplitLine(i))) = 1 Then

  ReDim smallArray(3, 1)

  smallArray(0, 0) =

  "" 'Character to Print

  smallArray(1, 0) = FontStyle.Regular

  'Print Style

  smallArray(2, 0) = -1

  'Start Position

  ymin +=

  CInt(the_font.Height)

  Else

  '***Special print 1 char at a time for formatting***

  smallArray = checkBold(Trim(MySplitLine(i).ToString), fntPrintFont)

  '***END print 1 char at a time for formatting***

  End If

  Dim x As Integer

  For x = varChar To smallArray.GetUpperBound(1) - 1 ' when returning from checkbold all three upperbounds should be then same

  'remove blanks so ascii works

  If smallArray(0, x).Length = 0 Then smallArray(0, x) = Chr(0)

  ' Get the font for measurement.

  the_font =

  New Font(fntPrintFont.Name, CInt(fntPrintFont.Size), CInt(smallArray(1, x)), fntPrintFont.Unit)

  ' Set the text start location if desired

  If CInt(smallArray(2, x)) > -1 Then xmin = CInt(smallArray(2, x))

  ' Get the area available for this text.

  layout_rect =

  New RectangleF(xmin, ymin, e.MarginBounds.Right - xmin, the_font.Height)

  ' If the layout rectangle's height < 1, make it 1.

  If layout_rect.Height < 1 Then layout_rect.Height = 1

  ' See how big the text will be and how many characters will fit.

  ' text_size is the size of the character

  text_size = e.Graphics.MeasureString(smallArray(0, x).ToString, the_font,

  New SizeF(layout_rect.Width, layout_rect.Height), string_format, characters_fitted, lines_filled)

  ' See if any characters will fit.

  If characters_fitted > 0 Then 'Does Graphics.MeasureString return characters_fitted

  ' start accumulating the print location

  varWord(varWord.GetUpperBound(0) - 1) = layout_rect

  ' ************Draw the word when finished.************

  If Asc(smallArray(0, x).Chars(0)) = 32 Or x = smallArray.GetUpperBound(1) - 1 Then

  Dim z As Integer

  For z = x - (varWord.GetUpperBound(0) - 1) To x

  ' Get the font for measurement.

  the_font =

  New Font(fntPrintFont.Name, CInt(fntPrintFont.Size), CInt(smallArray(1, z)), fntPrintFont.Unit)

  ' actually print the character on the page.

  e.Graphics.DrawString(smallArray(0, z), the_font, Brushes.Black, varWord((z - x) + (varWord.GetUpperBound(0) - 1)), string_format)

  Next

  xmin += 4

  ReDim varWord(0)

  wordCountForLine += 1

  End If

  '' Draw a rectangle around the text (for debugging).

  'e.Graphics.DrawRectangle(Pens.Green, layout_rect.Left, layout_rect.Top, text_size.Width, text_size.Height)

  ' Increase the location where we can start.

  xmin +=

  CInt(text_size.Width) - 4

  ReDim Preserve varWord(varWord.GetUpperBound(0) + 1)

  ElseIf Asc(smallArray(0, x).Chars(0)) < 30 Then

  ' make sure to dispose of odd char's in the array

  Else ' See if some of the paragraph didn't fit

  ' ********Draw the word if longer than one line.**********

  If wordCountForLine = 0 Then

  varWord(varWord.GetUpperBound(0) - 1) = layout_rect

  Dim z As Integer

  For z = x - (varWord.GetUpperBound(0) - 1) To x

  e.Graphics.DrawString(smallArray(0, z), the_font, Brushes.Black, varWord((z - x) + (varWord.GetUpperBound(0) - 1)), string_format)

  Next

  ReDim varWord(0)

  End If

  '*******reset the variables*********

  wordCountForLine = 0

  x -= varWord.GetUpperBound(0)

  ReDim varWord(1)

  xmin = e.MarginBounds.Left

  ymin +=

  CInt(the_font.Height) ' move to the next line

  'see if there are more lines available

  If (e.MarginBounds.Bottom - ymin) < the_font.Height Then Exit For ' exit for loop so page can print

  End If

  Next

  ymin +=

  CInt(the_font.Height)

  ' move to the next line

  If (e.MarginBounds.Bottom - ymin) < the_font.Height Then

  varChar = x

  'save character location

  varStart = i

  'save line location

  e.HasMorePages =

  True 'after printing page, run sub again

  Exit For ' exit for loop so page can print

  Else

  varChar = 0

  e.HasMorePages =

  False

  End If

  Next

  End Sub

  Private Function checkBold(ByVal varString As String, ByVal startFont As Font) As String(,)

  Dim aryString As String(,)

  ReDim aryString(3, 1)

  Dim printStyle As FontStyle = FontStyle.Regular

  Dim varStartPlace As Integer = -1

  aryString(0, 0) =

  "" 'initialize the array to avoid errors

  aryString(1, 0) = printStyle

  aryString(2, 0) = varStartPlace

  Dim varPlace As Integer = 0

  Dim FontSize As Single = 10 'Added

  For varPlace = 1 To varString.Length

  Dim Pcode As String = "" 'Added

  Dim Lcode As Integer 'Added

  If Mid(varString, varPlace, 1) = "<" Then 'Added

  Dim j As Integer 'Added

  For j = varPlace To varString.Length 'Added

  If Mid(varString, j, 1) = ">" Or Mid(varString, j, 1) = "=" Then 'Added

  Pcode = Mid(varString, varPlace, j - varPlace + 1)

  'Added

  Lcode = j - varPlace + 1

  'Added

  Exit For 'Added

  End If 'Added

  Next 'Added

  End If 'Added

  Select Case Pcode

  Case "<B>"

  printStyle = FontStyle.Bold

  varPlace += 2

  Case "</B>"

  printStyle = FontStyle.Regular

  varPlace += 3

  Case "<I>"

  printStyle = FontStyle.Italic

  varPlace += 2

  Case "</I>"

  printStyle = FontStyle.Regular

  varPlace += 3

  Case "<ST="

  varPlace = InStr(varPlace + 4, varString,

  ">")

  Case "<FN="

  FontName = Mid(varString, varPlace + 4, InStr(varPlace + 4, varString,

  ">") - (varPlace + 4))

  varPlace = InStr(varPlace + 4, varString,

  ">")

  fntPrintFont =

  New Font(FontName, FontSize, FontStyle.Regular, GraphicsUnit.Point)

  Case "<FS="

  FontSize =

  CInt(Mid(varString, varPlace + 4, InStr(varPlace + 4, varString, ">") - (varPlace + 4)))

  varPlace = InStr(varPlace + 4, varString,

  ">")

  fntPrintFont =

  New Font(Me.FontName, FontSize, FontStyle.Regular, GraphicsUnit.Point)

  Case Else

  ReDim Preserve aryString(3, aryString.GetUpperBound(1) + 1)

  aryString(0, aryString.GetUpperBound(1) - 1) = Mid(varString, varPlace, 1)

  aryString(1, aryString.GetUpperBound(1) - 1) = printStyle

  aryString(2, aryString.GetUpperBound(1) - 1) = varStartPlace

  varStartPlace = -1

  End Select

  Next

  Return (aryString)

  End Function

  End

  Class

  Bob

  Report abuse
• • Reply

  12 years ago

  by stixoffire

  stixoffire

  USA, United States

  Joined 16 years ago

  I think the problem lies in that the system font default size is 10 point but I am not sure..

  Report abuse