'--------------------------------
'扩展文本框功能
Public Const EM_GETSEL = &HB0
Public Const EM_LINEFROMCHAR = &HC9
Public Const EM_LINEINDEX = &HBB
Public Const EM_GETLINE = &HC4
Public Const EM_GETLINECOUNT = &HBA
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SendMessages Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
'获得文本的行数
Public Function GetTextLines(txtHwnd As Long) As Long
GetTextLines = SendMessage(txtHwnd, EM_GETLINECOUNT, 0, 0)
End Function
'功能描述：获得指定文本的光标
Public Sub GetCaretPos(ByVal TextHwnd As Long, LineNo As Long, ColNo As Long)
Dim i As Long, j As Long
Dim lParam As Long, wParam As Long
Dim k As Long
'首先向文本框传递EM_GETSEL消息以获取从起始位置到
'光标所在位置的字符数
i = SendMessage(TextHwnd, EM_GETSEL, wParam, lParam)
j = i / 2 ^ 16
'再向文本框传递EM_LINEFROMCHAR消息根据获得的字符
'数确定光标以获取所在行数
LineNo = SendMessage(TextHwnd, EM_LINEFROMCHAR, j, 0)
LineNo = LineNo + 1
'向文本框传递EM_LINEINDEX消息以获取所在列数
k = SendMessage(TextHwnd, EM_LINEINDEX, -1, 0)
ColNo = j - k + 1
End Sub
'功能描述：获得指定行的文本
Public Function ReadLine(ByVal TextHwnd As Long, intLine As Long) As String
Dim m_sLineString As String
Dim m_intRet As Long
m_sLineString = Space$(1056)
m_intRet = SendMessages(TextHwnd, EM_GETLINE, intLine, ByVal m_sLineString)
ReadLine = Left(m_sLineString, m_intRet)
End Function
'获得光标处的字符
Public Function GetWord(ByVal TextHwnd As Long) As String
'打开错误处理陷阱
On Error GoTo ErrGoto
'---------------------------------
'代码正文
Dim LineNo As Long
Dim ColNo As Long
Dim strData As String
Dim i As Integer
Dim intAsc As Integer
Dim intBegin As Integer, intEnd As Integer
GetCaretPos TextHwnd, LineNo, ColNo
strData = ReadLine(TextHwnd, LineNo - 1)
'---------------------------
'修正含有汉字的列数
intCharNum = 0
For i = 0 To Len(strData) - 1
If Asc(Mid(strData, i + 1, 1)) < 0 Then
intCharNum = intCharNum + 2
Else
intCharNum = intCharNum + 1
End If
If intCharNum >= ColNo Then
Exit For
End If
Next i
ColNo = i + 1
'-----------------------------
If Len(strData) > 0 Then
For i = ColNo - 1 To 1 Step -1
intAsc = Asc(Mid(strData, i, 1))
If Not ((intAsc >= Asc("a") And intAsc <= Asc("z")) Or (intAsc >= Asc("A") And intAsc <= Asc("Z")) Or (intAsc >= Asc("0") And intAsc <= Asc("9")) Or intAsc = Asc("_")) Then
intBegin = i + 1
Exit For
End If
Next i
For i = ColNo To Len(strData)
intAsc = Asc(Mid(strData, i, 1))
If Not ((intAsc >= Asc("a") And intAsc <= Asc("z")) Or (intAsc >= Asc("A") And intAsc <= Asc("Z")) Or (intAsc >= Asc("0") And intAsc <= Asc("9")) Or intAsc = Asc("_")) Then
intEnd = i - 1
Exit For
End If
Next i
If intBegin <= 0 Then intBegin = 1
If intEnd <= 0 Then intEnd = Len(strData)
If intEnd > intBegin Then
GetWord = Trim(Mid(strData, intBegin, intEnd - intBegin + 1))
Else
GetWord = ""
End If
Else
GetWord = ""
End If
'----------------------
Exit Function
'----------------------
ErrGoto:
GetWord = ""
End Function
