很好的一段源码

End Sub

Sub Selifh2(B)
'方块变换状态程序
'按向上方向键
 
'************************************
'在X(2)在1和10中方块可变化
If X(2) > 1 And X(2) < 10 And Y(2) < 20 Then
For i = -1 To 1
For u = 1 To 1
If E(X(2) + i, Y(2) + u) > 0 Then eE = 1
Next
Next
Else '当方块在边界时设定为不能变化
eE = 1
End If  '在方块周围没有方块才变化
If eE = 0 Then
A = A + 1  '状态变量增加1
If A > 4 Then A = 1
If B = 1 Then '方块是第1种
Select Case A
Case 1 '状态是1时
 X(1) = X(2) - 1
 Y(1) = Y(2)
 X(3) = X(2) + 1
 X(4) = X(2) + 1
 Y(3) = Y(2)
 Y(4) = Y(2) - 1
Case 2
 X(1) = X(2)
 Y(1) = Y(2) + 1
 X(3) = X(2)
 Y(3) = Y(2) - 1
 X(4) = X(2) - 1
 Y(4) = Y(2) - 1
Case 3
X(1) = X(2) + 1
X(3) = X(2) - 1
Y(1) = Y(2)
Y(3) = Y(2)
X(4) = X(2) - 1
Y(4) = Y(2) + 1
Case 4
X(1) = X(2)
Y(1) = Y(2) - 1
X(3) = X(2)
Y(3) = Y(2) + 1
X(4) = X(2) + 1
Y(4) = Y(2) + 1
End Select
End If
'******************************
If B = 3 Then  '方块是第三种状态
Select Case A
Case 1
X(1) = X(2) - 1
Y(1) = Y(2)
Y(3) = Y(2)
X(3) = X(2) + 1
X(4) = X(2)
Y(4) = Y(2) - 1
Case 2
For i = 1 To 3
X(i) = X(2)
Next
Y(1) = Y(2) + 1
Y(3) = Y(2) - 1
X(4) = X(2) - 1
Y(4) = Y(2)
Case 3
For i = 1 To 3
Y(i) = Y(2)
Next
X(1) = X(2) + 1
X(3) = X(2) - 1
X(4) = X(2)
Y(4) = Y(2) + 1
Case 4
For i = 1 To 3
X(i) = X(2)
Next
Y(1) = Y(2) - 1
Y(3) = Y(2) + 1
X(4) = X(2) + 1
Y(4) = Y(2)
End Select
End If
'*********************************
If B = 4 Then  '第四种方块
Select Case A
Case 1
X(1) = X(2)
X(3) = X(2) + 1
X(4) = X(2) + 1
Y(1) = Y(2) - 1
Y(3) = Y(2)
Y(4) = Y(2) + 1
Case 2
X(1) = X(2) - 1
X(3) = X(2)
X(4) = X(2) + 1
Y(1) = Y(2)
Y(3) = Y(2) - 1
Y(4) = Y(2) - 1
Case 3
X(1) = X(2)
X(3) = X(2) - 1
X(4) = X(2) - 1
Y(1) = Y(2) + 1
Y(3) = Y(2)
Y(4) = Y(2) - 1
Case 4
X(1) = X(2) + 1
X(3) = X(2)
X(4) = X(2) - 1
Y(1) = Y(2)
Y(3) = Y(2) + 1
Y(4) = Y(2) + 1
End Select
End If
'******************************
If B = 5 Then  '第五种方块
Select Case A
Case 1
X(1) = X(2)
X(3) = X(2) + 1
Y(1) = Y(2) + 1
Y(3) = Y(2)
Y(4) = Y(2) - 1
X(4) = X(2) + 1
Case 2
X(1) = X(2) + 1
X(3) = X(2)
X(4) = X(2) - 1
Y(1) = Y(2)
Y(3) = Y(2) - 1
Y(4) = Y(2) - 1
Case 3
X(1) = X(2)
X(3) = X(2) - 1
Y(1) = Y(2) - 1
Y(3) = Y(2)
Y(4) = Y(2) + 1
X(4) = X(2) - 1
Case 4
X(1) = X(2) - 1
X(3) = X(2)
X(4) = X(2) + 1
Y(1) = Y(2)
Y(3) = Y(2) + 1
Y(4) = Y(2) + 1
End Select
End If
If B = 7 Then  '第七种方块
Select Case A
Case 1
X(1) = X(2) - 1
X(3) = X(2) + 1
X(4) = X(2) - 1
Y(1) = Y(2)
Y(3) = Y(2)
Y(4) = Y(2) - 1
Case 2
X(1) = X(2)
X(3) = X(2)
Y(1) = Y(2) + 1
Y(3) = Y(2) - 1
X(4) = X(2) - 1
Y(4) = Y(2) + 1
Case 3
X(1) = X(2) + 1
X(3) = X(2) - 1
Y(1) = Y(2)
Y(3) = Y(2)
X(4) = X(2) + 1
Y(4) = Y(2) + 1
Case 4
X(1) = X(2)
X(3) = X(2)
Y(1) = Y(2) - 1
Y(3) = Y(2) + 1
X(4) = X(2) + 1
Y(4) = Y(2) - 1
End Select
End If
End If '结束13457种方块的变换选择
'第二种方块的变换方式
  If X(2) > 1 And X(2) < 9 Then
  For i = -1 To 2 '方块周围的方块分布
  For u = -2 To 1
  If E(X(2) + i, Y(2) + u) > 0 Then eE = 1
  Next
  Next
  Else
  eE = 1
  End If
