level 1
go看热闹的人
楼主
模仿扫雷做的,源码如下,纯属个人爱好。代码还有好多地方需要优化,大家可以提提意见或借鉴一下

Option Explicit
Option Base 1
Dim a(16, 16) As Integer
Dim LS As Integer
Dim ID As Integer
Dim Gamestate As Boolean
Dim Gtime As Integer
Dim ZD_YLS As Integer
Dim zdyls As String
Private Sub Bulei()
Dim i, j As Integer
For i = 1 To 16
For j = 1 To 16
a(i, j) = 0
Next j
Next i
Do While (1)
zdyls = InputBox("输入雷的数量,雷的数量最多60,再多了开发者觉得你就玩不转了,哈哈", "自定义雷数", "")
If Not zdyls = "" And Int(Val(zdyls)) <= 60 Then
Exit Do
End If
Loop
Label7.Caption = zdyls
Dim X, Y As Integer
Do While LS < zdyls
cc:
Randomize
X = Int(Rnd * 16) + 1
Y = Int(Rnd * 16) + 1
If a(X, Y) = 9 Then GoTo cc
a(X, Y) = 9
LS = LS + 1
Loop
End Sub
Private Sub seek_kongge(ByVal i As Integer, ByVal j As Integer)
Dim m, n As Integer
Dim s, d As Integer
If i > 1 And i < 16 And j > 1 And j < 16 Then
For m = i - 1 To i + 1
For n = j - 1 To j + 1
If a(m, n) < 9 Then
Command1((m - 1) * 16 + n).Visible = False
Command1((m - 1) * 16 + n).Caption = 1
End If
Next n
Next m
End If
a(i, j) = 1
If i > 1 And i < 16 And j > 1 And j < 16 Then
For s = i - 1 To i + 1
For d = j - 1 To j + 1
If a(s, d) = 0 Then
Call seek_kongge(s, d)
End If
Next d
Next s
End If
End Sub
Private Sub Command1_MouseDown(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Gamestate = False Then Exit Sub
If Check2.Value = 1 Then
wmp1.URL = App.Path & "\button33.wav"
wmp1.Controls.play
End If
If Button = 1 Then
Dim i, j As Integer
For i = 1 To 16
For j = 1 To 16
If index = (i - 1) * 16 + j Then
If a(i, j) < 9 Then
Command1(index).Visible = False
Command1(index).Caption = 1
Else
Command1(index).Picture = LoadPicture(App.Path & "\1.ico")
Call Gameover
End If
If a(i, j) = 0 Then
Call seek_kongge(i, j)
End If
End If
Next j
Next i
End If
win
Dim Have_picture As Boolean
If Button = 2 Then
If Have_picture = False Then
Command1(index).Picture = LoadPicture(App.Path & "\0.ico")
Have_picture = True
ElseIf Have_picture = True Then
Command1(index).Picture = LoadPicture("")
Have_picture = False
End If
End If
End Sub
Private Sub win()
Dim i, j, k As Integer
For i = 1 To 256
If Command1(i).Visible = True And IsNumeric(Command1(i).Caption) = False Then
k = k + 1
End If
Next i
If k = zdyls Then
wmp1.URL = App.Path & "\cartoon34.wav"
wmp1.Controls.play
MsgBox "恭喜过关", vbOKOnly, "胜利"
Gamestate = False
End If
End Sub
Private Sub Gameover()
wmp1.URL = App.Path & "\cartoon15.wav"
wmp1.Controls.play
MsgBox "你踩到雷了,Game Over", vbOKOnly, "游戏结束"
Gamestate = False
End Sub
Private Sub Paintmap()
Dim i, j As Integer
Dim top As Integer
For i = 1 To 16
For j = 1 To 16
ID = (i - 1) * 16 + j
Load Label1(ID)
Label1(ID).Visible = True
Label1(ID).BackColor = QBColor(10)
Label1(ID).Left = Label1(0).Width * (j - 1) + 50
Label1(ID).top = top + 50
Label1(ID).FontSize = 14
Label1(ID).FontBold = True
Load Command1(ID)
Command1(ID).Visible = True
Command1(ID).Left = Command1(ID).Width * (j - 1) + 50
Command1(ID).top = top + 50
If a(i, j) <> 0 Then
Label1(ID).Caption = a(i, j)
If a(i, j) >= 9 Then Label1(ID).BackColor = vbRed
End If
Biaoqian_color
Next j
top = Label1(0).Height * i
Next i
End Sub
Private Sub Biaoqian_color()
Select Case Label1(ID).Caption
Case 1
Label1(ID).ForeColor = QBColor(9)
Case 2
Label1(ID).ForeColor = QBColor(2)
Case 3
Label1(ID).ForeColor = QBColor(12)
Case 4
Label1(ID).ForeColor = QBColor(13)
Case 5
Label1(ID).ForeColor = QBColor(3)
Case 6
Label1(ID).ForeColor = QBColor(14)
Case 7
Label1(ID).ForeColor = QBColor(12)
Case 8
Label1(ID).ForeColor = QBColor(12)
End Select
End Sub
Private Sub Check1_Click() '背景音乐控制
If Check1.Value = 0 Then
wmp2.Controls.pause
Else
wmp2.Controls.play
End If
End Sub
Private Sub Form_Load()
Me.Icon = LoadPicture(App.Path & "\5.ico")
wmp2.URL = App.Path & "\Sundial Dreams.mp3"
wmp2.settings.setMode "loop", True
End Sub
Private Sub Label10_Click()
Unload Me
Set Form1 = Nothing
End Sub
Private Sub Label4_Click()
Bulei
JSlei
Gamestate = True
LS = 0
If Label4.Caption = "重新开始" Then
For ID = 1 To 256
Unload Label1(ID)
Unload Command1(ID)
Next ID
End If
Label4.Caption = "重新开始"
Paintmap
Gtime = 0
Timer1.Enabled = True
End Sub
Private Sub JSlei()
Dim i, j As Integer
Dim m, n As Integer
For i = LBound(a) + 1 To UBound(a) - 1
For j = LBound(a) + 1 To UBound(a) - 1
If a(i, j) >= 9 Then
For m = i - 1 To i + 1
For n = j - 1 To j + 1
a(m, n) = a(m, n) + 1
Next n
Next m
End If
Next j
Next i
For i = LBound(a) To LBound(a)
For j = LBound(a) + 1 To UBound(a) - 1
If a(i, j) >= 9 Then
For m = i To i + 1
For n = j - 1 To j + 1
a(m, n) = a(m, n) + 1
Next n
Next m
End If
Next j
Next i
For i = UBound(a) To UBound(a)
For j = LBound(a) + 1 To UBound(a) - 1
If a(i, j) >= 9 Then
For m = i - 1 To i
For n = j - 1 To j + 1
a(m, n) = a(m, n) + 1
Next n
Next m
End If
Next j
Next i
For i = LBound(a) + 1 To UBound(a) - 1
For j = LBound(a) To LBound(a)
If a(i, j) >= 9 Then
For m = i - 1 To i + 1
For n = j To j + 1
a(m, n) = a(m, n) + 1
Next n
Next m
End If
Next j
Next i
For i = LBound(a) + 1 To UBound(a) - 1
For j = UBound(a) To UBound(a)
If a(i, j) >= 9 Then
For m = i - 1 To i + 1
For n = j - 1 To j
a(m, n) = a(m, n) + 1
Next n
Next m
End If
Next j
Next i
If a(1, 1) >= 9 Then
a(1, 2) = a(1, 2) + 1
a(2, 1) = a(2, 1) + 1
a(2, 2) = a(2, 2) + 1
End If
If a(1, 16) >= 9 Then
a(1, 15) = a(1, 15) + 1
a(2, 15) = a(2, 15) + 1
a(2, 16) = a(2, 16) + 1
End If
If a(16, 1) >= 9 Then
a(15, 1) = a(15, 1) + 1
a(15, 2) = a(15, 2) + 1
a(16, 2) = a(16, 2) + 1
End If
If a(16, 16) >= 9 Then
a(15, 15) = a(15, 15) + 1
a(15, 16) = a(15, 16) + 1
a(16, 15) = a(16, 15) + 1
End If
End Sub
Private Sub Timer1_Timer()
If Gamestate = True Then
Gtime = Gtime + 1
Else
Timer1.Enabled = False
End If
Label3.Caption = Gtime & "秒"
End Sub
2017年03月22日 11点03分
1

Option ExplicitOption Base 1
Dim a(16, 16) As Integer
Dim LS As Integer
Dim ID As Integer
Dim Gamestate As Boolean
Dim Gtime As Integer
Dim ZD_YLS As Integer
Dim zdyls As String
Private Sub Bulei()
Dim i, j As Integer
For i = 1 To 16
For j = 1 To 16
a(i, j) = 0
Next j
Next i
Do While (1)
zdyls = InputBox("输入雷的数量,雷的数量最多60,再多了开发者觉得你就玩不转了,哈哈", "自定义雷数", "")
If Not zdyls = "" And Int(Val(zdyls)) <= 60 Then
Exit Do
End If
Loop
Label7.Caption = zdyls
Dim X, Y As Integer
Do While LS < zdyls
cc:
Randomize
X = Int(Rnd * 16) + 1
Y = Int(Rnd * 16) + 1
If a(X, Y) = 9 Then GoTo cc
a(X, Y) = 9
LS = LS + 1
Loop
End Sub
Private Sub seek_kongge(ByVal i As Integer, ByVal j As Integer)
Dim m, n As Integer
Dim s, d As Integer
If i > 1 And i < 16 And j > 1 And j < 16 Then
For m = i - 1 To i + 1
For n = j - 1 To j + 1
If a(m, n) < 9 Then
Command1((m - 1) * 16 + n).Visible = False
Command1((m - 1) * 16 + n).Caption = 1
End If
Next n
Next m
End If
a(i, j) = 1
If i > 1 And i < 16 And j > 1 And j < 16 Then
For s = i - 1 To i + 1
For d = j - 1 To j + 1
If a(s, d) = 0 Then
Call seek_kongge(s, d)
End If
Next d
Next s
End If
End Sub
Private Sub Command1_MouseDown(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Gamestate = False Then Exit Sub
If Check2.Value = 1 Then
wmp1.URL = App.Path & "\button33.wav"
wmp1.Controls.play
End If
If Button = 1 Then
Dim i, j As Integer
For i = 1 To 16
For j = 1 To 16
If index = (i - 1) * 16 + j Then
If a(i, j) < 9 Then
Command1(index).Visible = False
Command1(index).Caption = 1
Else
Command1(index).Picture = LoadPicture(App.Path & "\1.ico")
Call Gameover
End If
If a(i, j) = 0 Then
Call seek_kongge(i, j)
End If
End If
Next j
Next i
End If
win
Dim Have_picture As Boolean
If Button = 2 Then
If Have_picture = False Then
Command1(index).Picture = LoadPicture(App.Path & "\0.ico")
Have_picture = True
ElseIf Have_picture = True Then
Command1(index).Picture = LoadPicture("")
Have_picture = False
End If
End If
End Sub
Private Sub win()
Dim i, j, k As Integer
For i = 1 To 256
If Command1(i).Visible = True And IsNumeric(Command1(i).Caption) = False Then
k = k + 1
End If
Next i
If k = zdyls Then
wmp1.URL = App.Path & "\cartoon34.wav"
wmp1.Controls.play
MsgBox "恭喜过关", vbOKOnly, "胜利"
Gamestate = False
End If
End Sub
Private Sub Gameover()
wmp1.URL = App.Path & "\cartoon15.wav"
wmp1.Controls.play
MsgBox "你踩到雷了,Game Over", vbOKOnly, "游戏结束"
Gamestate = False
End Sub
Private Sub Paintmap()
Dim i, j As Integer
Dim top As Integer
For i = 1 To 16
For j = 1 To 16
ID = (i - 1) * 16 + j
Load Label1(ID)
Label1(ID).Visible = True
Label1(ID).BackColor = QBColor(10)
Label1(ID).Left = Label1(0).Width * (j - 1) + 50
Label1(ID).top = top + 50
Label1(ID).FontSize = 14
Label1(ID).FontBold = True
Load Command1(ID)
Command1(ID).Visible = True
Command1(ID).Left = Command1(ID).Width * (j - 1) + 50
Command1(ID).top = top + 50
If a(i, j) <> 0 Then
Label1(ID).Caption = a(i, j)
If a(i, j) >= 9 Then Label1(ID).BackColor = vbRed
End If
Biaoqian_color
Next j
top = Label1(0).Height * i
Next i
End Sub
Private Sub Biaoqian_color()
Select Case Label1(ID).Caption
Case 1
Label1(ID).ForeColor = QBColor(9)
Case 2
Label1(ID).ForeColor = QBColor(2)
Case 3
Label1(ID).ForeColor = QBColor(12)
Case 4
Label1(ID).ForeColor = QBColor(13)
Case 5
Label1(ID).ForeColor = QBColor(3)
Case 6
Label1(ID).ForeColor = QBColor(14)
Case 7
Label1(ID).ForeColor = QBColor(12)
Case 8
Label1(ID).ForeColor = QBColor(12)
End Select
End Sub
Private Sub Check1_Click() '背景音乐控制
If Check1.Value = 0 Then
wmp2.Controls.pause
Else
wmp2.Controls.play
End If
End Sub
Private Sub Form_Load()
Me.Icon = LoadPicture(App.Path & "\5.ico")
wmp2.URL = App.Path & "\Sundial Dreams.mp3"
wmp2.settings.setMode "loop", True
End Sub
Private Sub Label10_Click()
Unload Me
Set Form1 = Nothing
End Sub
Private Sub Label4_Click()
Bulei
JSlei
Gamestate = True
LS = 0
If Label4.Caption = "重新开始" Then
For ID = 1 To 256
Unload Label1(ID)
Unload Command1(ID)
Next ID
End If
Label4.Caption = "重新开始"
Paintmap
Gtime = 0
Timer1.Enabled = True
End Sub
Private Sub JSlei()
Dim i, j As Integer
Dim m, n As Integer
For i = LBound(a) + 1 To UBound(a) - 1
For j = LBound(a) + 1 To UBound(a) - 1
If a(i, j) >= 9 Then
For m = i - 1 To i + 1
For n = j - 1 To j + 1
a(m, n) = a(m, n) + 1
Next n
Next m
End If
Next j
Next i
For i = LBound(a) To LBound(a)
For j = LBound(a) + 1 To UBound(a) - 1
If a(i, j) >= 9 Then
For m = i To i + 1
For n = j - 1 To j + 1
a(m, n) = a(m, n) + 1
Next n
Next m
End If
Next j
Next i
For i = UBound(a) To UBound(a)
For j = LBound(a) + 1 To UBound(a) - 1
If a(i, j) >= 9 Then
For m = i - 1 To i
For n = j - 1 To j + 1
a(m, n) = a(m, n) + 1
Next n
Next m
End If
Next j
Next i
For i = LBound(a) + 1 To UBound(a) - 1
For j = LBound(a) To LBound(a)
If a(i, j) >= 9 Then
For m = i - 1 To i + 1
For n = j To j + 1
a(m, n) = a(m, n) + 1
Next n
Next m
End If
Next j
Next i
For i = LBound(a) + 1 To UBound(a) - 1
For j = UBound(a) To UBound(a)
If a(i, j) >= 9 Then
For m = i - 1 To i + 1
For n = j - 1 To j
a(m, n) = a(m, n) + 1
Next n
Next m
End If
Next j
Next i
If a(1, 1) >= 9 Then
a(1, 2) = a(1, 2) + 1
a(2, 1) = a(2, 1) + 1
a(2, 2) = a(2, 2) + 1
End If
If a(1, 16) >= 9 Then
a(1, 15) = a(1, 15) + 1
a(2, 15) = a(2, 15) + 1
a(2, 16) = a(2, 16) + 1
End If
If a(16, 1) >= 9 Then
a(15, 1) = a(15, 1) + 1
a(15, 2) = a(15, 2) + 1
a(16, 2) = a(16, 2) + 1
End If
If a(16, 16) >= 9 Then
a(15, 15) = a(15, 15) + 1
a(15, 16) = a(15, 16) + 1
a(16, 15) = a(16, 15) + 1
End If
End Sub
Private Sub Timer1_Timer()
If Gamestate = True Then
Gtime = Gtime + 1
Else
Timer1.Enabled = False
End If
Label3.Caption = Gtime & "秒"
End Sub