vb.net和GDI+实现经典俄罗斯方块游戏

先放游戏截图

 下面是代码

Public Class 俄罗斯方块 '窗体类
    Dim myTrtris As Tetris '实例化对象
    Private Sub 俄罗斯方块_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp '窗体按键事件

        If myTrtris IsNot Nothing Then '如果对象呗实例化就要触发下落或者改变方向事件,然后画图
            myTrtris.DownCubes(e)
            pictureBox1.Image = myTrtris.Bitmap
        End If

    End Sub

    Private Sub 青铜ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 青铜ToolStripMenuItem.Click '菜单选择难度,难度梯度通过让计时器间隔变小实现
        myTrtris = New Tetris()
        Timer1.Enabled = True
        Timer1.Interval = 1000
    End Sub

    Private Sub 白银ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 白银ToolStripMenuItem.Click
        myTrtris = New Tetris()
        Timer1.Enabled = True
        Timer1.Interval = 500
    End Sub

    Private Sub 黄金ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 黄金ToolStripMenuItem.Click
        myTrtris = New Tetris()
        Timer1.Enabled = True
        Timer1.Interval = 300
    End Sub

    Private Sub 白金ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 白金ToolStripMenuItem.Click
        myTrtris = New Tetris()
        Timer1.Enabled = True
        Timer1.Interval = 200
    End Sub

    Private Sub 钻石ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 钻石ToolStripMenuItem.Click
        myTrtris = New Tetris()
        Timer1.Enabled = True
        Timer1.Interval = 120
    End Sub

    Private Sub 大师ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 大师ToolStripMenuItem.Click
        myTrtris = New Tetris()
        Timer1.Enabled = True
        Timer1.Interval = 60
    End Sub
    Private Sub 王者ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 王者ToolStripMenuItem.Click
        myTrtris = New Tetris()
        Timer1.Enabled = True
        Timer1.Interval = 30
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick '当到达了时间
        If myTrtris IsNot Nothing Then
            myTrtris.DownCubes(New KeyEventArgs(Keys.Down)) '下降
            pictureBox1.Image = myTrtris.Bitmap '显示图片
            label5.Text = myTrtris.Score '显示分数
            If myTrtris.Score > highScore Then
                label6.Text = myTrtris.Score
                My.Settings.elsHighScore = myTrtris.Score '储存最高分到setting
            End If

            If myTrtris.GameOver = True Then
                Timer1.Enabled = False
                MsgBox("游戏结束你的得分为" & myTrtris.Score)

            End If
        End If
    End Sub
    Dim highScore As Integer
    Private Sub 俄罗斯方块_Load(sender As Object, e As EventArgs) Handles MyBase.Load '显示最高分
        highScore = My.Settings.elsHighScore
        label6.Text = highScore
    End Sub

    Private Sub 俄罗斯方块_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing '窗体关闭的时候触发的事件
        If Val(label6.Text) <= highScore Then


        Else
            My.Settings.elsHighScore = Val(label6.Text)
        End If
    End Sub

    Private Sub label1_Click(sender As Object, e As EventArgs) Handles label1.Click 'label1用来代替按钮的功能,可以暂停游戏继续游戏并且显示当前游戏的进程,通过计时器的可用性实现
        If myTrtris IsNot Nothing Then
            If label1.Text = "暂停" Then
                label1.Text = "继续"
                Timer1.Enabled = False
            ElseIf label1.Text = "继续" Then
                label1.Text = "暂停"
                Timer1.Enabled = True
            End If
        End If
    End Sub

    Private Sub label2_Click(sender As Object, e As EventArgs) Handles label2.Click '游戏结束按钮,对象清空
        myTrtris = Nothing
        pictureBox1.Image = Nothing
        If Timer1.Enabled = True Then
            label1.Text = "继续"

        End If

    End Sub

    Private Sub pictureBox1_Click(sender As Object, e As EventArgs) Handles pictureBox1.Click

    End Sub
End Class


