VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 鼠标取词
发表评论(0)作者:, 平台:, 阅读:10540, 日期:2000-03-12


鼠标取词



在有些软件里当鼠标移到某单词上,其注释就会显示单词的中文解释.这样的软件是如何制作的呢?下面我就介绍以下获取鼠标所在单词的方法,至于中文结实要关系到数据库及字库问题在此我不做解释.

首先建立新工程,在FORM上添加一个TEXT文本框.

声明SendMessage函数.

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

Const EM_CHARFORMPOS=&HD7'在API浏览器里无此值请自己加上.


自定义过程:

Private Sub Text1_MouseDown(Button As Intege,Shift As Integer,x As Single, y As Single)

'获取鼠标所点的是第几行第几个字符

Dim pos As Long,Lc As Long

Dim Line As Integer,CharPos As Integer


x=x/Screen.TwipsPerPixelX

y=y/Screen.TwipsperPixelY

pos=x+y*65536

Lc=SendMessage(Text1.hwnd,EM_CHARFROMPOS,0,ByVal pos)


Line=Lc\65536 '第几行

CharPos=Lc MOD 65536 '第几个字符

End Sub

'接下来才是真正的读取函数

Function GetWord(txt As TextBox,pos As Integer) As String

Dim bArr()As Byte,pos1 As Integer,pos2 As Integer, i As Integer


bArr=StrConv(txt.Text,vbFromUnicode)'转换成Byte数组

pos1=0:pos2=UBound(bArr)


'向前搜索分格符的位置

For i=pos-1 To 0 Step -1

If IsDelimiter(bArr(i)) Then

pos1=i+1

Exit For

End If

Next

'向后搜寻分隔符字符的位置

For i=pos To UBound(bArr)

If IsDelimiter(bArr(i)) Then

pos2=i-1

Exit For

End If

Next

'截取pos1-pos2之间的字符,以构成一个单词

If pos2>pos1 Then

ReDim bArr2(pos2-pos1) As Byte

For i=pos1 To Pos2

bArr2(i-pos1)=bArr(i)

Next


GetWord=StrConv(bArr2,vbUnicode)

Else

GetWord=""

End If

End Function

'IsDelimiter函数

Functon IsDelimiter(ByVal Char As Byte) As Boolean

Dim S As String


S=Chr(Char)

IsDelimiter=False

If S=" " Or S="," Or S="." Or S="?" Or S="vbCr Or S=vbLf Then

IsDelimiter=True

End If

End Function