78.txt

VB文章集（含API、窗口、数据库、多媒体、系统、文件、等等）

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