📄 text1.txt
字号:
Public Sub InputStaticNumber()
Dim Tmp1, Tmp2 As Integer
Randomize
'初始化三维数组
For i = 1 To 30
For j = 1 To 16
'用于记录地雷的数目和雷的位置
NumLTBob(i, j, 0) = 0
'用于记录按钮显示的状况
NumLTBob(i, j, 1) = 0
Next j
Next i
i = 0
'为三维数组添加99颗雷的标记；
While i <> NumOfBob
Tmp1 = Int(30 * Rnd()) + 1
Tmp2 = Int(16 * Rnd()) + 1
If NumLTBob(Tmp1, Tmp2, 0) <> -1 Then
'标记地雷(随机执行)
NumLTBob(Tmp1, Tmp2, 0) = -1
i = i + 1
End If
Wend
'计算地雷周围的数字
For i = 1 To 30
For j = 1 To 16
If NumLTBob(i, j, 0) <> -1 Then
If NumLTBob(i - 1, j, 0) = -1 Then NumLTBob(i, j, 0) = NumLTBob(i, j, 0) + 1
If NumLTBob(i + 1, j, 0) = -1 Then NumLTBob(i, j, 0) = NumLTBob(i, j, 0) + 1
If NumLTBob(i, j - 1, 0) = -1 Then NumLTBob(i, j, 0) = NumLTBob(i, j, 0) + 1
If NumLTBob(i, j + 1, 0) = -1 Then NumLTBob(i, j, 0) = NumLTBob(i, j, 0) + 1
If NumLTBob(i - 1, j - 1, 0) = -1 Then NumLTBob(i, j, 0) = NumLTBob(i, j, 0) + 1
If NumLTBob(i + 1, j - 1, 0) = -1 Then NumLTBob(i, j, 0) = NumLTBob(i, j, 0) + 1
If NumLTBob(i - 1, j + 1, 0) = -1 Then NumLTBob(i, j, 0) = NumLTBob(i, j, 0) + 1
If NumLTBob(i + 1, j + 1, 0) = -1 Then NumLTBob(i, j, 0) = NumLTBob(i, j, 0) + 1
End If
Next j
Next i
End Sub
Public Sub FrmMouseDown(ByVal x As Integer, ByVal y As Integer, Optional Button As Integer = 1)
With FrmClear
If x >= 1 And x <= 30 And y >= 1 And y <= 16 Then
If Button = 1 And NumLTBob(x, y, 1) = 0 Then
If NumLTBob(x, y, 0) >= 1 And NumLTBob(x, y, 0) <= 8 Then
'显示数字
BitBlt .hDC, (x - 1) * PicV.dx + 12, (y - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, 0, (NumLTBob(x, y, 0) - 1) * PicV.dy, SRCCOPY
NumLTBob(x, y, 1) = -1
End If
If NumLTBob(x, y, 0) = -1 Then
'显示红雷并结束游戏
BitBlt .hDC, (x - 1) * PicV.dx + 12, (y - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 7 * PicV.dy, SRCCOPY
NumLTBob(x, y, 1) = -2
GameOver
End If
If NumLTBob(x, y, 0) = 0 Then
'显示空白并递归所有相连的空白
BitBlt .hDC, (x - 1) * PicV.dx + 12, (y - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 1 * PicV.dy, SRCCOPY
NumLTBob(x, y, 1) = -1
'递归查找
FindBlank x, y
End If
End If
If Button = 2 Then
Select Case NumLTBob(x, y, 1)
Case 0
'插上红旗
BitBlt .hDC, (x - 1) * PicV.dx + 12, (y - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 4 * PicV.dy, SRCCOPY
NumLTBob(x, y, 1) = 1
Case 1
'打上标记
BitBlt .hDC, (x - 1) * PicV.dx + 12, (y - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 5 * PicV.dy, SRCCOPY
NumLTBob(x, y, 1) = 2
Case 2
'还原按钮
BitBlt .hDC, (x - 1) * PicV.dx + 12, (y - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 0 * PicV.dy, SRCCOPY
NumLTBob(x, y, 1) = 0
End Select
End If
End If
End With
End Sub
Public Sub FindBlank(ByVal i As Integer, ByVal j As Integer)
'递归函数,用于查找空白地
If i >= 1 And i <= 30 And j >= 1 And j <= 16 Then
FrmMouseDown i - 1, j - 1
FrmMouseDown i - 1, j
FrmMouseDown i - 1, j + 1
FrmMouseDown i, j + 1
FrmMouseDown i, j - 1
FrmMouseDown i + 1, j - 1
FrmMouseDown i + 1, j
FrmMouseDown i + 1, j + 1
End If
End Sub
Public Sub RefFrmClear()
'窗体刷新时回复原来的战况
With FrmClear
For i = 1 To 30
For j = 1 To 16
If NumLTBob(i, j, 1) = -1 Then
If NumLTBob(i, j, 0) >= 1 And NumLTBob(i, j, 0) <= 8 Then
BitBlt .hDC, (i - 1) * PicV.dx + 12, (j - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, 0, (NumLTBob(i, j, 0) - 1) * PicV.dy, SRCCOPY
End If
If NumLTBob(i, j, 0) = -1 Then
BitBlt .hDC, (i - 1) * PicV.dx + 12, (j - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 6 * PicV.dy, SRCCOPY
End If
If NumLTBob(i, j, 0) = 0 Then
BitBlt .hDC, (i - 1) * PicV.dx + 12, (j - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 1 * PicV.dy, SRCCOPY
End If
End If
If NumLTBob(i, j, 0) = -1 And NumLTBob(i, j, 1) = -2 Then
BitBlt .hDC, (i - 1) * PicV.dx + 12, (j - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 7 * PicV.dy, SRCCOPY
End If
Next j
Next i
End With
End Sub
Public Sub GameOver()
'游戏结束,显示尚未挖掘的地雷
With FrmClear
For i = 1 To 30
For j = 1 To 16
If NumLTBob(i, j, 1) = 0 And NumLTBob(i, j, 0) = -1 Then
BitBlt .hDC, (i - 1) * PicV.dx + 12, (j - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 6 * PicV.dy, SRCCOPY
End If
NumLTBob(i, j, 1) = -1
Next j
Next i
'画上哭泣的脸
BitBlt .hDC, 240, 15, PicV.FaceDx, PicV.FaceDy, .PicFace.hDC, 0, 1 * PicV.FaceDy, SRCCOPY
End With
End Sub
Public Sub ShowMeABob(ByVal i As Integer, ByVal j As Integer)
Dim Num As Integer
Num = 0
If NumLTBob(i - 1, j - 1, 1) = 1 Then Num = Num + 1
If NumLTBob(i - 1, j, 1) = 1 Then Num = Num + 1
If NumLTBob(i - 1, j + 1, 1) = 1 Then Num = Num + 1
If NumLTBob(i, j - 1, 1) = 1 Then Num = Num + 1
If NumLTBob(i, j + 1, 1) = 1 Then Num = Num + 1
If NumLTBob(i + 1, j - 1, 1) = 1 Then Num = Num + 1
If NumLTBob(i + 1, j, 1) = 1 Then Num = Num + 1
If NumLTBob(i + 1, j + 1, 1) = 1 Then Num = Num + 1
If NumLTBob(i, j, 0) <= Num Then
FrmMouseDown i - 1, j - 1
FrmMouseDown i - 1, j
FrmMouseDown i - 1, j + 1
FrmMouseDown i, j + 1
FrmMouseDown i, j - 1
FrmMouseDown i + 1, j - 1
FrmMouseDown i + 1, j
FrmMouseDown i + 1, j + 1
Else
With FrmClear
If NumLTBob(i - 1, j - 1, 1) = 0 And (i - 1 >= 1 And i - 1 <= 30 And j - 1 >= 1 And j - 1 <= 16) Then BitBlt .hDC, (i - 1 - 1) * PicV.dx + 12, (j - 1 - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 1 * PicV.dy, SRCCOPY
If NumLTBob(i - 1, j, 1) = 0 And (i - 1 >= 1 And i - 1 <= 30 And j >= 1 And j <= 16) Then BitBlt .hDC, (i - 1 - 1) * PicV.dx + 12, (j - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 1 * PicV.dy, SRCCOPY
If NumLTBob(i - 1, j + 1, 1) = 0 And (i - 1 >= 1 And i - 1 <= 30 And j + 1 >= 1 And j + 1 <= 16) Then BitBlt .hDC, (i - 1 - 1) * PicV.dx + 12, (j + 1 - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 1 * PicV.dy, SRCCOPY
If NumLTBob(i, j - 1, 1) = 0 And (i >= 1 And i <= 30 And j - 1 >= 1 And j - 1 <= 16) Then BitBlt .hDC, (i - 1) * PicV.dx + 12, (j - 1 - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 1 * PicV.dy, SRCCOPY
If NumLTBob(i, j + 1, 1) = 0 And (i >= 1 And i <= 30 And j + 1 >= 1 And j + 1 <= 16) Then BitBlt .hDC, (i - 1) * PicV.dx + 12, (j - 1 + 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 1 * PicV.dy, SRCCOPY
If NumLTBob(i + 1, j - 1, 1) = 0 And (i + 1 >= 1 And i + 1 <= 30 And j - 1 >= 1 And j - 1 <= 16) Then BitBlt .hDC, (i + 1 - 1) * PicV.dx + 12, (j - 1 - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 1 * PicV.dy, SRCCOPY
If NumLTBob(i + 1, j, 1) = 0 And (i + 1 >= 1 And i + 1 <= 30 And j >= 1 And j <= 16) Then BitBlt .hDC, (i + 1 - 1) * PicV.dx + 12, (j - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 1 * PicV.dy, SRCCOPY
If NumLTBob(i + 1, j + 1, 1) = 0 And (i + 1 >= 1 And i + 1 <= 30 And j + 1 >= 1 And j + 1 <= 16) Then BitBlt .hDC, (i + 1 - 1) * PicV.dx + 12, (j + 1 - 1) * PicV.dy + 55, PicV.dx, PicV.dy, .Pic.hDC, PicV.dx, 1 * PicV.dy, SRCCOPY
End With
End If
End Sub ⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -