新建一个 Module1.bas

'函数说明 FindColorS 高速全屏找色(左上横坐标,左上纵坐标,右下横坐标,右下纵坐标,颜色,RGB偏差(0-255,0为最相似))[返回找到的横坐标,找到的纵坐标]
'部分API调用有多余
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0 '  color table in RGBs

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 RGBCOLOR
        rgbRed As Byte
        rgbGreen As Byte
        rgbBlue As Byte
        rgbReserved As Byte
End Type
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 Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function CloseHandle Lib "Kernel32.dll " (ByVal handle 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 GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal LpApplicationNam As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Public Function FindColorS(ByVal x As Long, ByVal y As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal colors As String, ByVal xiang As Long)
    Dim hmemDC As Long, hmemBMP As Long, bmp_info As BITMAPINFO, lpBits As Long
    Dim PicData() As Byte
    Dim ScreenDC As Long
    Dim TargetColor As Long
    Dim crColor As RGBCOLOR
    TargetColor = &HFF&
    CopyMemory crColor, TargetColor, 4

    ScreenDC = GetDC(0)

    With bmp_info.bmiHeader
        .biSize = LenB(bmp_info.bmiHeader)
        .biWidth = Screen.Width / Screen.TwipsPerPixelX
        .biHeight = Screen.Height / Screen.TwipsPerPixelY
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
        .biSizeImage = .biHeight * (((.biWidth * .biBitCount + 31) And &HFFFFFFE0) \ 8)
    End With

    hmemDC = CreateCompatibleDC(ScreenDC)
    hmemBMP = CreateDIBSection(ScreenDC, bmp_info, DIB_RGB_COLORS, lpBits, 0, 0)
    SelectObject hmemDC, hmemBMP

    BitBlt hmemDC, 0, 0, bmp_info.bmiHeader.biWidth, bmp_info.bmiHeader.biHeight, ScreenDC, 0, 0, vbSrcCopy

    ReDim PicData(3, bmp_info.bmiHeader.biWidth - 1, bmp_info.bmiHeader.biHeight - 1) As Byte

    CopyMemory PicData(0, 0, 0), ByVal lpBits, bmp_info.bmiHeader.biSizeImage
    B = CInt("&H" & Left(colors, 2))
    G = CInt("&H" & Mid(colors, 3, 2))
    R = CInt("&H" & Right(colors, 2))
    For dwY = y To y2
        For dwX = x To x2
            If Abs(PicData(2, dwX, bmp_info.bmiHeader.biHeight - 1 - dwY) - R) + Abs(PicData(1, dwX, bmp_info.bmiHeader.biHeight - 1 - dwY) - G) + Abs(PicData(2, dwX, bmp_info.bmiHeader.biHeight - 1 - dwY) - B) ＜ xiang Then
                fx = dwX: fy = dwY
                FindColorS = fx & "," & fy
                If True Then GoTo Mend
            End If
        Next
    Next
Mend:
    DeleteDC hmemDC
    DeleteObject hmemBMP
    ReleaseDC 0, ScreenDC
End Function

新建一个 Form1，Command1

Private Sub Command1_Click()
    Dim x, y, x2, y2 As Long
    Dim colors As String
    Dim xiang As Long
    x = 70
    y = 70
    x2 = 300
    y2 = 300
    colors = "FFFFFF"
    xiang = 10
    intR = FindColorS(x, y, x2, y2, colors, xiang)
    MsgBox intR
End Sub