也发一个vb.net俄罗斯方块
很喜欢俄罗斯方块这个游戏，今天也发一个凑个热闹
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 SubEnd Class