面向对象的方法在游戏中的应用的一个例子（下）(转)[@more@]

　　' 准备开始一盘新游戏

　　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 < mintRows

　　blnDx = intX + c >= 0 And intX + c < mintCols

　　

　　'如果没有出有效的地雷分布区

　　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 < 0 Then

　　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