也发一个vb.net俄罗斯方块

[lhblxm]

很喜欢俄罗斯方块这个游戏，今天也发一个凑个热闹

Public Class Form1
    '28种方块形态，其实只有19种，有重复是为了计算旋转
    Dim Blocks As Integer() = {27648, 35904, 27648, 35904, 50688, 19584, 50688, 19584, 58368, 35968, _
                               19968, 19520, 17600, 57856, 51328, 36352, 35008, 11776, 50240, 59392, _
                               3840, 17476, 3840, 17476, 52224, 52224, 52224, 52224}
    '二维数组，记录已固定的方块
    Dim BackPane As Integer(,)
    Dim PreviewArea As New Rectangle(220, 10, 100, 100) '预览区’
    Dim MainArea As New Rectangle(10, 10, 200, 400) '主显示区’
    Dim WithEvents Timer1 As New Timer With {.Interval = 200}
    Structure Block '方块定义
        Dim Order As Integer  '在28种方块形态的位置’
        Dim Position As Point  '相对显示区的坐标’
        Dim descPoints As List(Of Point) '方块特征描述’
    End Structure
    Dim CurBlock As Block '当前方块
    Dim NextBlock As Block '下一方块’

    '选取顺序为ORDER的方块，并偏移坐标’
    '这里选转换为二进制0和1，在一个4X4的方里，1表示为有填充’
    Function GetBlock(ByVal Order As Integer, ByVal position As Point) As Block
        Dim blk As New Block With {.Order = Order, .Position = position, .descPoints = New List(Of Point)}
        Dim s As String = Convert.ToString(Blocks(Order), 2).ToString.PadLeft(16, "0")
        For i As Integer = 0 To s.Length - 1
            If s.Chars(i) = "1" Then
                blk.descPoints.Add(New Point(i Mod 4 + position.X, i \ 4 + position.Y))
            End If
        Next
        Return blk
    End Function
    '绘制已固定的方块
    Sub DrawBackImage(ByVal g As Graphics, ByVal pane As Integer(,))
        For i As Integer = 0 To pane.GetLength(0) - 1
            For j As Integer = 0 To pane.GetLength(1) - 1
                If pane(i, j) = "1" Then
                    Dim rec As New Rectangle(10 + 20 * i, 10 + 20 * j, 20, 20)
                    g.FillRectangle(Brushes.Blue, rec)
                    g.DrawRectangle(Pens.White, rec)
                End If
            Next
        Next
    End Sub
    '绘制单个方块（移动及提示的方块）’
    Sub DrawBlock(ByVal g As Graphics, ByVal blk As Block, ByVal location As Point)
        For Each p As Point In blk.descPoints
            Dim rec As New Rectangle(location.X + p.X * 20, location.Y + p.Y * 20, 20, 20)
            g.FillRectangle(Brushes.Blue, rec)
            g.DrawRectangle(Pens.White, rec)
        Next
    End Sub
    '以下部分分别取得当前方块旋转、左移、右移、下移一次后的方块，’
    Function getRollNextBlock(ByVal blk As Block) As Block
        Dim newOrder = IIf((blk.Order + 1) Mod 4 = 0, blk.Order - 3, blk.Order + 1)
        Return GetBlock(newOrder, blk.Position)
    End Function
    Function getLeftBlock(ByVal blk As Block)
        Return GetBlock(blk.Order, New Point(blk.Position.X - 1, blk.Position.Y))
    End Function
    Function getRightBlock(ByVal blk As Block)
        Return GetBlock(blk.Order, New Point(blk.Position.X + 1, blk.Position.Y))
    End Function
    Function getDownBlock(ByVal blk As Block)
        Return GetBlock(blk.Order, New Point(blk.Position.X, blk.Position.Y + 1))
    End Function

    Sub start()
        ReDim BackPane(10, 20)
        CurBlock = CreateBlock()
        NextBlock = CreateBlock()
        Timer1.Enabled = True
    End Sub
    Sub CreateNextBlock()
        CurBlock = NextBlock
        NextBlock = CreateBlock()
    End Sub
    Function CreateBlock() As Block '随机生成方块’
        Randomize()
        Dim RndOrder As Integer = Int(Rnd() * 28)
        Return GetBlock(RndOrder, New Point(3, 0))
    End Function

    '操作及碰撞判断’
    Private Sub Form4_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyUp
        Select Case e.KeyCode
            Case Keys.Up
                Dim rollBlk As Block = getRollNextBlock(CurBlock)
                For Each p As Point In rollBlk.descPoints
                    If p.X < 0 OrElse p.X > 9 OrElse BackPane(p.X, p.Y) = 1 Then
                        Exit Sub
                    End If
                Next
                CurBlock = rollBlk
            Case Keys.Left
                Dim leftBlk As Block = getLeftBlock(CurBlock)
                For Each p As Point In leftBlk.descPoints
                    If p.X < 0 OrElse BackPane(p.X, p.Y) = 1 Then
                        Exit Sub
                    End If
                Next
                CurBlock = leftBlk
            Case Keys.Right
                Dim rightBlk As Block = getRightBlock(CurBlock)
                For Each p As Point In rightBlk.descPoints
                    If p.X > 9 OrElse BackPane(p.X, p.Y) = 1 Then
                        Exit Sub
                    End If
                Next
                CurBlock = rightBlk
            Case Keys.Down
                For i As Integer = 1 To 20
                    If Not MoveDown(CurBlock) Then
                        Exit Sub
                    End If
                Next
            Case Keys.Enter
                start()
            Case Keys.Space
                Timer1.Enabled = Not Timer1.Enabled
        End Select
    End Sub
    '下移，固定方块，是否游戏结束’
    Function MoveDown(ByVal blk As Block) As Boolean
        Dim downBlk As Block = getDownBlock(CurBlock)
        For Each p As Point In downBlk.descPoints
            If BackPane(p.X, p.Y) = 1 Or p.Y > 19 Then
                For Each pt As Point In CurBlock.descPoints
                    BackPane(pt.X, pt.Y) = 1
                    If pt.Y = 0 Then
                        Timer1.Enabled = False
                        If MsgBox("游戏结束，是否重新开始", MsgBoxStyle.YesNo, "游戏结束") _
                            = MsgBoxResult.Yes Then
                            start()
                            Return False
                        Else
                            End
                        End If
                    End If
                Next
                clearLine()
                CreateNextBlock()
                Return False
            End If
        Next
        CurBlock = downBlk
        Return True
    End Function

    Private Sub Form4_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Me.DoubleBuffered = True '消除闪烁’
    End Sub
    '在PAINT事件中绘图’
    Private Sub Form4_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        e.Graphics.FillRectangles(Brushes.Gray, New Rectangle() {PreviewArea, MainArea})
        If Timer1.Enabled Then
            DrawBackImage(e.Graphics, BackPane)
            DrawBlock(e.Graphics, CurBlock, MainArea.Location)
            DrawBlock(e.Graphics, NextBlock, PreviewArea.Location - New Size(60, 0))
        End If
    End Sub
    '定时下移’
    Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        MoveDown(CurBlock)
        Me.Invalidate()
    End Sub

    '消除已满行’
    Sub clearLine()
        For i As Integer = 0 To 19
            Dim IsFull As Boolean = True
            For j As Integer = 0 To 9
                If BackPane(j, i) = 0 Then
                    IsFull = False
                End If
            Next
            If IsFull Then
                FallDownOneRow(i) '下移一行
            End If
        Next
    End Sub

    Sub FallDownOneRow(ByVal rowIndex As Integer)
        If rowIndex > 1 Then
            For i As Integer = 0 To 9
                BackPane(i, rowIndex) = BackPane(i, rowIndex - 1)
            Next
            FallDownOneRow(rowIndex - 1)
        End If
    End Sub

