当前位置： vb游戏小程序-vb游戏小程序
发布时间：2023-01-23 16:25 浏览次数：次 作者：佚名
提醒：
文章写得不好。 新手不用按照博文中的描述来写。 建议直接下载原项目vb游戏小程序，先运行试试。
先说成品：
相关信息：
源码下载链接
CSDN：扫雷源码下载
百度网盘：Minesweeper.rar 提取码：7pu6
建议先下载源码，参考对应的工程文件再阅读下面的流程。
编写过程 1. 建立控制
0.调整Form1属性
Caption = "扫雷"
添加适当的图标作为图标
ScaleMod = 1 - 缇
身高 = 6825
宽度 = 6105
1.新建三个Label控件
名字不重要
Caption属性有：{rows:}, {thunder number:}, {time:}vb游戏小程序，调整到对应的位置和大小（如上图）
2.新建四个TextBox控件
名称分别是：Row, Column, MineNumber, TimeDial（行、列、矿号、时间）
文本属性为：16、16、32、0
前两个控件的MaxLength属性设置为2，第四个Locked属性设置为True
3.新建一个PictureBox控件
高度 = 6050
宽度 = 6050
比例高度 = 5985
刻度宽度 = 5985
4.在PictureBox上新建一个按钮数组Block()
高度 = 375
宽度 = 375
可见 = 假
标题设置为空
请根据您的喜好设置字体和大小
只保留Block(0)，如上图所示放置
5. 创建一个计时器
名称是 Timer1
间隔 = 1000
2.写代码
实现这个游戏的代码并不难。 唯一的困难可能是转动网格的步骤。 主要思想是使用DFS搜索连续八个块。
这一步对于学过信息学竞赛的同学来说应该比较容易理解。
请结合注释理解。
代码如下：
Option Explicit
Option Base 0 '默认数组下标为0
Dim Time, MineNum As Integer '时间和地雷数
Dim R, C As Integer '行列数
Dim Map() As Integer '二维数组，用于保存格子状态
Private Sub Form_Load()
End Sub
Private Sub Start_Click() '点击开始按钮
With Block(0)
.Visible = True
.Caption = ""
.BackColor = &HC0C0C0
End With
Time = 0
Call Distribution '排布地图
Timer1.Enabled = True
End Sub
Private Sub UnloadMap() '卸载原有地图
Dim i As Integer
For i = 1 To Block.UBound
Unload Block(i)
Next
End Sub
Private Sub Distribution() '排布地图
UnloadMap '先卸载原有地图
Dim i As Integer, j As Integer
R = Val(Row)
C = Val(Column)
MineNum = Val(MineNumber)
If R < 4 Or C < 4 Or R > 32 Or C > 32 Then '检查数据是否合法
MsgBox "行列设置超出范围[4,32]，已改为默认", vbInformation, "说明"
R = 16: C = 16
Row.Text = "16": Column.Text = "16"
End If
If MineNum >= R * C Then
MineNum = Int(R * C / 8)
MineNumber.Text = MineNum
MsgBox "地雷数过多，已改为默认", vbInformation, "说明"
End If
ReDim Map(R, C) '重定义地图规模
MapBox.Width = Block(0).Width * C + 50
MapBox.Height = Block(0).Height * R + 50
Me.Width = MapBox.Width + 80
If Me.Width < 6050 Then Me.Width = 6050
Me.Height = MapBox.Height + 800
For i = 0 To R - 1 '开始排布
For j = 0 To C - 1
If i * C + j > 0 Then '第一块已经布好，需要特判
Load Block(i * C + j)
With Block(i * C + j)
.Top = i * Block(0).Height
.Left = j * Block(0).Width
.Visible = True
End With
End If
Next
Next
Call LoadMine '排布地雷
Call CalcNum '计算格子数字
End Sub
Private Sub LoadMine() '排布地雷
Randomize '初始化随机数种子
Dim i As Integer, R As Integer, tmp As Integer, M() As Integer
ReDim M(Block.Count)
For i = 0 To Block.UBound
M(i) = i
Next
For i = 0 To Block.UBound '乱序排列
R = Int(Rnd * Block.UBound)
tmp = M(i)
M(i) = M(R)
M(R) = tmp
Next
For i = 0 To MineNum - 1
Map(Int(M(i) / C), M(i) Mod C) = 9 '数字9表示地雷
Next
End Sub
Private Sub CalcNum() '计算格子的数字
Dim i As Integer, x As Integer, y As Integer
For i = 0 To Block.UBound
x = Int(i / C): y = i Mod C
If Map(x, y) = 9 Then '周围格子数字加一
If x > 0 Then Map(x - 1, y) = IIf(Map(x - 1, y) = 9, 9, Map(x - 1, y) + 1)
If y > 0 Then Map(x, y - 1) = IIf(Map(x, y - 1) = 9, 9, Map(x, y - 1) + 1)
If x < R - 1 Then Map(x + 1, y) = IIf(Map(x + 1, y) = 9, 9, Map(x + 1, y) + 1)
If y < C - 1 Then Map(x, y + 1) = IIf(Map(x, y + 1) = 9, 9, Map(x, y + 1) + 1)
If x > 0 And y > 0 Then Map(x - 1, y - 1) = IIf(Map(x - 1, y - 1) = 9, 9, Map(x - 1, y - 1) + 1)
If x < R - 1 And y < C - 1 Then Map(x + 1, y + 1) = IIf(Map(x + 1, y + 1) = 9, 9, Map(x + 1, y + 1) + 1)
If x > 0 And y < C - 1 Then Map(x - 1, y + 1) = IIf(Map(x - 1, y + 1) = 9, 9, Map(x - 1, y + 1) + 1)
If x < R - 1 And y > 0 Then Map(x + 1, y - 1) = IIf(Map(x + 1, y - 1) = 9, 9, Map(x + 1, y - 1) + 1)
End If
Next
End Sub
Private Sub Block_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
If Timer1.Enabled = False Then Exit Sub
Dim x1 As Integer, y1 As Integer
If Button = 1 Then '左键
If Block(Index).Caption = "☆" Or IsNumeric(Block(Index).Caption) Then
Exit Sub
End If
x1 = Int(Index / C): y1 = Index Mod C
If Map(x1, y1) = 9 Then
Call GameOver '踩到地雷，游戏结束
Else
Call RevealGrid(x1, y1) '翻格子
Call IsWin '判断是否胜利
End If
End If
If Button = 2 Then '右键
If Block(Index).Caption = "" Then
Block(Index).Caption = "☆"
Block(Index).BackColor = vbRed
MineNumber = Val(MineNumber) - 1
ElseIf Block(Index).Caption = "☆" Then
Block(Index).Caption = "?"
Block(Index).BackColor = vbYellow
MineNumber = Val(MineNumber) + 1
ElseIf Block(Index).Caption = "?" Then
Block(Index).Caption = ""
Block(Index).BackColor = &HC0C0C0
End If
End If
End Sub
Private Sub IsWin() '判断是否胜利
Dim i As Integer, Cnt As Integer
For i = 0 To Block.UBound
If Block(i).Visible = True And IsNumeric(Block(i).Caption) = False Then
Cnt = Cnt + 1 '如果当前格子未被翻开
End If
Next
If Cnt = MineNum Then
MineNumber.Text = MineNum
Timer1.Enabled = False
MsgBox "恭喜过关！", , "胜利"
End If
End Sub
Private Sub GameOver() '游戏结束
Dim x, y, i As Integer
For i = 0 To Block.UBound
x = Int(i / C): y = i Mod C
If Map(x, y) = 9 Then
Block(i).BackColor = vbRed
Block(i).Caption = "*"
ElseIf Block(i).Caption = "☆" Then
Block(i).BackColor = RGB(180, 0, 0)
Block(i).Caption = "×"
End If
Next
Timer1.Enabled = False
MineNumber.Text = MineNum
MsgBox "游戏结束！", , "失败"
End Sub
Private Sub RevealGrid(x As Integer, y As Integer) '用DFS算法翻格子
Dim ID As Integer
ID = x * C + y
If Map(x, y) = 0 And Block(ID).Visible = True Then
Block(ID).Visible = False
If x > 0 Then Call RevealGrid(x - 1, y)
If y > 0 Then Call RevealGrid(x, y - 1)
If x < R - 1 Then Call RevealGrid(x + 1, y)
If y < C - 1 Then Call RevealGrid(x, y + 1)
If x > 0 And y > 0 Then Call RevealGrid(x - 1, y - 1)
If x < R - 1 And y < C - 1 Then Call RevealGrid(x + 1, y + 1)
If x > 0 And y < C - 1 Then Call RevealGrid(x - 1, y + 1)
If x < R - 1 And y > 0 Then Call RevealGrid(x + 1, y - 1)
Else
Block(ID).Caption = Map(x, y)
Select Case Map(x, y) '修改颜色
Case 1
Block(ID).BackColor = &HC0FFC0
Case 2
Block(ID).BackColor = &HFFFFC0
Case 3
Block(ID).BackColor = &HFFC0C0
Case 4
Block(ID).BackColor = &HFFC0FF
Case 5
Block(ID).BackColor = &H8080FF
Case 6
Block(ID).BackColor = &H80FF&
Case 7
Block(ID).BackColor = &HFF8080
Case 8
Block(ID).BackColor = &HC000C0
End Select
End If
End Sub
Private Sub Timer1_Timer() '统计时间
Time = Time + 1
TimeDial.Text = Time
End Sub3.运行调试
程序的健壮性非常重要。 请注意Distribution()过程，并添加代码防止用户非法输入数据导致卡顿或崩溃。
上一篇 
