frmmain.frm

VB做的扫雷程序

    End If
    m_Rows = Rows: m_Columns = Columns: m_Mines = Mines
    m_MineWidth = MINE_FRAME_WIDTH + NUMBER_WIDTH * Columns + MINE_FRAME_WIDTH
    m_MineHeight = MINE_FRAME_WIDTH + NUMBER_HEIGHT * Rows + MINE_FRAME_WIDTH
    m_MineLeft = LEFT_OFFSET + LEFT_MARGIN
    m_ScoreBoxTop = TOP_OFFSET + TOP_MARGIN
    m_MineTop = m_ScoreBoxTop + SCORE_BOX_HEIGHT + MIDDLE_MARGIN
    m_Width = m_MineLeft + m_MineWidth + RIGHT_MARGIN
    m_Height = m_MineTop + m_MineHeight + BOTTOM_MARGIN
    m_FaceLeft = m_MineLeft + (m_MineWidth - FACE_WIDTH) \ 2
    m_FaceTop = m_ScoreBoxTop + (SCORE_BOX_HEIGHT - FACE_HEIGHT) \ 2 + 1
    m_DigitBoxTop = m_ScoreBoxTop + (SCORE_BOX_HEIGHT - DIGIT_HEIGHT) \ 2
    m_RemainingBoxLeft = m_MineLeft + SCORE_FRAME_WIDTH + REMAINING_BOX_MARGIN + REMAINING_FRAME_WIDTH
    m_TimeBoxLeft = m_MineLeft + m_MineWidth - SCORE_FRAME_WIDTH - TIME_BOX_MARGIN - TIME_FRAME_WIDTH - DIGIT_WIDTH * 3
    m_InnerLeft = m_MineLeft + MINE_FRAME_WIDTH
    m_InnerTop = m_MineTop + MINE_FRAME_WIDTH
    m_Status = Gaming
    m_Remaining = m_Mines
    m_Uncertain = m_Columns * m_Rows
    m_Time = 0
    tmrTick.Enabled = False
    ReDim m_Data(Rows - 1, Columns - 1)
    ReDim m_Buffer(Rows - 1, Columns - 1)
    m_Generated = False
    SetWindowRect m_Width, m_Height
    RedrawAll
End Sub

Private Sub DrawFrame(ByVal Thick As Integer, ByVal Flat As Boolean, ByVal Left As Integer, ByVal Top As Integer, ByVal Width As Integer, ByVal Height As Integer)
    Dim UpperColor As Long, LowerColor As Long
    If m_Style = 0 Then
        UpperColor = COLOR_DARKGRAY
    Else
        UpperColor = COLOR_BLACK
    End If
    If Flat = True Then
        LowerColor = UpperColor
    Else
        LowerColor = COLOR_WHITE
    End If
    Do While Thick > 0
        Line (Left, Top)-(Left + Width - 1, Top), UpperColor
        Line (Left, Top + 1)-(Left, Top + Height - 1), UpperColor
        Line (Left + Width - 1, Top + 1)-(Left + Width - 1, Top + Height), LowerColor
        Line (Left + 1, Top + Height - 1)-(Left + Width - 1, Top + Height - 1), LowerColor
        Left = Left + 1: Top = Top + 1
        Width = Width - 2: Height = Height - 2: Thick = Thick - 1
    Loop
End Sub

Private Sub DrawFace(ByVal Face As Integer)
    PaintPicture imgFaces(m_Style).Picture, m_FaceLeft, m_FaceTop, FACE_WIDTH, FACE_HEIGHT, 0, Face * FACE_HEIGHT, FACE_WIDTH, FACE_HEIGHT
End Sub

Private Sub DrawNumber(ByVal Number As Integer, ByVal Column As Integer, ByVal Row As Integer)
    PaintPicture imgNumbers(m_Style).Picture, m_InnerLeft + Column * NUMBER_WIDTH, m_InnerTop + Row * NUMBER_HEIGHT, NUMBER_WIDTH, NUMBER_HEIGHT, 0, Number * NUMBER_HEIGHT, NUMBER_WIDTH, NUMBER_HEIGHT
