如何实现金山词霸的鼠标取词功能？

Question

在VB中能实现象金山糍粑那样的鼠标取词功能吗？如何实现？急！

Answer 1

太复杂了。
delphi下有源码

Answer 2

记得有一个API是可以做到,不过,记不太清了,好像类似于先发送一条消息,获取当前的光标句柄及位置,再获取当前行的字串,然后,再取得光标位置的单词(通过空格分段)好像Dapha上有一个实例吧!

Answer 3

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

Answer 4

以前见过类似的问题
现在帮你转一下吧
通过SendMessage函数向RichTextBox控件发送EM_CHARFROMPOS消息，可以将鼠标在RichTextBox控件中的位置信息转换为字符的位置信息。这样，以该字符为中心，向前向后检索该单词的其他字符即可。代码如下Option Explicit
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
Private Const EM_CHARFROMPOS& = &HD7
Private Type POINTAPI
    X As Long
    Y As Long
End Type' Return the word the mouse is over.
Public Function RichWordOver(rch As RichTextBox, X As Single, Y As Single) As String
    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
    '检索单词的第一个字符 Find the start of the word.
    txt = rch.Text
    For start_pos = pos To 1 Step -1
        ch = Mid$(rch.Text, start_pos, 1)
        '允许字符为数字、字母和下划线
        If Not ((ch >= "0" And ch <= "9") Or _
            (ch >= "a" And ch <= "z") Or _
            (ch >= "A" And ch <= "Z") Or ch = "_") Then
            Exit For
        End If
    Next start_pos
    start_pos = start_pos + 1
    '检索单词的第一个字符 Find the end of the word.
    txtlen = Len(txt)
    For end_pos = pos To txtlen
        ch = Mid$(txt, end_pos, 1)
        '允许字符为数字、字母和下划线
        If Not ((ch >= "0" And ch <= "9") Or _
            (ch >= "a" And ch <= "z") Or _
            (ch >= "A" And ch <= "Z") Or ch = "_") Then
            Exit For
        End If
    Next end_pos
    end_pos = end_pos - 1
    '取出单词
    If start_pos <= end_pos Then
        RichWordOver = Mid$(txt, start_pos, end_pos - start_pos + 1)
    End If
End FunctionPrivate Sub Form_Load()
    RichTextBox1.Text = "Ready-To-Run Visual Basic Algorithms, Second Edition" & _
        vbCrLf & vbCrLf & "Extend your applications with powerful algorithms written in Visual Basic. Sorting, searching, trees, hashing, advanced recursion, network algorithms, object-oriented programming, and much more. Visual Basic Algorithms updated and expanded for Visual Basic 6." & _
        vbCrLf & vbCrLf & "http://www.vb-helper.com/vba.htm"
    Label1.Caption = ""
End SubPrivate Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim txt As String
    txt = RichWordOver(RichTextBox1, X, Y)
    If Label1.Caption <> txt Then
        Label1.Caption = txt
    End If
End Sub

Answer 5

那就要进行子类处理了，提示一下：先用GetCursorPos得到鼠标位置，再用WindowFromPoint得到窗口句柄。 

Answer 6

用vb处理不是太行的通，他是用的api的钩子，也就是说用钩子钩住在我们显示文字是用的
textout、ExtTextOut等函数，用vb不是太好作因为需要知道这些api函数具体的内存地址。
不过例子还是很多的，到vc区查查有很多。楼上的呵呵，恭喜呀。散点分吧！！

Answer 7

会VC吧，看看这篇文章：
http://vip.6to23.com/NowCan1/tech/pmqc.htm

Answer 8

<%@ LANGUAGE = VBScript %> 
<% 
'Response.Expires = 0 Dim Conn,Rs,StrcnnSet Conn = Server.CreateObject("ADODB.Connection") 
StrCnn="Provider=sqloledb;User ID=sa;Password=;Initial Catalog=test;Data Source=supper" Cnn.Open strConnsql="select * from y_main"set rs=conn.execute(sql)
response.Write rs("版号")
set rs=nothing
conn.close
%>怎么连不上asp了.

Answer 9

http://home.ncust.edu.cn/xqkz/softlife/quci.htm去看看吧，好象解决了

Answer 10

要鼠标钩子，还要API Hook，也就是说需要DLL，由于VB不能做DLL，所以不行。