admin 管理员组文章数量: 887021
2024年1月23日发(作者：c程序的三种基本结构)
VB扫雷小游戏
一．编程目的
二．编程思路
1. 新建 command_up和label_down控件
2. 用load加载控件
3. 根据雷区的X、Y、以及难度进行随机布雷。
4. 统计每一个label周围雷的数量并作为label的caption。
5. 在单击command的时候显示label
6. 在右击command的时候进行标记
7. 在label上左右键同时按下的时候检查已标记雷的数量与label显示的数量是否一致。
三．界面设计
四.代码设计
Dim Start_Time, End_Time
Dim Area_X%, Area_Y%, Area%, Area_List()
Dim Current_Mine%
Dim Difficulty#
Dim Continue_Flag%, Success_Flag%, LeftAndRight_Flag%
Dim Near_List
Dim Mine_Count
Private Sub Command_End_Click()
End
End Sub
Private Sub Delete_Item(List(), Index As Integer)
Dim i%
For i = LBound(List) + Index - 1 To UBound(List) - 1
List(i) = List(i + 1)
Next i
'防止100%的困难度
If UBound(List) > LBound(List) Then ReDim Preserve List(LBound(List) To UBound(List) - 1)
End Sub
Private Sub Command_retry_Click()
'卸载
For i = 1 To Area
Unload Label_Down(i)
Unload Command_Up(i)
Next i
Command_n = "开始游戏"
Call Command_Start_Click
End Sub
Private Sub Command_Up_Click(Index As Integer)
Success_Flag = 1
If Continue_Flag = 1 Then
If d = False Then Call Command_Start_Click
If Label_Down(Index).Caption = "X" Then
Success_Flag = 0
Continue_Flag = 0
For i = 1 To Area
If Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And
Label_Down(i).BackColor = vbRed Then
'标记雷正确
Command_Up(i).Picture = LoadPicture( +
"picturesmine_", , , Command_Up(i).Width, Command_Up(i).Height)
Command_Up(i).Visible = True
Label_Down(i).Visible = True
ElseIf Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And
Label_Down(i).BackColor = vbGreen Then
'标记雷错误
Command_Up(i).Picture = LoadPicture( +
"picturesmine_", , , Command_Up(i).Width, Command_Up(i).Height)
Command_Up(i).Visible = True
Label_Down(i).Visible = True
Else
Command_Up(i).Visible = False
Label_Down(i).Visible = True
End If
Next i
d = False
temp = MsgBox("Game Over !", vbOKOnly, "游戏结束")
ElseIf Val(Label_Down(Index).Caption) > 0 Then
Command_Up(Index).Visible = False
Label_Down(Index).Visible = True
Else
'如果等于0的话应该将周边的清零
Command_Up(Index).Visible = False
Label_Down(Index).Visible = True
j = Index
For i = 1 To 8
'判断控件是否存在
If j + Near_List(i) > 0 And j + Near_List(i) <= Area Then
'判断是否相邻
If Abs(Label_Down(j + Near_List(i)).Left - Label_Down(j).Left) <=
Label_Down(j).Width And Abs(Label_Down(j + Near_List(i)).Top - Label_Down(j).Top) <=
Label_Down(j).Height Then
'判断是否有雷
If Label_Down(j + Near_List(i)).BackColor = vbGreen And
Command_Up(j + Near_List(i)).Visible = True Then
Call Command_Up_Click(j + Near_List(i)) '注意此处循环调用的时候一定要避免陷入死循环
End If
End If
End If
Next i
End If
'检查是否游戏成功
For i = 1 To Area
If Command_Up(i).Visible = True And Label_Down(i).Caption <> "X" Then
Success_Flag = 0
Exit For
End If
Next i
If Success_Flag = 1 Then
If Continue_Flag = 1 Then
d = False
For i = 1 To Area
If Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And
Label_Down(i).BackColor = vbRed Then
'标记雷正确
Command_Up(i).Picture = LoadPicture( +
"picturesmine_", , , Command_Up(i).Width, Command_Up(i).Height)
Command_Up(i).Visible = True
Label_Down(i).Visible = True
ElseIf Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And
Label_Down(i).BackColor = vbGreen Then
'标记雷错误
Command_Up(i).Picture = LoadPicture( +
"picturesmine_", , , Command_Up(i).Width, Command_Up(i).Height)
Command_Up(i).Visible = True
Label_Down(i).Visible = True
Else
Command_Up(i).Visible = False
Label_Down(i).Visible = True
End If
Next i
temp = MsgBox("恭喜，扫雷成功！" & vbCrLf & "耗时：" &
Mid(Label_n, 4) & vbCrLf & "鸣谢：平方X O(∩_∩)O~", vbOKOnly, "成功")
End If
Continue_Flag = 0 '提示一次后结束，防止在调用Command_Click事件中重复提示
End If
End If
Command_us
End Sub
Private Sub Command_Start_Click()
If Command_n = "开始游戏" Then
Command_n = "重新开始"
Continue_Flag = 1
d = True
Difficulty = Val(Text_) / 100
Area_X = Val(Text_)
Area_Y = Val(Text_)
Area = Area_X * Area_Y
'初始化这里进行二次初始化的原因是如果在之前的运行中对字体进行了改变，将有可能造成此处的控件大小发生变化
With Picture_show
.Left = 200
.Top = 200
.Width = 750 * 10
.Height = 750 * 10
.Visible = False
End With
With Command_Up(0)
.Left = Picture_
.Top = Picture_
.Width = Picture_ / 10
.Height = Picture_ / 10
.FontSize = 1 '防止自动缩放
.Visible = False
End With
With Label_Down(0)
.Left = Picture_
.Top = Picture_
.Width = Picture_ / 10
.Height = Picture_ / 10
.FontSize = 1 '防止自动缩放
.Visible = False
End With
With Label_Down(0)
.Left = 200
.Top = 200
.Width = 750 * 10 / IIf(Area_X > Area_Y, Area_X, Area_Y)
.FontSize = 25 * (.Width / 750) '会自动缩放，必须先设置了
.Height = 750 * 10 / IIf(Area_X > Area_Y, Area_X, Area_Y)
.Visible = False
End With
With Command_Up(0)
.Left = 200
.Top = 200
.Width = Label_Down(0).Width
.Height = Label_Down(0).Height
.Visible = False
End With
ReDim Near_List(1 To 8)
Near_List(1) = 0 - 1 - Area_Y
Near_List(2) = 0 - 0 - Area_Y
Near_List(3) = 0 + 1 - Area_Y
Near_List(4) = 0 - 1
Near_List(5) = 0 + 1
Near_List(6) = 0 - 1 + Area_Y
Near_List(7) = 0 - 0 + Area_Y
Near_List(8) = 0 + 1 + Area_Y
'如果在列表中有相等的元素将有可能造成统计雷的数目错误
For i = 1 To 8
For j = i + 1 To 8
If Near_List(i) = Near_List(j) Then Near_List(i) = 0
Next j
Next i
Area_temp = 0
For Y = 1 To Area_Y
'加载label
For X = 1 To Area_X
Area_temp = Area_temp + 1
Load Label_Down(Area_temp)
With Label_Down(Area_temp)
.Left = Label_Down(0).Left + Label_Down(0).Width * ((Area_temp -
1) Mod Area_Y)
.Top = Label_Down(0).Top + Label_Down(0).Height * ((Area_temp -
1) Area_Y)
.BackColor = vbGreen
.Visible = False
.Alignment = 2
.Font = .FontBold
End With
'加载command
Load Command_Up(Area_temp)
With Command_Up(Area_temp)
'对列数求余的话就是在这一行第几个了
.Left = Command_Up(0).Left + Command_Up(0).Width *
((Area_temp - 1) Mod Area_Y)
'整除列数的话可以确定第几行
.Top = Command_Up(0).Top + Command_Up(0).Height *
((Area_temp - 1) Area_Y)
.Visible = True
End With
Next X
Next Y
ReDim Area_List(1 To Area)
For i = 1 To Area
Area_List(i) = i
Next i
' 随即布雷
Randomize
Mine_Count = Val(Text_Mine_)
For i = 1 To Mine_Count
Current_Mine = Int(Rnd * (UBound(Area_List) - LBound(Area_List) + 1) + 1) '在数
组中随机一个，注意此处2个+1的必要性和准确性
Label_Down(Area_List(Current_Mine)).BackColor = vbRed '将该位置标记为雷
Call Delete_Item(Area_List, Current_Mine) '删除该位置，防止再次标记
Next i
'检查雷的数目
For j = 1 To Area
If Label_Down(j).BackColor = vbRed Then
Label_Down(j).Caption = "X"
Else
Mine_Number = 0
For i = 1 To 8
'判断控件是否存在
If j + Near_List(i) > 0 And j + Near_List(i) <= Area Then
'判断是否相邻
If Abs(Label_Down(j + Near_List(i)).Left - Label_Down(j).Left) <=
Label_Down(j).Width And Abs(Label_Down(j + Near_List(i)).Top - Label_Down(j).Top) <=
Label_Down(j).Height Then
'判断是否有雷
If Label_Down(j + Near_List(i)).BackColor = vbRed Then
Mine_Number = Mine_Number + 1
End If
End If
End If
Next i
Label_Down(j).Caption = Mine_Number
End If
Next j
Start_Time = Now()
ElseIf Command_n = "重新开始" Then
Call Command_retry_Click
End If
End Sub
Private Sub Command_Up_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As
Single, Y As Single)
If Button = 2 Then
If Command_Up(Index).Caption = "" Then
Command_Up(Index).Caption = "X"
Command_Up(Index).Picture = LoadPicture( + "", , ,
Command_Up(Index).Width, Command_Up(Index).Height)
ElseIf Command_Up(Index).Caption = "X" Then
Command_Up(Index).Caption = "?"
Command_Up(Index).Picture = LoadPicture( + "", , ,
Command_Up(Index).Width, Command_Up(Index).Height)
ElseIf Command_Up(Index).Caption = "?" Then
Command_Up(Index).Caption = ""
Command_Up(Index).Picture = LoadPicture("")
End If
End If
End Sub
Private Sub Form_Load()
With Picture_show
.Left = 200
.Top = 200
.Width = 750 * 10
.Height = 750 * 10
.Visible = False
End With
With Command_Up(0)
.Left = Picture_
.Top = Picture_
.Width = Picture_ / 10
.Height = Picture_ / 10
.FontSize = 1 '防止自动缩放
.Visible = False
End With
With Label_Down(0)
.Left = Picture_
.Top = Picture_
.Width = Picture_ / 10
.Height = Picture_ / 10
.FontSize = 1 '防止自动缩放
.Visible = False
End With
'加载计时器
d = False
al = 100
'加载滚动条
With HScroll_Difficulty
.LargeChange = 5
.SmallChange = 1
.Max = 100
.Min = 0
.Value = 10
End With
With HScroll_Area_X
.LargeChange = 5
.SmallChange = 1
.Max = 100
.Min = 1
.Value = 10
End With
With HScroll_Area_Y
.LargeChange = 5
.SmallChange = 1
.Max = 100
.Min = 1
.Value = 10
End With
With HScroll_Mine_Count
.LargeChange = 5
.SmallChange = 1
.Max = 100
.Min = 0
.Value = 10
End With
'由于很多数据不方便处理，索性让其禁用了
Text_d = False
Text_Mine_d = False
Text_d = False
Text_d = False
End Sub
Private Sub HScroll_Area_X_Change()
Text_ = HScroll_Area_
HScroll_Mine_ = HScroll_Area_ * HScroll_Area_
HScroll_Mine_ = HScroll_Area_ * HScroll_Area_ / 100
HScroll_
End Sub
Private Sub HScroll_Area_X_Scroll()
Text_ = HScroll_Area_
HScroll_Mine_ = HScroll_Area_ * HScroll_Area_
HScroll_Mine_ = HScroll_Area_ * HScroll_Area_ / 100
HScroll_
End Sub
*
*
Private Sub HScroll_Area_Y_Change()
Text_ = HScroll_Area_
HScroll_Mine_ = HScroll_Area_ * HScroll_Area_
HScroll_Mine_ = HScroll_Area_ * HScroll_Area_ / 100 *
HScroll_
End Sub
Private Sub HScroll_Area_Y_Scroll()
Text_ = HScroll_Area_
HScroll_Mine_ = HScroll_Area_ * HScroll_Area_
HScroll_Mine_ = HScroll_Area_ * HScroll_Area_ / 100 *
HScroll_
End Sub
Private Sub HScroll_Difficulty_Change()
Text_ = HScroll_
HScroll_Mine_ = HScroll_Area_ * HScroll_Area_ / 100 *
HScroll_
End Sub
Private Sub HScroll_Difficulty_Scroll()
Text_ = HScroll_
HScroll_Mine_ = HScroll_Area_ * HScroll_Area_ / 100 *
HScroll_
End Sub
Private Sub HScroll_Mine_Count_Change()
Text_Mine_ = HScroll_Mine_
HScroll_ = HScroll_Mine_ / (HScroll_Area_ *
HScroll_Area_) * 100
End Sub
Private Sub HScroll_Mine_Count_Scroll()
Text_Mine_ = HScroll_Mine_
HScroll_ = HScroll_Mine_ / (HScroll_Area_ *
HScroll_Area_) * 100
End Sub
Private Sub Label_Down_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As
Single, Y As Single)
For i = 1 To 8
'判断控件是否存在
If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then
'判断是否相邻
If Abs(Label_Down(Index + Near_List(i)).Left - Label_Down(Index).Left) <=
Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -
Label_Down(Index).Top) <= Label_Down(Index).Height Then
'判断是否有标记雷
If Command_Up(Index + Near_List(i)).Caption <> "X" And
Command_Up(Index + Near_List(i)).Caption <> "?" Then
Command_Up(Index + Near_List(i)).Picture = LoadPicture("")
End If
End If
End If
Next i
End Sub
Private Sub label_down_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As
Single, Y As Single)
If LeftAndRight_Flag + Button = 3 Then '双击完成
Mine_Number = Val(Label_Down(Index).Caption)
Mark_mine_number = 0
For i = 1 To 8
'判断控件是否存在
If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then
'判断是否相邻
If Abs(Label_Down(Index + Near_List(i)).Left - Label_Down(Index).Left) <=
Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -
Label_Down(Index).Top) <= Label_Down(Index).Height Then
'判断是否有标记雷
If Command_Up(Index + Near_List(i)).Caption = "X" Then
Mark_mine_number = Mark_mine_number + 1
End If
End If
End If
Next i
If Val(Label_Down(Index).Caption) - Mark_mine_number <= 0 Then '已全部标出，自动点开
For i = 1 To 8
'判断控件是否存在
If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then
'判断是否相邻
If Abs(Label_Down(Index + Near_List(i)).Left - Label_Down(Index).Left)
<= Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -
Label_Down(Index).Top) <= Label_Down(Index).Height Then
'判断是否有标记雷
If Command_Up(Index + Near_List(i)).Caption <> "X" Then
Call Command_Up_Click(Index + Near_List(i))
End If
End If
End If
Next i
Else '如果没有全部标注的话应该显示一下嘛
For i = 1 To 8
'判断控件是否存在
If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then
'判断是否相邻
If Abs(Label_Down(Index + Near_List(i)).Left - Label_Down(Index).Left)
<= Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -
Label_Down(Index).Top) <= Label_Down(Index).Height Then
'判断是否有标记雷
If Command_Up(Index + Near_List(i)).Caption <> "X" Then
Command_Up(Index + Near_List(i)).Picture =
LoadPicture( + "", , , Command_Up(Index).Width,
Command_Up(Index).Height)
End If
End If
End If
Next i
End If
Else
LeftAndRight_Flag = Button
'Print LeftAndRight_Flag
End If
End Sub
Private Sub Timer1_Timer()
LeftAndRight_Flag = 0
End_Time = Now()
spend_time = (End_Time - Start_Time) * 10 ^ 5
Label_n = "时间：" & Format(Int(spend_time) (60 * 60), "00") & ":" &
Format((Int(spend_time) Mod (60 * 60)) 60, "00") & ":" & Format(Int(spend_time) Mod 60, "00")
& "." & Format(Int((spend_time - Int(spend_time)) * 1000), "000")
End Sub
五．软件截图
1
2
3
版权声明：本文标题：VB扫雷小游戏编程代码 内容由网友自发贡献，该文观点仅代表作者本人， 转载请联系作者并注明出处：http://www.freenas.com.cn/free/1705983620h496656.html， 本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容，一经查实，本站将立刻删除。
发表评论