Help: RichTextBox Caret

[nivex]

This code will create a caret for INSERT and OVERWRITE in a specified RichTextBox control when you press a Key in a form, or when the form is entered.

There is a slight problem however, the text is not being measured properly. I am clueless as to exactly how to measure it.

I believe I am close, but it doesn't account for small characters such as spaces, or some symbols. Sometimes the caret overlaps other characters.

If anyone could fix this code, I'd greatly apperciate it. If there is a simpler way to do this, please advise. Thank you !

I also hope that someone finds this code useful, please feel free to use it as your own with no limitations.

' Set your forms KEYPREVIEW to TRUE or else this will not work !

[B][COLOR="Blue"]'PLACE THE FOLLOWING IN A MODULE[/COLOR][/B]

Option Explicit On
Option Strict On

Imports System.Runtime.InteropServices

Module modCaret

    <DllImport("user32.dll", CharSet:=CharSet.Auto)> _
    Public Sub CreateCaret(ByVal hWnd As IntPtr, ByVal hBitmap As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer)
    End Sub

    <DllImport("user32.dll", CharSet:=CharSet.Auto)> _
    Public Sub ShowCaret(ByVal hWnd As IntPtr)
    End Sub

    Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer ' Get key stated for specified key
    Public Const VK_INSERT As Integer = &H2D ' Constant for Insert key

    Public Sub Measure(ByVal strText As String, ByVal rtb As RichTextBox, ByRef nWidth As Single, ByRef nHeight As Single) 

        ' Measure the length and width of a string, then return them in the nWidth and nHeight variables
        Dim e As Graphics = rtb.CreateGraphics ' Create graphic for MeasureString function
        Dim f As New Font(rtb.Font.Name, rtb.Font.Size, rtb.Font.Style, GraphicsUnit.Pixel) ' Copy font used for strText

        nWidth = e.MeasureString(strText, f).Width ' Get width of strText
        nHeight = e.MeasureString(strText, f).Height ' Get height of strText

        e.Dispose() ' Dispose Graphics
        f.Dispose() ' Dispose Font

    End Sub

End Module

[B][COLOR="Blue"]'PLACE THE FOLLOWING IN YOUR FORMS CLASS[/COLOR][/B]

Private Sub Caret() Handles Me.KeyUp, Me.Enter ' Sub will trigger when the form handles KeyUp or Enter

        Dim nWidth, nHeight As Single ' Variables to store Width and Height of RichTextBox1
        Dim nKeyState As Integer = GetKeyState(VK_INSERT) ' Get key state for the Insert key
        'sbpInsert.Text = IIf(nKeyState = 0, "Overwrite", "Insert").ToString ' Status Bar Panel

        Select Case nKeyState
            Case 0 ' Overwrite
	  ' If selection start + 1 > than the RichTextBox1.Length, set the SelectionStart to RichTextBox1.Length
                Dim nStart As Integer = CInt(IIf(RichTextBox1.SelectionStart + 1 > RichTextBox1.Text.Length, RichTextBox1.SelectionStart, RichTextBox1.SelectionStart + 1)) 
                Measure(RichTextBox1.Text.Substring(nStart, 1), RichTextBox1, nWidth, nHeight) ' Get the length of the next character, store values in nWidth and nHeight
                CreateCaret(RichTextBox1.Handle, 0, CInt(nWidth), CInt(nHeight)) ' Create the caret with the specified properties
                ShowCaret(RichTextBox1.Handle) ' Show the caret using the created caret
            Case 1 ' Insert
                Measure("X", RichTextBox1, nWidth, nHeight) ' Measure the letter X with the RichTextBox1 font, store values in nWidth and nHeight
                CreateCaret(RichTextBox1.Handle, 0, 0, CInt(nHeight))  ' Create the caret with the specified properties
                ShowCaret(RichTextBox1.Handle) ' Show the caret using the created caret
        End Select

End Sub