frmmain.frm

用VB实现的俄罗斯方块游戏

    For i = 0 To MAX_BRICK_ID
        For j = 0 To 3
            For y = 0 To 3
                For x = 0 To 3
                    Input #FileNum, b
                    Brick(i, j, y, x) = b
                Next
            Next
        Next
    Next
    
    Dim r As Integer
    Input #FileNum, Rate(0)
    For i = 1 To MAX_BRICK_ID
        Input #FileNum, r
        Rate(i) = Rate(i - 1) + r
    Next
    
    Close
    ReadData = True
    Exit Function
    
FileErr:
    Close
    ReadData = False
End Function


'________________________________________________________________________________
'
' 游戏功能实现
'________________________________________________________________________________
'
' 载入下一个方块
Private Sub LoadBrick()
    CurrX = (MAX_X - 3) \ 2
    CurrY = MAX_Y
    CurrID = NextID
    CurrDir = NextDir
    
    Dim r As Single
    Dim i As Integer
    r = Rnd * Rate(MAX_BRICK_ID)
    For i = 0 To MAX_BRICK_ID
        If r < Rate(i) Then
            NextID = i
            Exit For
        End If
    Next
    NextDir = Int(Rnd * 4)
    DrawNextBrick
End Sub

' 方块下落
Private Function FallBrick() As Boolean
    Dim OldY As Integer
    Dim x As Integer, y As Integer
    Dim TmpX As Integer, TmpY As Integer

    OldY = CurrY
    CurrY = CurrY - 1
    For y = 0 To 3
        For x = 0 To 3
            TmpY = CurrY - y: TmpX = CurrX + x
            If Brick(CurrID, CurrDir, y, x) Then
                If TmpY >= 0 Then
                    If Space(TmpY, TmpX) > 0 Then
                        CurrY = OldY
                        FallBrick = False
                        Exit Function
                    End If
                Else
                    CurrY = OldY
                    FallBrick = False
                    Exit Function
                End If
            End If
        Next
    Next
    EraseBrick CurrX, OldY, CurrID, CurrDir
    DrawBrick CurrX, CurrY, CurrID, CurrDir
    FallBrick = True
End Function

' 旋转方块
Private Function RotateBrick(Deasil As Boolean) As Boolean
    Dim OldDir As Integer
    Dim x As Integer, y As Integer
    Dim TmpX As Integer, TmpY As Integer
    
    OldDir = CurrDir
    If Deasil Then
        CurrDir = (CurrDir + 1) Mod 4
    Else
        CurrDir = (CurrDir + 3) Mod 4
    End If

    For y = 0 To 3
        For x = 0 To 3
            TmpY = CurrY - y: TmpX = CurrX + x
            If Brick(CurrID, CurrDir, y, x) Then
                If TmpY >= 0 And TmpX >= 0 And TmpX <= 9 Then
                    If Space(TmpY, TmpX) > 0 Then
                        CurrDir = OldDir
                        RotateBrick = False
                        Exit Function
                    End If
                Else
                    CurrDir = OldDir
                    RotateBrick = False
                    Exit Function
                End If
            End If
        Next
    Next
    EraseBrick CurrX, CurrY, CurrID, OldDir
    DrawBrick CurrX, CurrY, CurrID, CurrDir
    RotateBrick = True
End Function

' 左右移动方块
Private Function MoveBrick(dx As Integer) As Boolean
    Dim OldX As Integer
    Dim x As Integer, y As Integer
    Dim TmpX As Integer, TmpY As Integer

    OldX = CurrX
    CurrX = CurrX + dx
    For y = 0 To 3
        For x = 0 To 3
            TmpY = CurrY - y: TmpX = CurrX + x
            If Brick(CurrID, CurrDir, y, x) Then
                If TmpY >= 0 And TmpX >= 0 And TmpX <= 9 Then
                    If Space(TmpY, TmpX) > 0 Then
                        CurrX = OldX
                        MoveBrick = False
                        Exit Function
                    End If
                Else
                    CurrX = OldX
                    MoveBrick = False
                    Exit Function
                End If
            End If
        Next
    Next
    EraseBrick OldX, CurrY, CurrID, CurrDir
    DrawBrick CurrX, CurrY, CurrID, CurrDir
    MoveBrick = True