End Class

[123工艺品]

111
lz 牛人啊 ,我没看懂，能解释一下不？

[沐NeMo]

■■■■■■ ■■■■■■
■ ■
■ ■■■■■■
■ ■ ■
■ ■ ■ ■
■ ■ ■ ■■ ■
■■ ■ ■
■ ■ ■

[水猿兵团五哥]

该结贴了，lz

[沐NeMo]

■■■■■□■■■■■■
□□■□□□□□■□□□
□□■□□□■■■■■■
□□■□□□■□□□□■
□□■□□□■□■□□■
□□■□□□■□■□□■
■■■□□□■□■■□■
□■■□□□□■□■□□
□□■□□□■□□□■□

[lhblxm]

哎，没人看，能否把分退回，让我去水区散了

[冰镇宝贝321]

牛X啊 LZ 服你了

[lhblxm]

压缩一下，108行

Public Class Form4
    Dim Blks As Integer() = {27648, 35904, 27648, 35904, 50688, 19584, 50688, 19584, 58368, 35968, 19968, 19520, _
            17600, 57856, 51328, 36352, 35008, 11776, 50240, 59392, 3840, 17476, 3840, 17476, 52224, 52224, 52224, 52224}
    Dim btmPane As Integer(,) = {{0, 0}, {0, 0}}
    Dim TopPane As Integer(,) = {{0, 0}, {0, 0}}
    Dim ShowArea() As Rectangle = {New Rectangle(230, 10, 100, 100), New Rectangle(10, 10, 200, 400)}
    Dim WithEvents Timer1 As New Timer With {.Interval = 300, .Enabled = True}
    Structure Block '方块定义
        Dim SN As Integer  '在28种方块形态的位置’
        Dim Pos As Point  '相对显示区的坐标’
        Dim Pts As List(Of Point) '方块特征描述’
    End Structure
    Dim CurBlk, NextBlk As Block
    Function GetBlock(ByVal SN As Integer, ByVal pos As Point) As Block
        Dim blk As New Block With {.SN = SN, .Pos = pos, .Pts = New List(Of Point)}
        Dim s As String = Convert.ToString(Blks(SN), 2).ToString.PadLeft(16, "0")
        For i As Integer = 0 To s.Length - 1
            If s.Chars(i) = "1" Then
                blk.Pts.Add(New Point(i Mod 4 + pos.X, i \ 4 + pos.Y))
            End If
        Next
        Return blk
    End Function
    Sub DrawBackImage(ByVal g As Graphics, ByVal c As Color, ByVal pane As Integer(,), ByVal x As Integer)
        For i As Integer = 0 To pane.Length - 1
            If pane(i Mod x, i \ x) = "1" Then
                g.FillRectangle(New SolidBrush(c), 11 + 20 * (i Mod x), 11 + 20 * (i \ x), 19, 19)
            End If
        Next
    End Sub
    Private Sub Form4_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        Select Case e.KeyCode
            Case Keys.Right
                Dim rtBlk As Block = GetBlock(CurBlk.SN, New Point(CurBlk.Pos.X + 1, CurBlk.Pos.Y))
                For Each p As Point In rtBlk.Pts
                    If p.X > 9 OrElse btmPane(p.X, p.Y) = 1 Then Exit Sub
                Next
                CurBlk = rtBlk
            Case Keys.Left
                Dim lBlk As Block = GetBlock(CurBlk.SN, New Point(CurBlk.Pos.X - 1, CurBlk.Pos.Y))
                For Each p As Point In lBlk.Pts
                    If p.X < 0 OrElse btmPane(p.X, p.Y) = 1 Then Exit Sub
                Next
                CurBlk = lBlk
            Case Keys.Up
                Dim rlBlk As Block = GetBlock(IIf((CurBlk.SN + 1) Mod 4 = 0, CurBlk.SN - 3, CurBlk.SN + 1), CurBlk.Pos)
                For Each p As Point In rlBlk.Pts
                    If p.X < 0 OrElse p.X > 9 OrElse p.Y > 19 OrElse btmPane(p.X, p.Y) = 1 Then Exit Sub
                Next
                CurBlk = rlBlk
            Case Keys.Down
                MoveDown()
        End Select
    End Sub
    Function MoveDown() As Boolean
        Dim downBlk As Block = GetBlock(CurBlk.SN, New Point(CurBlk.Pos.X, CurBlk.Pos.Y + 1))
        For Each p As Point In downBlk.Pts
            If p.Y > 19 OrElse btmPane(p.X, p.Y) = 1 Then
                For Each pt As Point In CurBlk.Pts
                    btmPane(pt.X, pt.Y) = 1
                    If pt.Y = 0 Then
                        Timer1.Enabled = False
                        MsgBox("game is over")
                        Exit Function
                    End If
                Next
                clearLine()
                CurBlk = GetBlock(NextBlk.SN, New Point(3, 0))
                NextBlk = GetBlock(Now.Ticks Mod 28, New Point(12, 1))
                Exit Function
            End If
        Next
        CurBlk = downBlk
    End Function
    Private Sub Form4_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Me.DoubleBuffered = True
        ReDim btmPane(9, 19)
        CurBlk = GetBlock(Now.Ticks Mod 27, New Point(3, 0))
        NextBlk = GetBlock(Now.Ticks Mod 28, New Point(12, 1))
        Timer1.Enabled = True
    End Sub
    Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        MoveDown()
        ReDim TopPane(16, 19)
        For i As Integer = 0 To 3
            TopPane(CurBlk.Pts(i).X, CurBlk.Pts(i).Y) = 1
            TopPane(NextBlk.Pts(i).X, NextBlk.Pts(i).Y) = 1
        Next
        Me.CreateGraphics.FillRectangles(Brushes.LightBlue, ShowArea)
        DrawBackImage(Me.CreateGraphics, Color.Red, btmPane, 10)
        DrawBackImage(Me.CreateGraphics, Color.Blue, TopPane, 17)
    End Sub
    Sub clearLine()
        For i As Integer = 0 To 19
            Dim IsFull As Boolean = True
            For j As Integer = 0 To 9
                If btmPane(j, i) = 0 Then IsFull = False
            Next
            If IsFull Then
                For x As Integer = 0 To 9
                    For y As Integer = i To 1 Step -1
                        btmPane(x, y) = btmPane(x, y - 1)
                    Next
                Next
            End If
        Next
    End Sub
End Class

[冰镇宝贝321]

lz 牛人啊

[liuyilin888]

牛人,我顶,顶顶

[EnForGrass]

支持一下，谢谢分享

[家里蹲大学民工]

运行不了呀。。。

[lhblxm]

按回车键开始