Public Class four1 '这是一个子类
    '编号3
    Inherits CubeParent '继承父类



    Friend Overrides ReadOnly Property Number As Integer '实现接口
        Get
            Return 4
        End Get
    End Property

    Sub New() '初始化每个点的位置
        Sites(1) = New Point(80, 20)
        Sites(2) = New Point(80, 0)
        Sites(3) = New Point(80, -20)
        Sites(4) = New Point(80, -40)

    End Sub
End Class
Public Class four2
    Inherits CubeParent

    Friend Overrides ReadOnly Property Number As Integer
        Get
            Return 4
        End Get
    End Property
    Sub New()
        Sites(1) = New Point(80, -20)
        Sites(2) = New Point(100, -20)
        Sites(3) = New Point(80, 0)
        Sites(4) = New Point(100, 0)
    End Sub
End Class
Public Class four3
    Inherits CubeParent



    Friend Overrides ReadOnly Property Number As Integer
        Get
            Return 4

        End Get

    End Property
    Sub New()
        Sites(1) = New Point(120, -20)
        Sites(2) = New Point(100, -20)
        Sites(3) = New Point(80, -20)
        Sites(4) = New Point(80, 0)
    End Sub


End Class
Public Class four4
    Inherits CubeParent



    Friend Overrides ReadOnly Property Number As Integer
        Get
            Return 4

        End Get

    End Property
    Sub New()
        Sites(1) = New Point(120, -20)
        Sites(2) = New Point(100, -20)
        Sites(3) = New Point(80, -20)
        Sites(4) = New Point(120, 0)
    End Sub

End Class
Public Class four5
    Inherits CubeParent



    Friend Overrides ReadOnly Property Number As Integer
        Get
            Return 4
        End Get
    End Property

    Sub New()
        Sites(1) = New Point(120, 0)
        Sites(2) = New Point(100, 0)
        Sites(3) = New Point(80, 0)
        Sites(4) = New Point(100, -20)
    End Sub
End Class
Public Class four6
    Inherits CubeParent



    Friend Overrides ReadOnly Property Number As Integer
        Get
            Return 4
        End Get
    End Property


    Sub New()
        Sites(1) = New Point(100, 0)
        Sites(2) = New Point(80, 0)
        Sites(3) = New Point(100, -20)
        Sites(4) = New Point(120, -20)
    End Sub
End Class
Public Class one
    Inherits CubeParent

    Sub New()
        Sites(1) = New Point(80, -20)
    End Sub
    Friend Overrides ReadOnly Property Number() As Integer
        Get
            Return 1
        End Get
    End Property
End Class
Public Class Tetris
#Region "结构,变量"
    Private Structure cubes '结构,(点,图片)
        Dim Point As Point
        Dim Image As Bitmap
    End Structure
    Private Width As Integer = 200
    Private Height As Integer = 320
    Private NewCubes As CubeParent
#End Region
#Region "属性"
    Private M_Score As Integer = 0 '总成绩
    Public Property Score() As Integer '成绩
        Get
            Return M_Score
        End Get
        Set(ByVal value As Integer)
            M_Score = value
        End Set
    End Property

    Private m_GameOver As Boolean = False
    Public Property GameOver() As Boolean '是否游戏结束
        Get
            Return m_GameOver
        End Get
        Set(ByVal value As Boolean)
            m_GameOver = value
        End Set
    End Property

    Private M_Image As Bitmap
    Public Property Image() As Bitmap '图片
        Get
            Return M_Image
        End Get
        Set(ByVal value As Bitmap)
            M_Image = value
        End Set
    End Property


    Private M_AllCubes As New List(Of cubes)
    Private Property AllCubes As List(Of cubes) '所有的方格
        Get
            Return M_AllCubes
        End Get
        Set(ByVal value As List(Of cubes))
            M_AllCubes = value
        End Set
    End Property


    Private m_Bitmap As New Bitmap(Width, Height) '图片
    Public Property Bitmap() As Bitmap
        Get
            Return m_Bitmap
        End Get
        Set(ByVal value As Bitmap)
            m_Bitmap = value
        End Set
    End Property
#End Region

