Option Explicit
Private Type POINTAPI '滑鼠座標XY參數
    X As Long
    Y As Long
End Type
'取得色碼
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
'取得滑鼠座標
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'取得句柄
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Private Sub Form_Load()
    Timer1.Interval = 300 '循環毫秒
    'Timer1.Enabled = False '循環停止
End Sub

Private Sub Command1_Click()
    Timer1.Enabled = False '循環停止
    Dim Col3 As String, intXY As String, FFcl As Long
    Dim X1 As Long, X2 As Long, Y1 As Long, Y2 As Long, Nux As Byte, Nuy As Byte
    Label6.Caption = "開始查找"
    Label7.Caption = ""
    Delay 10
    X1 = Text1.Text '尋找座標X1
    Y1 = Text2.Text
    X2 = Text3.Text
    Y2 = Text4.Text '尋找座標Y2
    Col3 = Text5.Text '尋找顏色 '5EAB25
    Nux = Val(Text6.Text)
    Nuy = Val(Text7.Text)
    intXY = FindColor(Col3, X1, Y1, X2, Y2, Nux, Nuy)
    If intXY <> "" Then
        Label6.Caption = "找到顏色"
        Label7.Caption = "座標：" & intXY
    Else
        Label6.Caption = "未找到"
        Label7.Caption = ""
        Timer1.Enabled = True '循環開始
    End If
   
End Sub
'區域找 色顏色X1,Y1,X2,Y2,模糊值
Private Function FindColor(ColH As String, inX1 As Long, inY1 As Long, inX2 As Long, inY2 As Long, Nux As Byte, Nuy As Byte) '區域找 色顏色X1,Y1,X2,Y2,模糊值
    Dim lDC As Long, ColA As Long, i As Long, p As Long, ColB As Long
    lDC = GetWindowDC(0) '取得最底層視窗句柄
    ColA = Val("&H" & ColH & "&")
    For i = inY1 To inY2 Step Nuy
        For p = inX1 To inX2 Step Nux
            ColB = GetPixel(lDC, p, i)
            If ColA = ColB Then
                FindColor = p & "," & i '返回找到座標
                Exit Function
            End If
        Next p
    Next i
End Function
'取單點顏色
Private Function GetPixelColor(inX As Long, inY As Long) '取單點顏色
    Dim lColor As Long, lDC As Long
    lDC = GetWindowDC(0) '取得最底層視窗句柄
    lColor = GetPixel(lDC, inX, inY) '取得座標點色碼
    GetPixelColor = Right$("000000" & Hex(lColor), 6) '轉成16進制
End Function

Private Sub Timer1_Timer()
    Dim tPOS As POINTAPI '滑鼠座標
    Dim sTmp As String
    Dim lColor As Long
    Dim lDC As Long
    lDC = GetWindowDC(0) '取得視窗句柄
    Call GetCursorPos(tPOS) '取得滑鼠座標
    lColor = GetPixel(lDC, tPOS.X, tPOS.Y) '取得座標點色碼
    sTmp = Right$("000000" & Hex(lColor), 6) '轉成16進制
    Label9.Caption = tPOS.X & "," & tPOS.Y
    Label11.Caption = sTmp
    Label12.BackColor = lColor
End Sub

Private Sub Delay(ByVal Sec As Single) '延遲毫秒
    Dim sgnThisTime As Single, sgnCount As Single
    Sec = Sec / 1000
    sgnThisTime = Timer
    Do While sgnCount < Sec
        sgnCount = Timer - sgnThisTime
        DoEvents
    Loop
End Sub

[此贴子已经被作者于2022-3-4 10:36编辑过]