取得TextBox、RichTextBox光标所在的行和列(支持中文)修正 (转)

最新推荐文章于 2024-12-13 15:01:55 发布

转载最新推荐文章于 2024-12-13 15:01:55 发布 · 115 阅读

本文介绍了一个VBScript函数，用于获取TextBox或RichTextBox中光标所在的具体行和列位置，特别考虑了中文字符的宽度。

取得TextBox、RichTextBox光标所在的行和列(支持中文)修正 (转)[@more@]

'************************************************************
'功能：取得TextBox、RichTextBox光标所在的行和列

'支持中文，一个汉字算一列
'有问题请给我写邮件
'作者：Matrix
'邮件：Mailto:ASPBIT@163.COM">ASPBIT@163.COM
'2003-01-24修正了马虎的错误
'************************************************************

Option Explicit

Public Const WM_USER = &H400
Public Const EM_EXGETSEL = WM_USER + 52

Public Const EM_LINEFROMCHAR = &HC9
Public Const EM_LINEINDEX = &HBB
Public Const EM_GETSEL = &HB0

Public Type CHARRANGE
cpMin As Long
cpMax As Long
End Type

Public Type POINTapi
x As Long
y As Long
End Type

Public Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As _
Long, ByVal wParam As Long, lParam As Any) As Long

Public 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

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/10752043/viewspace-996731/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/10752043/viewspace-996731/