#Region "方法"
    Private Sub RaiseCube() '生成新的方格
        Dim Temps() As CubeParent = {New one, New two, New three, New three2, New four1, New four2, New four3, New four4, New four5, New four6}
        Randomize()
        Dim n As Integer = Int(Rnd() * 10)
        '随机从所有的子类中实例化一个方块类型对象
        NewCubes = Temps(n)
    End Sub

    Public Sub DownCubes(e As KeyEventArgs) '下降cubes
        If e.KeyCode = Keys.Down AndAlso NewCubes.NextContactEdge(Width, Height, CubeParent.方向.下) = False Then

            Dim temp As Boolean = False
            For Each item As cubes In AllCubes
                For i As Integer = 1 To NewCubes.Number
                    If item.Point.X = NewCubes.Sites(i).X AndAlso item.Point.Y = NewCubes.Sites(i).Y + 20 Then
                        temp = True
                        Exit For
                    End If
                    If temp = True Then Exit For '如果接触到了下方的方格
                Next
            Next
            '如果没有接触到边界
            If temp = False Then
                NewCubes.OneStep(CubeParent.方向.下) '所有的方块下落一个点;'下落点之后再次判断

                Dim Contact As Boolean = False
                For Each item As cubes In AllCubes
                    For i As Integer = 1 To NewCubes.Number
                        If item.Point.X = NewCubes.Sites(i).X AndAlso item.Point.Y = NewCubes.Sites(i).Y + 20 Then
                            Contact = True
                            Exit For
                        End If
                        If Contact = True Then Exit For
                    Next
                Next
                If Contact = True Then
                    For i As Integer = 1 To NewCubes.Number '接触到了下方已经不动的方块集合,就加分,然后方块集合增加新的方块
                        Score += 1
                        Dim Tempcube As cubes
                        Tempcube.Point = NewCubes.Sites(i)
                        Tempcube.Image = NewCubes.Image
                        AllCubes.Add(Tempcube)
                    Next
                    RaiseCube()
                End If

            Else '如果有谁的方块的y坐标是0就表示游戏结束了

                For i As Integer = 1 To NewCubes.Number
                    Dim Tempcube As cubes
                    If NewCubes.Sites(i).Y = 0 Then

                        Me.GameOver = True
                        Exit Sub
                    End If
                    Tempcube.Point = NewCubes.Sites(i)
                    Tempcube.Image = NewCubes.Image
                    AllCubes.Add(Tempcube)
                    Score += 1
                Next
                RaiseCube()
            End If

        ElseIf e.KeyCode = Keys.Right And NewCubes.NextContactEdge(Width, Height, CubeParent.方向.右) = False Then '所有的带你向右移动

            Dim temp As Boolean = False
            For Each item As cubes In AllCubes
                For i As Integer = 1 To NewCubes.Number
                    If item.Point.Y = NewCubes.Sites(i).Y AndAlso item.Point.X = NewCubes.Sites(i).X + 20 Then
                        temp = True
                        Exit For
                    End If
                Next

            Next
            '如果没有接触到边界
            If temp = False Then
                NewCubes.OneStep(CubeParent.方向.右)
            End If


        ElseIf e.KeyCode = Keys.Left And NewCubes.NextContactEdge(Width, Height, CubeParent.方向.左) = False Then

            Dim temp As Boolean = False
            For Each item As cubes In AllCubes
                For i As Integer = 1 To NewCubes.Number
                    If item.Point.Y = NewCubes.Sites(i).Y AndAlso item.Point.X = NewCubes.Sites(i).X - 20 Then
                        temp = True
                        Exit For
                    End If
                Next

            Next
            '如果没有接触到allcubes
            If temp = False Then
                NewCubes.OneStep(CubeParent.方向.左)
            End If
        ElseIf e.KeyCode = Keys.Up Then '如果是上键,就让方格改变方向
            Dim Contact As Boolean = False
            Dim tempPoints() As Point = NewCubes.ChangeStates '先看旋转之后的点是否会越界,如果越界就不旋转或者平移到变革
            For Each Item As cubes In AllCubes

                For Each index As Point In tempPoints

                    If Item.Point = index Or index.Y >= Height Then
                        Contact = True
                        Exit For

                    End If

                Next
                If Contact = True Then Exit For
            Next
            If Contact = False Then

                For i As Integer = 1 To NewCubes.Number
                    NewCubes.Sites(i) = tempPoints(i)
                Next

            End If

            NewCubes.Inner(Width) '在框体中间
        End If


        If NewCubes.NextContactEdge(Width, Height, CubeParent.方向.下) = True Then
            For i As Integer = 1 To NewCubes.Number
                Dim Tempcube As cubes
                Tempcube.Point = NewCubes.Sites(i)
                Tempcube.Image = NewCubes.Image
                AllCubes.Add(Tempcube) '如果接触到了下方边界,就会让所有的方块集合增加一个元素
                Score += 1
            Next
            RaiseCube()
        End If
        FillOneRow()
        DrawAll()
    End Sub
    Private Sub DrawAll() '画图
        Dim objGraphics As Graphics = Graphics.FromImage(m_Bitmap) '绘图场景对象来源于bitmap对象

        objGraphics.DrawImage(GridBitmap, 0, 0)
        For i As Integer = 1 To NewCubes.Number
            '会执行这个
            objGraphics.DrawImage(NewCubes.Image, NewCubes.Sites(i).X, NewCubes.Sites(i).Y, 19, 19) '画图
        Next

        For Each Item As cubes In AllCubes
            objGraphics.DrawImage(Item.Image, Item.Point.X, Item.Point.Y, 19, 19)
        Next


    End Sub



    Private Sub FillOneRow() '判断有没有一行已经满了
        Dim TempRow(Height / 20) As Integer
        For Each Item As cubes In AllCubes
            TempRow(Item.Point.Y / 20 + 1) += 1
        Next
        Dim FilledRow As New Generic.List(Of Integer)
        For i As Integer = 1 To Height / 20
            If TempRow(i) = Width / 20 Then
                Dim temp As Integer = i
                FilledRow.Add(i)
                AllCubes.RemoveAll(Function(item As cubes) item.Point.Y = temp * 20 - 20)
            End If
        Next
        Score += FilledRow.Count ^ 2 * 10
        For i As Integer = 0 To FilledRow.Count - 1
            For j As Integer = 0 To AllCubes.Count - 1
                If AllCubes(j).Point.Y / 20 + 1 < FilledRow(i) Then '所在的y在空格的上方就下落
                    Dim tempCube As cubes
                    tempCube.Point = New Point(AllCubes(j).Point.X, AllCubes(j).Point.Y + 20)
                    tempCube.Image = AllCubes(j).Image

                    AllCubes(j) = tempCube
                End If
            Next
        Next

    End Sub
