frmmain.frm

得用Visual Basic编写的小游戏-俄罗斯方块。

    intYCur = intYNext
    intXCur = intXNext
    intOrieCur = intOrieNext
End Sub

Private Sub Command1_Click()
    Call Form_Activate
End Sub

Private Sub Form_Activate()
    Dim i As Integer, j As Integer
    '绘制表格与已有的堆积方块
    For i = 0 To 19
        For j = 0 To 9
            If blnGrid(i, j) Then
                picGrid.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), lngColor(i, j), B
                picGrid.Line (j * 20 + 4, i * 20 + 4)-(j * 20 + 17, i * 20 + 17), lngColor(i, j), BF
            Else
                picGrid.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), vbBlack, B
                picGrid.Line (j * 20 + 4, i * 20 + 4)-(j * 20 + 17, i * 20 + 17), vbWhite, BF
            End If
        Next
    Next
    '绘制“下一个”网块
      For i = 0 To 3
        For j = 0 To 3
                picNext.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), vbBlack, B
        Next
    Next
   
    '初次启动时不显示下一个和移动方块
    If blnStarted Then
        If blnShowNext Then
             For i = 0 To 3
                For j = 0 To 3
                    If blnBlock(intTypeNew, intOrieNew, i, j) Then
                        picNext.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), lngColorNew, B
                        picNext.Line (j * 20 + 4, i * 20 + 4)-(j * 20 + 17, i * 20 + 17), lngColorNew, BF
                    Else
                        picNext.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), vbBlack, B
                        picNext.Line (j * 20 + 4, i * 20 + 4)-(j * 20 + 17, i * 20 + 17), vbWhite, BF
                    End If
                Next
            Next
        Else
             For i = 0 To 3
                For j = 0 To 3
                    picNext.Line (j * 20 + 2, i * 20 + 2)-(j * 20 + 19, i * 20 + 19), vbBlack, B
                    picNext.Line (j * 20 + 4, i * 20 + 4)-(j * 20 + 17, i * 20 + 17), vbWhite, BF
                Next
            Next
        End If
    
        Call ShowBlock
    End If
End Sub

Private Sub form_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = 13 Then
        If Not blnStarted Then
            Call lblStart_Click
            Exit Sub
        End If
        If Timer1.Enabled Then
            Timer1.Enabled = False
            lblStart.Caption = "继 续"
            Exit Sub
        Else
            Timer1.Enabled = True
            lblStart.Caption = "暂 停"
            Exit Sub
        End If
    End If
    If Not Timer1.Enabled Then Exit Sub
    If blnScheme Then
        Select Case KeyCode
            Case vbKeyLeft
                GoLeft
            Case vbKeyRight
                GoRight
            Case vbKeyUp
                Rotate
            Case vbKeyDown                                  '加速下降
                QuickDown
        End Select
    Else
        Select Case KeyCode
            Case Asc("A")
                GoLeft
            Case Asc("S")
                GoRight
            Case Asc("W")
                Rotate
            Case Asc("Z")                                '加速下降
                QuickDown
        End Select
    End If
    Call ShowBlock
End Sub

Private Sub Form_Unload(Cancel As Integer)
         Open App.Path & "\block.dat" For Output As 1
        Write #1, intDownDistance, blnClockWise, blnShowNext, blnScheme, lngHighScore
        Close 1
End Sub


Private Sub lblStart_Click()
     If Not blnStarted Then
        Randomize
        blnStarted = True
        intTypeCur = Int(Rnd * 5)                   '随机出现方块与下一个方块
        lngColorCur = QBColor(Int(Rnd * 7))
        intOrieCur = Int(Rnd * 4)                    '随机决定方块方位
        intOrieNext = intOrieCur
        intYCur = -3: intXCur = 2                   '方块出现时的位置
        intYNext = intYCur: intXNext = intXCur
        
        intTypeNew = Int(Rnd * 5)                 '随机产生下个方块的类型,方块与颜色
        intOrieNew = Int(Rnd * 4)
        lngColorNew = QBColor(Int(Rnd * 7))
       
        Call ShowBlock
        Call ShowNext
    End If
    Timer1.Enabled = Not Timer1.Enabled
    If Timer1.Enabled Then
        lblStart.Caption = "暂 停"
    Else
        lblStart.Caption = "继 续"
    End If

