?? winmine.cls
字號:
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 '
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -