Getting and Setting the Position of the Caret in a TextBox Control

The TextBox class shipped as part of .NET’s Windows Forms does not support querying and setting the position of the caret. Not even the underlying EDIT control class provides messages for this purpose. Instead, it is necessary to utilize the functions GetCaretPos, SetCaretPos, and SendMessage in conjunction with the EM_POSFROMCHAR and EM_CHARFROMPOS messages. The code below contains an implementation of an extended textbox control providing a CaretPosition property which supports both getting and setting the position of the textbox’ caret. In addition to that a handy replacement for the Win32 macros MAKELONG, LOWORD, and HIWORD is supplied.

Imports MvpsOrg.Dotnet.InteropHelpers.WordConverter
Imports System.ComponentModel
Imports System.Runtime.InteropServices

Public Class ExtendedTextBox
    Inherits TextBox

    Private Declare Auto Function SendMessage Lib "user32.dll" ( _
        ByVal hWnd As IntPtr, _
        ByVal Msg As Int32, _
        ByVal wParam As IntPtr, _
        ByVal lParam As IntPtr _
    ) As IntPtr

    Private Declare Auto Function GetCaretPos Lib "user32.dll" ( _
        ByRef lpPoint As POINTAPI _
    ) As Boolean

    Private Declare Auto Function SetCaretPos Lib "user32.dll" ( _
        ByVal x As Int32, _
        ByVal y As Int32 _
    ) As Boolean

    Private Const EM_POSFROMCHAR As Int32 = &HD6
    Private Const EM_CHARFROMPOS As Int32 = &HD7

    <StructLayout(LayoutKind.Sequential)> _
    Private Structure POINTAPI
        Public x As Int32
        Public y As Int32
    End Structure

    Private Declare Auto Function DrawText Lib "user32.dll" ( _
        ByVal hDC As IntPtr, _
        ByVal lpStr As String, _
        ByVal nCount As Int32, _
        ByRef lpRect As RECT, _
        ByVal wFormat As Int32 _
    ) As Int32

    Private Const DT_CALCRECT As Int32 = &H400

    Private Structure RECT
        Public Left As Int32
        Public Top As Int32
        Public Right As Int32
        Public Bottom As Int32
    End Structure

    Private Declare Function SelectObject Lib "gdi32.dll" ( _
        ByVal hdc As IntPtr, _
        ByVal hObject As IntPtr _
    ) As IntPtr

    < _
        DesignerSerializationVisibility( _
            DesignerSerializationVisibility.Hidden _
        ) _
    > _
    Public Property CaretPosition() As Integer
        Get
            Dim pt As POINTAPI
            If Not GetCaretPos(pt) Then
                Throw New Win32Exception()
                Exit Property
            End If
            Return _
                LoWord( _
                    SendMessage( _
                        Me.Handle, _
                        EM_CHARFROMPOS, _
                        IntPtr.Zero, _
                        New IntPtr(MakeLong(pt.x, pt.y)) _
                    ).ToInt32() _
                )
        End Get
        Set(ByVal Value As Integer)
            Dim x As Integer
            If Value >= Me.TextLength Then
                Value = Me.TextLength - 1
                Using g As Graphics = Me.CreateGraphics()
                    Dim hDC As IntPtr = g.GetHdc()
                    Dim hNewFont As IntPtr = Me.Font.ToHfont()
                    Dim hOldFont As IntPtr = SelectObject(hDC, hNewFont)
                    Dim rct As RECT
                    rct.Right = Int32.MaxValue
                    rct.Bottom = Int32.MaxValue
                    If _
                        DrawText( _
                            hDC, _
                            Strings.Right(Me.Text, 1), _
                            1, _
                            rct, _
                            DT_CALCRECT _
                        ) = 0 _
                    Then
                        Throw New Win32Exception()
                        Exit Property
                    End If
                    x = rct.Right
                    SelectObject(hDC, hOldFont)
                    g.ReleaseHdc(hDC)
                End Using
            End If
            Dim n As Int32 = _
                SendMessage( _
                    Me.Handle, _
                    EM_POSFROMCHAR, _
                    New IntPtr(Value), _
                    IntPtr.Zero _
                ).ToInt32()
            x += LoWord(n)
            Dim y As Integer = HiWord(n)

            ' HACK:  Is there any other way to get the Y-offset of the
            ' caret?
            Select Case Me.BorderStyle
                Case BorderStyle.Fixed3D
                    y += 1
                Case BorderStyle.FixedSingle
                    y += 2
                'Case BorderStyle.None
                '    y += 0
            End Select

            If Not SetCaretPos(x, y) Then
                Throw New Win32Exception()
                Exit Property
            End If
        End Set
    End Property
End Class

Public Class WordConverter
    <StructLayout(LayoutKind.Explicit)> _
    Private Structure DWord
        <FieldOffset(0)> Public LongValue As Integer
        <FieldOffset(0)> Public LoWord As Short
        <FieldOffset(2)> Public HiWord As Short
    End Structure

    Private Shared m_DWord As DWord

    Public Shared Function MakeLong( _
        ByVal LoWord As Short, _
        ByVal HiWord As Short _
    ) As Integer
        m_DWord.LoWord = LoWord
        m_DWord.HiWord = HiWord
        Return m_DWord.LongValue
    End Function

    Public Shared Function MakeLong( _
        ByVal LoWord As Integer, _
        ByVal HiWord As Integer _
    ) As Integer
        Return MakeLong(CShort(LoWord), CShort(HiWord))
    End Function

    Public Shared Function LoWord(ByVal LongValue As Integer) As Short
        m_DWord.LongValue = LongValue
        Return m_DWord.LoWord
    End Function

    Public Shared Function HiWord(ByVal LongValue As Integer) As Short
        m_DWord.LongValue = LongValue
        Return m_DWord.HiWord
    End Function
End Class