如何截取屏幕上某块区域或某个控件上的文字？
比方像是QQ的好友列表，IE的菜单栏上的文字，或弹按下菜单后出来的文字。
[解决办法]
鼠标取词在有些软件里当鼠标移到某单词上,其注释就会显示单词的中文解释.这样的软件是如何制作的呢?下面我就介绍以下获取鼠标所在单词的方法,至于中文结实要关系到数据库及字库问题在此我不做解释.首先建立新工程,在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 LongConst 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 LongDim Line As Integer,CharPos As Integerx=x/Screen.TwipsPerPixelXy=y/Screen.TwipsperPixelYpos=x+y*65536Lc=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 StringDim bArr()As Byte,pos1 As Integer,pos2 As Integer, i As IntegerbArr=StrConv(txt.Text,vbFromUnicode)'转换成Byte数组pos1=0:pos2=UBound(bArr)'向前搜索分格符的位置For i=pos-1 To 0 Step -1If IsDelimiter(bArr(i)) Thenpos1=i+1Exit ForEnd IfNext'向后搜寻分隔符字符的位置For i=pos To UBound(bArr)If IsDelimiter(bArr(i)) Thenpos2=i-1Exit ForEnd IfNext '截取pos1-pos2之间的字符,以构成一个单词If pos2>pos1 ThenReDim bArr2(pos2-pos1) As ByteFor i=pos1 To Pos2bArr2(i-pos1)=bArr(i)NextGetWord=StrConv(bArr2,vbUnicode)ElseGetWord=""End IfEnd Function'IsDelimiter函数Functon IsDelimiter(ByVal Char As Byte) As BooleanDim S As StringS=Chr(Char)IsDelimiter=FalseIf S=" " Or S="," Or S="." Or S="?" Or S="vbCr Or S=vbLf ThenIsDelimiter=TrueEnd IfEnd Function
[解决办法]
VERSION 5.00Begin VB.Form Form1 BackColor = &H00000000& BorderStyle = 4 'Fixed ToolWindow Caption = "XdictGrb-屏幕取词保存到剪贴板和c:\XdictGrb.txt中" ClientHeight = 210 ClientLeft = 45 ClientTop = 285 ClientWidth = 8310 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 210 ScaleWidth = 8310 ShowInTaskbar = 0 'False Begin VB.Label Label2 BackColor = &H00000000& ForeColor = &H0000FFFF& Height = 255 Left = 30 TabIndex = 0 Top = 15 Width = 8280 EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False'将XdictGrb.dll放在system32下.运行regsvr32 XdictGrb.dll注册.'新建工程,引用XdictGrb.dll.'加三个Label到窗体.Option ExplicitPrivate Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPrivate Const SWP_NOMOVE = &H2 '不移动窗体Private Const SWP_NOSIZE = &H1 '不改变窗体尺寸Private Const Flag = SWP_NOMOVE Or SWP_NOSIZEPrivate Const HWND_TOPMOST = -1 '窗体总在最前面Private Const HWND_NOTOPMOST = -2 '窗体不在最前面Implements IXDictGrabSinkPrivate gp As GrabProxyDim f As IntegerDim ls As StringPrivate Sub Form_Load() ls = "" f = FreeFile() Open "c:\XDictGrb.txt" For Append As #f Set gp = New GrabProxy With gp .GrabEnabled = True '是否有效 .GrabInterval = 5 '指定抓取时间间隔 .GrabMode = XDictGrabMouse '模式(鼠标是否加按键) .AdviseGrab Me '接口指向自身 End With SetWindowPos Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FlagEnd SubPrivate Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Form1.Top = 600 - Form1.TopEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Form1.Top = 600 - Form1.TopEnd SubPrivate Sub Form_Unload(Cancel As Integer) Set gp = Nothing Close #fEnd SubPrivate Function IXDictGrabSink_QueryWord(ByVal WordString As String, ByVal lCursorX As Long, ByVal lCursorY As Long, ByVal SentenceString As String, lLoc As Long, lStart As Long) As Long' Label1.Caption = "当前坐标：" & "(" & lCursorX & "," & lCursorY & ")" Label2.Caption = SentenceString' Label3.Caption = "当前字符：" & Mid(SentenceString, lLoc + 1, 1000) If ls <> SentenceString Then ls = SentenceString Print #f, ls Clipboard.Clear Clipboard.SetText ls End If If 0 <= lCursorX And lCursorX <= 559 Then If 0 <= lCursorY And lCursorY <= 39 Then Form1.Top = 600 End If If 40 <= lCursorY And lCursorY <= 79 Then Form1.Top = 0 End If End IfEnd Function