winmine.cls

一个用vb做的扫雷源马

VERSION 1.0 CLASS
BEGIN
  MultiUse = 0   'False
END
Attribute VB_Name = "clsWinMine"
Attribute VB_Creatable = True
Attribute VB_Exposed = False
'***********************************************************************************'
'                                                                                   '
'   WINMINE: OVERVIEW                                                               '
'   -----------------                                                               '
'                                                                                   '
'   This is a Game Sample Application similar to MineSweeper that ships with        '
'   Windows 3.x \ Windows NT. This project comprises of the following files:        '
'                                                                                   '
'   winmine.cls:    This is a class module that implements the main functionality   '
'                   of different aspects of the game.                               '
'                                                                                   '
'   winmine.frm:    The main display form, that implements the user interface and   '
'                   instantiates an object of the above class.                      '
'                                                                                   '
'   coords.cls:     This is another class module that just implements a (X,Y)       '
'                   co-ordinate pair for wrong mine location markings.              '
'                                                                                   '
'   custdlg.frm:    This is the form that is shown modally when the custom game     '
'                   level is chosen from the Game\Custom menu.                      '
'                                                                                   '
'   instruct.frm:   This is the form that displays the rules and playing            '
'                   instructions when F1 is pressed.                                '
'                                                                                   '
'   about.frm       This is the form that displays info about the author etc.       '
'                                                                                   '
'***********************************************************************************'
Option Explicit

' left mouse button constant used by VB
Private Const LEFT_BUTTON As Byte = 1

' flag indicating empty square
Private Const NONE As Byte = 0
' flag indicating a square with a mine
Private Const MINE As Byte = 243
' flag indicating that square has already been opened
Private Const BEEN As Byte = 244
' flag indicating that square has been marked to be a mine
Private Const FLAGGED As Byte = 2
' flag indicating ambiguous square
Private Const QUESTION As Byte = 1

' Maximum\minimum # of mines, rows and columns
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

' Width of a square in pixels
Private Const mintButtonWidth As Byte = 16
' Height of a square in pixels
Private Const mintButtonHeight As Byte = 16

' Total number of Mines in current game level
Private mbytNumMines As Byte
' Number of squares correctly marked to indicate containing a mine
Private mbytCorrectHits As Byte
' Total number of marked squares (including wrong ones)
Private mbytTotalHits As Byte

' Total number of rows and columns in current game level
Private mintRows As Integer
Private mintCols As Integer

' row and column currently being processed
Private mintRow As Integer
Private mintCol As Integer

' flag indicating that its time for a new game
Public mblnNewGame As Boolean
' flag indicating that a mouse click is currently being processed
Private mblnHitTestBegun As Boolean
' variable to hold the main display form
Private mfrmDisplay As Form

' dynamic 2D array to keep track of which squares contain mines,
' which ones indicate mines surround them, which ones have
'already been opened, etc.
Private mbytMineStatus() As Byte

' dynamic 2D array to keep track of the current marking status of a square
' -- whether it is unmarked, ambiguous, flagged correctly, or incorrectly
Private mbytMarked() As Byte

' dynamic 2D array to keep track of the X and Y co-ords
' of the mbytNumMines mine locations in the minefield
Private mbytMineLocations() As Byte

