| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1400 人关注过本帖
标题:【分享】VB6 區域查找顏色範例 請問有比較好的方式嗎?
只看楼主 加入收藏
kedian1968
Rank: 2
等 级:论坛游民
帖 子:15
专家分:15
注 册:2022-2-15
结帖率:33.33%
收藏
 问题点数:0 回复次数:2 
【分享】VB6 區域查找顏色範例 請問有比較好的方式嗎?
图片附件: 游客没有浏览图片的权限,请 登录注册

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编辑过]

搜索更多相关主题的帖子: End Private Long Function Dim 
2022-03-04 10:32
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1934
专家分:3012
注 册:2009-12-22
收藏
得分:0 
有了像素的十六进制代码,直接遍历整个屏幕或图片也可以找。

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2022-03-04 11:01
sssooosss
Rank: 9Rank: 9Rank: 9
等 级:禁止访问
威 望:3
帖 子:664
专家分:1115
注 册:2019-8-27
收藏
得分:0 
共同学习
2022-03-08 08:36
快速回复:【分享】VB6 區域查找顏色範例 請問有比較好的方式嗎?
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.043242 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved