速度 1920*1080全屏，从左上到右下找色，找到的点靠近右下角时耗时 40-70毫秒，按键精灵的findcolorex稳定30+
有没有大手子再优化一下，
最耗时的地方就是BitBlt载图和GetDIBits拷贝到数组，这俩货花30+毫秒
Option Explicit
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal opCode As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Sub GetMem4 Lib "msvbvm60.dll" (ptr As Any, src As Any)
Private Const HORZRES As Integer = 8
Private Const VERTRES As Integer = 10
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Double
biClrUsed As Double
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 Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0
Public Function FindColor(x As Long, y As Long, x1 As Long, y1 As Long, nColor As Long, Rgboffset As Byte, rx As Long, ry As Long) As Boolean
'参数：左上角X，左上角Y，右下角X，右下角Y，10进制色值，色差值，返回X，返回Y
Dim hdc As Long
Dim hDcmem As Long
Dim hBmp As Long
Dim oldBmp As Long
Dim bmi As BITMAPINFO
Dim bits() As RGBQUAD
Dim width As Long
Dim height As Long
Dim Red As Long
Dim Blue As Long
Dim Green As Long
Dim col As RGBQUAD
Dim off As Long
width = x1 - x
height = y1 - y
If width > Screen.width \ Screen.TwipsPerPixelX Then width = Screen.width \ Screen.TwipsPerPixelX
If height > Screen.height \ Screen.TwipsPerPixelY Then height = Screen.height \ Screen.TwipsPerPixelY
ReDim bits(width * height)
hdc = GetDC(0)
hDcmem = CreateCompatibleDC(0)
hBmp = CreateCompatibleBitmap(hdc, width, height)
oldBmp = SelectObject(hDcmem, hBmp)
bmi.bmiHeader.biBitCount = 32
bmi.bmiHeader.biCompression = BI_RGB
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biWidth = width
bmi.bmiHeader.biHeight = -height
bmi.bmiHeader.biSize = Len(bmi.bmiHeader)
Call BitBlt(hDcmem, 0, 0, width, height, hdc, x, y, vbSrcCopy)
Call GetDIBits(hDcmem, hBmp, 0, height, bits(0), bmi, DIB_RGB_COLORS)
Call SelectObject(hDcmem, oldBmp)
Call DeleteObject(hBmp)
Call DeleteDC(hDcmem)
Call ReleaseDC(0, hdc)
Call GetMem4(ByVal VarPtr(nColor), ByVal VarPtr(col))
For rx = 0 To width - 1
For ry = 0 To height - 1
off = rx + ry * width
Red = bits(off).rgbRed
Green = bits(off).rgbGreen
Blue = bits(off).rgbBlue
If Abs(Red - col.rgbBlue) <= Rgboffset And Abs(Green - col.rgbGreen) <= Rgboffset And Abs(Blue - col.rgbRed) <= Rgboffset Then
rx = rx + x: ry = ry + y
FindColor = True
Exit Function
End If
Next
Next
rx = -1
ry = -1
End Function