End Function

' 方块落定
Private Sub BrickFallen()
    Dim x As Integer, y As Integer
    Dim AddScore As Integer, Plus As Integer
    
    sndPlaySound "Sound.wav", SND_ASYNC
    
    AddScore = 0
    Plus = 1
    For y = 0 To 3
        For x = 0 To 3
            If Brick(CurrID, CurrDir, y, x) Then
                Space(CurrY - y, CurrX + x) = CurrID + 1
            End If
        Next
        If CurrY - y >= 0 Then
            For x = 0 To MAX_X
                If Space(CurrY - y, x) = 0 Then
                    Exit For
                End If
            Next
            If x > MAX_X Then
                sndPlaySound "Sound2.wav", SND_ASYNC
                RemoveLine CurrY - y
                AddScore = AddScore + Plus
                Plus = Plus + 1
            End If
        End If
    Next
    
    Dim OldScore As Long
    OldScore = Score
    Score = Score + AddScore
    lblScore.Caption = Score
    If Score >= (OldScore \ 100 + 1) * 100 Then
        Level = Level + 1
        If Level > 9 Then
            MsgBox "你真是个天才！", vbCritical Or vbOKOnly, "俄罗斯方块"
            End
        End If
        SetDelayTime Level
        lblLevel.Caption = Level
    End If
End Sub

' 消去一行
Private Function RemoveLine(n As Integer)
    Dim y As Integer, x As Integer
    For y = n To MAX_Y - 1
        For x = 0 To MAX_X
            Space(y, x) = Space(y + 1, x)
            DrawCell y, x
        Next
    Next
End Function


'________________________________________________________________________________
'
' 图象处理
'________________________________________________________________________________
'
' 画一格
Private Function DrawCell(y As Integer, x As Integer)
    If y < MAX_Y - 3 Then
        BitBlt picSpace.hDC, x * 20, (MAX_Y - 4 - y) * 20, 20, 20, picBricks.hDC, Space(y, x) * 20, 0, vbSrcCopy
    End If
    picSpace.Refresh
End Function

' 清除方块
Private Sub EraseBrick(x As Integer, y As Integer, ID As Integer, Dir As Integer)
    Dim ix As Integer, iy As Integer
    Dim TmpX As Integer, TmpY As Integer
    For iy = 0 To 3
        For ix = 0 To 3
            TmpY = y - iy: TmpX = x + ix
            If Brick(ID, Dir, iy, ix) Then
                BitBlt picSpace.hDC, TmpX * 20, (19 - TmpY) * 20, 20, 20, _
                    picBricks.hDC, 0, 0, vbSrcCopy
            End If
        Next
    Next
    picSpace.Refresh
End Sub

' 画方块
Private Sub DrawBrick(x As Integer, y As Integer, ID As Integer, Dir As Integer)
    Dim ix As Integer, iy As Integer
    Dim TmpX As Integer, TmpY As Integer
    For iy = 0 To 3
        For ix = 0 To 3
            TmpY = y - iy: TmpX = x + ix
            If Brick(ID, Dir, iy, ix) Then
                BitBlt picSpace.hDC, TmpX * 20, (19 - TmpY) * 20, 20, 20, _
                    picBricks.hDC, (ID + 1) * 20, 0, vbSrcCopy
            End If
        Next
    Next
    picSpace.Refresh
End Sub

' 画下一个方块
Private Sub DrawNextBrick()
    Dim x As Integer, y As Integer
    For y = 0 To 3
        For x = 0 To 3
            If Brick(NextID, NextDir, y, x) Then
                BitBlt picNextBrick.hDC, x * 20, y * 20, 20, 20, _
                    picBricks.hDC, (NextID + 1) * 20, 0, vbSrcCopy
            Else
                BitBlt picNextBrick.hDC, x * 20, y * 20, 20, 20, _
                    picBricks.hDC, 0, 0, vbSrcCopy
            End If
        Next
    Next
    picNextBrick.Refresh
End Sub

'________________________________________________________________________________
'
' 其它函数
'________________________________________________________________________________
'
' 设置延迟时间
Private Sub SetDelayTime(Lev As Integer)
    tmrDelay.Interval = (10 - Lev) * 50
    lblLevel.Caption = Level
End Sub