winmine.cls

毕业设计

                    Else
                        intY = intY + 1
                        If (intXStart = intX And intYStart = intY) Then Exit Do
                    End If
                
                Else
                    
                    blnGoDown = False
                    blnGoLeft = True

                    intX = intX - 1
                    If (intXStart = intX And intYStart = intY) Then Exit Do
                
                End If
            
            ElseIf blnGoLeft Then
                
                If mbytMineStatus(intY - 1, intX) = NONE Then
                    
                    If intX = 0 Then
                        blnGoLeft = False
LFT:                    colX(intY).Add intX
                        If intY = 0 Then GoTo UP
                        intY = intY - 1
                        If (intXStart = intX And intYStart = intY) Then Exit Do
                        While mbytMineStatus(intY, intX) = NONE
                            colX(intY).Add intX
                            If intY = 0 Then GoTo UP
                            intY = intY - 1
                            If (intXStart = intX And intYStart = intY) Then Exit Do
                        Wend
                        colX(intY).Add intX
                        blnGoRight = True
                    Else
                        intX = intX - 1
                        If (intXStart = intX And intYStart = intY) Then Exit Do
                    End If
                
                Else
                    
                    blnGoLeft = False
                    blnGoUp = True

                    colX(intY).Add intX
                    intY = intY - 1
                    If (intXStart = intX And intYStart = intY) Then Exit Do
                
                End If
            
            End If
        
        End If

    Loop

    For y = 0 To mintRows - 1
        
        If colX(y).Count > 0 Then
        
           
            For x = 1 To colX(y).Count
                
                Dim intXValue As Integer
                intXValue = colX(y)(x)
                
                If intXValue < 10 Then
                    intXValue = intXValue + 48
                ElseIf intXValue >= 10 Then
                    intXValue = intXValue + 55
                End If
                
                mfrmDisplay.lstSortedX.AddItem Chr$(intXValue)
            
            Next
            
            
            For x = 0 To mfrmDisplay.lstSortedX.ListCount - 1 Step 2
            
                Dim intR1 As Integer
                Dim intC1 As Integer
                Dim intColStart As Integer
                Dim intColEnd As Integer
                Dim intDx As Integer
                Dim intWidth As Integer
                
                intR1 = y * mintButtonHeight
                
                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
        
            ' 清空收集
            mfrmDisplay.lstSortedX.Clear
            
        End If
        
    Next

End Sub

Private Sub ResizeDisplay()
    
    ' 设置外框边界尺寸
    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
    
    ' 设置标签尺寸
    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

Public Sub TrackHitTest(intButton As Integer, intX As Single, intY As Single)

    Dim blnLeftDown As Boolean
    blnLeftDown = (intButton And LEFT_BUTTON) > 0
    
    ' 如果鼠标左健点击
    If blnLeftDown Then
        
        ' 如果当前没有执行鼠标点击，则取消
        If Not mblnHitTestBegun Then Exit Sub

        ' 通过鼠标坐标确定栅格坐标
        intX = Int(intX / mintButtonWidth)
        intY = Int(intY / mintButtonHeight)

        ' 如果鼠标点击在游戏边界外边，则取消
        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

        ' 如果当前的方格已被标注，则取消
        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
        
        ' 存储前面栅格指针的位置
        intRowOld = mintRow
        intColOld = mintCol

        ' 计算当前鼠标指针的位置
        mintCol = intX * mintButtonWidth
        mintRow = intY * mintButtonHeight

        '如果当前的栅格坐标发生变化，显示方格被标注
        If intRowOld = mintRow And intColOld = mintCol Then
            If mfrmDisplay.imgPressed.Visible Or mfrmDisplay.imgQsPressed.Visible Then
                Exit Sub
            End If
        End If
        
        ' 如果当前的方格已被打开，则取消
        If mbytMineStatus(intY, intX) >= BEEN Then
            mfrmDisplay.imgPressed.Visible = False
            mfrmDisplay.imgQsPressed.Visible = False
            Exit Sub
        End If
        
        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

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
    
    ' 计算随机地雷的位置
    InitializeMineField
    
End Sub

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
    
    ' 清空现在的显示，重新开始游戏
    mfrmDisplay.Cls
    
    ' 调整游戏边界尺寸
    ResizeDisplay
    
End Sub

Private Sub Class_Terminate()
    
    Erase mbytMineStatus
    Erase mbytMarked
    Erase mbytMineLocations
    
    Dim i As Integer            ' 循环计数
    
    For i = 1 To mcolWrongLocations.Count
        mcolWrongLocations.Remove 1
    Next

End Sub