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.

“The question of whether computers can think is just like the question of whether submarines can swim.” - Edsger W. Dijkstra