欢迎访问infoheader的Blog——年华似水浪淘沙
E-mail：infoheader@gmail.com
GTalk：infoheader@gmail.com
来自fanfou：

2009年3月31日星期二

VB俄罗斯方块



  1. Const WidthCount As Integer = 10

  2. Const HeightCount As Integer = 20

  3. '"ttttffffffffffff"

  4. '"ttffttffffffffff"

  5. '"tttfftffffffffff"

  6. '"ttfffttfffffffff"

  7. '"tttftftfffffffff"

  8. 'Dim BlockS(1 To 10) As String

  9. Const BlockSCount As Integer = 8


  10. Dim Block(1 To 10, 1 To 4, 1 To 4, 1 To 4) As Boolean


  11. Dim P As PictureBox


  12. Dim B() As Integer

  13. Dim PosX As Integer

  14. Dim PosY As Integer

  15. Dim CurrentBlock As Integer

  16. Dim CurrentTurn As Integer


  17. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

  18.     If KeyCode = vbKeyReturn Then

  19.         ReStart

  20.         Exit Sub

  21.     End If

  22.     If Timer1.Enabled Then

  23.         If KeyCode = vbKeyLeft And PosX > 0 Then

  24.             If Not CheckSet(PosX - 1, PosY) Then

  25.                 PosX = PosX - 1

  26.             End If

  27.         ElseIf KeyCode = vbKeyRight And PosX < WidthCount - GetBlockWidth(CurrentBlock) Then

  28.             If Not CheckSet(PosX + 1, PosY) Then

  29.                 PosX = PosX + 1

  30.             End If

  31.         ElseIf KeyCode = vbKeyUp Then

  32.             TurnBlock

  33.         ElseIf KeyCode = vbKeyDown Then

  34.     '        Do

  35.     '            If CheckSet(PosX, PosY + 1) Then

  36.     '                SetBlock

  37.     '                CheckDecrease

  38.     '                NextBlock

  39.     '                Exit Do

  40.     '            Else

  41.     '                PosY = PosY + 1

  42.     '                Draw

  43.     '            End If

  44.     '        Loop

  45.             Timer1_Timer

  46.             Timer1.Interval = 20

  47.         End If

  48.         Draw

  49.     End If

  50. End Sub


  51. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)

  52.     Timer1.Interval = 200

  53. End Sub


  54. Private Sub Form_Load()

  55.     Set P = Picture1

  56.     P.AutoRedraw = True

  57.     Inti

  58.     Me.Show

  59.     Draw

  60. End Sub


  61. Private Sub TurnBlock()

  62.     CurrentTurn = CurrentTurn + 1

  63.     If CurrentTurn = 5 Then CurrentTurn = 1

  64.     If PosX + GetBlockWidth(CurrentBlock) > WidthCount Then

  65.         CurrentTurn = CurrentTurn - 1

  66.         If CurrentTurn = 0 Then CurrentTurn = 4

  67.     ElseIf CheckSet(PosX, PosY) Then

  68.         CurrentTurn = CurrentTurn - 1

  69.         If CurrentTurn = 0 Then CurrentTurn = 4

  70.     End If

  71. End Sub


  72. Private Sub CheckDecrease()

  73.     Dim I As Integer, J As Integer, M As Integer

  74.     For J = 1 To HeightCount

  75.         For I = 1 To WidthCount

  76.             If B(I, J) = 0 Then GoTo Lab1

  77.         Next

  78.         For M = J To 2 Step -1

  79.             For I = 1 To WidthCount

  80.                 B(I, M) = B(I, M - 1)

  81.             Next

  82.         Next

  83.         For I = 1 To WidthCount

  84.             B(I, 1) = 0

  85.         Next

  86. Lab1:

  87.     Next

  88. End Sub


  89. Private Function GetBlockWidth(BlockID As Integer) As Integer

  90.     Dim I As Integer, J As Integer

  91.     Dim Temp As Integer

  92.     Temp = 0

  93.     For J = 1 To 4

  94.         For I = 1 To 4

  95.             If Block(BlockID, I, J, CurrentTurn) Then

  96.                 If I > Temp Then Temp = I

  97.             End If

  98.         Next

  99.     Next

  100.     GetBlockWidth = Temp

  101. End Function


  102. Private Function CheckSet(pX As Integer, pY As Integer) As Boolean

  103.     Dim I As Integer, J As Integer

  104.     For J = 1 To 4

  105.         For I = 1 To 4

  106.             If Block(CurrentBlock, I, J, CurrentTurn) Then

  107.                 If pY + J > HeightCount Then

  108.                     CheckSet = True

  109.                     Exit Function

  110.                 ElseIf B(pX + I, pY + J) <> 0 Then

  111.                     CheckSet = True

  112.                     Exit Function

  113.                 End If

  114.             End If

  115.         Next

  116.     Next

  117.     CheckSet = False

  118. End Function


  119. Private Sub SetBlock()

  120.     On Error Resume Next

  121.     Dim I As Integer, J As Integer

  122.     For J = 1 To 4

  123.         For I = 1 To 4

  124.             If Block(CurrentBlock, I, J, CurrentTurn) Then

  125.                 B(PosX + I, PosY + J) = 2

  126.             End If

  127.         Next

  128.     Next

  129. End Sub


  130. Private Sub NextBlock()

  131.     Randomize

  132.     CurrentBlock = Int(Rnd() * BlockSCount + 1)

  133.     CurrentTurn = Int(Rnd() * 4 + 1)

  134.     PosX = Int((WidthCount - GetBlockWidth(CurrentBlock)) / 2)

  135.     PosY = 0

  136.     If CheckSet(PosX, PosY) Then

  137.         'Game Over

  138.         Timer1.Enabled = False

  139.         Draw

  140.     Else

  141.         Draw

  142.     End If

  143. End Sub


  144. Private Sub Inti()

  145.     Dim BlockS()

  146.     ReDim BlockS(1 To BlockSCount)

  147.     BlockS(1) = "tttt............t...t...t...t...tttt............t...t...t...t..."

  148.     BlockS(2) = "tt...tt..........t..tt..t.......tt...tt..........t..tt..t......."

  149.     BlockS(3) = "ttt..t..........t...tt..t........t..ttt..........t..tt...t......"

  150.     BlockS(4) = "tt..tt..........tt..tt..........tt..tt..........tt..tt.........."

  151.     BlockS(5) = "t...tt...t.......tt.tt..........t...tt...t.......tt.tt.........."

  152.     BlockS(6) = "ttt.t.t.........tt..t...tt......t.t.ttt.........tt...t..tt......"

  153.     BlockS(7) = "t...ttt...t......tt..t..tt......t...ttt...t......tt..t..tt......"

  154.     BlockS(8) = "t.t.....t.t.....t.t..t..t.t..........t..t.t......t..ttt..t......"

  155.     ReDim B(1 To WidthCount, 1 To HeightCount)

  156.     P.ScaleWidth = WidthCount

  157.     P.ScaleHeight = HeightCount

  158.     Dim I As Integer, J As Integer, H As Integer, G As Integer

  159.     For G = 1 To BlockSCount

  160.         For H = 1 To 4

  161.             For I = 1 To 4

  162.                 For J = 1 To 4

  163.                     Debug.Print (H - 1) * 16 + (J - 1) * 4 + I

  164.                     If Mid(BlockS(G), (H - 1) * 16 + (J - 1) * 4 + I, 1) = "t" Then

  165.                         Block(G, I, J, H) = True

  166.                     Else

  167.                         Block(G, I, J, H) = False

  168.                     End If

  169.                 Next

  170.             Next

  171.         Next

  172.     Next

  173.     ReStart

  174. End Sub


  175. Private Sub ReStart()

  176.     Dim I As Integer, J As Integer

  177.     For J = 1 To HeightCount

  178.         For I = 1 To WidthCount

  179.             B(I, J) = 0

  180.         Next

  181.     Next

  182.     Draw

  183.     Timer1.Enabled = True

  184.     NextBlock

  185. End Sub


  186. Private Sub Draw()

  187.     On Error Resume Next

  188.     Dim I As Integer, J As Integer

  189.     For J = 1 To HeightCount

  190.         For I = 1 To WidthCount

  191.             Select Case B(I, J)

  192.                 Case 0:

  193.                     P.Line (I - 1, J - 1)-(I, J), vbBlack, BF

  194.                 Case 1:

  195.                     P.Line (I - 1, J - 1)-(I, J), vbGreen, BF

  196.                 Case 2:

  197.                     P.Line (I - 1, J - 1)-(I, J), vbRed, BF

  198.             End Select

  199.         Next

  200.     Next

  201.     For J = 1 To 4

  202.         For I = 1 To 4

  203.             If Block(CurrentBlock, I, J, CurrentTurn) Then

  204.                 P.Line (PosX + I - 1, PosY + J - 1)-(PosX + I, PosY + J), vbGreen, BF

  205.             End If

  206.         Next

  207.     Next

  208. End Sub


  209. Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)

  210.     Form_KeyDown KeyCode, Shift

  211. End Sub


  212. Private Sub Picture1_KeyUp(KeyCode As Integer, Shift As Integer)

  213.     Form_KeyUp KeyCode, Shift

  214. End Sub


  215. Private Sub Timer1_Timer()

  216.     If CheckSet(PosX, PosY + 1) Then

  217.         SetBlock

  218.         CheckDecrease

  219.         NextBlock

  220.     Else

  221.         PosY = PosY + 1

  222.         Draw

  223.     End If

  224. End Sub
发帖者 时间：
标签： ,

2 条评论:

infoheader 说...

说明：
1、使用了ChiChou的代码染色。
2、不知道数据存储怎样比较好。
3、个别地方没有优化，比如那个GetBlockWidth()是不该经常调用的。

2009年3月31日 17:54
Kingsam Chen 说...

似乎那个HighLight看起来有点问题……
犀牛可以试试notepad2
ps：不知道Blogger是否对HTML解析有问题，我在FX下，HL的代码中间都多了一行
IE没问题~

2009年4月1日 12:44

发表评论

订阅： 博文评论 (Atom)