End Sub

Private Sub DrawRemaining(ByVal Number As Integer)
    DrawDigits Number, 3, m_RemainingBoxLeft, m_DigitBoxTop
End Sub

Private Sub DrawTime(ByVal Number As Integer)
    DrawDigits Number, 3, m_TimeBoxLeft, m_DigitBoxTop
End Sub

Private Sub RedrawAll()
    Dim Row As Integer, Column As Integer
    Line (LEFT_OFFSET, TOP_OFFSET)-(m_Width, m_Height), COLOR_GRAY, BF
    DrawFrame SCORE_FRAME_WIDTH, False, m_MineLeft, m_ScoreBoxTop, m_MineWidth, SCORE_BOX_HEIGHT
    DrawFrame MINE_FRAME_WIDTH, False, m_MineLeft, m_MineTop, m_MineWidth, m_MineHeight
    DrawFrame FACE_FRAME_WIDTH, True, m_FaceLeft - FACE_FRAME_WIDTH, m_FaceTop - FACE_FRAME_WIDTH, FACE_WIDTH + FACE_FRAME_WIDTH * 2, FACE_HEIGHT + FACE_FRAME_WIDTH * 2
    DrawFrame REMAINING_FRAME_WIDTH, False, m_RemainingBoxLeft - REMAINING_FRAME_WIDTH, m_DigitBoxTop - REMAINING_FRAME_WIDTH, REMAINING_FRAME_WIDTH + DIGIT_WIDTH * 3 + REMAINING_FRAME_WIDTH, REMAINING_FRAME_WIDTH + DIGIT_HEIGHT + REMAINING_FRAME_WIDTH
    DrawFrame REMAINING_FRAME_WIDTH, False, m_TimeBoxLeft - REMAINING_FRAME_WIDTH, m_DigitBoxTop - REMAINING_FRAME_WIDTH, REMAINING_FRAME_WIDTH + DIGIT_WIDTH * 3 + REMAINING_FRAME_WIDTH, REMAINING_FRAME_WIDTH + DIGIT_HEIGHT + REMAINING_FRAME_WIDTH
    DrawFace m_Status
    DrawRemaining m_Remaining
    DrawTime m_Time
    For Row = 0 To m_Rows - 1
        For Column = 0 To m_Columns - 1
            DrawNumber m_Buffer(Row, Column), Column, Row
        Next
    Next
End Sub

Private Function CoordFromPoint(ByVal X As Integer, ByVal Y As Integer) As COORD
    Dim Result As COORD
    If X >= m_FaceLeft And Y >= m_FaceTop And X < m_FaceLeft + FACE_WIDTH And Y < m_FaceTop + FACE_HEIGHT Then
        Result.Row = -2
    ElseIf X >= m_InnerLeft And Y >= m_InnerTop And X < m_InnerLeft + m_Columns * NUMBER_WIDTH And Y < m_InnerTop + m_Rows * NUMBER_HEIGHT Then
        Result.Column = (X - m_InnerLeft) \ NUMBER_WIDTH
        Result.Row = (Y - m_InnerTop) \ NUMBER_HEIGHT
    Else
        Result.Row = -1
    End If
    CoordFromPoint = Result
End Function

