winmine.cls

the mine game code in VBA

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
Private mbytMarked() As Byte

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, "May齨 Tarlas