[原创]取得TextBox、RichTextBox光标所在的行和列(支持中文，一个汉字算一列)

Question

'***********************************************************************
'功能：取得TextBox、RichTextBox光标所在的行和列
'      支持中文，一个汉字算一列
'      有问题请给我写邮件
'作者：Matrix
'邮件：[email protected]
'***********************************************************************
Option ExplicitPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
        lParam As Any) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Const WM_USER = &H400
Private Const EM_EXGETSEL = (WM_USER + 52)
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBBPrivate Type CHARRANGE
    cpMin As Long
    cpMax As Long
End Type'取得光标所在的列
Public Function GetCurCol(ByVal hWnd As Long, ByVal Text As String) As Long
    Dim LineIndex As Long
    Dim SelRange As CHARRANGE
    Dim TempStr As String
    Dim TempArray() As Byte
    Dim TempText() As Byte    TempArray = StrConv(Text, vbFromUnicode)
    
    '取得当前行第一个字符的位置
    LineIndex = SendMessage(hWnd, EM_LINEINDEX, -1, 0)
    '取得当前被选中文本的位置 适用于 RichTextBox
    'TextBox 用 EM_GETSEL 消息
    Call SendMessage(hWnd, EM_EXGETSEL, 0, SelRange)    If SelRange.cpMin - LineIndex = 0 Then
        GetCurCol = 1
    Else
        TempStr = String(SelRange.cpMin - LineIndex, 13)
        '复制当前行开始到选择文本开始的文本
        CopyMemory ByVal StrPtr(TempStr), ByVal StrPtr(TempArray), SelRange.cpMin - LineIndex
        TempText = TempStr
        '删除无用的信息
        ReDim Preserve TempText(SelRange.cpMin - LineIndex - 1)
        '转换为 Unicode
        TempStr = StrConv(TempText, vbUnicode)
        GetCurCol = Len(TempStr) + 1
    End If
End Function'取得光标所在的行
'此函数非原创
Public Function GetCurRow(ByVal hWnd As Long) As Long
    Dim LineIndex As Long
    'wParam参数设置为-1  取得当前行的字符位置
    LineIndex = SendMessage(hWnd, EM_LINEINDEX, -1, 0)
    '根据参数wParam指定的字符位置返回该字符所在的行号
    GetCurRow = SendMessage(hWnd, EM_LINEFROMCHAR, LineIndex, 0) + 1
End Function

Answer 1

'修正Option ExplicitPublic Const WM_USER = &H400
Public Const EM_EXGETSEL = WM_USER + 52Public Const EM_LINEFROMCHAR = &HC9
Public Const EM_LINEINDEX = &HBB
Public Const EM_GETSEL = &HB0Public Type CHARRANGE
    cpMin As Long
    cpMax As Long
End TypePublic Type POINTAPI
        x As Long
        y As Long
End TypePublic Declare Function SendMessage Lib "user32" Alias _
        "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As _
        Long, ByVal wParam As Long, lParam As Any) As LongPublic Declare Sub CopyMemory Lib "kernel32" Alias _
        "RtlMoveMemory" (pDst As Any, pSrc As Any, _
        ByVal ByteLen As Long)
'取得光标所在的行和列
Public Function GetCurPos(ByRef TextControl As Control) As POINTAPI
    Dim LineIndex As Long
    Dim SelRange As CHARRANGE
    Dim TempStr As String
    Dim TempArray() As Byte
    Dim CurRow As Long
    Dim CurPos As POINTAPI    TempArray = StrConv(TextControl.Text, vbFromUnicode)    '取得当前被选中文本的位置 适用于 RichTextBox
    'TextControl 用 EM_GETSEL 消息
    Call SendMessage(TextControl.hWnd, EM_EXGETSEL, 0, SelRange)    '根据参数wParam指定的字符位置返回该字符所在的行号
    CurRow = SendMessage(TextControl.hWnd, EM_LINEFROMCHAR, SelRange.cpMin, 0)    '取得指定行第一个字符的位置
    LineIndex = SendMessage(TextControl.hWnd, EM_LINEINDEX, CurRow, 0)    If SelRange.cpMin = LineIndex Then
        GetCurPos.x = 1
    Else        TempStr = String(SelRange.cpMin - LineIndex, 13)        '复制当前行开始到选择文本开始的文本
        CopyMemory ByVal StrPtr(TempStr), ByVal StrPtr(TempArray) + LineIndex, SelRange.cpMin - LineIndex
        TempArray = TempStr        '删除无用的信息
        ReDim Preserve TempArray(SelRange.cpMin - LineIndex - 1)        '转换为 Unicode
        TempStr = StrConv(TempArray, vbUnicode)        GetCurPos.x = Len(TempStr) + 1
    End If
    GetCurPos.y = CurRow + 1
End Function

Answer 2

UP!帖子淹没太深，一个UP都没有，实为可惜。1