If eE = 0 Then
'****************************
If B = 2 Then
Select Case A
Case 1, 3
X(1) = X(2) - 1
X(3) = X(2) + 1
X(4) = X(2) + 2
For i = 1 To 4
Y(i) = Y(2)
Next
Case 2, 4
For i = 1 To 4
X(i) = X(2)
Next
Y(1) = Y(2) + 1
Y(3) = Y(2) - 1
Y(4) = Y(2) - 2
End Select
End If '结束第二种方块变换
End If
 
End Sub

Private Sub Form_Paint()
Dim xX(4), Yy(4)
Call LiN
Call LI

 For i = 1 To 10
     For u = 1 To 20
    If E(i, u) <> 0 Then

    If u > 0 Then
          Form1.PaintPicture Image1(E(i, u)).Picture, (i - 1) * Image2.Width + 400, (u - 1) * Image2.Height + 400
         End If
    End If
    Next
    Next
For i = 1 To 4  '画方块
     If Y(i) > 0 Then
          Form1.PaintPicture Image1(B).Picture, (X(i) - 1) * Image2.Width + 400, (Y(i) - 1) * Image2.Height + 400
         End If
 Next
For i = 1 To 4
xX(i) = X(i)
Yy(i) = Y(i)
Next

If X(2) > 0 Then
X(2) = 14
Y(2) = 3
Sel1 (C)
End If
For i = 1 To 4
X(i) = xX(i)
Y(i) = Yy(i)
Next

End Sub

Private Sub Gotog_Click()
Pog = 1
Timer1.Enabled = True
SHOP.Enabled = True
Gotog.Enabled = False
Image8.Visible = False
Image8.Enabled = False
Image4.Enabled = True
Image4.Visible = True
End Sub

Private Sub Image3_Click()
OPE_Click

End Sub

Private Sub Image4_Click()
SHOP_Click

End Sub

Private Sub Image5_Click()
If jB < 40 Then
jB = jB + 1
End If
If jB > 1 Then
Image6.Enabled = True
Image6.Visible = True
减.Enabled = True
减.Visible = True
Else
Image6.Enabled = False
Image6.Visible = False
减.Enabled = False
减.Visible = False
End If
If jB < 40 Then
Image5.Enabled = True
Image5.Visible = True
加.Enabled = True
加.Visible = True
Else
Image5.Visible = False
Image5.Enabled = False
加.Enabled = False
加.Visible = False
End If
ENDG_Click
End Sub

Private Sub Image6_Click()
If jB > 1 Then
jB = jB - 1
End If
 If jB > 1 Then
Image6.Enabled = True
Image6.Visible = True
减.Enabled = True
减.Visible = True
Else
Image6.Enabled = False
Image6.Visible = False
减.Enabled = False
减.Visible = False
End If
If jB < 40 Then
Image5.Enabled = True
Image5.Visible = True
加.Enabled = True
加.Visible = True
Else
Image5.Visible = False
Image5.Enabled = False
加.Enabled = False
加.Visible = False
End If
ENDG_Click
PrI
End Sub

Private Sub Image7_Click()
ENDG_Click
End Sub

Private Sub Image8_Click()
Gotog_Click
End Sub

Private Sub Image9_Click()
Exite_Click
End Sub

