俄羅斯方塊項目：重啟
阿新 • • 發佈：2018-02-23
randomize pri keycode save tput soc shape string const
Const Boxl As Integer = 372, BoxNum As Integer = 200
Private Sub Combo1_DropDown()
Turn
End Sub Private Sub Timer1_Timer()
Timer1.Interval = TimeLen
CheckTop
Fail
Cleaner
XFull
End Sub Private 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
‘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
‘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 a End 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 Sub Private 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 Sub Private 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 Sub Public 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 Sub Public Sub Load() End Sub Public Sub ClsBox()
For a = 1 To 10
For b = 1 To 20
BF(a, b) = 0
Next b
Next a
End Sub Public 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 Sub Public Sub ComeTure()
For a = 1 To 4
x(a) = mX(a): y(a) = mY(a)
Next a
End Sub
‘用400行完成，希望對學習者有所幫助！
‘VB語言版俄羅斯方塊
‘Totoo、Aoo34智造（一個人的兩個名字），一些方塊，很多計算
Const Boxl As Integer = 372, BoxNum As Integer = 200
Private Sub Combo1_DropDown()
Turn
End Sub Private Sub Timer1_Timer()
Timer1.Interval = TimeLen
CheckTop
Fail
Cleaner
XFull
End Sub Private 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
‘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
‘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 a End 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 Sub Private 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 Sub Private 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 IntegerPublic 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 Sub Public 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 Sub Public Sub Load() End Sub Public Sub ClsBox()
For a = 1 To 10
For b = 1 To 20
BF(a, b) = 0
Next b
Next a
End Sub Public 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 Sub Public Sub ComeTure()
For a = 1 To 4
x(a) = mX(a): y(a) = mY(a)
Next a
End Sub
‘用400行完成，希望對學習者有所幫助！
俄羅斯方塊項目：重啟