本文实例讲述了VB实现的《QQ美女找茬游戏》作弊器。分享给大家供大家参考。具体如下：
比较无聊哈，原理很简单，用VB速度比较慢，但是实现很容易。
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
Option Explicit
Private Type sPOINT
x As Long
y As Long
End Type
Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST& = -1
' 将窗口置于列表顶部，并位于任何最顶部窗口的前面
Private Const SWP_NOSIZE& = &H1
' 保持窗口大小
Private Const SWP_NOMOVE& = &H2
' 保持窗口位置
Private Sub Form_Load()
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
' 将窗口设为总在最前
End Sub
'把long型的RGB值分解成3个分量
Sub ColorRGB(Color As Long, C() As Integer)
Const ByN As Integer = 256
Const ByN2 As Long = 65536
C(1) = (Color Mod ByN)
C(2) = ((Color Mod ByN2) \ ByN)
C(3) = (Color \ ByN2)
End Sub
Private Sub GetPoint()
Dim p1(497, 447) As Long, p2(497, 447) As Long, C1(3) As Integer, C2(3) As Integer
'数组大小匹配于图片的大小
Dim pic1 As sPOINT, pic2 As sPOINT
'设置两张图片的屏幕位置
pic1.x = 8
pic1.y = 192
pic2.x = 517
pic2.y = 192
Dim h As Long, hD As Long, r As Long, i As Integer, j As Integer
hD = GetDC(0)
'读入两张图片
For i = 0 To 497
For j = 0 To 447
p1(i, j) = GetPixel(hD, i + pic1.x, j + pic1.y)
p2(i, j) = GetPixel(hD, i + pic2.x, j + pic2.y)
Next
Next
'对比，标记差异
Dim t As Boolean
t = True
For i = 0 To 497
For j = 0 To 447
Call ColorRGB(p1(i, j), C1())
Call ColorRGB(p2(i, j), C2())
If (Abs(C1(1) - C2(1)) > 30 Or Abs(C1(2) - C2(2)) > 30 Or Abs(C1(3) - C2(3)) > 30) Then
t = Not t
If t Then
Picture1.ForeColor = &H0&
Else
Picture1.ForeColor = &HFF00&
End If
Else
Picture1.ForeColor = p1(i, j)
End If
Picture1.PSet (i, j)
Next
Next
End Sub
Private Sub Picture1_Click()
Me.Visible = False
DoEvents
GetPoint
Me.Visible = True
End Sub
|
希望本文所述对大家的VB程序设计有所帮助。