' 准备开始一盘新游戏
mblnNewGame = True
Dim CRLF As String
CRLF = Chr$(13) & Chr$(10)
' 对话框提示"你输了!"
MsgBox "你输了!", vbExclamation, "扫雷"
Case Else:
' 如果这个方格的周围有一个或更多的方格中包含地雷,那么显示它周围包含的地理数
mfrmDisplay.PaintPicture mfrmDisplay.imgPressed, mintCol, mintRow
mfrmDisplay.CurrentX = mintCol
mfrmDisplay.CurrentY = mintRow
mfrmDisplay.ForeColor = QBColor(mbytMineStatus(intY, intX))
mfrmDisplay.Print mbytMineStatus(intY, intX)
' 并且标记这个位置已经被打开
mbytMineStatus(intY, intX) = mbytMineStatus(intY, intX) + BEEN
End Select
End If
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' '
' 说明: 当这个窗体旧的对象的显示尺寸被赋予新的属性值时,过程被调用该过程在主显示窗体被载入时被调用
'
' 输入参数 : frmDisplay: 旧的主显示窗体对象 '
' '
' 输出参数: 无 '
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Property Set frmDisplay(frmDisplay As Form)
' Property 表示为一个类的属性,属性名为frmDisplay
Set mfrmDisplay = frmDisplay
mfrmDisplay.FontBold = True
' 按游戏中设置的尺度和雷数,来从新确定主窗体的大小
ResizeDisplay
End Property
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' '
' 说明: 将当前游戏中设定的游戏级别的地雷分布的行数 、列数以及地雷数显示在自定义对话框的文本框中
'
' 输入参数 : frmDisplay: 旧的主显示窗体对象 '
' '
' 输出参数: 无 '
' '
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Sub GetMineFieldDimensions(frmDialog As Form)
' 得到当前游戏中设定的游戏级别的地雷分布的行数 、列数以及地雷数
frmDialog.txtRows = mintRows
frmDialog.txtColumns = mintCols
frmDialog.txtMines = mbytNumMines
' 将其高亮显示在自定义对话框的文本框中
frmDialog.txtRows.SelLength = Len(frmDialog.txtRows)
frmDialog.txtColumns.SelLength = Len(frmDialog.txtColumns)
frmDialog.txtMines.SelLength = Len(frmDialog.txtMines)
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' '
' 说明: 按当前游戏中设定的地雷游戏的尺寸,动态的分配数组大小,并且随机分配地雷分布的区域
' 输入参数: 无 '
' 输出参数: 无
'
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Private Sub InitializeMineField()
' 按设置的行列数及雷数,设置二维动态数组中的大小
ReDim mbytMineStatus(mintRows - 1, mintCols - 1)
ReDim mbytMarked(mintRows - 1, mintCols - 1)
ReDim mbytMineLocations(mbytNumMines - 1, 1)
'在地雷分布区中产生随机的地雷位置,并将其存放在mbytMineLocations数组中
'并且用包含地雷的位置及其周围包含的地雷数填充mbytMineStatus数组
Randomize
Dim i As Integer '循环数
Dim r As Integer '循环数
Dim c As Integer '循环数
For i = 0 To mbytNumMines - 1
Dim intX As Integer
Dim intY As Integer
intX = Int(Rnd * mintCols)
intY = Int(Rnd * mintRows)
'如果得到的位置的状态为有雷,那么从新分配
While mbytMineStatus(intY, intX) = MINE
intX = Int(Rnd * mintCols)
intY = Int(Rnd * mintRows)
Wend
'将得到的位置的状态标记为有地雷
mbytMineStatus(intY, intX) = MINE
'将这个位置存放在二维数组中
mbytMineLocations(i, 0) = intY
mbytMineLocations(i, 1) = intX
'找到当前位置的周围8个位置,并判断在没有出地雷分布区时,这8个位置的状态,只要每有地雷分布,就将他们的状态加1,也就是将它标记为无雷
For r = -1 To 1
For c = -1 To 1
Dim blnDx As Boolean
Dim blnDy As Boolean
'找它的周围8个位置,看是否出了有效的地雷分布区
blnDy = intY + r = 0 And intY + r
blnDx = intX + c = 0 And intX + c
'如果没有出有效的地雷分布区
If blnDy And blnDx Then
'判断他们的状态是否有地雷分布
If mbytMineStatus(intY + r, intX + c) MINE Then
'如果没有地雷分布,那么将它的状态加1 ( 即设为无雷),并存放在mbytMineStatus中
mbytMineStatus(intY + r, intX + c) = mbytMineStatus(intY + r, intX + c) + 1
End If
End If
Next
Next
Next
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' '
' 说明: 开始一盘新的游戏
'
' 输入参数: 无 '
'
' 输出参数: 无 '
' '
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Sub NewGame()
' 清除再主窗体中的显示
mfrmDisplay.Cls
' 从新设置游戏中的变量和标志位
mbytCorrectHits = 0
mbytTotalHits = 0
mintRow = -1
mintCol = -1
mblnNewGame = False
mblnHitTestBegun = False
Dim i As Integer '循环数
' 清空错误标记地雷的mcolWrongLocations集合
For i = 1 To mcolWrongLocations.Count
mcolWrongLocations.Remove 1
Next
'从新计算新的地雷分布区域
InitializeMineField
' 从新设置主窗体中最下面的剩余地雷数
mfrmDisplay.lblMinesLeft = "剩余地雷数 : " & mbytNumMines
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' '
' 说明：如果这个方格被点击，并且其中不含有地雷，那么这个过程将打开所有的它周围的方格，直到遇到包含地雷的方格为止，这里使用了一种算法，有兴趣可以研究一下，首先从点击的方格位置开始，一直向左查找，直到遇到一个不为空的包含地雷的方格为止，此时以前一个扫描的方格位置为中心，顺时针查找它周围的方格是否含有地雷，从而勾画出没有地雷的方格的边缘，并存储边缘地雷的位置的x周坐标
'
' 函数的输入参数: inX: 记录鼠标键被点击的位置在X轴上的坐标 '
' inY: 记录鼠标键被点击的位置在Y轴上的坐标
' '
' 返回值: 无
' '
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Private Sub OpenBlanks(ByVal intX As Single, ByVal intY As Single)
' 定义四个布尔型变量，用来保存查找动作的移动方向
Dim blnGoUp As Boolean
Dim blnGoRight As Boolean
Dim blnGoDown As Boolean
Dim blnGoLeft As Boolean
' the border starts
' 用来保存查找动作的移动位置的X ， Y轴坐标
Dim intXStart As Integer
Dim intYStart As Integer
' 集合队列中的位置索引
Dim intPos As Integer
' 循环计数值
Dim element As Variant
' 循环计数值
Dim y As Integer
Dim x As Integer
Dim i As Integer
'一个动态的整型数组集合.其中每一个元素存放扫描行的起始和终止的方格的x轴坐标位置。通过这个数值可以得到没有包含地雷的位置边缘
Dim colX() As New Collection
'设定这个数组的大小和地雷分布区域的行数相同
ReDim colX(mintRows - 1)
'一直向左搜索,直到找到一个空的不包含地雷的位置
While mbytMineStatus(intY, intX) = NONE
intX = intX - 1
If intX
intX = 0
intXStart = intX
intYStart = intY
GoTo LFT
End If
Wend
' first direction to go is up
' 首先是向上搜索
blnGoUp = True
' store this first non-empty mine location as the s
