?? winmine.cls
字號:
intColStart = Asc(mfrmDisplay.lstSortedX.List(x))
If intColStart <= 57 Then
intColStart = intColStart - 48
ElseIf intColStart >= 65 Then
intColStart = intColStart - 55
End If
intColEnd = Asc(mfrmDisplay.lstSortedX.List(x + 1))
If intColEnd <= 57 Then
intColEnd = intColEnd - 48
ElseIf intColEnd >= 65 Then
intColEnd = intColEnd - 55
End If
intC1 = intColStart * mintButtonWidth
intDx = intColEnd - intColStart + 1
intWidth = intDx * mintButtonWidth
mfrmDisplay.PaintPicture mfrmDisplay.imgOpenBlocks, intC1, intR1, , , 0, 0, intWidth, mintButtonHeight
For i = 0 To intDx - 1
If mbytMarked(y, intColStart + i) > NONE Then
If mbytMarked(y, intColStart + i) = QUESTION Then
mfrmDisplay.PaintPicture mfrmDisplay.imgQuestion, intC1 + i * mintButtonWidth, intR1
Else
mfrmDisplay.PaintPicture mfrmDisplay.imgFlag, intC1 + i * mintButtonWidth, intR1
End If
ElseIf mbytMineStatus(y, intColStart + i) > NONE Then
mfrmDisplay.CurrentX = intC1 + i * mintButtonWidth
mfrmDisplay.CurrentY = intR1
If mbytMineStatus(y, intColStart + i) >= BEEN Then
mfrmDisplay.ForeColor = QBColor(mbytMineStatus(y, intColStart + i) - BEEN)
mfrmDisplay.Print mbytMineStatus(y, intColStart + i) - BEEN
ElseIf mbytMineStatus(y, intColStart + i) = MINE Then
mfrmDisplay.PaintPicture mfrmDisplay.imgButton, intC1 + i * mintButtonWidth, intR1
Else
mfrmDisplay.ForeColor = QBColor(mbytMineStatus(y, intColStart + i))
mfrmDisplay.Print mbytMineStatus(y, intColStart + i)
mbytMineStatus(y, intColStart + i) = mbytMineStatus(y, intColStart + i) + BEEN
End If
End If
Next
Next
' clear the listbox for the next scanline collection
mfrmDisplay.lstSortedX.Clear
End If
Next
End Sub
'***************************************************************************************'
' '
' Purpose: Resizes the main display form to fit the currently chosen game level's '
' minefield dimensions. '
' '
' Inputs: None '
' Returns: None '
' '
'***********************************************************************************'***'
Private Sub ResizeDisplay()
' set the form dimensions
mfrmDisplay.ScaleMode = 1
mfrmDisplay.Width = mfrmDisplay.Width - mfrmDisplay.ScaleWidth + mintCols * mintButtonWidth * Screen.TwipsPerPixelX
mfrmDisplay.Height = mfrmDisplay.Height - mfrmDisplay.ScaleHeight + mintRows * mintButtonHeight * Screen.TwipsPerPixelY + mfrmDisplay.lblMinesLeft.Height
' set the label (that displays the number of mines left) dimensions
mfrmDisplay.lblMinesLeft.Left = 0
mfrmDisplay.lblMinesLeft.TOP = mfrmDisplay.ScaleHeight - mfrmDisplay.lblMinesLeft.Height
mfrmDisplay.lblMinesLeft.Width = mfrmDisplay.ScaleWidth
mfrmDisplay.lblMinesLeft = "Mines Left : " & mbytNumMines
mfrmDisplay.ScaleMode = 3
End Sub
'***********************************************************************************'
' '
' Purpose: Determines over which square the mouse curser is, at present, while the '
' left mouse button is pressed, and takes action accordingly. Called from '
' the MouseMove 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 TrackHitTest(intButton As Integer, intX As Single, intY As Single)
Dim blnLeftDown As Boolean
blnLeftDown = (intButton And LEFT_BUTTON) > 0
' If left mouse button pressed ...
If blnLeftDown Then
' abort, if not currently processing a mouse click
If Not mblnHitTestBegun Then Exit Sub
' calculate the grid co-ords from the mouse co-ords
intX = Int(intX / mintButtonWidth)
intY = Int(intY / mintButtonHeight)
' abort, if the square over which the mouse cursor is currently
' over is outside the minefield
If intX >= mintCols Or intY >= mintRows Or intX < 0 Or intY < 0 Then
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgPressed.Visible = False
Exit Sub
End If
' abort, if current square has been marked with a flag
If mbytMarked(intY, intX) >= FLAGGED Then
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgPressed.Visible = False
Exit Sub
End If
Dim intRowOld As Integer
Dim intColOld As Integer
' store previous grid location of cursor
intRowOld = mintRow
intColOld = mintCol
' calculate current grid co-ords of mouse cursor
mintCol = intX * mintButtonWidth
mintRow = intY * mintButtonHeight
' Display current square as pressed, only if previous grid co-ords
' are not same as current grid co-ords
If intRowOld = mintRow And intColOld = mintCol Then
If mfrmDisplay.imgPressed.Visible Or mfrmDisplay.imgQsPressed.Visible Then
Exit Sub
End If
End If
' abort, if current square already opened
If mbytMineStatus(intY, intX) >= BEEN Then
mfrmDisplay.imgPressed.Visible = False
mfrmDisplay.imgQsPressed.Visible = False
Exit Sub
End If
' if current square is unmarked, or ambiguously marked display the
' corresponding square as pressed while the mouse cursor is over it
' and the left mouse button is pressed
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
End If
End Sub
'***************************************************************************************'
' '
' Purpose: Called when an object of type clsWinMine is instantiated. Initializes '
' game variables and flags and sets up the minefield '
' '
' Inputs: None '
' Returns: None '
' '
'***********************************************************************************'***'
Private Sub Class_Initialize()
mbytNumMines = 10
mbytCorrectHits = 0
mbytTotalHits = 0
mintRows = 8
mintCols = 8
mintRow = -1
mintCol = -1
mblnNewGame = False
mblnHitTestBegun = False
Set mfrmDisplay = Nothing
' Calculate random mine locations
InitializeMineField
End Sub
'***************************************************************************************'
' '
' Purpose: Checks to see if the specified number of rows, columns and mines for the '
' currently chosen game level is within limits and stores them in the '
' appropriate class properties. '
' '
' Inputs: intRows: Number of rows in the minefield '
' intCols: Number of columns in the minefield '
' bytMines: Number of mines in the minefield '
' blnLevelCustom: True if game level is custom; False otherwise '
' '
' Returns: None '
' '
'***********************************************************************************'***'
Public Sub SetMineFieldDimension(intRows As Integer, intCols As Integer, bytMines As Byte, blnLevelCustom As Boolean)
mintRows = intRows
If intRows < MIN_ROWS Then mintRows = MIN_ROWS
If intRows > MAX_ROWS Then mintRows = MAX_ROWS
mintCols = intCols
If intCols < MIN_COLS Then mintCols = MIN_COLS
If intCols > MAX_COLS Then mintCols = MAX_COLS
mbytNumMines = bytMines
If blnLevelCustom Then
Dim intMines As Integer
intMines = (mintRows * mintCols) \ 5
If bytMines < intMines Then
mbytNumMines = intMines
bytMines = intMines
ElseIf bytMines > (intMines * 4) \ 3 Then
mbytNumMines = (intMines * 4) \ 3
bytMines = mbytNumMines
End If
End If
If bytMines < MIN_MINES Then mbytNumMines = MIN_MINES
If bytMines > MAX_MINES Then mbytNumMines = MAX_MINES
' clear the current display to start new game
mfrmDisplay.Cls
' Adjust the display form size according to the new minefield dimensions
ResizeDisplay
End Sub
'***************************************************************************************'
' '
' Purpose: Called when the instance of the clsWinMine object is set to nothing when '
' the program terminates. Frees memory used for dynamically allocated arrays '
' and empties the collection of Wrong Mine locations. '
' '
' Inputs: None '
' Returns: None '
' '
'***********************************************************************************'***'
Private Sub Class_Terminate()
Erase mbytMineStatus
Erase mbytMarked
Erase mbytMineLocations
Dim i As Integer ' Loop counter
For i = 1 To mcolWrongLocations.Count
mcolWrongLocations.Remove 1
Next
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -