VB小游戏设计（一）：扫雷

HiMeditator

已于 2022-11-17 15:27:41 修改

阅读量1.1w

点赞数 14

分类专栏： VB 文章标签： VB 小游戏游戏设计扫雷

于 2020-09-01 12:01:23 首次发布

本文链接：https://blog.youkuaiyun.com/Hi_KER/article/details/108011059

版权

VB 专栏收录该内容

4 篇文章

订阅专栏

感谢VB吧@yjtx256，我的程序根据他公开的源代码改编而来

工程文件下载链接：

文件分享

提醒：

文章写得很烂，新手没必要按照博文里的描述来自己写，建议直接下载原工程，先尝试运行起来

先上完成品：

相关信息：

语言：VB
编写环境：（老掉牙的）Visual Basic 6.0
运行环境：Windows 10

源代码下载链接

优快云: 扫雷源代码下载

BaiduNetDisk: 扫雷.rar 提取码: 7pu6

建议先下载源代码，参考相应的工程文件后再看后面的过程。

编写过程

1.建立控件

0.调整 Form1 属性

Caption = “扫雷”

添加适当的图标设为 Icon

ScaleMod = 1 - Twip

Height = 6825

Width = 6105

1.新建三个 Label 控件

名称无所谓

Caption 属性分别为：{行列：}，{雷数：}，{用时：}，并调整到相应位置和大小（如上图）

2.新建四个 TextBox 控件

名称分别为：Row,Column, MineNumber,TimeDial (行，列，雷数，时间)

Text 属性分别为：16，16，32，0

前两个控件 MaxLength 属性设为 2 ，第四个 Locked 属性设为 True

3.新建一个 PictureBox 控件

Height = 6050

Width = 6050

ScaleHeight = 5985

ScaleWidth = 5985

4.在 PictureBox 上新建一个按钮数组 Block()

Height = 375

Width = 375

Visible = False

Caption 设为空

字体和大小请按自己喜好设置

只保留Block(0)，并按照上图方式摆放

5.建立一个 Timer

名称为 Timer1

Interval = 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 Sub