|
接触过计算机高级语言的人都听说过面向对象编程(即OOP),但究竟什么是面向对象编程呢?这个问题就不是刚刚接触计算机的初学者所能完全理解的了.为了帮助大家理解面向对象的编程,我们这里用VB作为开发工具,以一个相对较小的例子来看一看VB中怎样使用面向对象的编程方法。
什么是面向对象的编程方法呢?
总的说来面向对象的编程方法的核心就是:封装性、继承性和多态性。下面我们作一个简单的介绍：
封装性也就是说要将对象的信息（也就是对象的属性）和对象所能执行的动作（也就是对象的方法）包装起来，这样就可以让使用者可以用深入不了解内部的运作原理，就可以对其进行操作。举个简单的例子，在v b中我们要使用的一个控件，我们不必了解其中给一个属性是怎样传给对象的，也不要知道当我们调用一个对象控件的方法时，对象在其中为我们作了些什么，我们所要作的仅仅是要符合它的使用规范对其进行简单的使用即可。
继承性则是说，一个对象可以在一个或多个已有对象的基础上，通过继承这些对象具有的属性，方法和事件，并添加自己的属性方法和事件，使其功能更加强大。而其中对已有对象的属性，方法和事件的拥有，就是继承性的精髓所在。比如在V B中有一个TEXTBOX控件可以处理简单的文本信息，同时还有一个RICH TEXTBOX控件，很明显后一个控件是在前一个的基础上建立起来的，但在功能上后一个除了具备前一个控件的功能外，还具有远远强于前者的更加丰富的功能。
多态性，简单的说,就是在许多种不同的对象中,可以使用相同的方法,但是同样的方法能为各个对象执行不同的任务.也就是说程序能在运行时根据不同的对象,运行是用于当前对象的方法.例如,几乎所有的控件都包含一个move方法.当一个控件调用这个方法时,程序能够准确的知道是那一个控件在使用这个方法,从而执行此控件特定的任务.
可以看到面向对象的编程方法关键就是为了提高代码的可重用性，从而减少代码的长度，减轻程序员的负担。
那么在V B 中怎样进行面向对象的编程呢？其实说出来也很简单。在V B的工具箱中的每一个控件从实质上说都是一个类，其中包含了这个类的所有的属性，事件和方法。当你将一个控件放置在V B工程的窗体上时，开发工具自动为你创建这个控件类的一个实例，通过这个实例你可以方便的使用它的另一种属性，事件和方法。另一种，就是不使用可见的控件而是从“工程”中“引用”一个类的，并在代码中显示的定义这个类的一个实例，就可以想用控件一样对其属性，事件和方法进行灵活的控制了。
我们这篇文章将用类的方法完成一个扫雷游戏的编写,更主要的是在其中我们可以看到怎样建立一个自己的类，以及在工程中使用这个类。
一、我们现来看一看怎样建立一个类.
在VB中建立一个类要使用Class Module（类模块）.一个类模块相当于一个简单的程序对象.当一个类模块建立起来后,我们就可以在程序的其他窗体中,定义一个类的实例,然后就像使用一个对象一样访问它的属性,调用它的方法.下面是一个简单的例子.
对于扫雷游戏来说,每一个地雷都有一个位置,这些地雷按位置紧密排列在窗体上,所以我们可以先建立一个包含地雷x , y轴位置的类.具体过程如下:
1、创建一个类模块。首先在v b的[工程]菜单上选择[添加类模块]。这样就在工作区中显示了一个新的类模块，其默认的名字为Class1。
2、设定类的属性和事件。当建立一个新的类之后，就需要设定类的三个属性值。
属性：
Name属性：也就是类的名字，可以在程序中区别于其他的类。
Public属性：用来确定该类在当前的项目之外能否被其他程序使用。只有两个值：True和False。当该属性值为True时，其他应用程序可以对该类进行某种类型的访问。其访问类型由下面的Instancing决定。当该属性值被设置为False时，表示该类只能在定义类的程序中使用。
Instancing属性：用来确定其他的应用程序何时能够访问该类。该属性只有在Public属性设置为真时才起作用。（不是太重要，我们省略）
事件：类模块主要有两个事件：Initialize和Terminate。在创建类的时候，我们可以在这些事件中添加代码，这样就可以在类的实例被创建或被析构时使程序采取一些动作。类似于c / c + +中的构造函数和析构函数。
在这里我们主要修改了新类的Name属性:设置为clsCoords，这样我们就可以用这个名字来作为类的名字，定义它的实例，并访问它的属性和事件了.
3、向类中添加属性
在设定了类的属性和事件之后,我们就需要为类添加用户自己定义的属性了.要向类中添加属性有两种方法:一种是在类中定义public变量.在这里Public关键字表明在类中创建的变量是在任何模块中都可以使用的公共变量,也正因为这一点,所以程序的任何部分无须进行任何数据检查就能修改变量的值,这样如果传给对象的是一个坏数据,那么就可能产生问题(不过也因为使用简单,所以我们这里就使用这种方法);另一种是使用Property过程.这种方法类似于使用一个过程,通过调用过程时,将参数传递的数据,经过验证後,赋给类中的私有属性,(或者将私有属性传递给参数).通过使用这种方法,程序为访问和修改对象属性提供了接口,这样程序员就可以编写代码来验证向类传递的数据是否正确,使类的函数不会因传递了坏数据而崩溃.下面是对可以使用的三种属性过程及其作用的总结:
属性类别
作 用
Property Let
从调用的程序接收属性值,用来设置属性值
Property Get
向调用的程序传送属性值,用来获取属性值
Property Set
特殊情况的Let过程,用来设置对象变量的值
下面是具体个实现方法:
要创建类的属性过程,我们先要进到类的代码窗口,然后从[工具] ( Tool )菜单中选择[添加过程] ( Add Procedure ).在显示的”添加过程”对话框中,输入过程的名字,以及”类型”中的[属性]选项,单击[确定],这样就在类模块中创建了Property Let和Property Get过程。
4、向类中添加方法
任何程序都要实现一定的动作才能体现它的用处,因此,我们也要给类创建一些方法.它实质上也就是通过在类中编写公共过程实现的.这些过程与为程序的其他部分编写的过程类似.所有在类模块中的过程都以声明语句开始.如果这一语句使用Public关键字,那么该过程就是类的方法,并且该过程可以被在任何模块中创建的该类的实例所调用;如果该过程用Private关键字开始,那么该过程只能在定义该类的模块中调用.（方法同上）
5、向类中添加事件
为了在类中创建事件，需要完成下面两个步骤：
（1）在类中声明事件。若要声明事件，只要提供事件名和在事件中要传递的参数，方法和定义属性类似，只是关键字使用Event ，并且开始的关键字必须为Public，这样才能使在不同模块中定义的类的实例能触发该方法。
（2）使用Raise Event语句触发事件。声明了事件之后，就可以使用Raise Event语句在类的代码的任何地方触发该事件。
我们这里不使用对象的事件，所以省略。
二、怎样在程序中使用定义的类呢？
1、创建类的对象
要使用一个已经定义的类，首先要创建一个该类的对象。有两种方法可以从用户开发的类中创建对象：使用声明语句或使用Set语句。一旦用这两种方法创建了该类的对象后，就可以在程序中使用该对象，并能通过给对象访问对象的属性和方法。
当一个类的对象被创建后，类模块中的Initialize事件首先运行，为了的属性方法的访问做准备，相当于C++语言中的构造函数。
（1）使用声明语句: 当定义了一个类之后,我们就可以像使用一般的类型一样使用这个类.形式上唯一不同之处就是,在dim . . . as ..之后,还要加一个New关键字,形式变为 Dim . . . As New . . . 使用这种方式时,声明语句直接创建对象的实例,我们可以通过这个对象的实例在程序中访问对象的属性和方法.
（2）使用Set语句:这是创建对象的第二种方法.使用这种方法时,首先要声明对象变量,然后用Set语句创建对象的实例.如我们在游戏中使用了以下代码定义了一个clsCoords类型的实例objCoords 。
Dim objCoords As New clsCoords
同样,在我们用Set语句创建了对象变量之后,我们可以通过这个对象的实例在程序中访问对象的属性和方法.与前一种方法的不同之处在于,虽然我们先创建了一个对象的类型,但是我们还是不能使用这个对象,直到使用Set语句时才实际创建了对象的实例,这是我们才可以通过这个对象的实例在程序中访问对象的属性和方法.
2、设置和读取属性值:
对象的实例创建了,必然要对它的属性进行访问.对于这一步其实很简单,
例如我们在coords.cls类模块中定义的两个变量
'定义了一个对象用来保存被错误标记的地雷的x , y轴坐标
Public mintX As Integer
Public mintY As Integer
当我们要访问它的值时,我们只要使用像下面的方式即可.
Dim objCoords As New clsCoords
'在新建的clsCoords类的实例中存储被标记错误的地雷的X , Y坐标位置
objCoords.mintX = intX
objCoords.mintY = intY
这里我们给clsCoords类的新的实例objCoords的两个属性mintX和mintY赋予了新值.
3、使用对象的方法
要使用用户自己创建的对象的方法,与在v b中使用内在对象和控件的方法一样.只要提供要执行对象的名称和方法名,以及方法中要传递的数据即可.下面是我们在代码中的使用对象的方法的一个例子.
Private objMine As New clsWinMine
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'当鼠标左键被按下时，出发此事件，调用clsWinMine类的BeginHitTest过程来确定点击的方格的位置
objMine.TrackHitTest Button, x, y
End Sub
此段代码调用clsWinMine类的BeginHitTest过程来确定点击的方格的位置。
三、下面我们一起来分析一下在扫雷游戏中建立的类。
在这个例子中，我们可以看到主要有两个类，一个是用来描述地雷位置的coords类，其中定义了两个属性，mintX , mintY .代码如下：
'在coords.cls类模块中定义的两个变量
'定义了一个对象用来保存地雷的x , y轴坐标
Public mintX As Integer
Public mintY As Integer
另一个类是用来控制扫雷游戏的winmine类，其中定义了主要的属性，方法，代码如下：
'定义鼠标左键,同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
有了这些类的定义，那么在游戏的流程中我们只要用类就可以对游戏进行操作了，可以想象到剩下的工作就比较简单了，这也就是VC中MFC使用广泛的缘故。
四、最后我们给出扫雷游戏的源代码，其中有详细的注释，大家可以参考。
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * '
' '扫雷游戏总的工程介绍 '
' '
' 这个游戏中我们主要通过类的使用，看看在VB中OOP的使用方法。其中主要的文件及其主要作用如下所示： '
' '
' 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
| 
中搜索 