winmine.cls

毕业设计

                        Dim CRLF As String
                        CRLF = Chr$(13) & Chr$(10)
                        
                        MsgBox "You Lose!", vbExclamation, "WinMine"

            Case Else:  ' 如果当前的方格围绕着包含有地雷的方格
                        ' 展示这些包含地雷的方格的数目
                        mfrmDisplay.PaintPicture mfrmDisplay.imgPressed, mintCol, mintRow
                        mfrmDisplay.CurrentX = mintCol
                        mfrmDisplay.CurrentY = mintRow
                        mfrmDisplay.ForeColor = QBColor(mbytMineStatus(intY, intX))
                        mfrmDisplay.Print mbytMineStatus(intY, intX)
                        
                        ' 将其打开
                        mbytMineStatus(intY, intX) = mbytMineStatus(intY, intX) + BEEN
    
        End Select
    
    End If

End Sub

Public Property Set frmDisplay(frmDisplay As Form)
    
    Set mfrmDisplay = frmDisplay
    mfrmDisplay.FontBold = True
    
    ' 重新修改新游戏的外框边界
    ResizeDisplay
    
End Property

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

Private Sub InitializeMineField()
    
    ReDim mbytMineStatus(mintRows - 1, mintCols - 1)
    ReDim mbytMarked(mintRows - 1, mintCols - 1)
    ReDim mbytMineLocations(mbytNumMines - 1, 1)

    ' 随机布置地雷
    Randomize

    Dim i As Integer    ' 循环计数
    Dim r As Integer    ' 循环计数
    Dim c As Integer    ' 循环计数

    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

Public Sub NewGame()
    
    ' 刷新在当前界面的显示
    mfrmDisplay.Cls
 
    ' 重新设置变量和标注
    mbytCorrectHits = 0
    mbytTotalHits = 0

    mintRow = -1
    mintCol = -1

    mblnNewGame = False
    mblnHitTestBegun = False
    
    Dim i As Integer            ' 循环计数

    ' 清空错误坐标的计数
    For i = 1 To mcolWrongLocations.Count
        mcolWrongLocations.Remove 1
    Next
    
    ' 重新计数地雷的位置
    InitializeMineField
    
    ' 重新设置剩余地雷的数目
    mfrmDisplay.lblMinesLeft = "Mines Left : " & mbytNumMines
    
End Sub

Private Sub OpenBlanks(ByVal intX As Single, ByVal intY As Single)

    ' 标示当前鼠标移动的标记
    Dim blnGoUp As Boolean
    Dim blnGoRight As Boolean
    Dim blnGoDown As Boolean
    Dim blnGoLeft As Boolean
    
    Dim intXStart As Integer
    Dim intYStart As Integer
    
    ' 用来标记收集条目的指数
    Dim intPos As Integer
    ' 每个循环的变量
    Dim element As Variant
    
    ' 循环计数
    Dim y As Integer
    Dim x As Integer
    Dim i As Integer
    
    
    Dim colX() As New Collection
    
    ReDim colX(mintRows - 1)
    
    While mbytMineStatus(intY, intX) = NONE
        
        intX = intX - 1

        If intX < 0 Then
            intX = 0
            intXStart = intX
            intYStart = intY
            GoTo LFT
        End If
    
    Wend

    ' 先移动的方向是向上
    blnGoUp = True
    
    ' 利用第一个地雷坐标作为起始点
    intXStart = intX
    intYStart = intY

    ' 反复确定边界，直到回到起始点
    Do
        If mbytMineStatus(intY, intX) = NONE Then
            
            If blnGoUp Then
                intX = intX - 1
                intY = intY + 1
                colX(intY).Remove (colX(intY).Count)
                blnGoUp = False
                blnGoLeft = True
            ElseIf blnGoRight Then
                intX = intX - 1
                intY = intY - 1
                blnGoRight = False
                blnGoUp = True
            ElseIf blnGoDown Then
                intX = intX + 1
                intY = intY - 1
                colX(intY).Remove (colX(intY).Count)
                blnGoDown = False
                blnGoRight = True
            ElseIf blnGoLeft Then
                intX = intX + 1
                intY = intY + 1
                blnGoLeft = False
                blnGoDown = True
            End If

            If (intXStart = intX And intYStart = intY) Then Exit Do
        
        Else

            If blnGoUp Then

                colX(intY).Add intX

                If mbytMineStatus(intY, intX + 1) = NONE Then
                    
                    If intY = 0 Then
                        blnGoUp = False
UP:                     intX = intX + 1
                        If (intXStart = intX And intYStart = intY) Then Exit Do
                        While mbytMineStatus(intY, intX) = NONE
                            If intX = mintCols - 1 Then GoTo RIGHT
                            intX = intX + 1
                            If (intXStart = intX And intYStart = intY) Then Exit Do
                        Wend
                        blnGoDown = True
                    Else
                        intY = intY - 1
                        If (intXStart = intX And intYStart = intY) Then Exit Do
                    End If
                
                Else
                    
                    blnGoUp = False
                    blnGoRight = True
                    intX = intX + 1
                    If (intXStart = intX And intYStart = intY) Then
                        If colX(intY).Count Mod 2 <> 0 Then
                            intPos = 1
                            For Each element In colX(intY)
                                If element = intXStart Then
                                    colX(intY).Remove (intPos)
                                    Exit Do
                                End If
                                intPos = intPos + 1
                            Next
                        End If
                        Exit Do
                    End If
                
                End If
            
            ElseIf blnGoRight Then
                
                If mbytMineStatus(intY + 1, intX) = NONE Then
                    
                    If intX = mintCols - 1 Then
                        blnGoRight = False
RIGHT:                  colX(intY).Add intX
                        intY = intY + 1
                        If (intXStart = intX And intYStart = intY) Then Exit Do
                        While mbytMineStatus(intY, intX) = NONE
                            colX(intY).Add intX
                            If intY = mintRows - 1 Then GoTo DOWN
                            intY = intY + 1
                            If (intXStart = intX And intYStart = intY) Then Exit Do
                        Wend
                        colX(intY).Add intX
                        blnGoLeft = True
                    Else
                        intX = intX + 1
                        If (intXStart = intX And intYStart = intY) Then
                            If colX(intY).Count Mod 2 <> 0 Then
                                intPos = 1
                                For Each element In colX(intY)
                                    If element = intXStart Then
                                        colX(intY).Remove (intPos)
                                        Exit Do
                                    End If
                                    intPos = intPos + 1
                                Next
                            End If
                            Exit Do
                        End If
                    End If
                
                Else
                    
                    blnGoRight = False
                    blnGoDown = True
                    
                    colX(intY).Add intX
                    intY = intY + 1
                    If (intXStart = intX And intYStart = intY) Then Exit Do
                
                End If
            
            ElseIf blnGoDown Then
               
                colX(intY).Add intX
               
                If mbytMineStatus(intY, intX - 1) = NONE Then
                    
                    If intY = mintRows - 1 Then
                        blnGoDown = False
DOWN:                   intX = intX - 1
                        If (intXStart = intX And intYStart = intY) Then Exit Do
                        While mbytMineStatus(intY, intX) = NONE
                            If intX = 0 Then GoTo LFT
                            intX = intX - 1
                            If (intXStart = intX And intYStart = intY) Then Exit Do
                        Wend
                        blnGoUp = True