* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
' '扫雷游戏总的工程介绍 '
' '
' 这个游戏中我们主要通过类的使用，看看在ｖｂ中ｏｏｐ的使用方法。其中主要的文件及其主要作用如下所示： '
' '
' winmine . cls: 这是一个类模块，其中实现了游戏中主要的功能 '
' '
' winmine . frm: 这是游戏显示得主窗口，她是一个和玩家进行互动娱乐的主要界面接口，并且它也显示了winmine . cls 类的实例在游戏中的运用方法 '
' '
' cords . cls: 这是另一个类模块,这里主要是用来标记被错误标记的地雷的x , y坐标位置
' '
' custdlg . frm: 这是一个自定义游戏水平级别的窗体,当点击游戏显示主窗体中的自定义菜单时候,该对话框会以模式状态显示,所以必须做出选择,否则不能回到游戏现实主窗口进行游戏'
' '
' instruct . frm: 这是一个窗体文件,当F1键被按下时,该窗口显示出来,用来显示游戏规则和对玩法
' 进行指导, '
' '
' about . frm 这也是一个窗体文件,用来显示一些相关信息等等' '
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
在coords.cls类模块中定义的两个变量
'定义了一个对象用来保存被错误标记的地雷的x , y轴坐标
Public mintX As Integer
Public mintY As Integer
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
在winmine. cls类模块中建立一个类来方便对扫雷游戏的控制:
Option Explicit
'定义鼠标左键,同VB中的定义常数vbKeyLButton ,值都为1
Private Const LEFT_BUTTON As Byte = 1
'标记一个方格是否为空的标志
Private Const NONE As Byte = 0
'标记一个方格是否为一个带雷的方格
Private Const MINE As Byte = 243
'标记一个方格是否被点开
Private Const BEEN As Byte = 244
'标记一个方格是否已经被标记为一个带雷的方格
Private Const FLAGGED As Byte = 2
'标记一个方格是否被标记为一个问号,即一个存有疑问,不能确定的方格
Private Const QUESTION As Byte = 1
'定义扫雷游戏中最大和最小的地雷地图的行数和列数及其地雷个数
Private Const MIN_MINES As Byte = 10
'最小的地雷数
Private Const MIN_ROWS As Integer = 8
Private Const MIN_COLS As Integer = 8
'最小的地图行数列数
Private Const MAX_MINES As Byte = 99
'最大的地雷数
Private Const MAX_ROWS As Integer = 24
Private Const MAX_COLS As Integer = 36
'最大的地图行数列数
'设定每个方格的宽度为16个象素
Private Const mintButtonWidth As Byte = 16
'设定每个方格的宽度为16个像素
Private Const mintButtonHeight As Byte = 16
'记录当前游戏的玩家的水平
Private mbytNumMines As Byte
'记录在当前游戏中,被玩家正确标志出来的地雷的个数
Private mbytCorrectHits As Byte
'记录在当前游戏中,被玩家标志出来的地雷的个数,包括被错误标记的
Private mbytTotalHits As Byte
'记录在当前游戏中,游戏被设定的行数和列数
Private mintRows As Integer
Private mintCols As Integer
' 记录在游戏中由玩家点击鼠标的位置,而确定的点击的方块的行数和列数
Private mintRow As Integer
Private mintCol As Integer
'是否开始一盘新游戏的标志
Public mblnNewGame As Boolean
'在正在进行的游戏中，鼠标点击事件的标志
Private mblnHitTestBegun As Boolean
'定义游戏显示的主窗体
Private mfrmDisplay As Form
' 定义一个动态的二维数组，用来保存包含地雷的方格的位置，以及那一个位置的周围有没有地雷，有多少地雷
Private mbytMineStatus() As Byte
'其中定义一个动态的二维数组,用来保存被标记过的方格的位置,不管这个标记是否标记正确
Private mbytMarked() As Byte
'定义一个动态的二维数组，用来保存在分布的地雷区域所有分布的地雷总数的ｘ，ｙ中的坐标位置
Private mbytMineLocations() As Byte
' 定义一个集合，用来存放clsCoords类对象的ｘ ，ｙ轴坐标位置，他们指示着游戏中被标记错误的方格的位置
Private mcolWrongLocations As New Collection
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' '
' 作用: 判定那一个鼠标键被点击,以及在窗体中点击的位置,从而判断游戏玩家的行为
再主窗体显示区中的鼠标按下事件中被调用
' 函数的输入参数: intButton: 表示哪一个鼠标键被点击(左键或者右键以及中键)
' inX: 记录鼠标键被点击的位置在X轴上的坐标 '
' inY: 记录鼠标键被点击的位置在Y轴上的坐标
' 返回值: 无
'
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Sub BeginHitTest ( intButton As Integer , intX As Single , intY As Single )
'如果mblnNewGame值为真,表示新的一局游戏开始的标志,所以当前游戏被结束,并且开始一局新游戏, mblnNewGame 变量在前面有定义
If mblnNewGame Then
NewGame ' 调用此函数开始一局新游戏
End If
' 如果游戏正在进行,那么设置mblnHitTestBegun的值为真,表示鼠标点击事件的开始
mblnHitTestBegun = True
'判定鼠标点击的位置, mintButtonWidth和mintButtonHeight在前面的定义中,定义为每一个方格的宽度和高度,用得到的鼠标点击位置除以方格的宽高,取整後就可以得到鼠标点击了哪一个方格,既第几行第几列中的方格
intX = Int(intX / mintButtonWidth)
intY = Int(intY / mintButtonHeight)
'如果点击的位置超出了设定的游戏的窗口范围,那么退出此过程,也就是不做任何动作
If intX >= mintCols Or intY >= mintRows Or intX < 0 Or intY < 0 Then
'如果鼠标点击的位置的X轴大于游戏有效窗口的行数,
'或者鼠标点击的位置的Y轴大于游戏有效窗口的列数,
'或者鼠标点击的位置的X轴小于游戏有效窗口的的最小位置,
'或者鼠标点击的位置的Y轴小于游戏有效窗口的的最小位置,
'可以断定鼠标点击的位置已经超出了游戏的有效窗口
'所以退出此过程,也就是什么动作都不进行
Exit Sub
End If
' intX * mintButtonWidth从新的到鼠标在窗口中的位置坐标的X轴,并赋值给mintCol变量
' intY * mintButtonHeight从新的到鼠标在窗口中的位置坐标的X轴,并赋值给mintCol变量
mintCol = intX * mintButtonWidth
mintRow = intY * mintButtonHeight
' 调用mbytMineStatus ( ) 函数,判断鼠标点击位置X , Y 的状态,如果这个方格已被点开,
' 那么退出该过程, 即什么动作都不发生
If mbytMineStatus(intY, intX) >= BEEN Then Exit Sub
'定义一个此过程中的变量blnLeftDown,从而记录鼠标左键是否按下
Dim blnLeftDown As Boolean
'用得到的鼠标点击键与定义的常数相与,如果大于0,那么将blnLeftDown 赋值为真,
'说明按下的是鼠标左键,当然也可以用数值判断,将下面的语句改为
'blnLeftDown = (intButton - LEFT_BUTTON) > 0
'或者再和后面的
'blnLeftDown = (intButton And LEFT_BUTTON) > 0
'If blnLeftDown Then 这两句合并为
'If intButton = 1 then
blnLeftDown = (intButton And LEFT_BUTTON) > 0
'如果鼠标左键被点击
If blnLeftDown Then
'调用mbytMarked(intY, intX) 函数判断鼠标是否被标记为有雷
'如果返回值大于等于 2 (即 FLAGGED ),说明已经被标志,不做任何动作,退出此过程
If mbytMarked(intY, intX) >= FLAGGED Then Exit Sub
'调用mbytMarked(intY, intX) 函数判断鼠标是否被标记为问号,即不能确定
'如果返回值等于 1 (即 QUESTION ),说明已经被标志为问号,
'那么在原来的位置上显示 方块被按下的图片
If mbytMarked(intY, intX) = QUESTION Then
mfrmDisplay.imgPressed.Visible = False
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgQsPressed.Left = mintCol
mfrmDisplay.imgQsPressed.Top = mintRow
mfrmDisplay.imgQsPressed.Visible = True
Else
'调用mbytMarked(intY, intX) 函数判断鼠标是否被标记为问号,即不能确定
'如果返回值不等于 1 (即 QUESTION ),说明没有被标志,
'那么在原来的位置上显示 方块被按下的图片
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgPressed.Visible = False
mfrmDisplay.imgPressed.Left = mintCol
mfrmDisplay.imgPressed.Top = mintRow
mfrmDisplay.imgPressed.Visible = True
End If
Else
' 如果按下的是鼠标右键
Dim Msg As String
Dim CRLF As String
CRLF = Chr$(13) & Chr$(10)
Select Case mbytMarked(intY, intX)
'调用mbytMarked(intY, intX) 函数判断鼠标是否被标记
Case NONE:
'如果返回值大于等于 0 (即 NONE ),那么说明这里为一个空标志位
If mbytTotalHits = mbytNumMines Then
'如果该游戏中的所有雷数等于所标记为有雷的标记数
'那么对话框提示玩家不能再标记更多的有雷标志了
Msg = "不能再标记更多的有雷标志了" & CRLF
Msg = Msg & "有一个或更多的位置被错误的标志为有雷" & CRLF
Msg = Msg & "不能再用右键标志更多的雷了."
MsgBox Msg , vbCritical , "扫雷:错误"
Exit Sub ' 退出该过程
End If
'如果还可以标志雷,那么在鼠标点击的位置显示相应的有雷标志
mfrmDisplay.PaintPicture mfrmDisplay.imgFlag, mintCol, mintRow
'之后,将记录所标记地雷数量的个数加1
mbytTotalHits = mbytTotalHits + 1
' mbytNumMines – mbytTotalHits表示总的地雷数量减去已经标志
'为有地雷的个数,从而得到未使用的标记个数
mfrmDisplay.lblMinesLeft = "剩余地雷数 : " & mbytNumMines - mbytTotalHits
'如果鼠标点击的当前位置的状态为有雷,那么标记为有雷的正确个数加1.并且将此位置设置为已经标记过的有雷位置
If mbytMineStatus(intY, intX) = MINE Then
mbytCorrectHits = mbytCorrectHits + 1
mbytMarked(intY, intX) = FLAGGED
Else
'如果鼠标点击的当前位置的状态为无雷,即该位置被错误标记,那么定义一个用来存储所有被标记错误的地雷位置的clsCoords类的实例
Dim objCoords As New clsCoords
'在新建的clsCoords类的实例中存储被标记错误的地雷的X , Y坐标位置
objCoords.mintX = intX
objCoords.mintY = intY
'并且在集合mcolWrongLocations中新添加一个clsCoords类的实例
mcolWrongLocations.Add objCoords
'并且在mbytMarked数组中存储被错误标记方格的索引
mbytMarked(intY, intX) = mbytTotalHits - mbytCorrectHits + 2
End If
' 如果所有的地雷都被正确标记出来那么对话框提示”恭喜你!,你以经赢了!”
If mbytCorrectHits = mbytNumMines Then
Msg = "恭喜你!" & CRLF
Msg = Msg & "你已经赢了!" & CRLF
MsgBox Msg , vbInformation , "扫雷"
' 准备开始一盘新游戏
mblnNewGame = True
End If
Case QUESTION:
'如果返回值等于 1 (即 QUESTION ),那么说明这里为一个被标志为问号标志位,所以要将这个位置的状态设为NONE ,即设置为一个空的标志位
mbytMarked(intY, intX) = NONE
'在这个位置上显示正常的按钮图形
mfrmDisplay.PaintPicture mfrmDisplay.imgButton, mintCol, mintRow
Case Else:
'如果返回值为别的数值, 也就是为一个标记为地雷的状态,那么将其改为问号标志
mfrmDisplay.PaintPicture mfrmDisplay.imgQuestion, mintCol, mintRow
'并且将标记的地雷总数减1
mbytTotalHits = mbytTotalHits - 1
'显示剩余的标志个数
mfrmDisplay.lblMinesLeft = "剩余地雷数 : " & mbytNumMines - mbytTotalHits
' 如果鼠标点击的位置状态是一个地雷,那么
If mbytMineStatus(intY, intX) = MINE Then
'因为将正确的地雷标志,换为了问号标志,所以正确的标志数减1
mbytCorrectHits = mbytCorrectHits - 1
Else .
' 如果鼠标点击的位置状态不是一个地雷,也就是说开始的标记是错误的,那么修改后,为正确,所以要从错误标记表中删除这一标记
mcolWrongLocations.Remove mbytMarked(intY, intX) - 2
Dim intXwm As Integer ' 错误标记方格的x轴坐标位置
Dim intYwm As Integer '错误标记方格的y轴坐标位置
Dim i As Integer ' 循环数
'在mbytMarked数组中删除被错误标记方格的索引
For i = mbytMarked(intY, intX) - 2 To mcolWrongLocations.Count
intXwm = mcolWrongLocations(i).mintX
intYwm = mcolWrongLocations(i).mintY
mbytMarked(intYwm, intXwm) = mbytMarked(intYwm, intXwm) - 1
Next
End If
' 最後将鼠标点击位置的状态改为问号
mbytMarked(intY, intX) = QUESTION
End Select
End If
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' '
' 说明: 当鼠标被按下时,用来测定鼠标光标是在那个方格位置上经过的,从而决定产生什么动作,这个过程在游戏显示主窗口中产生鼠标弹起事件时被调用
'
' 函数的输入参数: intButton: 表示哪一个鼠标键被点击(左键或者右键以及中键)
' inX: 记录鼠标键被点击的位置在X轴上的坐标 '
' inY: 记录鼠标键被点击的位置在Y轴上的坐标
'
' 返回值: 无
'
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Sub EndHitTest(intButton As Integer, intX As Single, intY As Single)
' 如果当前正在进行的鼠标单击事件的标志mblnHitTestBegun为真
If mblnHitTestBegun Then
' 那么从新设置这个标志为假
mblnHitTestBegun = False
Else
'如果当前正在进行的鼠标单击事件的标志mblnHitTestBegun为假,那么可以断定鼠标的按下位置不是在游戏主显示窗口的合法位置,因此不做任何动作,退出该过程
Exit Sub
End If
Dim blnLeftDown As Boolean
blnLeftDown = (intButton And LEFT_BUTTON) > 0
' 如果鼠标左键被按下
If blnLeftDown Then
'判定鼠标点击的位置, mintButtonWidth和mintButtonHeight在前面的定义中,定义为每一个方格的宽度和高度,用得到的鼠标点击位置除以方格的宽高,取整後就可以得到鼠标点击了哪一个方格,既第几行第几列中的方格
intX = Int(intX / mintButtonWidth)
intY = Int(intY / mintButtonHeight)
'如果点击的位置超出了设定的游戏的窗口范围,那么退出此过程,也就是不做任何动作
If intX >= mintCols Or intY >= mintRows Or intX < 0 Or intY < 0 Then
'如果鼠标点击的位置的X轴大于游戏有效窗口的行数,
'或者鼠标点击的位置的Y轴大于游戏有效窗口的列数,
'或者鼠标点击的位置的X轴小于游戏有效窗口的的最小位置,
'或者鼠标点击的位置的Y轴小于游戏有效窗口的的最小位置,
'可以断定鼠标点击的位置已经超出了游戏的有效窗口
'所以退出此过程,也就是什么动作都不进行
Exit Sub
End If
' 如果鼠标安键动作被释放的位置上的方格已经被标记,那么什么动作都不做,退出该过程
If mbytMarked(intY, intX) >= FLAGGED Then Exit Sub
'如果鼠标安键动作被释放的位置上的方格没有被标记,那么计算鼠标光标的最后有效位置的坐标
intX = mintCol / mintButtonWidth
intY = mintRow / mintButtonHeight
'如果该坐标位置被标记为问号,那么不显示问号图标
'否则不显示鼠标按下的图标
If mbytMarked(intY, intX) = QUESTION Then
mfrmDisplay.imgQsPressed.Visible = False
Else
mfrmDisplay.imgPressed.Visible = False
End If
'判断鼠标弹起位置,方格的状态
Select Case mbytMineStatus(intY, intX)
Case Is >= BEEN:
' 如果当前位置的鼠标方格被打开,那么什么都不做,退出该过程
Exit Sub
Case NONE:
'如果当前方格的状态为空,那么打开它周围的所有空的方格
OpenBlanks intX, intY
Case MINE:
' 如果当前方格中包含地雷,那么你踩到地雷了
Dim intXm As Integer ' 地雷分布区的X坐标
Dim intYm As Integer '地雷分布区的Y坐标
Dim vntCoord As Variant ' 循环计数值
Dim i As Integer ' 循环计数值
'显示所有包含地雷的方格
For i = 0 To mbytNumMines - 1
' 在mbytMineLocations数组中取得所有包含地雷的方格的坐标
intYm = mbytMineLocations(i, 0)
intXm = mbytMineLocations(i, 1)
' 如果这个坐标位置的方格已经被标记,那么显示小旗图标
If mbytMarked(intYm, intXm) < FLAGGED Then
mfrmDisplay.PaintPicture mfrmDisplay.imgMine, intXm * mintButtonWidth, intYm * mintButtonHeight
End If
Next
' 在当前的方格中显示被踩中的地雷图标
mfrmDisplay.PaintPicture mfrmDisplay.imgBlown, mintCol, mintRow
' 显示所有被标记错误的地雷的图标(用差号)
For Each vntCoord In mcolWrongLocations
' 在mcolWrongLocations中取得被标记错误的地雷的图标位置
intYm = vntCoord.mintY
intXm = vntCoord.mintX
' 显示所有被标记错误的地雷的图标
mfrmDisplay.PaintPicture mfrmDisplay.imgWrongMine, intXm * mintButtonWidth, intYm * mintButtonHeight
Next
' 准备开始一盘新游戏
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 starting point.
'将搜索到的不包含地雷的空的位置作为一个新的开始位置保存起来,以进行一次新的搜索
intXStart = intX
intYStart = intY
'勾画出边界，直到又回到开始的位置
Do
If mbytMineStatus(intY, intX) = NONE Then
If blnGoUp Then
intX = intX - 1
intY = intY + 1
colX(intY).Remove (colX(intY).Count)
blnGoUp = False
blnGoLeft = True
ElseIf blnGoRight Then
intX = intX - 1
intY = intY - 1
blnGoRight = False
blnGoUp = True
ElseIf blnGoDown Then
intX = intX + 1
intY = intY - 1
colX(intY).Remove (colX(intY).Count)
blnGoDown = False
blnGoRight = True
ElseIf blnGoLeft Then
intX = intX + 1
intY = intY + 1
blnGoLeft = False
blnGoDown = True
End If
If (intXStart = intX And intYStart = intY) Then Exit Do
Else
If blnGoUp Then
colX(intY).Add intX
If mbytMineStatus(intY, intX + 1) = NONE Then
If intY = 0 Then
blnGoUp = False
UP: intX = intX + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
While mbytMineStatus(intY, intX) = NONE
If intX = mintCols - 1 Then GoTo RIGHT
intX = intX + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
Wend
blnGoDown = True
Else
intY = intY - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
Else
blnGoUp = False
blnGoRight = True
intX = intX + 1
If (intXStart = intX And intYStart = intY) Then
If colX(intY).Count Mod 2 <> 0 Then
intPos = 1
For Each element In colX(intY)
If element = intXStart Then
colX(intY).Remove (intPos)
Exit Do
End If
intPos = intPos + 1
Next
End If
Exit Do
End If
End If
ElseIf blnGoRight Then
If mbytMineStatus(intY + 1, intX) = NONE Then
If intX = mintCols - 1 Then
blnGoRight = False
RIGHT: colX(intY).Add intX
intY = intY + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
While mbytMineStatus(intY, intX) = NONE
colX(intY).Add intX
If intY = mintRows - 1 Then GoTo DOWN
intY = intY + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
Wend
colX(intY).Add intX
blnGoLeft = True
Else
intX = intX + 1
If (intXStart = intX And intYStart = intY) Then
If colX(intY).Count Mod 2 <> 0 Then
intPos = 1
For Each element In colX(intY)
If element = intXStart Then
colX(intY).Remove (intPos)
Exit Do
End If
intPos = intPos + 1
Next
End If
Exit Do
End If
End If
Else
blnGoRight = False
blnGoDown = True
colX(intY).Add intX
intY = intY + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
ElseIf blnGoDown Then
colX(intY).Add intX
If mbytMineStatus(intY, intX - 1) = NONE Then
If intY = mintRows - 1 Then
blnGoDown = False
DOWN: intX = intX - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
While mbytMineStatus(intY, intX) = NONE
If intX = 0 Then GoTo LFT
intX = intX - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
Wend
blnGoUp = True
Else
intY = intY + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
Else
blnGoDown = False
blnGoLeft = True
intX = intX - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
ElseIf blnGoLeft Then
If mbytMineStatus(intY - 1, intX) = NONE Then
If intX = 0 Then
blnGoLeft = False
LFT: colX(intY).Add intX
If intY = 0 Then GoTo UP
intY = intY - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
While mbytMineStatus(intY, intX) = NONE
colX(intY).Add intX
If intY = 0 Then GoTo UP
intY = intY - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
Wend
colX(intY).Add intX
blnGoRight = True
Else
intX = intX - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
Else
blnGoLeft = False
blnGoUp = True
colX(intY).Add intX
intY = intY - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
End If
End If
Loop
'从新遍历集合中的每一个扫描行的位置,并且打开曾经记录的被点开的方格
For y = 0 To mintRows - 1
If colX(y).Count > 0 Then
' Sort the X co-ord pairs in ascending order, by using
' a standard Listbox control
For x = 1 To colX(y).Count
Dim intXValue As Integer
intXValue = colX(y)(x)
If intXValue < 10 Then
intXValue = intXValue + 48
ElseIf intXValue >= 10 Then
intXValue = intXValue + 55
End If
mfrmDisplay.lstSortedX.AddItem Chr$(intXValue)
Next
'显示在数组集合中保存的扫描起始和终止位置的X坐标之间的方格为打开状态
For x = 0 To mfrmDisplay.lstSortedX.ListCount - 1 Step 2
Dim intR1 As Integer
Dim intC1 As Integer
Dim intColStart As Integer
Dim intColEnd As Integer
Dim intDx As Integer
Dim intWidth As Integer
intR1 = y * mintButtonHeight
intColStart = Asc(mfrmDisplay.lstSortedX.List(x))
If intColStart <= 57 Then
intColStart = intColStart - 48
ElseIf intColStart >= 65 Then
intColStart = intColStart - 55
End If
intColEnd = Asc(mfrmDisplay.lstSortedX.List(x + 1))
If intColEnd <= 57 Then
intColEnd = intColEnd - 48
ElseIf intColEnd >= 65 Then
intColEnd = intColEnd - 55
End If
intC1 = intColStart * mintButtonWidth
intDx = intColEnd - intColStart + 1
intWidth = intDx * mintButtonWidth
mfrmDisplay.PaintPicture mfrmDisplay.imgOpenBlocks, intC1, intR1, , , 0, 0, intWidth, mintButtonHeight
For i = 0 To intDx - 1
If mbytMarked(y, intColStart + i) > NONE Then
If mbytMarked(y, intColStart + i) = QUESTION Then
mfrmDisplay.PaintPicture mfrmDisplay.imgQuestion, intC1 + i * mintButtonWidth, intR1
Else
mfrmDisplay.PaintPicture mfrmDisplay.imgFlag, intC1 + i * mintButtonWidth, intR1
End If
ElseIf mbytMineStatus(y, intColStart + i) > NONE Then
mfrmDisplay.CurrentX = intC1 + i * mintButtonWidth
mfrmDisplay.CurrentY = intR1
If mbytMineStatus(y, intColStart + i) >= BEEN Then
mfrmDisplay.ForeColor = QBColor(mbytMineStatus(y, intColStart + i) - BEEN)
mfrmDisplay.Print mbytMineStatus(y, intColStart + i) - BEEN
ElseIf mbytMineStatus(y, intColStart + i) = MINE Then
mfrmDisplay.PaintPicture mfrmDisplay.imgButton, intC1 + i * mintButtonWidth, intR1
Else
mfrmDisplay.ForeColor = QBColor(mbytMineStatus(y, intColStart + i))
mfrmDisplay.Print mbytMineStatus(y, intColStart + i)
mbytMineStatus(y, intColStart + i) = mbytMineStatus(y, intColStart + i) + BEEN
End If
End If
Next
Next
mfrmDisplay.lstSortedX.Clear
End If
Next
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' '
' 说明:按照游戏中设置的窗体的大小,从新设置游戏主显示窗体的尺寸
'
' 输入参数:无
'输出参数:无
'
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Private Sub ResizeDisplay()
'设置窗体尺寸
mfrmDisplay.ScaleMode = 1
mfrmDisplay.Width = mfrmDisplay.Width - mfrmDisplay.ScaleWidth + mintCols * mintButtonWidth * Screen.TwipsPerPixelX
mfrmDisplay.Height = mfrmDisplay.Height - mfrmDisplay.ScaleHeight + mintRows * mintButtonHeight * Screen.TwipsPerPixelY + mfrmDisplay.lblMinesLeft.Height
'设置用来显示剩余地雷个数的label控件的尺寸
mfrmDisplay.lblMinesLeft.Left = 0
mfrmDisplay.lblMinesLeft.Top = mfrmDisplay.ScaleHeight - mfrmDisplay.lblMinesLeft.Height
mfrmDisplay.lblMinesLeft.Width = mfrmDisplay.ScaleWidth
mfrmDisplay.lblMinesLeft = "剩余地雷数 : " & mbytNumMines
mfrmDisplay.ScaleMode = 3
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' '
'说明: 只要鼠标左键被按下,即触发此动作,并测定鼠标光标在那个方格上经过.
此函数在游戏主显示窗口的鼠标移动事件中被调用
'
'函数的输入参数: intButton: 表示哪一个鼠标键被点击(左键或者右键以及中键)
' inX: 记录鼠标键被点击的位置在X轴上的坐标 '
' inY: 记录鼠标键被点击的位置在Y轴上的坐标
'
' 返回值: 空 '
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Sub TrackHitTest(intButton As Integer, intX As Single, intY As Single)
Dim blnLeftDown As Boolean
'定义一个布尔变量blnLeftDown ,用来标记鼠标左键是否被按下
blnLeftDown = (intButton And LEFT_BUTTON) > 0
'判断按下的是否为鼠标左键
'如果按下的是鼠标左键
If blnLeftDown Then
' 如果不是在运行中的游戏中点击左键,那么什么都不做,退出此过程
If Not mblnHitTestBegun Then Exit Sub
'判定鼠标点击的位置, mintButtonWidth和mintButtonHeight在前面的定义中,定义为每一个方格的宽度和高度,用得到的鼠标点击位置除以方格的宽高,取整後就可以得到鼠标点击了哪一个方格,既第几行第几列中的方格
intX = Int(intX / mintButtonWidth)
intY = Int(intY / mintButtonHeight)
'如果鼠标点击的位置的X轴大于游戏有效窗口的行数,
'或者鼠标点击的位置的Y轴大于游戏有效窗口的列数,
'或者鼠标点击的位置的X轴小于游戏有效窗口的的最小位置,
'或者鼠标点击的位置的Y轴小于游戏有效窗口的的最小位置,
'可以断定鼠标点击的位置已经超出了游戏的有效窗口
'所以退出此过程,也就是什么动作都不进行
If intX >= mintCols Or intY >= mintRows Or intX < 0 Or intY < 0 Then
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgPressed.Visible = False
Exit Sub
End If
' 如果鼠标点击的方格已经被标记为一个有地雷的方格
' 那么什么都不做,并退出此过程
If mbytMarked(intY, intX) >= FLAGGED Then
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgPressed.Visible = False
Exit Sub
End If
Dim intRowOld As Integer
Dim intColOld As Integer
'定义两个变量intRowOld和 intColOld ,用来记录前一次鼠标点击的位置
intRowOld = mintRow
intColOld = mintCol
'得到鼠标点击方格的坐标
mintCol = intX * mintButtonWidth
mintRow = intY * mintButtonHeight
'如果鼠标当前的点击位置,和前一次点击的位置相同,那么什么都不做并退出此过程
'除非鼠标当前的点击位置,和前一次点击的位置不相同,程序继续向下执行
If intRowOld = mintRow And intColOld = mintCol Then
If mfrmDisplay.imgPressed.Visible Or mfrmDisplay.imgQsPressed.Visible Then
Exit Sub
End If
End If
' 如果鼠标点击的当前位置已被点开,那么什么都不做,退出此过程
If mbytMineStatus(intY, intX) >= BEEN Then
mfrmDisplay.imgPressed.Visible = False
mfrmDisplay.imgQsPressed.Visible = False
Exit Sub
End If
' 如果鼠标点下的位置上的方格被标记为问号,那么显示鼠标按下问号的图标
If mbytMarked(intY, intX) = QUESTION Then
mfrmDisplay.imgPressed.Visible = False
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgQsPressed.Left = mintCol
mfrmDisplay.imgQsPressed.Top = mintRow
mfrmDisplay.imgQsPressed.Visible = True
Else
' 如果鼠标点下的位置上的方格没被标记,那么显示鼠标按下的图标
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgPressed.Visible = False
mfrmDisplay.imgPressed.Left = mintCol
mfrmDisplay.imgPressed.Top = mintRow
mfrmDisplay.imgPressed.Visible = True
End If
End If
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' '说明: 当一个clsWinMine类型的对象被初始化时,此函数被调用.从而初始化游戏中的变量和各个标志位以及从新布雷区
' 输入参数: 无
'
' 输出参数 : 无
' '
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Private Sub Class _ Initialize ( )
'设定当前级别游戏的总地雷数
mbytNumMines = 10
'初始化被正确标记为有地雷的方块的个数
mbytCorrectHits = 0
'初始化所做的总的标记数(包括错误的标记)
mbytTotalHits = 0
'初始化地雷区域总的行数
mintRows = 8
'初始化地雷区域总的列数
mintCols = 8
'初始化被正确标记出来的地雷区域的行数
mintRow = -1
'初始化被正确标记出来的地雷区域的列数
mintCol = -1
'初始化开始一个新游戏的标记
mblnNewGame = False
'初始化被当鼠标点下时该标记是否正确
mblnHitTestBegun = False
'初始化游戏显示的主窗体
Set mfrmDisplay = Nothing
'随机分布地雷的位置
InitializeMineField
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' '
' 说明: 阻止玩家设置不适当的地雷的行数、列数以及地雷数。并将地雷的行数、列数以及地雷数设置在适当的范围，最后将地雷的行数、列数以及地雷数存储在游戏clsWinMine类的相关属性中 '
' 输入参数： intRows: 设定的地雷分布区的行数 '
' intCols: 设定的地雷分布区的列数 '
' bytMines: 设定的地雷分布区所包含的地雷数 '
' blnLevelCustom: 如果是玩家自定义的地雷的行数、列数以及地雷数，那么该值被设为True，否则该值被设为假
'
' 输出参数 ： 无 '
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Sub SetMineFieldDimension(intRows As Integer, intCols As Integer, bytMines As Byte, blnLevelCustom As Boolean)
'取得游戏中设置的行列数,并进行比较,使它的设置被局限在合适的范围之内
mintRows = intRows
If intRows < MIN_ROWS Then mintRows = MIN_ROWS
If intRows > MAX_ROWS Then mintRows = MAX_ROWS
mintCols = intCols
If intCols < MIN_COLS Then mintCols = MIN_COLS
If intCols > MAX_COLS Then mintCols = MAX_COLS
'并且保证玩家设置的地雷的数量也合适, (当然具体数量可以自己确定)
mbytNumMines = bytMines
If blnLevelCustom Then
Dim intMines As Integer
intMines = (mintRows * mintCols) / 5
If bytMines < intMines Then
mbytNumMines = intMines
bytMines = intMines
ElseIf bytMines > (intMines * 4) / 3 Then
mbytNumMines = (intMines * 4) / 3
bytMines = mbytNumMines
End If
End If
If bytMines < MIN_MINES Then mbytNumMines = MIN_MINES
If bytMines > MAX_MINES Then mbytNumMines = MAX_MINES
' 清除当前窗口的显示,开始一盘新的游戏
mfrmDisplay.Cls
'根据游戏中设置的地雷地图的尺寸,调整显示主窗口的大小
ResizeDisplay
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' '
' 说明：当游戏clsWinMine类型的实例对象被设置为空的时候，调用此函数，也就是类的析构函数。 ' 用来释放游戏中所用到的动态数组的内存空间，并且腾空存储错误标记地雷位置的内存空间
' '
' 输入参数： 无
' '
' 输出参数： 无 '
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
Private Sub Class_Terminate()
' 在类型clsWinMine被析构时，释放三个数组的内存空间
Erase mbytMineStatus
Erase mbytMarked
Erase mbytMineLocations
Dim i As Integer ' 定义循环数
'腾空存储错误标记地雷位置的内存空间
For i = 1 To mcolWrongLocations.Count
mcolWrongLocations.Remove 1
Next
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
' winmine . frm: 这是游戏显示得主窗口，她是一个和玩家进行互动娱乐的主要界面接口，并且它'也显示了winmine . cls 类的实例在游戏中的运用方法
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
'在通用模块中声明的一个clsWinMine类的对象,并且将其命名为objMine.并且objMine对象拥有了
'clsWinMine类的所有属性(也就是变量),方法(也就是函数)
Private objMine As New clsWinMine
'主窗体被载入时相应以下事件:
Private Sub Form _ Load ( )
' 通过objMine对象,赋予它所属的clsWinMine类的frmDisplay属性的值,从而设置游戏的主窗
'口为当前窗口,这样当前窗口就可以随着游戏的进行而改变窗口的显示了
Set objMine.frmDisplay = Me
End Sub
'菜单新游戏中的代码:
Private Sub mnuNew _ Click ( )
' 准备开始一局新的游戏.
objMine.NewGame ' 调用objMine对象的NewGame方法,开始一局新的游戏.
End Sub
'选择主窗体中的游戏级别为初级水平时,触发此事件
Private Sub mnuBeginner _ Click ( )
' 将游戏级别中的初级水平前画上对勾(即将其选中)
mnuBeginner . Checked = True
'将游戏级别中的其余三种水平前取消对勾(即不将其选中)
mnuIntermediate . Checked = False
mnuExpert . Checked = False
mnuCustom . Checked = False
' 设置主窗体中的埋雷位置为8 * 8 的正方形,其中藏有10个雷,的初级水平
objMine.SetMineFieldDimension 8, 8, 10, False
'并且开始一局所设定的水平的新游戏
objMine.mblnNewGame = True
End Sub
'选择主窗体中的游戏级别为中级水平时,触发此事件
Private Sub mnuIntermediate_Click()
mnuBeginner.Checked = False
mnuIntermediate.Checked = True
mnuExpert.Checked = False
mnuCustom.Checked = False
'设定游戏中地雷分布区域的尺寸为中级水平,并且准备开始一盘新游戏
objMine.SetMineFieldDimension 16, 16, 40, False
objMine.mblnNewGame = True
End Sub
'选择主窗体中的游戏级别为高级水平时,触发此事件
Private Sub mnuExpert_Click()
mnuBeginner.Checked = False
mnuIntermediate.Checked = False
mnuExpert.Checked = True
mnuCustom.Checked = False
'设定游戏中地雷分布区域的尺寸为专家水平,并且准备开始一盘新游戏
objMine.SetMineFieldDimension 16, 30, 100, False
objMine.mblnNewGame = True
End Sub
'选择主窗体中的游戏级别为自定义水平时,触发此事件,此事件可以使用户自己决定要玩多大的藏雷地图并设定藏有多少颗雷.
Private Sub mnuCustom _ Click ( )
' 将游戏级别中的自定义水平前画上对勾(即将其选中)
'将游戏级别中的其余三种水平前取消对勾(即不将其选中)
mnuBeginner.Checked = False
mnuIntermediate.Checked = False
mnuExpert.Checked = False
mnuCustom.Checked = True
'得到前一次进行游戏时设定的藏雷位置大小,以及藏雷的数量
'并将所得到的前一次进行游戏时设定的藏雷位置大小,以及藏雷的数量值作为自定义窗体中相应输入框的默认值.
objMine.GetMineFieldDimensions frmCustomDlg
frmCustomDlg.Show 1 ' 显示自定义大小及雷数的自定义窗体
' 如果在自定义窗体中,按下键盘左上角Escape键,那么退出自定义窗体
If frmCustomDlg.mblnEscape Then Exit Sub
' 如果点击自定义窗体中的确定按钮,那么将以在自定义窗体中设定的藏雷地图的大小和所藏雷的个数重新建立新的扫雷游戏
objMine.SetMineFieldDimension Val(frmCustomDlg.txtRows), Val(frmCustomDlg.txtColumns), Val(frmCustomDlg.txtMines), True
' 并且释放自定义窗体
Unload frmCustomDlg
' 按设定,重新开始一局新游戏
objMine.mblnNewGame = True
End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
' 下面是自定义窗体中中添加的相关代码: custdlg . frm: 这是一个自定义游戏水平级别的窗体,当点击游戏显示主窗体中的自定义菜单时候,该对话框会以模式状态显示,所以必须做出选择,否则不能回到游戏现实主窗口进行游戏'
''* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
Option Explicit
' 定义了一个布尔型的变量，用来标记在自定义窗口中是否按下了ＥＳＣ键，如果按下了ＥＳＣ键，那么什么都不做，直接退出对话框
Public mblnEscape As Boolean
Private Sub cmdEscape_Click()
'当ＥＳＣ键被按下表示这个对话框中的设置将不被保存的放弃，所以退出对话窗口
'并且设置变量mblnEscape为真
mblnEscape = True
Unload Me
End Sub
Private Sub cmdOK_Click()
'当对话框上的确定按钮被按下，那么退出对话窗口，但其中设置的数值将被保存到相应的变量中
Me.Hide
End Sub
Private Sub Form_Load()
'在窗口载入时，初始化变量mblnEscape为假
mblnEscape = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
'在窗口内存被释放时，设置变量mblnEscape为真
mblnEscape = True
End Sub
Private Sub txtColumns_GotFocus()
'当设置对话框中的行数文本框得到焦点时，那么选中其中的文字，使其被高亮显示
txtColumns.SelStart = 0
txtColumns.SelLength = Len(txtColumns)
End Sub
Private Sub txtMines_GotFocus()
'当设置对话框中的地雷数量的文本框得到焦点时，那么选中其中的文字，使其被高亮显示
txtMines.SelStart = 0
txtMines.SelLength = Len(txtMines)
End Sub
Private Sub txtRows_GotFocus()
'当设置对话框中的列数文本框得到焦点时，那么选中其中的文字，使其被高亮显示
txtRows.SelStart = 0
txtRows.SelLength = Len(txtRows)
End Sub
'操作方法:
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'当鼠标左键被按下时，出发此事件，调用clsWinMine类的BeginHitTest过程来确定点击的方格的位置
objMine.BeginHitTest Button, x, y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'当鼠标左键被按下，并且经过某个位置时，出发此事件，调用clsWinMine类的TrackHitTest过程来确定经过的方格的位置
objMine.TrackHitTest Button, x, y
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'当鼠标左键弹起时，出发此事件，调用clsWinMine类的TrackHitTest过程来确定鼠标弹起的方格的位置
objMine.EndHitTest Button, x, y
End Sub
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
'添加about对话框
下图是我们添加的对话框的运行结果,其中我们加入了一个安钮(设置它的caption属性为cmdok ) , 和一个标签控件(设置它的caption属性为空, 因为我们在代码中进行了动态的设置).下面是主要的代码:
图画 About
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
‘= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
‘cmdOK _ Click ( ) 事件是点击按钮时发生的, 语句Unload Me 时释放窗体内存的意思
‘= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Private Sub cmdOK _ Click ( )
Unload Me
End Sub
‘= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
‘Form _ Load ( ) 事件是点击菜单中的”关于”时发生的, 作用是将窗体载入内存.
‘= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Private Sub Form_Load()
Dim hchh As String ‘定义一个字符串
hchh = Chr$(13) & Chr$(10) ‘并且将它的值设置为回车换行符
Dim AboutMessage As String ‘定义一个消息字符串,用来显示相关的关于信息
AboutMessage = hchh & hchh & "制作人:潇潇" & hchh
AboutMessage = AboutMessage & "二零零四年四月末"
lblAbout.Caption = AboutMessage ‘在标签中显示关于信息
End Sub
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
'在主窗体中添加”关于”菜单,并且在主窗体的代码窗中添加对关于窗体的调用代码:
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
Private Sub mnuAboutWinMine _ Click ( )
'显示”关于”对话框
frmAboutBox.Show 1
End Sub
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
'在主窗体中添加”游戏规则说明”菜单,并且在主窗体的代码窗中添加对游戏规则说明窗体的调用代码:
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
Private Sub mnuPlayingInstructions_Click()
' 显示游戏规则说明窗体
frmInstructBox.Show 1
End Sub
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
'下面是我们在游戏规则说明窗体中添加的代码:
'当点击游戏规则说明窗体中的确定按钮时,释放当前的游戏规则说明窗体
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
Private Sub cmdOK _ Click ( )
Unload Me
End Sub
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
'当游戏规则说明窗体载入时显示相关的说明,这些说明被定义在youxiguize变量中.
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
Private Sub Form_Load()
Dim hhhc As String
hhhc = Chr$(13) & Chr$(10)
Dim youxiguize As String
youxiguize = CRLF & "按下 F2 去开始一盘新游戏." & CRLF & CRLF
youxiguize = youxiguize & "这个游戏的目标就是要想方设法的标记出游戏中的包含地雷的方格. "
youxiguize = youxiguize & "在游戏中你可以通过察看,已经被打开的方格中显示得周围8个方格中所包含的地雷数,来判断其余地雷的随机分布情况. "
youxiguize = youxiguize & "如果你在游戏中点开了一个包含有地雷的方格,那么你就失败了,并且游戏也就随之结束了. "
youxiguize = youxiguize & "如果你在游戏中带开的是一个显示数字的方格,那么你可以通过这个数字判断周围的地雷数,因为这个数字就是表明了周围8个方格中包含的地雷数 "
youxiguize = youxiguize & "你可以在一个方格上点击鼠标右键,这时会在这个方格的位置上显示一个小旗标志,它表示这里被你确定为有地雷. "
youxiguize = youxiguize & "如果在一个被标记为一个有地雷的方格上再次点击鼠标右键,那么就会再此方格位置上显示一个问号的图标,表示这个地方你不能确定是否有地雷;如果你在次在此位置上点击鼠标右键,那么将显示一个正常的方格按钮,恢复最初的状态. "
youxiguize = youxiguize & "当你不能确定一个方格位置是否有地雷,那么这个问号是一个有益的帮助,你可以在以再返回来思考这个地方. "
youxiguize = youxiguize & "你也可以直接在一个方格上点击鼠标右键两次,那么它也会在此位置上显示一个问号的图标. "
youxiguize = youxiguize & "当然要想进行游戏,我们必须点击鼠标左键,这样如果点击的位置上没有地雷,就会打开这个位置,并且在这个上显示一个周围8个方格中所包含的地雷的个数."
txtInstruct . text = youxiguize
End Sub
3087
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
