VB小游戏设计（一）：扫雷 |
您所在的位置：网站首页 › 编写游戏程序可以用VS吗 › VB小游戏设计（一）：扫雷 |
VB小游戏设计（一）：扫雷
|
感谢VB吧@yjtx256，我的程序根据他公开的源代码改编而来 工程文件下载链接： 文件分享 提醒： 文章写得很烂，新手没必要按照博文里的描述来自己写，建议直接下载原工程，先尝试运行起来 先上完成品：
相关信息： 语言：VB编写环境：（老掉牙的）Visual Basic 6.0运行环境：Windows 10源代码下载链接 CSDN: 扫雷源代码下载 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 3.运行调试程序的鲁棒性很重要，大家注意看 Distribution() 过程，添加了防止因用户输入不合法的数据造成卡死或崩溃的代码。 |
【本文地址】