Click here to Skip to main content
15,887,397 members
Articles / Programming Languages / Visual Basic

Improved RichTextBox - IRTB

Rate me:
Please Sign up or sign in to vote.
4.73/5 (18 votes)
3 Apr 2013CPOL17 min read 71.9K   3.7K   47  
This article describes a simple way to implement Line Numbering, HighLight Line and show current Line and Column
Imports System.Windows.Forms
Imports System.IO
Imports System.Drawing
'*********************
''' <summary>
'''IRTB - Improved RTB
''' </summary>
''' <remarks>
''' Line Numbering ideas based on these articles:
''' http://www.codeproject.com/Articles/14566/Line-Numbering-of-RichTextBox-in-NET-2-0 by Michael Elly 
''' I was already using Michael approach to show only the line numbers of the visible lines on the richtextbox, however the main issue was related to the smooth scrolling.
''' Some issues with the numbering have been fixed on this version.
''' Since the Richtextbox does not scroll line by line but it uses smooth scrolling (in pixels) so the calcualtion made by Michael it helps to fix this issue.
''' I have read as well several other articles from codeproject like:
''' http://www.codeproject.com/Articles/12152/Numbering-lines-of-RichTextBox-in-NET-2-0 by Petr Minarik
''' http://www.codeproject.com/Articles/18294/LineNumbers-for-the-RichTextBox by nogChoco 
''' http://www.codeproject.com/Articles/38858/Line-Numbers-for-RichText-Control-in-C by Damian J. Suess
''' IRTB features are:
''' - Event Line Number wich provides the information about the Current Line and the col
''' - HighLight Line Color can be changed at runtime
''' - Prefix for Line Numbering can be enabled/disabled at runtime.
''' - Font can be changed at runtime.
''' - Highlight and numbering can be enabled/disabled at runtime.
''' - Drag/Drop is enabled
''' - Zoom
''' Known limitations:
''' - Performance is not good with files bigger than 1500Kb and it is really bad with files bigger than 2500Kb when both options, line numbering and highlight, are enabled. This is Mainly due the calculations needed to add the numbers and draw the highlight line in top fo the richtextbox
''' - Some flickering can be noticed depending of the action or the size of the file.
''' - If wrap is true it won't give the correct line numbering.</remarks>
Public Class IRTB
    Public Event LineInformation(ByVal LineStatus As String)
    Public Event DragDropFileInformation(ByVal FileInfo As String)
    Dim PLNumberingFont As Font
    Dim IRTBLineNumber As Integer
    Dim IRTBColumnNumber As Integer
    Dim IRTBKeysSelect As Integer
    Dim IRTBNumberPrefix As Boolean
    Dim PBAlign As Integer
    Dim PrefixFormat As String
    Dim PBAlignNumbers As Integer
    Dim IRTBLNColorFont As Color
    Dim IRTBLineCount As Integer
    Dim IRTBForceONPaint As Boolean = True
    Dim HighLightColor As Color = Color.Blue
    Dim EnableNumbering As Boolean = True
    Dim EnableHighLight As Boolean = True
    Dim FileToLoad As String = ""
    Enum IRTBSelectionCase As Integer
        KeysPageUpDown = 1
        KeysLeftRight = 2
        KeysSpecial = 3
        KeysNormal = 4
        Mouse = 5
    End Enum
    Enum IRTBAlignPos As Integer
        Left = 1
        Right = 2
    End Enum
#Region "ImprovedRTB Properties"
    <System.ComponentModel.Description("File to be load by the IRTB")> _
    Public Property IRTBFileToLoad() As String
        Get
            IRTBFileToLoad = FileToLoad
        End Get
        Set(ByVal value As String)
            FileToLoad = value
            LoadFileAndNumbering(value)
            OnPaint(Nothing)
        End Set
    End Property
    <System.ComponentModel.Description("Define the font for the IRTB")> _
    Public Property IRTBFont() As Font
        Get
            IRTBFont = IRTBTextContainer.Font
        End Get
        Set(ByVal value As Font)
            IRTBTextContainer.Font = value ' New System.Drawing.Font(value.FontFamily, Math.Ceiling(value.Size), FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
            PLNumberingFont = value ' New System.Drawing.Font(value.FontFamily, Math.Ceiling(value.Size), FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
            IRTBForceONPaint = True
            PBNumbering.Invalidate()
        End Set
    End Property
    <System.ComponentModel.Description("Define the color used by the line numbers")> _
    Public Property IRTBLNFontColor() As Color
        Get
            IRTBLNFontColor = IRTBLNColorFont
        End Get
        Set(ByVal value As Color)
            IRTBLNColorFont = value
            PBNumbering.Invalidate()
        End Set
    End Property
    <System.ComponentModel.Description("Define the highlight color")> _
    Public Property IRTBHighLightColor() As Color
        Get
            IRTBHighLightColor = HighLightColor
        End Get
        Set(ByVal value As Color)
            HighLightColor = value
            OnPaint(Nothing)
        End Set
    End Property
    <System.ComponentModel.Description("Show the total number of characters")> _
    Public ReadOnly Property ShowTotalChar() As Integer
        Get
            Dim TotalNumberOfChar As Integer
            If IRTBTextContainer.Lines.Count > 0 Then
                TotalNumberOfChar = IRTBTextContainer.GetFirstCharIndexFromLine(IRTBTextContainer.Lines.Count - 1) + Len(IRTBTextContainer.Lines(IRTBTextContainer.Lines.Count - 1))
            Else
                TotalNumberOfChar = 0
            End If
            ShowTotalChar = TotalNumberOfChar
        End Get
    End Property
    <System.ComponentModel.Description("Enable/Disable Line Numbering")> _
    Public Property IRTBEnableNumbering() As Boolean
        Get
            IRTBEnableNumbering = EnableNumbering
        End Get
        Set(ByVal value As Boolean)
            EnableNumbering = value
            PBNumbering.Visible = value
            If value = False Then
                Me.TableLayoutPanel1.ColumnStyles.Item(0).Width = 0
            Else
                Me.TableLayoutPanel1.ColumnStyles.Item(0).Width = CSng(Math.Ceiling(IRTBTextContainer.Font.Size) * 2)
            End If
            OnPaint(Nothing)
        End Set
    End Property
    <System.ComponentModel.Description("Enable/Disable HighLight")> _
    Public Property IRTBEnableHighLight() As Boolean
        Get
            IRTBEnableHighLight = EnableHighLight
        End Get
        Set(ByVal value As Boolean)
            EnableHighLight = value
            OnPaint(Nothing)
        End Set
    End Property
    <System.ComponentModel.Description("Expose the properties of the RichTextBox")> _
    Public ReadOnly Property IRTBContainer() As RichTextBox
        Get
            IRTBContainer = IRTBTextContainer
        End Get
    End Property
    <System.ComponentModel.Description("Expose the properties of the PictureBox")> _
    Public ReadOnly Property IRTBnumbering() As PictureBox
        Get
            IRTBnumbering = PBNumbering
        End Get
    End Property
    <System.ComponentModel.Description("Enable/Disable Line Number Prefix")> _
    Public Property IRTBPrefix() As Boolean
        Get
            IRTBPrefix = IRTBNumberPrefix
        End Get
        Set(ByVal value As Boolean)
            IRTBNumberPrefix = value
            IRTBForceONPaint = True
            PBNumbering.Invalidate()
        End Set
    End Property
    <System.ComponentModel.Description("Select aligment, LEFT or RIGHT")> _
    Public Property IRTBAlignNumbers() As IRTBAlignPos
        Get
            IRTBAlignNumbers = CType(PBAlign, IRTBAlignPos)
        End Get
        Set(ByVal value As IRTBAlignPos)
            PBAlign = value
            PBNumbering.Invalidate()
        End Set
    End Property
#End Region
#Region "General Subroutines"
    Private Sub LoadFileAndNumbering(ByVal mc_file As String)
        '**********Add protectio, i.e when the files are in use by other application(memory stream??), detect if the file is modified and request to reload,etc
        If System.IO.File.Exists(mc_file) Then
            IRTBLineCount = -1
            IRTBLineNumber = 0
            IRTBColumnNumber = 0
            IRTBTextContainer.Clear()
            Dim finfo As New FileInfo(mc_file)
            Dim fileext As String = finfo.Extension.ToUpper
            If fileext = ".RTF" Then
                IRTBTextContainer.LoadFile(mc_file, RichTextBoxStreamType.RichText)
            Else
                IRTBTextContainer.LoadFile(mc_file, RichTextBoxStreamType.PlainText)
            End If
            FileToLoad = mc_file
            My.Settings.Save()
            RTBGetLineCol()
            IRTBTextContainer.ReadOnly = finfo.IsReadOnly
        End If
        PrefixFormat = ""
        PBAlignNumbers = 0
        IRTBLineCount = IRTBTextContainer.Lines.Count
        IRTBForceONPaint = True
        PBNumbering.Invalidate()
    End Sub
    Private Sub IRTBDrawRectangle(ByVal RTBDrawColor As Color, ByVal RTBPointX As Integer, ByVal RTBPointY As Integer, ByVal RTBWidth As Integer, ByVal RTBHeight As Integer)
        If EnableHighLight = True Then
            Dim MyPen As New System.Drawing.Pen(RTBDrawColor)
            Dim FormGraphics As System.Drawing.Graphics
            Dim MySolidBrush As SolidBrush
            RTBHeight = CInt(RTBHeight * IRTBTextContainer.ZoomFactor + 2)
            'If RTBDrawColor.A > 64 Then
            MySolidBrush = New SolidBrush(Color.FromArgb(64, RTBDrawColor.R, RTBDrawColor.G, RTBDrawColor.B))
            'Else
            '   MySolidBrush = New SolidBrush(RTBDrawColor)
            'End If
            FormGraphics = IRTBTextContainer.CreateGraphics()
            FormGraphics.DrawRectangle(MyPen, RTBPointX, RTBPointY, RTBWidth - 1, RTBHeight)
            FormGraphics.FillRectangle(MySolidBrush, RTBPointX, RTBPointY, RTBWidth - 1, RTBHeight)
            MyPen.Dispose()
            FormGraphics.Dispose()
        End If
    End Sub
    Private Sub RTBGetLineCol()
        Dim GetFirstCharIndex As Integer = IRTBTextContainer.GetFirstCharIndexOfCurrentLine
        Dim GetRTBLine = IRTBTextContainer.GetLineFromCharIndex(GetFirstCharIndex)
        Dim GetPosition As Integer = IRTBTextContainer.SelectionStart - GetFirstCharIndex '- 1
        If GetPosition < 0 Then GetPosition = 0
        If GetRTBLine >= IRTBTextContainer.Lines.Count Then GetRTBLine = IRTBTextContainer.Lines.Count - 1
        If GetRTBLine = -1 Then GetRTBLine = 0
        IRTBLineNumber = GetRTBLine
        IRTBColumnNumber = GetPosition
        RaiseEvent LineInformation(GetRTBLine + 1 & "," & GetPosition + 1)
    End Sub
    Private Sub DrawIRTBLineNumbers(ByRef g As Graphics)
        Dim i As Integer
        PLNumberingFont = New System.Drawing.Font(IRTBTextContainer.Font.FontFamily, IRTBTextContainer.Font.Size * IRTBTextContainer.ZoomFactor, IRTBTextContainer.Font.Style, System.Drawing.GraphicsUnit.Point, CType(0, Byte)) ' New System.Drawing.Font(value.FontFamily, Math.Ceiling(value.Size), FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Dim LineNumberingString As String = ""
        Dim font_height As Single = IRTBTextContainer.GetPositionFromCharIndex(IRTBTextContainer.GetFirstCharIndexFromLine(2)).Y - IRTBTextContainer.GetPositionFromCharIndex(IRTBTextContainer.GetFirstCharIndexFromLine(1)).Y
        If font_height <= 0 Then font_height = IRTBTextContainer.Font.Height + 1 'Exit Sub
        'Get the first line index and location
        Dim firstIndex As Integer = IRTBTextContainer.GetCharIndexFromPosition(New Point(0, CInt(g.VisibleClipBounds.Y + font_height / 3)))
        Dim firstLine As Integer = IRTBTextContainer.GetLineFromCharIndex(firstIndex)
        Dim firstLineY As Integer = IRTBTextContainer.GetPositionFromCharIndex(firstIndex).Y
        Dim IRTBBrushes As Brush
        Dim IRTBPBWidthChange As Integer
        IRTBBrushes = New SolidBrush(IRTBLNColorFont)
        If EnableNumbering = True Then
            If IRTBNumberPrefix = True Then
                PrefixFormat = "0####"
            Else
                PrefixFormat = "0"
            End If
            'Print on the PictureBox the visible line numbers of the RichTextBox
            g.Clear(Control.DefaultBackColor)
            i = firstLine

            Dim y As Single
            Do While y < g.VisibleClipBounds.Y + g.VisibleClipBounds.Height
                If i > (IRTBLineCount) Or (i > (IRTBLineNumber + 1) And (IRTBLineNumber + 1) = IRTBLineCount) Then Exit Do '**This line will avoid to paint all possible numbers in the VisibleClipBounds even if the line number on the Richtextbox is 0
                y = firstLineY + 2 + font_height * (i - firstLine - 1) '
                LineNumberingString = Format(i, PrefixFormat) '** To Add some format to the line numbering
                Select Case PBAlign
                    Case IRTBAlignPos.Left
                        PBAlignNumbers = 0
                    Case IRTBAlignPos.Right
                        PBAlignNumbers = CInt(PBNumbering.Width - g.MeasureString(LineNumberingString, IRTBTextContainer.Font).Width * IRTBTextContainer.ZoomFactor)
                End Select
                If i > 0 Then '**To avoid painting the number 0 so in case we are zooming it won’t be shown
                    g.DrawString(LineNumberingString, PLNumberingFont, IRTBBrushes, PBAlignNumbers, y)
                End If
                i += 1
            Loop
            IRTBPBWidthChange = CInt(Me.TableLayoutPanel1.ColumnStyles.Item(0).Width)
            Me.TableLayoutPanel1.ColumnStyles.Item(0).Width = CSng(Math.Ceiling(IRTBTextContainer.Font.Size) * 2) + CInt(g.MeasureString(LineNumberingString, IRTBTextContainer.Font).Width * IRTBTextContainer.ZoomFactor)
            If IRTBPBWidthChange <> Me.TableLayoutPanel1.ColumnStyles.Item(0).Width Then
                IRTBForceONPaint = True
            End If
        End If
        IRTBTextContainer.Focus()
    End Sub
#End Region
#Region "IRTB Events"
    Private Sub ImprovedRTB_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        PLNumberingFont = New System.Drawing.Font(IRTBTextContainer.Font.FontFamily, CSng(Math.Ceiling(IRTBTextContainer.Font.Size)), IRTBTextContainer.Font.Style, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        IRTBTextContainer.Focus()
        IRTBLineNumber = 1
        IRTBColumnNumber = 0
        If IRTBTextContainer.Lines.Count = 0 Then
            IRTBLineCount = 1
        End If
        FileToLoad = ""
        IRTBTextContainer.AllowDrop = True
        HighLightColor = Color.Red
        PBAlign = IRTBAlignPos.Left
        MyBase.SetStyle(ControlStyles.DoubleBuffer Or ControlStyles.UserPaint Or ControlStyles.AllPaintingInWmPaint, True)
    End Sub
    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        Dim RTBPoint As Point
        IRTBTextContainer.Refresh()
        RTBPoint = IRTBTextContainer.GetPositionFromCharIndex(IRTBTextContainer.GetFirstCharIndexOfCurrentLine)
        IRTBDrawRectangle(HighLightColor, 1, RTBPoint.Y, IRTBTextContainer.Width - 1, CInt(IRTBTextContainer.Font.GetHeight))
    End Sub
    Private Sub PLNumbering_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PBNumbering.Paint
        If EnableNumbering = True Then
            DrawIRTBLineNumbers(e.Graphics)
            If IRTBForceONPaint = True Then
                OnPaint(Nothing)
                IRTBForceONPaint = False
            End If
        End If
    End Sub
    Private Sub IRTBHighLightPosition(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles IRTBTextContainer.MouseClick, IRTBTextContainer.HScroll, IRTBTextContainer.GotFocus
        If e.ToString = "System.Windows.Forms.MouseEventArgs" Then
            OnPaint(Nothing)
            RTBGetLineCol()
            IRTBKeysSelect = IRTBSelectionCase.Mouse
        Else
            OnPaint(Nothing)
        End If
    End Sub
    Private Sub IRTBMeRepaint(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.GotFocus, Me.SizeChanged
        IRTBForceONPaint = True
        PBNumbering.Invalidate()
        IRTBTextContainer.Focus()
    End Sub
    Private Sub IRTBLineSynchronization(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles IRTBTextContainer.VScroll
        If EnableNumbering = True Or EnableHighLight = True And IRTBKeysSelect <> IRTBSelectionCase.KeysPageUpDown Then
            PBNumbering.Invalidate()
        End If
        If EnableHighLight = True And IRTBKeysSelect <> IRTBSelectionCase.KeysPageUpDown Then
            '**Here it will redraw the highlight line when the caret postion is coming inside the VisibleClipBounds
            Dim CaretPos As Point = IRTBTextContainer.GetPositionFromCharIndex(IRTBTextContainer.GetFirstCharIndexOfCurrentLine)
            If (CaretPos.Y > -10 And CaretPos.Y < 30) Or (CaretPos.Y < IRTBTextContainer.Height + 30 And CaretPos.Y > IRTBTextContainer.Height - 100) Then
                OnPaint(Nothing)
            End If
        End If
    End Sub
    Private Sub IRTBCheckScoll(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles IRTBTextContainer.MouseWheel
        If IRTBKeysSelect = IRTBSelectionCase.KeysSpecial Then
            IRTBForceONPaint = True
        End If
    End Sub
    Private Sub RTBTextContainer_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles IRTBTextContainer.KeyDown
        Dim RTBText As RichTextBox
        RTBText = Nothing
        RTBText = CType(sender, RichTextBox)
        '***Here you can implement different actions for different combination of keys
        Select Case e.KeyCode
            Case Keys.Up
                IRTBKeysSelect = IRTBSelectionCase.KeysPageUpDown
            Case Keys.Down
                IRTBKeysSelect = IRTBSelectionCase.KeysPageUpDown
            Case Keys.Left
                IRTBKeysSelect = IRTBSelectionCase.KeysLeftRight
            Case Keys.Right
                IRTBKeysSelect = IRTBSelectionCase.KeysLeftRight
            Case Keys.Next 'handles Keys.PageDown
                IRTBKeysSelect = IRTBSelectionCase.KeysPageUpDown
                IRTBForceONPaint = True
                PBNumbering.Invalidate()
            Case Keys.PageUp
                IRTBKeysSelect = IRTBSelectionCase.KeysPageUpDown
            Case Keys.PageDown 'Handles in case of Windows Vista
                IRTBKeysSelect = IRTBSelectionCase.KeysPageUpDown
            Case Keys.Enter
                IRTBKeysSelect = IRTBSelectionCase.KeysSpecial
            Case Keys.Back
                IRTBKeysSelect = IRTBSelectionCase.KeysSpecial
            Case Keys.Delete
                IRTBKeysSelect = IRTBSelectionCase.KeysSpecial
                RTBGetLineCol()
                IRTBTextContainer_SelectionChanged(Nothing, Nothing)
            Case CType(CInt(e.Control = True) And Keys.V, Keys) '*******Here is how to catch CTRL+KEYS
                IRTBKeysSelect = IRTBSelectionCase.KeysSpecial
            Case CType(CInt(e.Control) And Keys.Home, Keys)
                IRTBKeysSelect = IRTBSelectionCase.KeysSpecial
            Case CType(CInt(e.Control) And Keys.End, Keys)
                IRTBKeysSelect = IRTBSelectionCase.KeysSpecial
            Case Keys.ControlKey
                IRTBKeysSelect = IRTBSelectionCase.KeysSpecial
                If IRTBForceONPaint = True Then
                    IRTBKeysSelect = IRTBSelectionCase.KeysSpecial
                    PBNumbering.Invalidate()
                End If
            Case Keys.Escape
                '********To set the ZOOM to 1 again
                If RTBText.ZoomFactor > 1 Or RTBText.ZoomFactor < 1 Then
                    RTBText.ZoomFactor = 1
                    IRTBForceONPaint = True
                    PBNumbering.Invalidate()
                End If
            Case Else
                IRTBKeysSelect = IRTBSelectionCase.KeysNormal
        End Select
    End Sub
    Private Sub IRTBTextContainer_KeyUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles IRTBTextContainer.KeyUp
        '***Here you can implement different actions for different combination of keys
        Select Case e.KeyCode
            Case Keys.Delete
                IRTBKeysSelect = IRTBSelectionCase.KeysSpecial
                RTBGetLineCol()
                IRTBTextContainer_SelectionChanged(Nothing, Nothing)
        End Select
    End Sub
    Private Sub IRTBTextContainer_SelectionChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles IRTBTextContainer.SelectionChanged
        Dim IRTBCurrentLine As Integer
        IRTBLineCount = IRTBTextContainer.Lines.Length
        If IRTBTextContainer.Lines.Count = 0 Then
            IRTBLineCount = 1
        End If
        Select Case IRTBKeysSelect
            Case IRTBSelectionCase.KeysPageUpDown
                RTBGetLineCol()
                IRTBForceONPaint = True
                PBNumbering.Refresh()
            Case IRTBSelectionCase.KeysLeftRight
                IRTBCurrentLine = IRTBLineNumber
                RTBGetLineCol()
                If IRTBLineNumber <> IRTBCurrentLine Then
                    IRTBForceONPaint = True
                End If
                PBNumbering.Refresh()
            Case IRTBSelectionCase.KeysSpecial
                RTBGetLineCol()
                IRTBForceONPaint = True
                PBNumbering.Refresh()
            Case IRTBSelectionCase.KeysNormal
                RTBGetLineCol()
            Case IRTBSelectionCase.Mouse
                RTBGetLineCol()
                PBNumbering.Refresh()
        End Select
    End Sub
#End Region
#Region "Extra Features" 'Drop Files
    Private Sub IRTBDragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles IRTBTextContainer.DragDrop
        Dim myFiles() As String
        myFiles = CType(e.Data.GetData(DataFormats.FileDrop), String())
        For Each mc_file In myFiles
            Dim FileName As String = mc_file.ToString
            LoadFileAndNumbering(FileName)
            RaiseEvent DragDropFileInformation(FileName)
        Next
    End Sub
    Private Sub IRTBDragEnter(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles IRTBTextContainer.DragEnter
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            e.Effect = DragDropEffects.All
        End If
    End Sub
#End Region

End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Sweden Sweden
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions