信息来源：中国VB网    作者：河北/王学军

这个游戏程序是本站的早期作品，使用的都是最基本的VB控件，代码也不复杂，现在拿出来只是想介绍给初学VB的朋友参考阅读。
　　右侧为游戏运行时的窗口界面。

　　标签Label1(1-4)用于存放用户输入的密码。标签Label1(0)用于显示剩余次数，标签Label2(1-4)用于红黄色正确性指示。按钮Command1用于试按确定。Command2(1-8)用于改变密码数字（数组中的单数放置在上面设置累加，双数放置在下面设置递减）。  


'**********************************************************************************
'*　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*
'*　　　　　　　　　　　　　　　　解密码游戏程序　　　　　　　　　　　　　　　　　*
'*　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*
'*　游戏的目的是破解电脑随机产生的一个四位数密码。密码板上方有四个彩色矩形是游戏　*
'*　对每次试开(按下OK钮)结果的提示：变成红色的个数就是密码中数字及位置都正确的个　*
'*　个数；变成黄色的个数就是密码中包含但位置不正确的数字个数，游戏提供12次机会。　*
'*　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*
'*　　　　　　　　　　　　　　　　程序设计：王学军　　　　　　　　　　　　　　　　*
'*　　　　　　　　　　　　相关地址:http://qipinw.126.com　　　　　　　　　　　　　*
'*　　　　　　　　　　　　　Copyright qipinw小雨点工作室　　　　　　　　　　　　　*
'*　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*
'**********************************************************************************
Option Explicit
Dim M(4), CISHU1, T0(4), T1, T2, T3(4) As Integer
Dim MM(4), MIMA(4) As String
Dim http, mail As String

Private Sub Form_Load()
Show
重新开始
End Sub

Private Sub 重新开始() '初始数据
Dim C As Integer
CISHU1 = 0
For C = 1 To 4
MM(C) = "0": Label1(C).Caption = "0"
Randomize (Timer)
MIMA(C) = Mid(Str(Int(10 * Rnd(1))), 2, 1)
Label2(C).BackColor = QBColor(0)
Next C
Label2(0).Caption = "12"
End Sub

Private Sub Command2_Click(Index As Integer) '按下数字按钮
Dim AnniuZu As Integer
AnniuZu = Int((Index - 1) / 2) + 1
M(AnniuZu) = Val(MM(AnniuZu))
If Int(Index / 2) = Index / 2 Then
If M(AnniuZu) = 0 Then M(AnniuZu) = 9 Else M(AnniuZu) = M(AnniuZu) - 1
Else
If M(AnniuZu) = 9 Then M(AnniuZu) = 0 Else M(AnniuZu) = M(AnniuZu) + 1
End If
MM(AnniuZu) = Mid$(Str(M(AnniuZu)), 2, 1)
Label1(AnniuZu).Caption = MM(AnniuZu)
Command1.SetFocus
End Sub

Private Sub Command1_Click() '试按OK
Dim A, C, AA As Integer
CISHU1 = CISHU1 + 1
If CISHU1 > 11 Then
A = MsgBox("游戏结束！" + Chr(13) + "密码应该是" + MIMA(1) + MIMA(2) + MIMA(3) + MIMA(4) + Chr(13) + "再来一把吗?", 4 + 32 + 0 + 0)
If A = 6 Then 重新开始: Exit Sub Else End
End If
'判断是否有位置及数值都对的位
T1 = 0: T2 = 0
For A = 1 To 4
If MM(A) = MIMA(A) Then
T0(A) = 1: T3(A) = 1: T1 = T1 + 1
Else
T0(A) = 0: T3(A) = 0
End If
Next
'判断是否有位置不对但数值对的位
For A = 1 To 4
For AA = 1 To 4
If T0(A) = 0 And T3(AA) = 0 Then
If MM(A) = MIMA(AA) Then T2 = T2 + 1: T3(AA) = 1: Exit For
End If
Next
Next
'显示正确情况
Label2(0).Caption = Mid(Str(12 - CISHU1), 2, Len(Str(12 - CISHU1)) - 1)
For A = 1 To 4: Label2(A).BackColor = QBColor(0): Next
For A = 1 To T1: Label2(A).BackColor = QBColor(12): Next
For A = T1 + 1 To T1 + T2: Label2(A).BackColor = QBColor(14): Next
If T1 = 4 Then
C = MsgBox("密码破解成功!" + Chr(13) + "再来一把吗?", 4 + 32 + 0 + 0)
If C = 6 Then 重新开始: Exit Sub Else End
End If
For A = 1 To 4: T0(A) = 0: Next
End Sub

Private Sub 退出_Click()
Dim C As Integer
C = MsgBox("确实要结束游戏吗？", 4 + 32 + 256 + 0)
If C = 6 Then End
End Sub

以下是我自己编写的解密码游戏：

Option Explicit
Dim a, b, c, d, s, x, M(4) As Integer

Private Sub Command1_Click()
For a = 1 To 4
If Text1(a - 1).Text = "" Then
b = MsgBox("请在第" + Str$(a) + "个框内输入数字", 0 + 16 + 0 + 0, "错误")
End If
Next a
For a = 0 To 2
For b = (a + 1) To 3
If Text1(a).Text = Text1(b).Text Then
c = MsgBox("请输入4个不同的数字", 0 + 16 + 0 + 0, "错误")
Text1(b).Text = ""
End If
Next b
Next a
s = 0
x = 0
d = d + 1
For a = 0 To 3
For b = 0 To 3
If Text1(a).Text = M(b + 1) Then
If a = b Then
s = s + 1
Else
x = x + 1
End If
End If
Next b
Next a
If s = 4 And d <= 10 Then
a = MsgBox("恭喜你成功了" + Chr$(13) + "再来一把？", 4 + 32 + 0 + 0, "获胜！")
If a = 6 Then
Call Form_Load
Text2.Text = ""
Else
End
End If
End If
Text2.Text = "第" + Str$(d) + "次:" + "A:" + Str$(s) + "B:" + Str$(x) + Chr$(13) + Chr$(10) + Text2.Text
For a = 0 To 3
Text1(a).Text = ""
Next a
If d > 10 Then
a = MsgBox("游戏结束！" + Chr$(13) + "密码应该为:" + Str$(M(1)) + Str$(M(2)) + Str$(M(3)) + Str$(M(4)) + Chr(13) + "再来一局？", 4 + 32 + 0 + 0, "任务失败！")
If a = 6 Then
Call Form_Load
Text2.Text = ""
Else
End
End If
End If
End Sub

Private Sub Command2_Click()
a = MsgBox("************************************************************" + Chr$(13) + Chr(10) + "* 　　　　　　　　　　解密码游戏程序　　　　　　　　　　 　*" + Chr$(13) + Chr(10) + "*游戏的规则就是破解产生的四个不重复数字。显示板上的A、B为每*" + Chr$(13) + Chr(10) + "*次测试（按下确定键） 结果的提示：A代表输入的数字和密码的数*" + Chr$(13) + Chr(10) + "*字及位子均相同；B代表数字相同而位子不同。游戏提供10次机会.*" + Chr$(13) + Chr(10) + "*            程序设计：redraiment              *" + Chr$(13) + Chr(10) + "************************************************************", 0, "帮助")
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Form_Load()
For a = 1 To 4
Randomize
M(a) = Int(10 * Rnd)
Next a
For a = 1 To 3
For b = (a + 1) To 4
While M(a) = M(b)
Randomize
M(b) = Int(10 * Rnd)
Wend
Next b
Next a
d = 0
End Sub