Getting and setting the position of the caret in a textbox control

Getting and setting the position of the caret in a textbox control
<URL:http://dotnet.mvps.org/dotnet/faqs/?id=textboxcaretpos&lang=en>
----------------------------------------------------------------------------

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
                Dim 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)
                g.Dispose()
            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
///