#End Region

#Region "构造函数"

    Private GridBitmap As Bitmap = New Bitmap(Width, Height) '

    Sub New() '构造函数没有参数
        RaiseCube()
        Dim objGraphics As Graphics = Graphics.FromImage(GridBitmap)
        objGraphics.Clear(Color.Black)
        For x As Integer = 0 To Width Step 20
            objGraphics.DrawLine(New Pen(System.Drawing.Color.FromArgb(35, 35, 35)), x, 0, x, Height)
        Next
        For y As Integer = 0 To Height Step 20
            objGraphics.DrawLine(New Pen(System.Drawing.Color.FromArgb(35, 35, 35)), 0, y, Width, y) '画出游戏的栅格
        Next
    End Sub
#End Region
End Class

Public Class three
    Inherits CubeParent
    '编号2


    Friend Overrides ReadOnly Property Number As Integer
        Get
            Return 3
        End Get
    End Property

    Sub New()
        Sites(1) = New Point(60, -20)
        Sites(2) = New Point(80, -20)
        Sites(3) = New Point(80, 0)
    End Sub

End Class
Public Class three2
    Inherits CubeParent



    Friend Overrides ReadOnly Property Number As Integer
        Get
            Return 3
        End Get
    End Property
    Sub New()
        Sites(1) = New Point(80, 0)
        Sites(2) = New Point(80, -20)
        Sites(3) = New Point(80, -40)
    End Sub
End Class
Public Class two
    Inherits CubeParent

    Friend Overrides ReadOnly Property Number As Integer
        Get
            Return 2
        End Get
    End Property


    Sub New()
        Sites(1) = New Point(80, -20)
        Sites(2) = New Point(100, -20)
    End Sub