End Sub

Private Sub mnuAbout_Click()
    frmAbout.Show 1, Me
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuOption_Click()
    Timer1.Enabled = False
    lblStart.Caption = "继 续"
    frmOption.Show 1, Me
End Sub

Private Sub Timer1_Timer()
    Dim i As Integer, j As Integer
    
    For i = 3 To 0 Step -1                                                                  '测试是否落到底
        For j = 0 To 3
            If blnBlock(intTypeCur, intOrieCur, i, j) And (i + intYCur >= 19) Then Exit For  '超出下边界
            If Not (i + intYCur + 1 < 0 Or i + intYCur + 1 > 19 Or j + intXCur < 0 Or j + intXCur > 9) Then '如果下边遇到方块
                If blnBlock(intTypeCur, intOrieCur, i, j) And (blnGrid(i + intYCur + 1, j + intXCur)) Then
                    Exit For
                End If
            End If
        Next
        If j <= 3 Then Exit For
    Next
        
    If i >= 0 Then                          '如果方块已落到底
        If intYCur <= -1 Then               '本轮已结果
            Timer1.Enabled = False
            If lngScore > lngHighScore Then
                lngHighScore = lngScore
                txtHigh.Text = lngHighScore
            End If
            
            lngScore = 0
            txtScore.Text = 0
            Randomize
            blnStarted = True
            intTypeCur = Int(Rnd * 5)                   '随机出现方块与下一个方块
            lngColorCur = QBColor(Int(Rnd * 14))
            intOrieCur = Int(Rnd * 4)                    '随机决定方块方位
            intOrieNext = intOrieCur
            intYCur = -3: intXCur = 2                   '方块出现时的位置
            intYNext = intYCur: intXNext = intXCur
            
            intTypeNew = Int(Rnd * 5)                 '随机产生下个方块的类型,方块与颜色
            intOrieNew = Int(Rnd * 4)
            lngColorNew = QBColor(Int(Rnd * 14))
            Erase blnGrid, lngColor
            lblStart.Caption = "开 始"
            Call Form_Activate
        Else
             
             For i = 0 To 3
                 For j = 0 To 3
                     If Not (i + intYCur < 0 Or i + intYCur > 19 Or j + intXCur < 0 Or j + intXCur > 9) Then '避免出现下标越界
                         If blnBlock(intTypeCur, intOrieCur, i, j) Then
                             blnGrid(i + intYCur, j + intXCur) = True
                             lngColor(i + intYCur, j + intXCur) = lngColorCur
                         End If
                     End If
                 Next
             Next
             
             Randomize
             intTypeCur = intTypeNew
             intTypeNew = Int(Rnd * 5)                     '随机出现下一个方块
             lngColorCur = lngColorNew
             lngColorNew = QBColor(Int(Rnd * 7))          '随机出现下一个方块的颜色
             intOrieCur = intOrieNew                       '随机决定方块方位
             intOrieNext = intOrieNew
             
             intOrieNew = Int(Rnd * 4)
             intYCur = -3: intXCur = 2                  '方块出现时的位置
             intYNext = intYCur: intXNext = intXCur
             
             intTypeNew = Int(Rnd * 5)                  '随机产生下个方块的类型,方块与颜色
             intOrieNew = Int(Rnd * 4)
             lngColorNew = QBColor(Int(Rnd * 7))
            
             Call Score
             Call ShowBlock
             Call ShowNext                               '显示下一个方块类型
        End If
    Else
        intYNext = intYNext + 1
        Call ShowBlock
    End If
End Sub
Private Sub GoLeft()
    Dim i As Integer, j As Integer

    For i = 0 To 3
        For j = 0 To 3
            If blnBlock(intTypeCur, intOrieCur, j, i) And i + intXCur <= 0 Then Exit Sub     '禁止超出左边界
        Next
    Next
    intXNext = intXNext - 1

End Sub
Private Sub GoRight()
    Dim i As Integer, j As Integer

    For i = 3 To 0 Step -1
        For j = 0 To 3