winmine.cls

一个用vb做的扫雷源马

                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