Private Sub ClickPosition(ByVal Row As Integer, ByVal Column As Integer)
    If IsValidPosition(Row, Column) = True Then
        GenerateMap m_Data, m_Rows, m_Columns, Row, Column
        If m_Buffer(Row, Column) = 0 Then
            If m_Data(Row, Column) = 5 Then
                tmrTick.Enabled = False
                m_Status = Lose
                DrawFace m_Status
                m_Buffer(Row, Column) = 3
                DrawNumber m_Buffer(Row, Column), Column, Row
                For Row = 0 To m_Rows - 1
                    For Column = 0 To m_Columns - 1
                        If m_Data(Row, Column) = 5 Then
                            If m_Buffer(Row, Column) <> 1 And m_Buffer(Row, Column) <> 3 Then
                                m_Buffer(Row, Column) = 5
                                DrawNumber m_Buffer(Row, Column), Column, Row
                            End If
                        ElseIf m_Buffer(Row, Column) = 1 Then
                            m_Buffer(Row, Column) = 4
                            DrawNumber 4, Column, Row
                        End If
                    Next
                Next
            Else
                If m_Status = Gaming Then If tmrTick.Enabled = False Then tmrTick.Enabled = True
                m_Buffer(Row, Column) = m_Data(Row, Column)
                DrawNumber m_Buffer(Row, Column), Column, Row
                m_Uncertain = m_Uncertain - 1
                If m_Uncertain = m_Remaining Then
                    tmrTick.Enabled = False
                    m_Status = Win
                    DrawFace m_Status
                    If m_Remaining <> 0 Then
                        For Row = 0 To m_Rows - 1
                            For Column = 0 To m_Columns - 1
                                If m_Data(Row, Column) = 5 Then
                                    m_Buffer(Row, Column) = 1
                                    DrawNumber 1, Column, Row
                                End If
                            Next
                        Next
                        m_Remaining = 0
                        DrawRemaining 0
                    End If
                ElseIf m_Data(Row, Column) = 15 Then
                    ClickCircle Row, Column
                End If
            End If
        End If
    End If
End Sub

Private Sub MarkPosition(ByVal Row As Integer, ByVal Column As Integer)
    Select Case m_Buffer(Row, Column)
        Case 0
            m_Buffer(Row, Column) = 1
            m_Remaining = m_Remaining - 1
            m_Uncertain = m_Uncertain - 1
            DrawNumber 1, Column, Row
            DrawRemaining m_Remaining
        Case 1
            If m_Mark = True Then
                m_Buffer(Row, Column) = 2
                DrawNumber 2, Column, Row
            Else
                m_Buffer(Row, Column) = 0
                DrawNumber 0, Column, Row
            End If
            m_Remaining = m_Remaining + 1
            m_Uncertain = m_Uncertain + 1
            DrawRemaining m_Remaining
        Case 2
            m_Buffer(Row, Column) = 0
            DrawNumber 0, Column, Row
    End Select
End Sub

Private Sub PushNumber(ByVal Row As Integer, ByVal Column As Integer, ByVal Push As Boolean)
    If IsValidPosition(Row, Column) = True Then
        If Push = True Then
            If m_Buffer(Row, Column) = 0 Then DrawNumber 15, Column, Row
        Else
            DrawNumber m_Buffer(Row, Column), Column, Row
        End If
    End If
End Sub

Private Sub ClickCircle(ByVal Row As Integer, ByVal Column As Integer)
    ClickPosition Row - 1, Column - 1
    ClickPosition Row - 1, Column
    ClickPosition Row - 1, Column + 1
    ClickPosition Row, Column - 1
    ClickPosition Row, Column + 1
    ClickPosition Row + 1, Column - 1
    ClickPosition Row + 1, Column
    ClickPosition Row + 1, Column + 1
End Sub

Private Sub PushCircle(ByVal Row As Integer, ByVal Column As Integer, ByVal Push As Boolean)
    PushNumber Row - 1, Column - 1, Push
    PushNumber Row - 1, Column, Push
    PushNumber Row - 1, Column + 1, Push
    PushNumber Row, Column - 1, Push
    PushNumber Row, Column, Push
    PushNumber Row, Column + 1, Push
    PushNumber Row + 1, Column - 1, Push
    PushNumber Row + 1, Column, Push
    PushNumber Row + 1, Column + 1, Push
End Sub

Private Function CountCircle(ByRef Buffer() As Byte, ByVal Row As Integer, ByVal Column As Integer, ByVal Number As Integer) As Integer
    Dim Result As Integer
    Result = CountPosition(Buffer, Row - 1, Column - 1, Number)
    Result = Result + CountPosition(Buffer, Row - 1, Column, Number)
    Result = Result + CountPosition(Buffer, Row - 1, Column + 1, Number)
    Result = Result + CountPosition(Buffer, Row, Column - 1, Number)
    Result = Result + CountPosition(Buffer, Row, Column + 1, Number)
    Result = Result + CountPosition(Buffer, Row + 1, Column - 1, Number)
    Result = Result + CountPosition(Buffer, Row + 1, Column, Number)
    Result = Result + CountPosition(Buffer, Row + 1, Column + 1, Number)
    CountCircle = Result
