Printing with formatting in VB.NET

This is a comment thread discussing Printing with formatting in VB.NET
  • 8 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

  • 8 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.

  • 7 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

  • 6 years ago

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

Post a reply

Enter your message below

Sign in or Join us (it's free).

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“Debugging is twice as hard as writing the code in the first place. Therefore, if you write the code as cleverly as possible, you are, by definition, not smart enough to debug it.” - Brian Kernighan