[原创]打印richtextbox的解决方案

在实际应用中，我们经常会遇到要打印文本框的情况，自行换行是一个必须解决的首要问题，最初我也不太懂MeasureString这个函数，走了许多弯路，用正则表达式进行单字匹配，执行的效率低效果又不太理想。
后来发贴求解，有一熟手提醒，于是自己写下代码，供后来者学习研究。
'============================================
'Power by：landlordh
'Print richtextbox or mulitline textbox
'============================================

    Private intcurrentchar As Integer

    Private Sub pdoc_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles Pdoc.PrintPage
        Try
            Dim g As Graphics
            g = e.Graphics
            Dim pen As New Drawing.Pen(Color.Black, 3)
            Dim font As New Font("Arial", 9)
            Dim font1 As New Font("Arial", 12)
            Dim font2 As New Font("Arial", 10)
            Dim intPrintAreaHeight As Integer
            Dim intPrintAreaWidth As Integer
            intPrintAreaHeight = Pdoc.DefaultPageSettings.PaperSize.Height - Pdoc.DefaultPageSettings.Margins.Top - Pdoc.DefaultPageSettings.Margins.Bottom
            intPrintAreaWidth = Pdoc.DefaultPageSettings.PaperSize.Width - Pdoc.DefaultPageSettings.Margins.Left - Pdoc.DefaultPageSettings.Margins.Right
            If Pdoc.DefaultPageSettings.Landscape Then
                Dim intTemp As Integer = intPrintAreaHeight
                intPrintAreaHeight = intPrintAreaWidth
                intPrintAreaWidth = intTemp
            End If
           'Dim intLineCount As Integer = CType((intPrintAreaHeight / font.Height), Integer)
            Dim rectPrintingArea As RectangleF = New RectangleF(Pdoc.DefaultPageSettings.Margins.Left, Pdoc.DefaultPageSettings.Margins.Top, intPrintAreaWidth, intPrintAreaHeight)
            Dim fmt As StringFormat = New StringFormat(StringFormatFlags.LineLimit)
            Dim intLinesFilled As Integer
            Dim intCharsFitted As Integer

            'draw page title
            g.DrawString("主题：" & topic.Text, font1, Brushes.Black, 0, 10)
            g.DrawLine(pen, 0, 12 + font1.Height, intPrintAreaWidth, 17 + font1.Height)
            g.MeasureString(word.Text.Substring(intcurrentchar), font, New SizeF(intPrintAreaWidth, intPrintAreaHeight), fmt, intCharsFitted, intLinesFilled)
            g.DrawString(word.Text.Substring(intcurrentchar), font, Brushes.Black, rectPrintingArea)
            intcurrentchar += intCharsFitted
            intLineCount += intLinesFilled
            g.DrawLine(pen, 0, 12 + font1.Height + intPrintAreaHeight + 6, intPrintAreaWidth, 12 + font1.Height + intPrintAreaHeight + 11)
            g.DrawString("Power by：LandlordAspx", font2, Brushes.Black, 625, 12 + font1.Height + intPrintAreaHeight + 12)
            'g.DrawString("共(" & Pdoc.PrinterSettings.ToPage & ")页", font2, Brushes.Black, 320, 12 + font1.Height + intPrintAreaHeight + 12)
            If intcurrentchar < (word.Text.Length - 1) Then
                e.HasMorePages = True
            Else
                e.HasMorePages = False
                intcurrentchar = 0
            End If
        Catch ex As Exception
            MessageBox.Show("系统执行时发生以下错误：" & Chr(10) & "错误源：" & ex.Source.ToString & Chr(10) & "错误信息：" & ex.Message.ToString & Chr(10) & Chr(10) & "请记录错误信息，并与管理员联系。", "系统提示")
        End Try
    End Sub

    Private Sub Printing()
        Dim PrintDialog1 As New PrintDialog
        PrintDialog1.Document = Pdoc
        PrintDialog1.AllowSelection = True
        PrintDialog1.AllowPrintToFile = True
        PrintDialog1.AllowSomePages = True
        PrintDialog1.PrintToFile = False

        If PrintDialog1.ShowDialog() = DialogResult.OK Then
            Pdoc.Print()
        End If
    End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If Trim(word.Text) <> "" Then
            Try
                Pdoc.DocumentName = "LandlordAspx RichTextBox打印"
                Pdoc.DefaultPageSettings.Margins.Top = 34
                Pdoc.DefaultPageSettings.Margins.Bottom = 70
                Pdoc.DefaultPageSettings.Margins.Left = 0
                Pdoc.DefaultPageSettings.Margins.Right = 18
                Printing()
            Catch ex As Exception
            End Try
        End If
    End Sub

本文地址：http://com.8s8s.com/it/it42676.htm