winmine.cls

毕业设计

VERSION 1.0 CLASS
BEGIN
  MultiUse = 0   'False
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsWinMine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' 设置鼠标左键常数
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 MAX_MINES As Byte = 99
Private Const MIN_ROWS As Integer = 8
Private Const MAX_ROWS As Integer = 24
Private Const MIN_COLS As Integer = 8
Private Const MAX_COLS As Integer = 36

' 方格的宽度
Private Const mintButtonWidth As Byte = 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

' 动态的2D队列，用来跟踪一个方格的现在状态
' 是否被标记，或者是否被标记正确
Private mbytMarked() As Byte

' 动态的2D队列，用来跟踪一个含有地雷的方格的行数和列数
Private mbytMineLocations() As Byte

Private mcolWrongLocations As New Collection

Public Sub BeginHitTest(intButton As Integer, intX As Single, intY As Single)
    
    ' 如果现在的游戏结束，开始新的游戏
    ' 当地雷区被点击
    If mblnNewGame Then
        NewGame
    End If
    
    ' 表明鼠标点击动作正在执行
    mblnHitTestBegun = True
    
    ' 通过鼠标的坐标确定实际方格的坐标
    intX = Int(intX / mintButtonWidth)
    intY = Int(intY / mintButtonHeight)

    ' 如果坐标位于游戏界面外边，则取消
    If intX >= mintCols Or intY >= mintRows Or intX < 0 Or intY < 0 Then
        Exit Sub
    End If

    ' 通过栅格坐标确定空格坐标
    mintCol = intX * mintButtonWidth
    mintRow = intY * mintButtonHeight

    ' 如果方格已点开，则取消
    If mbytMineStatus(intY, intX) >= BEEN Then Exit Sub

    Dim blnLeftDown As Boolean
    blnLeftDown = (intButton And LEFT_BUTTON) > 0

    ' 如果鼠标左键点击...
    If blnLeftDown Then
        
        ' 如果方格已经标记了，不能打开，则取消
        If mbytMarked(intY, intX) >= FLAGGED Then Exit Sub
        
        ' 临时图形显示控制
        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
        
    Else    '如果鼠标右键点击....
        
        Dim Msg As String
        Dim CRLF As String

        CRLF = Chr$(13) & Chr$(10)
        
        Select Case mbytMarked(intY, intX)
    
            Case NONE:      ' 如果所有的空格都被标注...
                            If mbytTotalHits = mbytNumMines Then
                                Msg = "Can't Mark Any More Mines!" & CRLF
                                Msg = Msg & "One or more Mines have been wrongly marked." & CRLF
                                Msg = Msg & "UnMark one or more mines with the right mouse button."
                                    
                                MsgBox Msg, vbCritical, "WinMine: Error!"
                                Exit Sub
                            End If
                                    
                            ' 如果没有标注，显示一个标记表示标注
                            mfrmDisplay.PaintPicture mfrmDisplay.imgFlag, mintCol, mintRow
                            ' 增加已被标注的方格数量
                            mbytTotalHits = mbytTotalHits + 1

                            ' 更新剩余地雷的显示
                            mfrmDisplay.lblMinesLeft = "Mines Left : " & mbytNumMines - mbytTotalHits
                            
                            ' 如果正确标记
                            If mbytMineStatus(intY, intX) = MINE Then
                                mbytCorrectHits = mbytCorrectHits + 1
                                mbytMarked(intY, intX) = FLAGGED
                            Else    ' 如果错误标记
                                Dim objCoords As New clsCoords
                                    
                                ' 在新文件中存储错误标记的坐标
                                objCoords.mintX = intX
                                objCoords.mintY = intY
                                    
                                ' 将它加入到收集
                                mcolWrongLocations.Add objCoords
                                
                                ' 存储被错误标注的方格的总数
                                mbytMarked(intY, intX) = mbytTotalHits - mbytCorrectHits + 2
                            End If
                                
                            ' 如果所有的地雷都被正确标注...
                            If mbytCorrectHits = mbytNumMines Then
                                Msg = "Congratulations!" & CRLF
                                Msg = Msg & "You have won." & CRLF
                                
                                MsgBox Msg, vbInformation, "WinMine"
                                
                                ' 准备新游戏
                                mblnNewGame = True
                            End If
            
            Case QUESTION:  ' 如果模糊标注，则不标注
                            mbytMarked(intY, intX) = NONE
                            ' 显示原始方格
                            mfrmDisplay.PaintPicture mfrmDisplay.imgButton, mintCol, mintRow

            Case Else:      ' 如果以前用“红旗”标注，则更改为空标注
                            ' 显示用“？”标注的方格
                            mfrmDisplay.PaintPicture mfrmDisplay.imgQuestion, mintCol, mintRow
                            
                            ' 减少已标注方格的总数
                            mbytTotalHits = mbytTotalHits - 1
                                
                            ' 更新剩余地雷的显示
                            mfrmDisplay.lblMinesLeft = "Mines Left : " & mbytNumMines - mbytTotalHits
                            
                            ' 如果以前标注的方格含有地雷
                            If mbytMineStatus(intY, intX) = MINE Then
                                ' 同时减少正确标注的方格数目
                                mbytCorrectHits = mbytCorrectHits - 1
                            Else    ' 如果是错误的标注方格
                                ' 取消这个错误的坐标
                                mcolWrongLocations.Remove mbytMarked(intY, intX) - 2
                                    
                                Dim intXwm As Integer   ' 错误地点的X坐标
                                Dim intYwm As Integer   ' 错误地点的Y坐标
                                Dim i As Integer        ' 循环计算
                                    
                                ' 更新其它错误标注的坐标指数
                                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

Public Sub EndHitTest(intButton As Integer, intX As Single, intY As Single)
    
    ' 如果正在执行一个鼠标的点击动作.
    If mblnHitTestBegun Then
        ' 重新设置标记
        mblnHitTestBegun = False
    Else
        ' 如果不是，则取消
        ' 当鼠标被点击
        Exit Sub
    End If
    
    Dim blnLeftDown As Boolean
    blnLeftDown = (intButton And LEFT_BUTTON) > 0

    '  如果鼠标左键被点击
    If blnLeftDown Then
        
        '通过鼠标的坐标确定方格的坐标
        intX = Int(intX / mintButtonWidth)
        intY = Int(intY / mintButtonHeight)

        ' 如果坐标位于游戏界面外，则取消
        If intX >= mintCols Or intY >= mintRows Or intX < 0 Or intY < 0 Then
            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
                            
                            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

                            intYm = vntCoord.mintY
                            intXm = vntCoord.mintX

                            mfrmDisplay.PaintPicture mfrmDisplay.imgWrongMine, intXm * mintButtonWidth, intYm * mintButtonHeight
                        
                        Next
                        
                        ' 准备新游戏
                        mblnNewGame = True