' A collection of clsCoords objects to hold the
' X and Y co-ords of the squares marked wrongly
' to contain mines
Private mcolWrongLocations As New Collection
'***********************************************************************************'
'                                                                                   '
' Purpose:  Determines which square was clicked and with which mouse button, and    '
'           takes action accordingly. Called from the MouseDown event of the main   '
'           display form.                                                           '
'                                                                                   '
' Inputs:   intButton:  The mouse button clicked (left or right\middle)             '
'           inX:        X co-ordinate of mouse cursor position                      '
'           inY:        Y co-ordinate of mouse cursor position                      '
'                                                                                   '
' Returns:  None                                                                    '
'                                                                                   '
'***********************************************************************************'
Public Sub BeginHitTest(intButton As Integer, intX As Single, intY As Single)
    
    ' If the current game is over, start a new game
    ' when the minefield is clicked
    If mblnNewGame Then
        NewGame
    End If
    
    ' Indicate that a mouse click is currently in progress
    mblnHitTestBegun = True
    
    ' Calculate row and col grid co-ords from mouse co-ords
    intX = Int(intX / mintButtonWidth)
    intY = Int(intY / mintButtonHeight)

    ' abort, if  co-ords lie outside minefield
    If intX >= mintCols Or intY >= mintRows Or intX < 0 Or intY < 0 Then
        Exit Sub
    End If

    ' calculate exact square co-ords from grid co-ords
    mintCol = intX * mintButtonWidth
    mintRow = intY * mintButtonHeight

    ' abort, if square already opened
    If mbytMineStatus(intY, intX) >= BEEN Then Exit Sub

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

    ' If left mouse button clicked ...
    If blnLeftDown Then
        
        ' if square already marked, can't open, so abort
        If mbytMarked(intY, intX) >= FLAGGED Then Exit Sub
        
        ' temporarily display image control with appropriate bitmap
        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    ' if right mouse button clicked ...
        
        Dim Msg As String
        Dim CRLF As String

        CRLF = Chr$(13) & Chr$(10)
        
        Select Case mbytMarked(intY, intX)
    
            Case NONE:      ' if you run out of squares to mark ...
                            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
                                    
                            ' if not marked, display a flag in the square to indicate marking
                            mfrmDisplay.PaintPicture mfrmDisplay.imgFlag, mintCol, mintRow
                            ' increment the total # of squares marked
                            mbytTotalHits = mbytTotalHits + 1

                            ' Update display of mines left
                            mfrmDisplay.lblMinesLeft = "Mines Left : " & mbytNumMines - mbytTotalHits
                            
                            ' if correctly marked ...
                            If mbytMineStatus(intY, intX) = MINE Then
                                mbytCorrectHits = mbytCorrectHits + 1
                                mbytMarked(intY, intX) = FLAGGED
                            Else    ' if wrongly marked ...
                                Dim objCoords As New clsCoords
                                    
                                ' store co-ords of wrong location in a new object
                                objCoords.mintX = intX
                                objCoords.mintY = intY
                                    
                                ' and add it to the collection
                                mcolWrongLocations.Add objCoords
                                
                                ' store the index in the collection, of this wrongly marked square
                                ' in the corresponding element of the mbytMarked array.
                                mbytMarked(intY, intX) = mbytTotalHits - mbytCorrectHits + 2
                            End If
                                
                            ' if all mines were correctly marked ...
                            If mbytCorrectHits = mbytNumMines Then
                                Msg = "Congratulations!" & CRLF
                                Msg = Msg & "You have won." & CRLF
                                
                                MsgBox Msg, vbInformation, "WinMine"
                                
                                ' prepare for new game
                                mblnNewGame = True
                            End If
            
            Case QUESTION:  ' if ambiguously marked, unmark it
                            mbytMarked(intY, intX) = NONE
                            ' and display the original square
                            mfrmDisplay.PaintPicture mfrmDisplay.imgButton, mintCol, mintRow

            Case Else:      ' if previously marked with a flag, mark it as ambiguous now
                            ' and display square with ?
                            mfrmDisplay.PaintPicture mfrmDisplay.imgQuestion, mintCol, mintRow
                            
                            ' Decrement total number of marked squares
                            mbytTotalHits = mbytTotalHits - 1
                                
                            ' Update display of mines left
                            mfrmDisplay.lblMinesLeft = "Mines Left : " & mbytNumMines - mbytTotalHits
                            
                            ' if previously marked square contained a mine...
                            If mbytMineStatus(intY, intX) = MINE Then
                                ' decrement the number of correctly marked squares as well
                                mbytCorrectHits = mbytCorrectHits - 1
                            Else    ' if it is a wrongly marked square ...
                                ' remove this wrongly marked co-ords from corresponding position in the collection
                                mcolWrongLocations.Remove mbytMarked(intY, intX) - 2
                                    
                                Dim intXwm As Integer   ' X co-ord of wrong location
                                Dim intYwm As Integer   ' Y co-ord of wrong location
                                Dim i As Integer        ' Loop counter
                                    
                                ' Update the index of the other wrong co-ords in the collection,
                                ' (that appear after the currently deleted item), in the mbytMarked array.
                                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
'***********************************************************************************'
'                                                                                   '
' Purpose:  Determines over which square the mouse curser is when the left mouse    '
'           button is released and takes action accordingly. Called from the        '
'           MouseUp event of the main display form                                  '
'                                                                                   '
' Inputs:   intButton:  The mouse button clicked (left or right\middle)             '
'           inX:        X co-ordinate of mouse cursor position                      '