短小精悍的俄罗斯方块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 SubEnd Class

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