具体的规则和逻辑是：
1，鼠标左击则弹开一个雷区，如果是炸弹，则游戏结束，如果不是炸弹且其周围有炸弹，那么将会出现一个数字，指示玩家周围有几个炸弹。如果不是炸弹且周围也没有炸弹，那么则自动弹开周围所有的雷区，并按照上述规则做递归执行。这里用到了递归思想。
2，对一个数字区双击鼠标左击或者同时按下左键和右键时，可以自动为用户检查周围雷区，如果满足条件，则会自动弹开所有周围雷区。其中同时按下左键和右键这个功能，在VB中是没有此类事件的，其难点在于左键和右键的单击事件在vb中是单独的事件过程，而玩家在“同时”按下左键和右键时，其实并不是真正的同时，而是有一定的时间间隔的。这里我用了一个方法完美的完成了这个功能。大概逻辑就是，当用户按下一个左键或者右键时，那么记录此时的时间1，然后在按下另外一个右键或者左键时，记录时间2，如果时间1和时间2的间隔小于一个设定值时，那么认为玩家同时按下了左键和右键，具体代码见下方。
3，鼠标右键可以标记某个雷区，在三种状态中来回切换(不标记，标记，问号)
4，游戏中的排行榜功能，用到了文件操作，这里使用的是txt文本来记录玩家的记录。仅记录打破记录的时间和玩家姓名。
5，扫雷结束有三种方式：玩家主动退出、玩家扫雷失败、玩家扫雷成功。扫雷成功的判断条件是：当用户标记(即红旗)的数量与游戏中隐藏的炸弹数量一致时，判断其所有标记是否正确，如果正确则提示扫雷成功。
6，游戏难度分为4个等级，当时，我这里采用的是function函数，可以自定义任意难度，而不需要修改代码，只需要输入不同的参数即可，非常的方便。
7，第一个必定不是雷，新的扫雷游戏为了提升玩家体验，已经自动适配，让玩家点的第一个格子必定不是炸弹，且一定是一个空格子，因为空格子可以自动弹开周围的雷区。
下面看一下这个游戏的界面：
主界面
扫雷界面(中等难度)
扫雷界面(骨灰级难度)
扫雷失败时
扫雷成功并打破记录时
排行榜界面
下面看一下整个工程结构：
1，文件目录比较简单，需要注意的是，要在工程所在目录下建立一个image文件夹，用于存放用到的图片。并在工程所在目录同级下建立一个rank.txt文件，用来记录玩家排行榜。当然rank.txt文件不建立也没关系，因为代码中可以自动创建。
Image文件夹中需要准备以下这些图片和图标。这些都可以在网上找到。图标和图片不一定要和我的一样，但是命名必须一样，格式也要一样。图片大小也要差不多大小的。
工程包含两个窗体，如下所示：
接着来看一下两个窗体中的控件布置：
窗体1(form1)包含了菜单栏、一个frame2(其中包含两个标签和2个文本框)，一个frmae1(其中包含一个按钮和一个标签)，一个Image1图像，一个timer1
菜单栏设计如下：
Frame1框架中包含：
一个按钮和一个标签。Label3(0)和Command1(0)两个控件数组。控件数组是将其index属性值设置为非空，这里是设置的0，这样可以利用控件数组方便的控制控件的数量和大小位置。
Frame2框架中包含：
两个标签和2个文本框，名称分别是：Label1和Label2，Text1和Text2，分别用于显示游戏进行的时间和排雷的数量。
窗体2中，包含了一个frame1控件，和若干标签，标签名称见下图所示。
下面来看完整的代码：
窗体Form1的代码如下：
Option Explicit
Dim IndexMax% 'command1按钮编号索引
Dim a%() '对应每个command1的属性，-1表示是炸弹，0表示其周围没有炸弹，大于1表示周围有几个炸弹
Dim B$() '对应每个按钮的标记情况，flag表示旗子,""表示未标记," "表示周围没有炸弹且已被点击
Dim rows%, cols% '行数和列数
Dim bs% '炸弹数量(优化：可以将bombnums局部变量取消)
Dim lastGame As Integer '记录最近一次的游戏等级
Dim LoadFlag As Boolean '加载画面过程中的标记
Dim L As Single, r As Single, t AsSingle '用于控制同时按下鼠标左右键的参数
Dim firstClick As Boolean '标记为，标记是否首次单击
'窗体1加载
Private Sub Form_Load()
Image1.Top = 0
Image1.Left = 0
Image1.Height = 5000
Image1.Width = 5000
Image1.Stretch = True
Me.Icon = LoadPicture(App.Path & "/image/tile.ico")
Timer1.Interval = 1000
Timer1.Enabled = False
Call unloadWindows '调用卸载窗体控件的子程序
ReDim a(1) '初始化数组
ReDim B(1) '初始化数组
End Sub
'卸载窗体按钮
Function unloadWindows()
Dim i%
Image1.Visible = True
Image1.Picture = LoadPicture(App.Path &"/image/background.jpg")
If IndexMax > 1 Then
Frame1.Visible = False
For i = 1 To IndexMax
Unload Command1(i)
Unload Label3(i)
Next i
End If
IndexMax = 0
Frame1.Visible = False
Frame2.Visible = False
Frame1.Left = 200
Command1(0).Visible = False
Label3(0).Visible = False
Form1.Height = 5000
Form1.Width = 5000
Text1 = "0"
Timer1.Enabled = False
Erase a
Erase B
End Function
'开始初级难度游戏
Private Sub game1_Click()
rows = 9 '雷区横向数量
cols = 9 '雷区纵向数量
bs = 12 '炸弹数量
lastGame = 99 '标记
Call unloadWindows '调用卸载窗体控件的子程序(雷区)
Call creatWindow '调用创建窗体控件的子程序(雷区)
End Sub
'开始中级难度游戏
Private Sub game2_Click()
rows = 16
cols = 16
bs = 42
lastGame = 1616
Call unloadWindows
Call creatWindow
End Sub
'开始高级难度游戏
Private Sub game3_Click()
rows = 16
cols = 30
bs = 90
lastGame = 1630
Call unloadWindows
Call creatWindow
End Sub
'开始骨灰级难度游戏
Private Sub game4_Click()
rows = 25
cols = 40
bs = 180
lastGame = 2540
Call unloadWindows
Call creatWindow
End Sub
'创建窗体及按钮(创建雷区)
Function creatWindow()
Dim i%, j%
LoadFlag = True '加载标记位至为真，防止用户在加载过程中单击鼠标
Image1.Picture = LoadPicture("")
Image1.Visible = False
Load Label3(1)
Label3(1).Visible = True
Label3(1).BackColor = &HC0C0C0
Label3(1) = ""
Label3(1).Height = 400
Label3(1).Width = 400
Label3(1).Top = 230
Label3(1).Left = 50
Load Command1(1)
Command1(1).Visible = True
Command1(1).BackColor = RGB(58, 154, 254)
Command1(1).Caption = ""
Command1(1).Height = 400
Command1(1).Width = 400
Command1(1).Top = 150
Command1(1).Left = 50
Command1(1).Picture = LoadPicture("")
Frame1.Visible = True
Frame2.Visible = True
Frame1.Height = rows * 400 + 300
Frame1.Width = cols * 400 + 100
Form1.Height = Frame1.Height + 2000
Form1.Width = Frame1.Width + 600
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
Text1.Text = 0
Text2.Text = bs
'创建雷区的所有按钮和标签(按照游戏等级的行列数)
For i = 1 To rows
For j = 1 To cols
IndexMax = IndexMax + 1
If IndexMax <> 1 Then
DoEvents
Load Label3(IndexMax)
Label3(IndexMax).Height =400
Label3(IndexMax).Width =400
Label3(IndexMax).Top =Label3(1).Top + Label3(1).Height * (i - 1)
Label3(IndexMax).Left =Label3(1).Left + Label3(1).Width * (j - 1)
Label3(IndexMax).BackColor= &HC0C0C0
Label3(IndexMax) =""
Label3(IndexMax).Visible =True
Load Command1(IndexMax)
Command1(IndexMax).Height =400
Command1(IndexMax).Width =400
Command1(IndexMax).Top =Command1(1).Top + Command1(1).Height * (i - 1)
Command1(IndexMax).Left = Command1(1).Left+ Command1(1).Width * (j - 1)
Command1(IndexMax).Caption= ""
Command1(IndexMax).BackColor = RGB(58, 154, 254)
Command1(IndexMax).Visible= True
End If
Next j
Next i
ReDim a(IndexMax)
ReDim B(IndexMax)
For i = 1 To IndexMax
B(i) = ""
Next i
firstClick = False
Text1.SetFocus
LoadFlag = False
End Function
'鼠标单击事件(鼠标左键单击某个雷区)
Private Sub Command1_Click(index AsInteger)
Dim row%, col%, i%
If LoadFlag Then Exit Sub
If firstClick = False Then '判断是否首次单击雷区
Call rndBomb(index) '如果玩家首次单击雷区，则调用随机炸弹的子程序，布置炸弹。
firstClick = True
End If
Text1.SetFocus
If B(index) = "" Then '判断玩家点到的是炸弹还是数字或者是空白区域
'点到炸弹
If a(index) = -1 Then
Call gameOver '点到炸弹，调用游戏结束子程序
'点到数字
ElseIf a(index) > 0 Then
Command1(index).Visible = False
'点到空白
ElseIf a(index) = 0 Then
Command1(index).Visible = False
B(index) = " "
col = IIf(index Mod cols = 0, cols, index Mod cols)
row = ((index - col) / cols) + 1
Call X(row, col) '调用递归程序，用于循环判断周围所有的雷区
End If
End If
'判断是否正确扫雷
If Text2.Text = "0" And noSignCommandNums = 0 Then
Call isok
End If
End Sub
'随机布置炸弹子程序
'由于要求玩家首次单击的雷区一定是空白区，所以需要用到循环，在随机炸弹后，判断是否满足这个条件。
'如果不满足的话需要重新goto跳转到L行的代码，直到满足这个要求。
Function rndBomb(index%)
Dim i%, j%, m%, n%, r%, nums%, counts%, meBombNums%
L:
nums = 0
counts = 0
meBombNums = 0
ReDim a(IndexMax)
Do
Randomize
r = Int(Rnd() * IndexMax) + 1
If a(r) <> -1 Then
a(r) = -1 '炸弹
nums = nums + 1
End If
DoEvents
Loop Until (nums = bs)
For i = 1 To rows
For j = 1 To cols
counts = counts + 1
If a(counts) <> -1 Then
meBombNums = 0
For m = i - 1 To i + 1
For n = j - 1 To j + 1
If m > 0 And m <=rows And n > 0 And n <= cols Then
If a((m - 1) * cols+ n) = -1 Then
meBombNums = meBombNums + 1
End If
End If
Next n
Next m
a(counts) = meBombNums
Label3(counts) = meBombNums
If a(counts) = 0 Then
Label3(counts) =""
ElseIf a(counts) = 1 Then
Label3(counts).ForeColor =vbBlue
ElseIf a(counts) = 2 Then
Label3(counts).ForeColor =&H8000&
ElseIf a(counts) = 3 Then
Label3(counts).ForeColor =vbRed
ElseIf a(counts) = 4 Then
Label3(counts).ForeColor =&H400000
ElseIf a(counts) = 5 Then
Label3(counts).ForeColor =&H4080&
End If
End If
Next j
Next i
If a(index) <> "0" Then GoTo L '判断是否满足首次单击的区域是空白
Timer1.Enabled = True
End Function
'游戏结束子程序
Sub gameOver()
Dim i%
'循环将所有炸弹显示
For i = 1 To IndexMax
If a(i) = -1 Then
Command1(i).Picture = LoadPicture(App.Path &"/image/bom.jpg")
End If
Next i
If 2 = MsgBox("炸弹，游戏结束", vbRetryCancel, "提示") Then
Call unloadWindows
Else
If lastGame = 99 Then
Call game1_Click
ElseIf lastGame = 1616 Then
Call game2_Click
ElseIf lastGame = 1630 Then
Call game3_Click
ElseIf lastGame = 2540 Then
Call game4_Click
End If
End If
End Sub
'递归程序，空白区自动点开周围雷区
Function X(row%, col%)
Dim i%, j%, m%, n%, index%
For m = row - 1 To row + 1
For n = col - 1 To col + 1
index = (m - 1) * cols + n
If m > 0 And n > 0 And m < rows + 1 And n < cols + 1 Then
If B(index) = "" Then
If a(index) = 0 Then
Command1(index).Visible= False
B(index) = ""
Call X(m, n)
ElseIf a(index) > 0Then
Command1(index).Visible= False
End If
End If
End If
Next n
Next m
End Function
'鼠标右键事件(标记雷区)
Private Sub Command1_MouseDown(index As Integer,Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 And Command1(index).Caption = "" Then
If B(index) = "" Then
'按钮图片改为旗子
Command1(index).Picture = LoadPicture(App.Path &"/image/flag.jpg")
B(index) = "flag"
Text2.Text = Val(Text2.Text) - 1
ElseIf B(index) = "flag" Then
Command1(index).Picture = LoadPicture("")
'按钮图片改为问号
Command1(index).Picture = LoadPicture(App.Path & "/image/mark.jpg")
B(index) = "?"
Text2.Text = Val(Text2.Text) + 1
ElseIf B(index) = "?" Then
B(index) = ""
'删除按钮图片
Command1(index).Picture = LoadPicture("")
End If
End If
End Sub
'Label3标签的双击事件
Private Sub Label3_DblClick(index AsInteger)
Call m(index) '调用快速自动消除周边雷区的子程序
End Sub
'此代码实现判断用户是否同时按下鼠标左右键(允许时间误差0.1s以内)
Private Sub Label3_MouseDown(index AsInteger, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
L = Timer
ElseIf Button = 2 Then
r = Timer
End If
If Button = 1 Or Button = 2 Then
t = Abs(L - r)
If t <= 0.1 Then
Call m(index)
End If
End If
End Sub
'双击数字或者同时按下左右键，快速自动消除周围所有雷区
'仅在双击或同时按下左右键的是一个数字雷区，并且其周边已经标记了同等数量的炸弹数。
Sub m(index As Integer)
Dim row%, col%, m%, n%, index2%, c%
col = IIf(index Mod cols = 0, cols, index Mod cols)
row = ((index - col) / cols) + 1
For m = row - 1 To row + 1
For n = col - 1 To col + 1
index2 = (m - 1) * cols + n
If m > 0 And n > 0 And m < rows + 1 And n < cols + 1 Then
If B(index2) = "flag"Then c = c + 1
End If
Next n
Next m
If a(index) = c Then
For m = row - 1 To row + 1
For n = col - 1 To col + 1
index2 = (m - 1) * cols + n
If m > 0 And n > 0 And m< rows + 1 And n < cols + 1 Then
If a(index2) = 0 Then
B(index2) =" "
Call X(m, n)
ElseIf a(index2) = -1And B(index2) <> "flag" Then
Call gameOver
Exit Sub
End If
IfCommand1(index2).Visible = True And B(index2) <> "flag" AndB(index2) <> "问号" Then Command1(index2).Visible = False
End If
Next n
Next m
End If
'判断是否正确扫雷
If Text2.Text = "0" And noSignCommandNums = 0 Then
Call isok
End If
End Sub
'打开排行榜窗口
Private Sub pxb_Click()
Form2.Show
End Sub
'剩余炸弹个数，当剩余炸弹数量改变时，进行判断
Private Sub Text2_Change()
'判断是否正确扫雷
If Text2.Text = "0" And noSignCommandNums = 0 Then 'noSignCommandNums函数返回当前未被标记数量
Call isok '调用判断是否扫雷全部正确的子程序
End If
End Sub
'函数返回当前玩家剩余未标记的数量(即总炸弹数减去标记数量)
Function noSignCommandNums() As Integer
Dim i%
noSignCommandNums = IndexMax
For i = 1 To IndexMax
If Command1(i).Visible = False Or B(i) = "flag" Then
noSignCommandNums = noSignCommandNums - 1
End If
Next i
End Function
'判断玩家扫雷是否正确的子程序
Function isok()
Dim i%, nums%
For i = 1 To IndexMax
If a(i) = -1 And B(i) = "flag" Then
nums = nums + 1
End If
Next i
If nums = bs Then '如果扫雷正确
Timer1.Enabled = False
Call saverank '调用保存记录的子程序
If 2 = MsgBox("恭喜，扫雷成功，用时：" & Text1 & "秒",vbRetryCancel, "提示") Then
Call unloadWindows
Else
If lastGame = 99 Then
Call game1_Click
ElseIf lastGame = 1616 Then
Call game2_Click
ElseIf lastGame = 1630 Then
Call game3_Click
ElseIf lastGame = 2540 Then
Call game4_Click
End If
End If
End If
End Function
'保存游戏记录的子程序
Sub saverank()
Dim str$, s$(), pathName$
Dim fs As Object
Dim a As Object
On Error Resume Next
pathName = App.Path & "/rank.txt"
If Dir(pathName) = "" Then
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("rank.txt", True)
a.WriteLine "0,0,0,0,0,0,0,0"
a.Close
End If
OpenpathName For Input As #1
Line Input #1, str
Close #1
s= Split(str, ",")
If lastGame = 99 Then
If Text1 < s(0) Or s(0) = "0" Then
s(0) = Text1
s(1) = InputBox("大侠，留下你的尊姓大名", "恭喜，打破记录")
End If
ElseIf lastGame = 1616 Then
If Text1 < s(2) Or s(2) = "0" Then
s(2) = Text1
s(3) = InputBox("大侠，留下你的尊姓大名", "恭喜，打破记录")
End If
ElseIf lastGame = 1630 Then
If Text1 < s(4) Or s(4) = "0" Then
s(4) = Text1
s(5) = InputBox("大侠，留下你的尊姓大名", "恭喜，打破记录")
End If
ElseIf lastGame = 2540 Then
If Text1 < s(6) Or s(7) = "0" Then
s(6) = Text1
s(7) = InputBox("大侠，留下你的尊姓大名", "恭喜，打破记录")
End If
End If
str = Join(s, ",")
Open pathName For Output As #1
Print #1, str
Close #1
End Sub
'计时器
Private Sub Timer1_Timer()
Text1 = Val(Text1) + 1
End Sub
窗体Form2的代码如下：
Option Explicit
Dim L1NoTime$, L1NoName$
Dim L2NoTime$, L2NoName$
Dim L3NoTime$, L3NoName$
Dim pathName$
'窗体加载
Private Sub Form_Load()
Dim fs As Object
Dim a As Object
Me.Icon = LoadPicture(App.Path & "/image/tile.ico")
Label6 = ""
Label7 = ""
Label8 = ""
Label9 = ""
Label10 = ""
Label11 = ""
Label13 = ""
Label14 = ""
pathName = App.Path & "/rank.txt"
If Dir(pathName) = "" Then
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("rank.txt", True)
a.WriteLine "0,0,0,0,0,0,0,0"
a.Close
End If
Call getRank '取出现有记录
End Sub
'子程序：取出当前现有的记录值
Sub getRank()
Dim str$, s$()
On Error Resume Next
Open pathName For Input As #1
Line Input #1, str
Close #1
s= Split(str, ",")
If s(0) <> "0" Then
Label6 = s(0)
Else
Label6 = "暂无"
End If
If s(1) <> "0" Then
Label7 = s(1)
Else
Label7 = "暂无"
End If
If s(2) <> "0" Then
Label8 = s(2)
Else
Label8 = "暂无"
End If
If s(3) <> "0" Then
Label9 = s(3)
Else
Label9 = "暂无"
End If
If s(4) <> "0" Then
Label10 = s(4)
Else
Label10 = "暂无"
End If
If s(5) <> "0" Then
Label11 = s(5)
Else
Label11 = "暂无"
End If
If s(6) <> "0" Then
Label13 = s(6)
Else
Label13 = "暂无"
End If
If s(7) <> "0" Then
Label14 = s(7)
Else
Label14 = "暂无"
End If
End Sub
以上两个窗体的代码直接复制粘贴到对应窗体即可直接运行(窗体界面控件先布置好)。
创作不易，如果能对你有所帮助，请记得给我支持哦！！
473
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
