‘VB语言版俄罗斯方块
‘Totoo、Aoo34智造（一个人的两个名字），一些方块，很多计算
Const WN As Integer = 10, HN As Integer = 20
Const Boxl As Integer = 372, BoxNum As Integer = 200
Private Sub Combo1_DropDown()
Turn
End SubPrivate Sub Timer1_Timer()
Timer1.Interval = TimeLen
CheckTop
Fail
Cleaner
XFull
End SubPrivate Sub Form_Load()
Call Load
Form1.Width = Screen.Width
Form1.Height = Screen.Height
‘For a = 0 To 3
With Label1
.Caption = ” 华康强大 华夏复兴”
.Width = Form1.ScaleWidth – 10 * Boxl
.Height = 20 * Boxl
.Move 10 * Boxl, 0
End With
‘Next a
With Label2
.Move 0, 20 * Boxl
.Caption = “经以此纪念伟大的盗版者，中国人民的英雄——雷华康！”
End With
Form1.Caption = “w,a,s,d分别为变形、左、右及降落”
TimeLen = 200
Timer1.Interval = 1000
Call ClearUpEr
ShapeAdd
For a = 0 To 3
With Shape2(a)
.Width = Boxl
.Height = Boxl
End With
Next a
End Sub
Private Sub ClearUpEr()
‘Totoo作品
With Form1
.Width = WN * 372 / 2 * 3
.Height = 27 * Boxl
End With
Dim Ia As Integer, ib As Integer
Dim x(BoxNum) As Integer, y(BoxNum) As Integer
x(1) = 0
y(1) = 0
For a = 0 To 199
With Shape1(a)
.Width = Boxl * (Iret + 1)
.Height = Boxl * (Iret + 1)
End With
Ia = Ia + 1
If (Ia <> 0) And (a Mod WN = 0) Then Ia = 0: ib = ib + 1
x(a) = Boxl * Ia
y(a) = Boxl * (ib – 1)
Shape1(a).Move x(a), y(a)
Next a
‘Totoo作品
End Sub
Sub ShapeAdd()
‘Totoo作品
Dim Sret As Integer
x(1) = 0: y(1) = 0: stet = 3
For j = 2 To 4
If j = 4 Then
If x(3) = 1 And y(3) = 1 Then
Rndget Sret, 2
If Sret = 0 Then GoTo Four:
End If
End If
Rndget Sret, 2
If Sret = 1 Then
Sret = j
NextBox Sret, Sret – 1, 1, 1
Else
Sret = j
NextBox Sret, Sret – 1, 1, 0
End If Next j
If 1 = 2 Then
Four:
Rndget Sret, 2
Select Case x(2)
Case 1:
If Sret = 1 Then
NextBox 4, 2, 1, 1
Else
NextBox 4, 3, -1, 1
End If
Case 0:
If Sret = 1 Then
NextBox 4, 2, 1, 0
Else
NextBox 4, 3, -1, 0
End If
End Select
End If
initialize:
For a = 1 To 4
With Shape2(a – 1)
.Move x(a) * Boxl, y(a) * Boxl
.Width = Boxl
.Height = Boxl
End With
Next a
corect:
Dim reta3, reta4 As Integer
For a = 1 To 4
reta3 = x(a)
If reta3 > reta4 Then: reta4 = reta3
Next a
Randomize
reta3 = Fix(Rnd * (9 – reta4)) + 1
For a = 1 To 4
x(a) = x(a) + reta3
Next a
‘Totoo作品
End Sub
Sub Cleaner()
‘Totoo作品，中国智造
For a = 1 To 10
For b = 1 To 20
If BF(a, b) = 1 Then
Shape1(a + (b – 1) * 10 – 1).FillStyle = 0
Else
Shape1(a + (b – 1) * 10 – 1).FillStyle = 1
End If
Next b
Next aEnd Sub
Sub CheckTop()
‘Totoo作品，中国智造
On Error GoTo done:
For a = 1 To 4
If x(a) + 1 < 19 Then On Error Resume Next
If y(a) > 18 Then GoTo done:
If BF(x(a) + 1, y(a) + 2) = 1 Then GoTo done:On Error GoTo Over:
If x(a) + 1 > 20 Or x(a) + 1 < 1 Then GoTo Over:
Next a
If 1 = 2 Then
Over:
Call ClsBox
‘Timelen = 500
Call ShapeAdd
‘MsgBox “GameOver!”: End
End If
If 1 = 2 Then
done:
For a = 1 To 4
If BF(x(a) + 1, y(a) + 1) = 1 Then GoTo Over:
Next a
For a = 1 To 4
BF(x(a) + 1, y(a) + 1) = 1
Next a
Call ShapeAdd: If BottomAsk = True Then TimeLen = 500: BottomAsk = False
End If
Pass:
End SubPrivate Sub Turn()
Dim ret As Integer
For a = 1 To 4
ret = x(a) – x(3): mY(a) = ret + y(3)
ret = y(a) – y(3): mX(a) = ret + x(3)
doit:
‘ On Error GoTo chc:
‘ If 1 = 2 Then
‘ If syssin Then
‘chc:
‘ On Error Resume Next
‘ Else
‘ On Error GoTo handle:
‘ End If
‘ End If
‘
Next a
‘
‘If 1 = 2 Then
‘handle:
‘ If BF(mX(a) + 2, mY(a) + 2) = 1 Then GoTo Pass:
‘End If
ComeTure
‘Pass:
‘Totoo作品，中国智造
End Sub
Sub XFull() ‘Totoo作品，中国智造
Dim Ia As Integer, I As Integer
Dim mY As Integer, BfRet(1 To 10, 1 To 20) As Integer
Dim Cleanit As Boolean
For b = 1 To 20
For a = 1 To 10
If BF(a, b) = 1 Then Ia = Ia + 1
Next a
If Ia = 10 Then I = I + 1: Toper(I) = b: ‘记录满格
Ia = 0
Next b
If I <> 0 Then
For b = 1 To I
For a = 1 To 10
BF(a, Toper(b)) = 0
Next a
socre = socre + 200
Next b
Label2.Caption = “得分：” & Str(socre)
End If
If (Clean = True) Then
For a = 1 To 10
Cleanit = False
For b = 1 To 20
mY = 0
mY = BF(a, b)
If BF(a, b) = 1 Then
For c = 1 To I
If Toper(c) <> 0 Then
If b < Toper(c) Then
mY = mY + 1
Cleanit = True
End If
End If
If c = I Then
If b + mY > 20 Then GoTo Pass:
BfRet(a, b + mY – 1) = 1
If 1 = 2 Then
Pass:
For d = 1 To 10
BfRet(a, 20) = 1
Next d
End If
End If
Next c
End If
mY = 0
Next b
If Cleanit = True Then
For b = 1 To 20
BF(a, b) = BfRet(a, b)
BfRet(a, b) = 0
Next b
End If
Next a
End If
For L = 1 To I
Toper(L) = 0
Next L
End Sub Private Sub Save()
Dim SFN As String
CommonDialog1.ShowOpen
SFN = CommonDialog1.FileName
If SFN <> “” Then
Open SFN & “.totooDat” For Output As #1
For a = 1 To 10
For b = 1 To 20
Print #1, BF(a, b)
Next b, a
Print socre
Close #1
End If
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 65, 37: MoveLeft
Case 68, 39: MoveRight
Case 87, 38: Turn
Case 83, 40: TimeLen = 20: BottomAsk = True
End Select
If KeyCode = 13 Then
EntI = EntI + 1
If EntI Mod 2 = 1 Then
TimeLen = 10
Else: TimeLen = 1000: End If
End If
End SubPrivate Sub Fail()
Clean = True
For a = 1 To 4
y(a) = y(a) + 1
Shape2(a – 1).Move x(a) * Boxl, y(a) * Boxl
Next a
End Sub
‘Totoo作品，中国智造Public x(1 To 4), y(1 To 4) As Integer
Public BF(1 To 10, 1 To 20) As Integer, mX(1 To 4), mY(1 To 4) As Integer
Public retY(1 To 20), Toper(1 To 20) As Integer, Saver(1 To 10) As String
Public socre, Iret, MarkNum As Integer, TimeLen As Integer, EntI As Integer
Public SystemAsk As Boolean, BottomAsk As Boolean, ret As String
Public Repeat As Boolean, Clean As Boolean
Public Sub MoveLeft()
‘Totoo作品
On Error GoTo Pass:
For a = 1 To 4
mX(a) = x(a) – 1
If BF(mX(a) + 1, y(a) + 1) = 1 Then GoTo Pass:
Next a
For a = 1 To 4
x(a) = mX(a)
Next a
Pass:
End SubPublic Sub MoveRight()
On Error GoTo Pass:
For a = 1 To 4
mX(a) = x(a) + 1
If BF(mX(a) + 1, y(a) + 1) = 1 Then GoTo Pass:
Next a
For a = 1 To 4
x(a) = mX(a)
Next a
Pass:
End SubPublic Sub Load()End SubPublic Sub ClsBox()
For a = 1 To 10
For b = 1 To 20
BF(a, b) = 0
Next b
Next a
End SubPublic Sub NextBox(a As Integer, b As Integer, c As Integer, d As Integer)
If d = 0 Then
x(a) = x(b): y(a) = y(b) + c
Else
x(a) = x(b) + c: y(a) = y(b)
End If
End Sub
Public Sub Rndget(a, b As Integer)
Randomize
a = Fix(Rnd * b)
End SubPublic Sub ComeTure()
For a = 1 To 4
x(a) = mX(a): y(a) = mY(a)
Next a
End Sub
‘用400行完成，希望对学习者有所帮助！
