?? winmine.cls
字號:
' inY: Y co-ordinate of mouse cursor position '
' '
' Returns: None '
' '
'***********************************************************************************'
Public Sub EndHitTest(intButton As Integer, intX As Single, intY As Single)
' if currently processing a mouse click ...
If mblnHitTestBegun Then
' reset the flag
mblnHitTestBegun = False
Else
' if not, abort. This makes sure that the code below is executed only
' when a mouse button is pressed.
Exit Sub
End If
Dim blnLeftDown As Boolean
blnLeftDown = (intButton And LEFT_BUTTON) > 0
' if left mouse button pressed ...
If blnLeftDown Then
' Calculate row and col grid co-ords from the clicked 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
' abort, if current square, over which mouse is released has been
' marked with a flag
If mbytMarked(intY, intX) >= FLAGGED Then Exit Sub
' Calculate the grid co-ords from last valid mouse cursor co-ords
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: ' abort, if current square has already been opened
Exit Sub
Case NONE: ' if current square is empty, iteratively open all
' surrounding squares until non-empty squares are reached
OpenBlanks intX, intY
Case MINE: ' if current square contains a mine, you blew it!
Dim intXm As Integer ' X co-ord of mine location
Dim intYm As Integer ' Y co-ord of mine location
Dim vntCoord As Variant ' variant used in For Each loop
Dim i As Integer ' Loop counter
' reveal all the squares that contain mines
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
' display the current square as a blown mine
mfrmDisplay.PaintPicture mfrmDisplay.imgBlown, mintCol, mintRow
' reveal all the squares that were wrongly marked as mines
For Each vntCoord In mcolWrongLocations
intYm = vntCoord.mintY
intXm = vntCoord.mintX
mfrmDisplay.PaintPicture mfrmDisplay.imgWrongMine, intXm * mintButtonWidth, intYm * mintButtonHeight
Next
' prepare for new game
mblnNewGame = True
Dim CRLF As String
CRLF = Chr$(13) & Chr$(10)
MsgBox "You Lose!", vbExclamation, "WinMine"
Case Else: ' if current square surrounds one or more squares that contains a mine
' reveal the number of such mines that surrounds it
mfrmDisplay.PaintPicture mfrmDisplay.imgPressed, mintCol, mintRow
mfrmDisplay.CurrentX = mintCol
mfrmDisplay.CurrentY = mintRow
mfrmDisplay.ForeColor = QBColor(mbytMineStatus(intY, intX))
mfrmDisplay.Print mbytMineStatus(intY, intX)
' and mark it as being opened
mbytMineStatus(intY, intX) = mbytMineStatus(intY, intX) + BEEN
End Select
End If
End Sub
'***********************************************************************************'
' '
' Purpose: Does other important stuff like calculate the size of the display form '
' when the form object used for display is passed to the class by '
' assigning it to this property procedure. Called in the form load event '
' of the main display form. '
' '
' Inputs: frmDisplay: The form object that is used as the main display form '
' Returns: None '
' '
'***********************************************************************************'
Public Property Set frmDisplay(frmDisplay As Form)
Set mfrmDisplay = frmDisplay
mfrmDisplay.FontBold = True
' Resize the form to fit the chosen game level's minefield dimensions
ResizeDisplay
End Property
'***********************************************************************************'
' '
' Purpose: Displays the values for the number of rows, columns and mines from the '
' current game level, in the textboxes of the custom dialog box '
' '
' Inputs: frmDialog: The modal form object that is used as the custom dialog box '
' Returns: None '
' '
'***********************************************************************************'
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
'***********************************************************************************'
' '
' Purpose: Allocates memory for dynamic arrays according to current minefield '
' dimensions and sets up the mine locations in the minefield '
' '
' Inputs: None '
' Returns: None '
' '
'***********************************************************************************'
Private Sub InitializeMineField()
' allocate space for the 2D dynamic arrays to fit the current
' minefield size
ReDim mbytMineStatus(mintRows - 1, mintCols - 1)
ReDim mbytMarked(mintRows - 1, mintCols - 1)
ReDim mbytMineLocations(mbytNumMines - 1, 1)
' Generate random mine locations in the minefield and store them in
' the mbytMineLocations array. Also fill the mbytMineStatus array with
' info as to which squares contain mines and which are the ones that
' indicate surrounding mines
Randomize
Dim i As Integer ' Loop counter
Dim r As Integer ' Loop counter
Dim c As Integer ' Loop counter
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
For r = -1 To 1
For c = -1 To 1
Dim blnDx As Boolean
Dim blnDy As Boolean
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
mbytMineStatus(intY + r, intX + c) = mbytMineStatus(intY + r, intX + c) + 1
End If
End If
Next
Next
Next
End Sub
'***********************************************************************************'
' '
' Purpose: Prepares for a new game '
' Inputs: None '
' Returns: None '
' '
'***********************************************************************************'
Public Sub NewGame()
' clear the current display in the main form
mfrmDisplay.Cls
' reset game variables and flags
mbytCorrectHits = 0
mbytTotalHits = 0
mintRow = -1
mintCol = -1
mblnNewGame = False
mblnHitTestBegun = False
Dim i As Integer ' Loop counter
' empty the collection of wrong co-ords
For i = 1 To mcolWrongLocations.Count
mcolWrongLocations.Remove 1
Next
' re-calculate new mine locations
InitializeMineField
' Reset the display of number of mines left
mfrmDisplay.lblMinesLeft = "Mines Left : " & mbytNumMines
End Sub
'***************************************************************************************'
' '
' Purpose: If the square that was clicked was empty, then this function iteratively '
' opens all squares surrounding it, until non-empty squares are encountered '
' A general fill algorithm is adopted here, wherein, the current square '
' location keeps moving left, until it comes across a non-empty square. From '
' here onwards, it tries to trace out a border of non-empty squares by moving '
' clockwise in the directions where it can go. At the same time it stores the '
' pairs of starting and ending X co-ords on each scanline that crosses the '
' region enclosed by the traced out border. '
' '
' Inputs: inX: X grid co-ordinate of the square where the mouse was clicked '
' inY: Y grid co-ordinate of the square where the mouse was clicked '
' '
' Returns: None '
' '
'***********************************************************************************'***'
Private Sub OpenBlanks(ByVal intX As Single, ByVal intY As Single)
' flags to keep track of the direction in which current square moves
Dim blnGoUp As Boolean
Dim blnGoRight As Boolean
Dim blnGoDown As Boolean
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -