Question

VB编程怎么实现屏幕区域找物，最好有代码

Answer 1

阁下是做游戏辅助工具吧，我有例子，思路很简单。
区域找物可以看做区域找色，物上总有一些点的颜色是和别的地方不同的，遍历某区域分析色值计算容差，如何和目标的容差在一定范围即是找到了
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Dim lpPoint As POINTAPI
Dim env As Boolean
'lpx,lpy为起始点坐标，cle为扫描圈数，m一般取0，sdc为目标色值
Private Sub saomiao(lpx As Long, lpy As Long, cle As Integer, m As Long, sdc As Long)
Sleep 700
Dim x1 As Long, y1 As Long, sm As Long
For cir = 1 To cle
x1 = lpx - cir * 30: y1 = lpy - cir * 30
Do
sm = sm + 1
If sm Mod 100 = 0 Then DoEvents
en: dc = GetDC(0): s = GetPixel(dc, x1, y1) '获得(x,y)的颜色
If s = m Then env = True: Exit Sub
If s = sdc Then SetCursorPos x1, y1 + 90: MsgBox ("找到"): env = True: Call leftdown: Exit Sub
If cir = 0 Then Exit Do
If y1 = lpy - cir * 30 Or y1 = lpy + cir * 30 Then x1 = x1 + 30 '首末两行
If x1 = lpx + cir * 30 + 30 And y1 = lpy - cir * 30 Then x1 = lpx - cir * 30: y1 = lpy + cir * 30 '首行结束
If x1 = lpx + cir * 30 + 30 And y1 = lpy + cir * 30 Then x1 = lpx - cir * 30: y1 = lpy - cir * 30 + 30: GoTo en '末行结束
If cir = 1 And x1 = lpx - cir * 30 And y1 = lpy - cir + 30 Then x1 = lpx + cir * 30: y1 = lpy - cir * 30 + 30 'n=1特殊情况
If cir <> 1 And y1 > lpy - cir * 30 And y1 < lpy + cir * 30 Then y1 = y1 + 30 '行数递加
If x1 = lpx - cir * 30 And y1 = lpy + cir * 30 - 30 Then SetCursorPos x1, y1: x1 = lpx + cir * 30: y1 = lpy - cir * 30 + 30: GoTo en '进入尾列
If x1 = lpx + cir * 30 And y1 = lpy + cir * 30 - 30 Then SetCursorPos x1, y1 '事件
Loop Until x1 = lpx + cir * 30 And y1 = lpy + cir * 30 - 30
Next cir
If env = False Then MsgBox ("找不到")
End Sub

这个函数有点长，主要是从指定区域找的算法过程稍微复杂一点，因为高效的办法自然是像以该点圆心，不断增大半径依次画圆式的寻找，如果是从某点一行一行扫描显然并非高效的，这里是从指定点开始依次画正方形扩大扫描范围。
Private Sub Command1_Click()
saomiao 700, 525, 70, 0, 16777215 '调用例子
End Sub

'分离颜色例子
Private Sub Timer1_Timer()
Dim s As Long, r As Long, g As Long, b As Long
Dim dc As Long, s As Long
GetCursorPos lpPoint
dc = GetDC(0) '获得屏幕的DC句柄
s = GetPixel(dc, lpPoint.x, lpPoint.y) '获得(x,y)的颜色
r = s Mod 256 '分离出红色
g = (s \ 256) Mod 256 '分离出绿色
b = s \ 256 \ 256 '分离出蓝色
Label1.BackColor = RGB(r, g, b)
Print r, g, b
End Sub

追问

别的都很好，只是区域遍历的过程有点复杂，能不能改成画圆式的，就像一颗石子落入湖水中荡起的波纹，不知我说的对不