Private Sub OnE_Click(Index As Integer)
For i = 0 To 6
OnE(i).Checked = False
Next
OnE(Index).Checked = True
ENDG_Click
jB = Index * 5
If jB = 0 Then jB = 1
Image5_Click
Image6_Click

 PrI
End Sub

Private Sub OPE_Click()

Call LI

C = Int(Rnd * 7) + 1
X(2) = 14
Y(2) = 3
Sel1 (C)

Call LiN
B = Int(Rnd * 7) + 1
X(2) = 5
Y(2) = 1
 
A = 1
Sel1 (B)
Nuex = 0
YesNot = 0
 
sTo = 0
MOany = 0
ToTo = 1
PrI
For i = 1 To 10
For u = 1 To 20
E(i, u) = 0
Next
Next
Pog = 1
Image4.Enabled = True
Image4.Visible = True
Image7.Visible = True
Image7.Enabled = True
Image8.Visible = False
Image8.Enabled = False

Gotog.Enabled = False
ENDG.Enabled = True
SHOP.Enabled = True
Timer1.Enabled = True
End Sub

Private Sub SHOP_Click()
Pog = 0
Timer1.Enabled = False
Gotog.Enabled = True
SHOP.Enabled = False
Image4.Enabled = False
Image4.Visible = False
Image8.Visible = True
Image8.Enabled = True
End Sub

Private Sub TA_Click()

End Sub

Private Sub Timer1_Timer()
'************************************************
  '如果方块停止向下就保存方块位置
Timer1.Interval = 800 - jB * 20

If Nuex > 0 Then
Nuex = 0 '环止前面方块停止下落,但是方块到了可以下落的地方又停下不能下落
For i = 1 To 4
'如果方块真的无法向下时保存结束当前窗口方块运动
'否而方块继续运动   ,方块在停止的时侯到了可以下落的地方不保存结果
If E(X(i), Y(i) + 1) <> 0 Or Y(i) > 19 Then
For u = 1 To 4
'保存位置
E(X(u), Y(u)) = B
Next
'结束当前方块
YesNot = 1
Exit For
'结束保存位置
End If
Next '结束四小块方块的判断
End If '结束停止向下的判断
'**********************************************
Nex (B)

If YesNot = 1 Then

 Call EndSel
 MOany = MOany + 50
B = C
C = Int(Rnd * 7) + 1
X(2) = 14
Y(2) = 3
 Form1.Line (400 + Image2.Width * 10 + 400, 400)-Step(Image2.Width * 5, Image2.Height * 5), , BF
 
Sel1 (C)
ToTo = ToTo + 1
X(2) = 5
Y(2) = 1
A = 1
Nuex = 0
YesNot = 0
Sel1 (B)
PrI
End If

End Sub
Sub Nex(B)
'输入命令循环结束向下运动程序
'如果方块中的一块下面有方块就设定为停止
      For i = 1 To 4
      '只有Y(I)+1>0 才计算 环止E(1,-1)出现这样的错误
      If Y(i) + 1 > 0 Then
      If Y(i) > 19 Or E(X(i), Y(i) + 1) <> 0 Then
      Nuex = 1
      End If
      End If
      Next
If Nuex = 0 Then '当方块不是停止时运行下面程序向下落

For i = 1 To 4  '每块方块纵坐标加1
  '只有方块在窗口中才有向下落
 If Y(i) > 0 Then  '擦掉在窗中的方块
          Form1.PaintPicture Image2.Picture, (X(i) - 1) * Image2.Width + 400, (Y(i) - 1) * Image2.Height + 400
 End If
Y(i) = Y(i) + 1  '纵坐标加1
 
Next
End If '结束判断和下落
For i = 1 To 4  '画方块
     If Y(i) > 0 Then
          Form1.PaintPicture Image1(B).Picture, (X(i) - 1) * Image2.Width + 400, (Y(i) - 1) * Image2.Height + 400
         End If

 Next
End Sub
Sub EndSel()
Dim eE, Te
'方块运动后判断程序
'检查窗口中方块分布的样子
For i = 1 To 20
eE = 1
For u = 1 To 10
'如果U行中有一个位置是空的,否而删除这行
If E(u, i) = 0 Then eE = 0
Next
'如果没有空的进行删除循环
If eE <> 0 Then
'计算删除的总行数
sTo = sTo + 1
'如果删除总行数跳出20时级别上升一级
If sTo > 20 Then
sTo = 1
jB = jB + 1
 
End If
'计算积分
MOany = MOany + 100
'计算当前方块所删除总行数
Te = Te + 1
 
