谁会用VB做屏幕取词的技术，急!!!!

Question

老总要我搞个这样的功能进去，但我一筹莫展，网上没有这方面的详细资料，请高手指教

Answer 1

模块：
Option ExplicitPublic Const EM_CHARFROMPOS = &HD7
Public Const EM_GETLINECOUNT = &HBA
Public Const EM_GETLINE = &HC4
Public Const EM_LINEINDEX = &HBB
Public Const EM_LINELENGTH = &HC1Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long窗体：
Option ExplicitPrivate Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim pos As Long, lc As Long
    Dim Line As Integer, CharPos As Integer
    
    pos = X / Screen.TwipsPerPixelX + Y / Screen.TwipsPerPixelY * 65536
    lc = SendMessage(Text1.hwnd, EM_CHARFROMPOS, 0, ByVal pos)
    
    Line = lc \ 65536
    CharPos = lc Mod 65536
    
    MsgBox " = " & GetLine(Text1, Line) & vbCrLf & "单词= " & GetWord(Text1, CharPos)
End SubFunction 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)
    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
    
    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 FunctionFunction 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 FunctionFunction GetLine(txt As TextBox, ByVal Line As Integer) As String
    Dim S As String, Length As Integer, pos As Long
    
    GetLine = ""
    pos = SendMessage(txt.hwnd, EM_LINEINDEX, Line, ByVal 0&)
    Length = SendMessage(txt.hwnd, EM_LINELENGTH, pos, ByVal 0&)
    S = String(Length, Chr(0))
    RtlMoveMemory ByVal S, Length, 2
    If SendMessage(Text1.hwnd, EM_GETLINE, Line, ByVal S) > 0 Then
        GetLine = S
    End If
End FunctionPrivate Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim pos As Long, lc As Long
    Dim Line As Integer, CharPos As Integer
    
    pos = X / Screen.TwipsPerPixelX + Y / Screen.TwipsPerPixelY * 65536
    lc = SendMessage(Text1.hwnd, EM_CHARFROMPOS, 0, ByVal pos)
    
    Line = lc \ 65536
    CharPos = lc Mod 65536
    
    Text1.ToolTipText = GetWord(Text1, CharPos)
End Sub

Answer 2

虽然我不知道这个代码能干什么，但我找到一个效果跟它一样的代码Text1.ToolTipText = Text1

Answer 3

Text1.ToolTipText = Text1???????????????????????????这有用吗？？呵呵

Answer 4

Text1.ToolTipText = Text1？？？？？？？？？？？？？这是屏幕截词？我晕了。

Answer 5

http://www.csdn.net/develop/Read_Article.asp?Id=2786

Answer 6

一言难尽，我只知其然，不知其所以然，API拦截偶也没有试过你可以说说你的具体要求，或许可以用其它方法
比如取窗口文字可以用GetWindowText

Answer 7

据我所知，用纯VB截取其他程序界面上的词是不可能的
需要用VC写钩子，拦截textout函数
等高手来吧

Answer 8

对本进程中的取词较简单，但对其它进行中的文字取词要复杂得多。主要原理如下：
1、获得鼠标的位置，并判断其所在的进程；
2、向该进程发送鼠标的位置原屏幕显示已失效的信息，让程序对这一区域进行重画；
3、截取并跟踪重画信息所在的内存，通过textout取出结果。