啟動vb6，建立一個標準exe工程，單擊“工程”――“部件”，選中Microsoft rich text control6.0，單擊“確定”按鈕，然后在窗體中添加該控件，命名為rchMainText，在窗體底部添加一個標簽控件命名為label1，雙擊窗體，寫入以下代碼：
Option Explicit
Private Const EM_CHARFROMPOS& = &HD7‘返回鼠標所在位置的字符指針
Private Type POINTAPI
X As Long
Y As Long
End Type‘鼠標位置坐標
Private 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 Function RichWordOver(rch As RichTextBox, X As Single, Y As Single) As String
'當鼠標移動到richtext控件時，分離出當前的單詞
Dim pt As POINTAPI ‘鼠標指針坐標
Dim pos As Integer
Dim start_pos As Integer
Dim end_pos As Integer
Dim ch As String
Dim txt As String
Dim txtlen As Integer
pt.X = X \ Screen.TwipsPerPixelX
pt.Y = Y \ Screen.TwipsPerPixelY
‘獲得鼠標所在位置
pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&, pt)
If pos <= 0 Then Exit Function
txt = rch.Text
For start_pos = pos To 1 Step -1
ch = Mid$(rch.Text, start_pos, 1)
'從當前字符開始查找0-9、a-z、A-Z和“-”以外的字符，因為它們不‘可能是單詞的組成，據此可以判斷出本單詞第一個字母的位置
If Not ( _(ch >= "0" And ch <= "9") Or _(ch >= "a" And ch <= "z") Or _
(ch >= "A" And ch <= "Z") Or _ch = "_") Then Exit For
Next start_pos ‘找到后退出循環
start_pos = start_pos + 1‘紀錄本單詞開始位置
'從鼠標當前位置查找本單詞的最后一個字母位置，判斷原理同上
txtlen = Len(txt)
For end_pos = pos To txtlen
ch = Mid$(txt, end_pos, 1)
' Allow digits, letters, and underscores.
If Not ( (ch >= "0" And ch <= "9") Or (ch >= "a" And ch <= "z") Or _
(ch >= "A" And ch <= "Z") Or _
ch = "_" _
) Then Exit For ‘找到后退出循環
Next end_pos
end_pos = end_pos - 1‘紀錄最后一個單詞位置
If start_pos <= end_pos Then
RichWordOver = Mid$(txt, start_pos, end_pos - start_pos + 1)
'利用MID函數取出該單詞
End Function
Private Sub Form_Load() ‘程序運行時初始化RICHTEXT
On Error Resume Next
Me.Caption = App.Title '添加應用程序標題
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2 '窗體具中
rchMainText.Text = "Button As Integer, Shift As Integer, X As Single, Y As Single"
End Sub
Private Sub rchMainText_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'當鼠標移動到RICHTEXT時，開始激活單詞分離過程
Dim txt As String‘分離出的單詞
txt = RichWordOver(rchMainText, X, Y)‘單詞判斷
If label1.Caption <> txt Then
label1.Caption = txt
‘將返回的單詞傳遞給LABEL1標簽
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub‘程序結束
延伸閱讀
文章來源于領測軟件測試網 http://www.kjueaiud.com/
