黃易群俠傳M脫機外掛應用程式黃易神行
1564
2

[發問] 如何依照座標判定為什麼顏色才執行內容

arieszninjam2 發表於 2011-10-19 00:12:21 | 只看該作者 回帖獎勵 |倒序瀏覽 |
請教各位高手大大,不知vb有辦法做到嗎 ,可否給我個方向,如何寫

不知有沒有辦法去診測當下營幕,若 座標 x=100,y=100 為紅色時,執行 F5,若沒有時,就一直診測直到  座標 x=100,y=100 為紅色時,再執行 F5

就這樣一直迴圈
收藏收藏 分享分享 讚 幹 分享分享 FB分享
回覆

使用道具 舉報


arieszninjam2 當前離線
UID
147456
熱心
24 值
嘉獎
0 次
違規
0 次
在線時間
12 小時
經驗
16 點
積分
94
精華
0
最後登錄
2018-8-1
閱讀權限
20
註冊時間
2007-1-12
論壇幣
20 幣
聯合幣
21 枚
幸運鑽
2 顆
招待卷
0 點
Yahoo! 查看詳細資料
Rank: 2Rank: 2
arieszninjam2 2011-10-19 01:29:42
沒有人會?
真的好需要用vb寫這個功能
先感謝大大指點
回覆

使用道具 舉報

chi.. 當前離線
UID
1678715
熱心
32 值
嘉獎
0 次
違規
0 次
在線時間
6 小時
經驗
35 點
積分
35
精華
0
最後登錄
2013-1-28
閱讀權限
20
註冊時間
2011-4-26
論壇幣
32 幣
聯合幣
0 枚
幸運鑽
0 顆
招待卷
0 點
查看詳細資料
Rank: 2Rank: 2
chi.. 2011-11-24 16:25:01
請教各位高手大大,不知vb有辦法做到嗎 ,可否給我個方向,如何寫

不知有沒有辦法去診測當下營幕,若 座標 x=100,y=100 為紅色時,執行 F5,若沒有時,就一直診測直到  座標 x=100,y=100 為紅色時,再執行 F5

...
arieszninjam2 發表於 2011-10-19 00:12
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type RGB
    RED As String
    GREEN As String
    BLUE As String
End Type
Private p As POINTAPI   '鼠標位置
Private dc As Long      '設備場景
Private clr As Long     '顏色
Private mRGB As RGB
Private Sub Command1_Click()
    Unload Me
End Sub
Private Sub Form_Load()
    Me.ScaleMode = vbPixels
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        MousePointer = 2
        Line1.Visible = False
        Line2.Visible = False
        Call GetCursorPos(p)
        lblX.Caption = "X: " & p.x
        lblY.Caption = "Y: " & p.y
        dc = GetDC(0)
        clr = GetPixel(dc, p.x, p.y)
        Call setColorFormat
        If clr >= 0 Then Picture2.BackColor = clr
    End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    MousePointer = 0
    Line1.Visible = True
    Line2.Visible = True
End Sub
Private Sub setColorFormat()
    If optFormat(0).Value Then      '十進制
        txtColor.Text = clr
    ElseIf optFormat(1).Value Then  '十六進制
        txtColor.Text = "0x" & Replace(Format(Hex$(clr), "@@@@@@"), " ", "0")
    ElseIf optFormat(2).Value Then  'HTML顏色
        mRG●禁私人部落格●B(clr)
        txtColor.Text = "#" & mRGB.RED & mRGB.GREEN & mRGB.BLUE
    ElseIf optFormat(3).Value Then  'RGB顏色
        mRG●禁私人部落格●B(clr)
        txtColor.Text = "RGB(0x" & mRGB.RED & ", 0x" & mRGB.GREEN & ", 0x" & mRGB.BLUE & ")"
    Else
        txtColor.Text = ""
    End If
End Sub
Private Sub optFormat_Click(Index As Integer)
    setColorFormat
End Sub
Private Function ColorToRGB(ByVal dwColor As Long) As RGB
    Dim clrHex As String
    clrHex = Replace(Format(Hex$(dwColor), "@@@@@@"), " ", "0")
    ColorToRGB.RED = Mid$(clrHex, 5, 2)
    ColorToRGB.GREEN = Mid$(clrHex, 3, 2)
    ColorToRGB.BLUE = Mid$(clrHex, 1, 2)
   
'    '通過And &HFF獲得低位8個bit
'    ColorToRGB.RED = Replace(Format$(CStr(Hex(dwColor And &HFF)), "@@"), " ", "0")
'
'    '乘以2^(-8)再取整,表示將整個數右移8個bit,然後通過And &HFF獲得低位8個bit
'    ColorToRGB.GREEN = Replace(Format$(CStr(Hex(Int(dwColor * 2 ^ (-8)) And &HFF)), "@@"), " ", "0")
'
'    '乘以2^(-16)再取整,表示將整個數右移16個bit,然後通過And &HFF獲得低位8個bit
'    ColorToRGB.BLUE = Replace(Format$(CStr(Hex(Int(dwColor * 2 ^ (-16)) And &HFF)), "@@"), " ", "0")
'
End Function

Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type RGB
    RED As String
    GREEN As String
    BLUE As String
End Type
Private p As POINTAPI   '公夾
回覆

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 註冊


手機版 | Archiver | 外掛聯合國

GMT+8, 2024-9-27 23:57 , Processed in 0.046642 second(s), 19 queries , Memcache On.

版權說明:
  本站不會製作、經銷、代理外掛程式。僅免費提供外掛程式下載前之掃毒及掃木馬等安全檢測驗證,協助會員遠離盜號危險程式。本站所有資料均來自網際網路收集整理,說明文字暨下載連結轉載自原程 式開發站。站上出現之公司名稱、遊戲名稱、程式等,商標及著作權,均歸各公司及程式原創所有,本站程式所有權歸外掛聯合國所有。本程式所有權歸外掛聯合國所有.......

回頂部
第二步?
第三步?