VB实现的《QQ美女找茬游戏》实例
作者:暮色微凉
时间:2026-06-29
来源:互联网
浏览:0
一个基于VB的自动找茬程序,通过API截取屏幕两幅图片,逐像素对比其RGB分量,差值超过30时标记为差异点,并在窗体上绘制结果。程序将窗口设为总在最前,点击触发分析,实现快速自动找茬。
用VB写一个自动找茬的小程序,听起来有点无聊,但其实挺有意思的。原理非常简单:截取屏幕上的两幅图片,逐像素对比,标记出差异点。虽然VB的执行速度远不如C++,但实现起来毫不费力,代码量也很少。

下面看看具体的实现代码。核心思路是通过API获取屏幕设备上下文,然后逐个像素读取两张图片的颜色值,比较它们的RGB分量。如果差值超过阈值(这里设为30),就认为这是不同的像素,用不同颜色标记出来。
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
整个程序的核心就是GetPoint过程:先读取左右两张图片的像素,然后遍历比较,最后在Picture1上绘制结果。点击Picture1即可触发找茬分析。注意窗口设置为“总在最前”,方便定位。
希望这个简单的例子能给大家的VB学习带来一些参考和启发。
作者最新文章
白描 PDF
2026-09-16 17:44
密码键盘
2026-09-16 17:43
3dmax快捷键失效了怎么办
2026-09-16 13:53
Xiaomi 18 Fold首销数据解读:较上代大折叠增长310%的原因与配置分析
2026-09-08 16:55
PDF文件太大怎么压缩?在线减小体积的操作步骤
2026-09-03 11:12
热门文章
更多
精品专题
更多
Mac软件
更多
WINDOWS
更多
Windows 10
Windows
Windows 10 是一款微软推出的经典操作系统,拥有硬件兼容性与多任务处理能力。它更偏向把系统状态查看和常用调节动作放在一起,适合需要持续观察和微调设备状态的场景。
极度公式
Windows/macOS/Linux
极度公式是一款跨平台专业LaTeX公式识别编辑软件,支持OCR公式识别和多平台编辑。和使用说明,避免使用,享受完整功能与稳定支持。做扫描整理、文字提取和表格转换时,它能把识别后的处理步骤接得更顺,资料录入这类场景会省下不少时间。
