End Function

Private Sub UncoverPosition(ByVal Row As Integer, ByVal Column As Integer)
    Dim Count As Integer
    If IsValidPosition(Row, Column) = True Then
        If m_Buffer(Row, Column) < 7 Then
            PushCircle Row, Column, False
        Else
            Count = CountCircle(m_Buffer, Row, Column, 1)
            If Count = 15 - m_Buffer(Row, Column) Then
                ClickCircle Row, Column
            Else
                PushCircle Row, Column, False
            End If
        End If
    End If
End Sub

Private Function KeyConvert(ByVal Button As Integer, ByVal Shift As Integer) As Integer
    If m_Button = 1 And (Shift And 1) = 0 Then
        KeyConvert = 1
    ElseIf (m_Button And 3) = 3 Or (m_Button And 4) = 4 Or ((m_Button And 1) = 1 And (Shift And 1) = 1) Then
        KeyConvert = 2
    End If
End Function

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim Position As COORD
    Position = CoordFromPoint(X, Y)
    If Button = 1 And Position.Row = -2 Then
        m_FaceClick = True
        DrawFace 0
    ElseIf m_Status = Gaming Then
        m_LastPosition.Row = -1
        m_Button = m_Button Or Button
        m_Shift = Shift
        If m_Button = 2 Then If Position.Row >= 0 Then MarkPosition Position.Row, Position.Column
        Form_MouseMove Button, Shift, X, Y
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim Position As COORD
    Position = CoordFromPoint(X, Y)
    If m_FaceClick = True Then
        If Position.Row = -2 Then
            DrawFace 0
        Else
            DrawFace m_Status
        End If
    Else
        Select Case KeyConvert(m_Button, m_Shift)
            Case 1
                If (m_LastPosition.Row <> Position.Row Or m_LastPosition.Column <> Position.Column) Then
                    If m_LastPosition.Row >= 0 Then PushNumber m_LastPosition.Row, m_LastPosition.Column, False
                    If Position.Row >= 0 Then PushNumber Position.Row, Position.Column, True
                    m_LastPosition = Position
                End If
            Case 2
                If (m_LastPosition.Row <> Position.Row Or m_LastPosition.Column <> Position.Column) Then
                    If m_LastPosition.Row >= 0 Then PushCircle m_LastPosition.Row, m_LastPosition.Column, False
                    If Position.Row >= 0 Then PushCircle Position.Row, Position.Column, True
                    m_LastPosition = Position
                End If
        End Select
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim Position As COORD
    Position = CoordFromPoint(X, Y)
    If Button = 1 And m_FaceClick = True Then
        m_FaceClick = False
        If Position.Row = -2 Then
            m_Button = 0
            mnuNew_Click
        Else
            DrawFace m_Status
        End If
    Else
        Select Case KeyConvert(m_Button, m_Shift)
            Case 1
                ClickPosition Position.Row, Position.Column
            Case 2
                UncoverPosition Position.Row, Position.Column
        End Select
    End If
    m_Button = 0
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuLevel_Click(Index As Integer)
    mnuLevel(m_Level).Checked = False
    m_Level = Index
    mnuLevel(m_Level).Checked = True
    Select Case m_Level
        Case 0
            m_Rows = 9: m_Columns = 9: m_Mines = 10
        Case 1
            m_Rows = 16: m_Columns = 16: m_Mines = 40
        Case 2
            m_Rows = 16: m_Columns = 30: m_Mines = 99
    End Select
    NewGame m_Rows, m_Columns, m_Mines
End Sub

Private Sub mnuNew_Click()
    If m_Button = 0 Then NewGame m_Rows, m_Columns, m_Mines
End Sub

Private Sub tmrTick_Timer()
    m_Time = m_Time + 1
    DrawTime m_Time
End Sub