End Class
Public MustInherit Class CubeParent '抽象的父类
    Friend Enum 方向 '方向枚举
        下
        左
        右
    End Enum

    Private M_Image As Bitmap '位图属性
    Friend Property Image() As Bitmap
        Get
            Return M_Image
        End Get
        Set(ByVal value As Bitmap)
            M_Image = value
        End Set
    End Property

    Protected m_sites(Number) As Point '点属性数组
    Friend Property Sites(ByVal index As Integer) As Point
        Get
            Return m_sites(index)
        End Get
        Set(value As Point)
            m_sites(index) = value
        End Set
    End Property

    Friend MustOverride ReadOnly Property Number() As Integer '子类必须实现的属性,方格的个数
    Friend Function NextContactEdge(Width As Integer, Height As Integer, Direction As 方向) As Boolean  '再走一步就过边界根据方向枚举来

        For i As Integer = 1 To Number
            If Direction = 方向.下 Then
                If Sites(i).Y + 20 = Height Then
                    Return True
                End If
            ElseIf Direction = 方向.左 Then
                If Sites(i).X - 20 = -20 Then
                    Return True
                End If
            ElseIf Direction = 方向.右 Then
                If Sites(i).X + 20 = Width Then
                    Return True
                End If
            End If
        Next
        Return False

    End Function




    Friend Sub OneStep(Direction As 方向) '走一步
        Select Case Direction
            Case 方向.下
                For i As Integer = 1 To Number
                    Sites(i) = New Point(Sites(i).X, Sites(i).Y + 20)
                Next
            Case 方向.左
                For i As Integer = 1 To Number
                    Sites(i) = New Point(Sites(i).X - 20, Sites(i).Y)
                Next
            Case 方向.右
                For i As Integer = 1 To Number
                    Sites(i) = New Point(Sites(i).X + 20, Sites(i).Y)
                Next
        End Select


    End Sub
    Sub New() '随机方块颜色
        Randomize()
        Dim MyBitmaps() As Bitmap = {My.Resources.红色, My.Resources.黄色, My.Resources.灰色, My.Resources.蓝色, My.Resources.绿色, My.Resources.紫色, My.Resources.暗红, My.Resources.黑色, My.Resources.橘色, My.Resources.青色}
        Image = MyBitmaps(Int(10 * Rnd()))

    End Sub

    Friend Sub Inner(width) '潜在的bug
        For i As Integer = 1 To Number
            If Sites(i).X < 0 Then
                For j As Integer = 1 To Number
                    Sites(j) = New Point(Sites(j).X + 20, Sites(j).Y)

                Next
            ElseIf Sites(i).X = width Then
                For j As Integer = 1 To Number
                    Sites(j) = New Point(Sites(j).X - 20, Sites(j).Y)

                Next
            End If

        Next
    End Sub
    Friend Function ChangeStates() As Point() '改变方向,通用的过程,是让旋转方块基点是1号方块
        Static Angle As Integer
        Angle = 90
        Dim tempPoints(4) As Point
        tempPoints(1) = Sites(1)
        For i As Integer = 2 To Number

            Dim dx As Integer = Sites(i).X - Sites(1).X
            Dim dy As Integer = Sites(i).Y - Sites(1).Y
            Dim 弧度 As Double = Angle * Math.PI / 180
            tempPoints(i) = New Point(CInt(dx * Math.Cos(弧度) + dy * Math.Sin(弧度)) + Sites(1).X, CInt(dy * Math.Cos(弧度) - dx * Math.Sin(弧度)) + Sites(1).Y)
            '公式上述
        Next
        Return tempPoints
    End Function
End Class

结构：

其中俄罗斯方块是窗体类，CubeParent是所有方块的基类，teris是游戏类，其他都是cubeParent的派生类。把所有方块都有特点放在基类当中，把不同的地方各自类再声明。这是以前写的程序，如果算法现在再实现一下，用上常用的数据结构，或许可以能够实现的更漂亮一些。

以上是所有的控件，下面一些是菜单控件的项 

俄罗斯方块，小游戏，vb.net,GDI+，封装继承