Keskustelu: Koodit: VB.NET: RichTextBoxin laajennus

Imports System.Drawing.Printing
Public Class rtfBox
    '************************************************
    ' This class inherits from RichTextBox and
    ' implements  Print ja PrinPreview methods
    ' usage:  rtfBox1.Print(), rtfBox1.PrintPreview()
    ' issue: font is fixed during printing!
    ' Author: tnb 10/2004,   vb.net 2003 code
    ' used textbook: Microsoft vb.net cookbook
    '************************************************
    Inherits RichTextBox
    '
    Public Sub New()
        MyBase.New() 'RichTextBox
    End Sub
    '
    Friend MyFont As Font
    Friend sbText As New System.Text.StringBuilder
    Friend sbLine As New System.Text.StringBuilder
    '
    Public Sub Print()
        ' Create the document and attach an event handler.
        Dim MyDoc As PrintDocument = New PrintDocument
        AddHandler MyDoc.PrintPage, AddressOf MyDoc_PrintPage
        '
        'pass font and text
        MyFont = Me.Font
        sbText = sbText.Append(Me.Text)
        '
        ' Allow the user to choose a printer and specify other settings.
        Dim dlgSettings As New PrintDialog
        dlgSettings.Document = MyDoc
        Dim Result As DialogResult = dlgSettings.ShowDialog()
        '
        ' If the user clicked OK, print the document.
        If Result = DialogResult.OK Then
            ' This method returns immediately, before the print job starts.
            ' The PrintPage event will fire asynchronously.
            ' MyDoc.DefaultPageSettings.Landscape = True
            MyDoc.Print()
        End If
    End Sub

    Public Sub PrintPreview()
        ' Create the document and attach an event handler.
        Dim MyDoc As PrintDocument = New PrintDocument
        AddHandler MyDoc.PrintPage, AddressOf MyDoc_PrintPage
        'pass parameters
        MyFont = Me.Font
        sbText = sbText.Append(Me.Text)
        '
        ' This method returns immediately, before the print job starts.
        ' The PrintPage event will fire asynchronously.
        Dim dlgPreview As New PrintPreviewDialog
        dlgPreview.Document = MyDoc
        dlgPreview.Show()

    End Sub
    '
    Private Sub MyDoc_PrintPage(ByVal sender As Object, _
     ByVal e As PrintPageEventArgs)
        '
        Dim linesPerPage As Single = 0
        Dim Lines As Integer 'number of lines printed
        Dim ch As Char
        '
        ' Read the margin settings
        Dim x As Single = e.MarginBounds.Left
        Dim y As Single = e.MarginBounds.Top
        '
        ' Determine the height of a line (based on the font used).
        Dim LineHeight As Single = MyFont.GetHeight(e.Graphics)
        ' Calculate the number of lines per page.
        linesPerPage = e.MarginBounds.Height / MyFont.GetHeight(e.Graphics)
        '
        ' Draw the text until page full or no more text
        Do
            sbLine.Append(sbText.Chars(0))
            sbText = sbText.Remove(0, 1)
            ch = sbLine.Chars(sbLine.Length - 1)
            'check if newline
            If ch = vbNewLine Or ch = vbLf Then
                e.Graphics.DrawString(sbLine.ToString, MyFont, Brushes.Black, x, y)
                y = y + LineHeight
                Lines = Lines + 1
                sbLine = New System.Text.StringBuilder
            Else
                'check if word break
                If ch = " " Then
                    Dim strTest As String = sbLine.ToString
                    If e.Graphics.MeasureString(strTest, MyFont).Width > (e.PageBounds.Width - 200) Then
                        e.Graphics.DrawString(sbLine.ToString, MyFont, Brushes.Black, x, y)
                        y = y + LineHeight
                        Lines = Lines + 1
                        sbLine = New System.Text.StringBuilder
                    End If
                End If
            End If
        Loop While (sbText.Length > 0) And (Lines < linesPerPage)
        ' the last line
        e.Graphics.DrawString(sbLine.ToString, MyFont, Brushes.Black, x, y)
        ' If more lines exist, print another page.
        If (sbText.Length > 0) Then
            e.HasMorePages = True
        Else
            e.HasMorePages = False
        End If
    End Sub
End Class

Public Class Form2
    Inherits System.Windows.Forms.Form
    '

#Region " Windows Form Designer generated code "
    '
    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub
    '
    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.
    'Do not modify it using the code editor.
    Friend WithEvents rtfBox1 As rtfBox '##################
    Friend WithEvents Button1 As System.Windows.Forms.Button
    Friend WithEvents Button2 As System.Windows.Forms.Button
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.Button1 = New System.Windows.Forms.Button
        Me.rtfBox1 = New PrintText.rtfBox
        Me.Button2 = New System.Windows.Forms.Button
        Me.SuspendLayout()
        '
        'Button1
        '
        Me.Button1.Location = New System.Drawing.Point(24, 224)
        Me.Button1.Name = "Button1"
        Me.Button1.Size = New System.Drawing.Size(96, 32)
        Me.Button1.TabIndex = 0
        Me.Button1.Text = "Print"
        '
        'rtfBox1
        '
        Me.rtfBox1.Location = New System.Drawing.Point(16, 20)
        Me.rtfBox1.Name = "rtfBox1"
        Me.rtfBox1.Size = New System.Drawing.Size(240, 180)
        Me.rtfBox1.TabIndex = 1
        Me.rtfBox1.Text = "rtfBox1"
        '
        'Button2
        '
        Me.Button2.Location = New System.Drawing.Point(152, 224)
        Me.Button2.Name = "Button2"
        Me.Button2.Size = New System.Drawing.Size(96, 32)
        Me.Button2.TabIndex = 2
        Me.Button2.Text = "Preview"
        '
        'Form2
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(292, 266)
        Me.Controls.Add(Me.Button2)
        Me.Controls.Add(Me.Button1)
        Me.Controls.Add(Me.rtfBox1)
        Me.Name = "Form2"
        Me.Text = "Form2"
        Me.ResumeLayout(False)

    End Sub

#End Region
    '
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        rtfBox1.Print()
    End Sub
    '
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        rtfBox1.PrintPreview()
    End Sub


End Class