短小精悍的俄罗斯方块VB.NET源代码

窗体上不需要任何控件，代码共128行。

Public Class Form1
    Private Declare Function Beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Integer, ByVal dwDuration As Integer) As Boolean
    Private ShowBitMap As New Bitmap(20, 20), BackBitMap As New Bitmap(20, 20), PreviewBitmap As Bitmap, PreviewGraphics As Graphics
    Private BlockType As Integer, BlockState As Integer, DrawRectangle As Rectangle = New Rectangle(2, 2, 15, 26), DrawLocation As Point, Score As Long, NextType As Integer = 3, Blocks(,) As Integer '0 隐藏，1显示，2 静止  
    Private AllPoints()() As Point = {New Point() {New Point(0, 0), New Point(1, 0), New Point(2, 0), New Point(3, 0)}, New Point() {New Point(0, 0), New Point(0, 1), New Point(1, 0), New Point(1, 1)}, New Point() {New Point(0, 0), New Point(1, 0), New Point(2, 0), New Point(0, 1)}, New Point() {New Point(0, 0), New Point(1, 0), New Point(2, 0), New Point(2, 1)}, New Point() {New Point(0, 0), New Point(1, 0), New Point(1, 1), New Point(2, 1)}, New Point() {New Point(0, 1), New Point(1, 1), New Point(1, 0), New Point(2, 0)}, New Point() {New Point(0, 0), New Point(1, 0), New Point(2, 0), New Point(1, 1)}}
    Private WithEvents MyTimer As New Timer
    Private Function NewBlock(ByVal nLocation As Point, ByVal nState As Integer, ByVal nBeep As Boolean) As Boolean
        Dim nLeft As Integer = 100, nRight As Integer = -1, nBottom As Integer = -1, nPoints() As Point = AllPoints(BlockType).Clone()
        For i As Integer = 1 To nState Mod 4 '旋转
            nPoints(2) = New Point(nPoints(2).Y - nPoints(1).Y + nPoints(1).X, 2 - nPoints(2).X + nPoints(1).X + nPoints(1).Y - 2)
            nPoints(0) = New Point(nPoints(0).Y - nPoints(1).Y + nPoints(1).X, 2 - nPoints(0).X + nPoints(1).X + nPoints(1).Y - 2)
            nPoints(3) = New Point(nPoints(3).Y - nPoints(1).Y + nPoints(1).X, 2 - nPoints(3).X + nPoints(1).X + nPoints(1).Y - 2)
        Next
        For Each n As Point In nPoints
            If n.X < nLeft Then nLeft = n.X
            If n.X > nRight Then nRight = n.X
            If n.Y > nBottom Then nBottom = n.Y
        Next
        If nLocation.X + nLeft < 0 Then nLocation.X = -nLeft
        If nLocation.X + nRight > DrawRectangle.Width Then nLocation.X = DrawRectangle.Width - nRight
        If nLocation.Y + nBottom > DrawRectangle.Height Then Return True
        For Each p As Point In nPoints
            If p.Y + nLocation.Y >= 0 AndAlso Blocks(p.X + nLocation.X, p.Y + nLocation.Y) > 1 Then Return True
        Next
        For y As Integer = 0 To DrawRectangle.Height
            For x As Integer = 0 To DrawRectangle.Width
                If Blocks(x, y) = 1 Then Blocks(x, y) = 0
            Next
        Next
        For Each p As Point In nPoints
            If p.Y + nLocation.Y >= 0 Then Blocks(p.X + nLocation.X, p.Y + nLocation.Y) = 1
        Next
        BlockState = nState
        DrawLocation = nLocation
        If nBeep Then Beep(1800, 50) '  My.Computer.Audio.PlaySystemSound(Media.SystemSounds.Asterisk)
    End Function
    Private Sub Key_Up(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyUp
        If MyTimer.Enabled AndAlso (e.KeyCode = Keys.W OrElse e.KeyCode = Keys.Up) Then '向上键
            If NewBlock(DrawLocation, BlockState + 1, True) = False Then DrawBlock()
        ElseIf MyTimer.Enabled AndAlso (e.KeyCode = Keys.D OrElse e.KeyCode = Keys.Right) Then '向右键
            If NewBlock(New Point(DrawLocation.X + 1, DrawLocation.Y), BlockState, True) = False Then DrawBlock()
        ElseIf MyTimer.Enabled AndAlso (e.KeyCode = Keys.A OrElse e.KeyCode = Keys.Left) Then '向左键
            If NewBlock(New Point(DrawLocation.X - 1, DrawLocation.Y), BlockState, True) = False Then DrawBlock()
        ElseIf MyTimer.Enabled AndAlso (e.KeyCode = Keys.S OrElse e.KeyCode = Keys.Down OrElse e.KeyCode = Keys.Space) Then '向下键
            For y As Integer = 1 To DrawRectangle.Height
                If NewBlock(New Point(DrawLocation.X, DrawLocation.Y + 1), BlockState, y = 1) Then Exit For
            Next
            DrawBlock() '绘制整个矩阵
        ElseIf e.KeyCode = Keys.Enter OrElse e.KeyCode = Keys.Escape Then '回车键
            MyTimer.Enabled = Not MyTimer.Enabled '计时器开关设置
            If MyTimer.Enabled Then
                Graphics.FromImage(ShowBitMap).FillRectangle(New System.Drawing.Drawing2D.HatchBrush(Rnd() * 52, Color.FromArgb(&HFF000000 Or &HFFFFFF * Rnd()), Color.FromArgb(&HFF000000 Or &HFFFFFF * Rnd())), New Rectangle(0, 0, 20, 20))
                Graphics.FromImage(ShowBitMap).DrawRectangle(New Pen(Color.Black, 1), New Rectangle(1, 1, 17, 17))
                Graphics.FromImage(BackBitMap).FillRectangle(New System.Drawing.Drawing2D.HatchBrush(Rnd() * 52, Color.FromArgb(&HFF000000 Or &HFFFFFF * Rnd()), Color.FromArgb(&HFF000000 Or &HFFFFFF * Rnd())), New Rectangle(0, 0, 20, 20))
                Graphics.FromImage(BackBitMap).DrawRectangle(New Pen(Color.Black, 2), New Rectangle(0, 0, 19, 19))
                MyTimer.Interval = 500
                ReDim Blocks(DrawRectangle.Width, DrawRectangle.Height)
                Score = 0 '初始化分数
                NewBlock(New Point(5, 0), 0, False) '初始化当前块位置
                DrawBlock()  '绘制整个矩阵
                Me.Text = "分数:" & Score '设置窗口标题
            End If
        End If
    End Sub
    Private Sub Timer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyTimer.Tick
        If NewBlock(New Point(DrawLocation.X, DrawLocation.Y + 1), BlockState, False) Then '如果触碰到底边
            For y As Integer = 1 To DrawRectangle.Height
                For x As Integer = 0 To DrawRectangle.Width
                    If Blocks(x, y) = 1 Then Blocks(x, y) = 2
                Next
            Next
            Dim i As Integer = ClearLine(0) '从第0行开始清行
            If i Then '如果有行被消除
                Score += (i ^ 2) * 10 '计算分数
                Me.Text = "分数:" & Score '设置窗口标题
            End If
            BlockType = NextType '设置当前块类型为预览块类型
            NextType = Rnd() * 6 '随机出下一个预览块
            If NewBlock(New Point(5, 0), 0, i) Then '如果新的块直接触碰到底。
                MyTimer.Enabled = False '停止计时器
                If MsgBox("游戏结束，按下 Enter 键重新开始。") = MsgBoxResult.Ok Then Exit Sub
            End If
        End If
        DrawBlock() '绘制整个矩阵
    End Sub
    Private Function ClearLine(ByVal StartIndex As Integer) As Integer
        If StartIndex > DrawRectangle.Height Then Return 0 '如果超出了矩阵范围，直接返回0 
        For x As Integer = 0 To DrawRectangle.Width
            If Blocks(x, StartIndex) <> 2 Then Return ClearLine(StartIndex + 1)
        Next
        For x As Integer = 0 To DrawRectangle.Width
            For y = StartIndex To 1 Step -1
                Blocks(x, y) = Blocks(x, y - 1)
            Next
        Next
        If MyTimer.Interval > 100 Then MyTimer.Interval -= 1 '每消一行减少时间1毫秒
        Return ClearLine(StartIndex + 1) + 1 '返回递归下一行的值并且加1(成功消了一行)
    End Function
    Private Sub DrawBlock()
        Dim i(5, 5) As Integer '新初始化一个预览矩阵
        For Each p As Point In AllPoints(NextType)
            i(p.X + 1, p.Y + 3) = 1
        Next
        DrawPicture(Blocks, DrawRectangle.Location) '将矩阵画到窗体缓存图片上
        DrawPicture(i, New Point(DrawRectangle.Right + 2, DrawRectangle.Y)) '将预览矩阵画到窗体缓存图片
        Me.CreateGraphics.DrawImage(PreviewBitmap, New Point(0, 0)) '将窗体缓存图片画到窗体上
    End Sub
    Private Sub DrawPicture(ByVal Picture(,) As Integer, ByVal nDrawPoint As Point)
        For x As Integer = 0 To Picture.GetUpperBound(0)
            For y As Integer = 1 To Picture.GetUpperBound(1)
                PreviewGraphics.DrawImage(BackBitMap, New Point(nDrawPoint.X * 20 + x * 20, nDrawPoint.Y * 20 + (y - 1) * 20)) '画背景块
                If Picture(x, y) = 1 OrElse Picture(x, y) = 2 Then '如果状态为1或2则画方块
                    PreviewGraphics.DrawImage(ShowBitMap, New Point(nDrawPoint.X * 20 + x * 20, nDrawPoint.Y * 20 + (y - 1) * 20))
                End If
            Next
        Next
    End Sub
    Private Sub Form_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Randomize() '初始化随机种子
        Me.Text = "按下 Enter 开始新游戏" '设置窗口标题
        Me.DoubleBuffered = True
        Me.SetBounds(Screen.PrimaryScreen.Bounds.X + (Screen.PrimaryScreen.Bounds.Width - (DrawRectangle.Right + 10) * 20) / 2, Screen.PrimaryScreen.Bounds.Y + (Screen.PrimaryScreen.Bounds.Height - (DrawRectangle.Bottom + 5) * 20) / 2, (DrawRectangle.Right + 10) * 20, (DrawRectangle.Bottom + 5) * 20)
        Me.FormBorderStyle = Windows.Forms.FormBorderStyle.FixedToolWindow '设置窗口样式
        Me.MaximizeBox = False '取消最大化按钮
        PreviewBitmap = New Bitmap((DrawRectangle.Right + 10) * 20, (DrawRectangle.Bottom + 5) * 20)
        PreviewGraphics = Graphics.FromImage(PreviewBitmap)
    End Sub
End Class

VS2010环境测试通过，VS2013下色彩有些问题。