'把删除行数上面的保存的位置的数值向下代替
For u = i To 1 Step -1 '从删除行数开始
For o = 1 To 10     '让上行的数值代替
E(o, u) = E(o, u - 1)
Next
Next '结束代替
'擦掉窗口

Line (400, 400)-Step(Image2.Width * 10, Image2.Height * 20), , BF
            
End If  '结束删除
Next  '结束窗口检查
'当前方块删除行跳出1行时加总分
     If Te > 0 Then MOany = MOany + (Te - 1) * 100
'把擦掉的窗口按保存的位置画小方块
     For i = 1 To 10
     For u = 1 To 20
    If E(i, u) <> 0 Then

    If u > 0 Then
          Form1.PaintPicture Image1(E(i, u)).Picture, (i - 1) * Image2.Width + 400, (u - 1) * Image2.Height + 400
         End If
    End If
    Next
    Next
For i = 1 To 4 '当方块在窗口上方停下
For u = 1 To 4 '游戏结束
If Y(i) <= 1 Then
IfEnd = 1

SHOP_Click
Gotog.Enabled = False
ENDG.Enabled = False
End If
Next
Next
End Sub

Sub PrI()
Label2.Caption = jB
Label4.Caption = ToTo
Label6.Caption = sTo
Label8.Caption = MOany

End Sub

Sub LiN()
'画方块下落的窗体镜面
Line (400, 400)-Step(Image2.Width * 10, Image2.Height * 20), , BF
Line (385, 385)-Step(Image2.Width * 10 + 20, Image2.Height * 20 + 20), QBColor(15), B
Line (385, 385)-Step(0, Image2.Height * 20 + 20), QBColor(8)
Line (385, 385)-Step(Image2.Width * 10 + 20, 0), QBColor(8)
Line (350, 350)-Step(Image2.Width * 10 + 100, Image2.Height * 20 + 100), , B
Line (320, 320)-Step(Image2.Width * 10 + 160, Image2.Height * 20 + 160), QBColor(15), B
Line (350, 350)-Step(Image2.Width * 10 + 100, 0), QBColor(15)
Line (350, 350)-Step(0, Image2.Height * 20 + 100), QBColor(15)
Line (320, 320)-Step(Image2.Width * 10 + 160, 0)
Line (320, 320)-Step(0, Image2.Height * 20 + 160)
'******画小窗体预览窗体
Line (50, 50)-(Form1.ScaleWidth - 50, Form1.ScaleHeight - 50), QBColor(15), B
Line (50, 50)-(50, Form1.ScaleHeight - 50)
Line (50, 50)-(Form1.ScaleWidth - 50, 50)
Line (70, 70)-(Form1.ScaleWidth - 70, Form1.ScaleHeight - 70), , B
Line (70, 70)-(Form1.ScaleWidth - 60, 70), QBColor(15)
Line (70, 70)-(70, Form1.ScaleHeight - 60), QBColor(15)

End Sub

Sub LI()
Form1.Line (400 + Image2.Width * 10 + 400, 400)-Step(Image2.Width * 5, Image2.Height * 5), , BF
Form1.Line (400 + Image2.Width * 10 + 400, 400)-Step(Image2.Width * 5, Image2.Height * 5), QBColor(15), B
Form1.Line (400 + Image2.Width * 10 + 400, 400)-Step(0, Image2.Height * 5)
Form1.Line (400 + Image2.Width * 10 + 400, 400)-Step(Image2.Width * 5, 0)
Form1.Line (350 + Image2.Width * 10 + 400, 350)-Step(Image2.Width * 5 + 100, Image2.Height * 5 + 100), , B
Form1.Line (350 + Image2.Width * 10 + 400, 350)-Step(Image2.Width * 5 + 100, 0), QBColor(15)
Form1.Line (350 + Image2.Width * 10 + 400, 350)-Step(0, Image2.Height * 5 + 100), QBColor(15)
Form1.Line (320 + Image2.Width * 10 + 400, 320)-Step(Image2.Width * 5 + 150, Image2.Height * 5 + 150), QBColor(15), B
Form1.Line (320 + Image2.Width * 10 + 400, 320)-Step(Image2.Width * 5 + 140, 0)
Form1.Line (320 + Image2.Width * 10 + 400, 320)-Step(0, Image2.Height * 5 + 140)

End Sub

Private Sub 加_Click()
Image5_Click

End Sub

Private Sub 减_Click()
Image6_Click
End Sub