求大神帮忙，关于vb屏幕找色

[wzw2901]

Option Explicit

Private Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Type POINT
X As Integer
Y As Integer
End Type
Private Const DIB_RGB_COLORS As Long = &H0&
Private Const BI_RGB As Long = &H0&
Private Const OBJ_BITMAP As Long = &H7&
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, _
ByVal nNumScans As Long, ByVal lpBits As Long, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Function findColor(ByVal hdc As Long, ByVal Width As Integer, ByVal Height As Integer, ByVal find_Color As Long, ByRef retClr() As POINT) As Long
Dim bi As BITMAPINFO
Dim LngCol As Long, hMap As Long, lenBuf As Long, r As Long, s As Long
Dim bmpBuf() As Byte
Dim X As Integer, Y As Integer
Erase retClr
find_Color = (&HFF And find_Color) * &H10000 + (&HFF00& And find_Color) + (&HFF0000 And find_Color) / &H10000
With bi.bmiHeader
.biSize = Len(bi.bmiHeader)
.biWidth = Width
.biHeight = Height
.biPlanes = 1
.biBitCount = 24
.biCompression = BI_RGB
End With
lenBuf = CLng(Width) * Height * 3
ReDim bmpBuf(lenBuf - 1)
hMap = GetCurrentObject(hdc, OBJ_BITMAP)
GetDIBits hdc, hMap, 0, bi.bmiHeader.biHeight, VarPtr(bmpBuf(0)), bi, DIB_RGB_COLORS
Dim aa As Long
For Y = Height To 1 Step -1
For X = 1 To Width
CopyMemory LngCol, bmpBuf(r), 3
If LngCol = find_Color Then
ReDim Preserve retClr(s)
With retClr(s)
.X = X
.Y = Y
End With
s = s + 1
aa = 3
' Exit For
End If
r = r + 3
Next
'If aa = 3 Then
'Exit For
'End If

Next
Erase bmpBuf
findColor = s
End Function
Private Sub Command1_Click()
On Error Resume Next
Dim a As Long, b As Long
a = 0
b = 0


Dim hdc As Long, sint As Single, retClr() As POINT, ret As Long
sint = Timer
' hdc = GetDC(526622)
hdc = GetDC(0)
' ret = findColor(hdc, 640, 480, &HF7F718, retClr())
ret = findColor(hdc, 1280, 800, &H28394D, retClr())
ReleaseDC 0, hdc
If ret <> 0 Then
MoveTo retClr(a).X, retClr(a).Y
MsgBox "此颜色点数:" & ret & " 用时: " & (Timer - sint) & " 坐标" & retClr(a).X & " " & retClr(a).Y
'MsgBox "此颜色点数:" & ret & " 用时: " & (Timer - sint) '& " 坐标" & retClr(a).x & " " & retClr(a).y
Else


MsgBox "未找到"
End If
End Sub

这是屏幕找一个颜色的代码，怎样实现通过找颜色相邻的坐标颜色固定找到颜色坐标的目的。

[赵4老师]

vb做这种事比C/C++慢。

[赵4老师]

参考http://www.autohotkey.com源代码中ImageSearch功能的实现。

[wzw2901]

那不是vb的代码

[wzw2901]

前面那个代码最后返回的坐标是最后一个颜色的坐标，我想找到一个颜色后，通过这个颜色附近其他坐标的颜色固定我要找的坐标。 我用getpixel找到的不对，但是在找到第一个点后用debug输出getpixel坐标颜色确实对的，用if判断就不行

[舉杯邀明月]

怎样实现通过找颜色相邻的坐标颜色固定找到颜色坐标的目的 没法理解这句话的意思。 难道是我还需要“深造”一下，学习汉语的语法么……