写了个半成品，中国方块【临武一中吧】

Totoo作品，中国智造
'Totoo作品'中国智造Const WN As Integer = 10, HN As Integer = 20Const Boxl As Integer = 372, BoxNum As Integer = 200
Private Sub Command1_Click()Clean = True 'Totoo作品'Timer1.Interval = 20Turn'Totoo作品End Sub
Public Function RndGet(a As Integer, b As Integer)'Totoo作品Randomize
a = Fix(Rnd * b)'Totoo作品End Function
Private Sub Command3_Click()'Totoo作品On Error GoTo Pass:For a = 1 To 4mX(a) = x(a) - 1If BF(mX(a) + 1, y(a) + 1) = 1 Then GoTo Pass:Next aFor a = 1 To 4x(a) = mX(a)Next aPass:End Sub
Private Sub Command4_Click()On Error GoTo Pass:For a = 1 To 4mX(a) = x(a) + 1If BF(mX(a) + 1, y(a) + 1) = 1 Then GoTo Pass:Next aFor a = 1 To 4x(a) = mX(a)Next aPass:'Totoo作品End Sub
Private Sub Form_Load()'Totoo作品Command3.Caption = "左"Command4.Caption = "右"Timer1.Interval = 1000ClearUpErShapeAddCommand1.Move 11 * BoxlFor a = 0 To 3With Shape2(a).Width = Boxl.Height = BoxlEnd WithNext 'Totoo作品End Sub
Private Sub Timer1_Timer()'Totoo作品Clean = TrueCheckTop'Label1.Caption = ""Timer1.Interval = 200 'Timer1.Interval - 10CleanerFor a = 1 To 4y(a) = y(a) + 1Shape2(a - 1).Move x(a) * Boxl, y(a) * BoxlNext a
XFullFor l = 1 To 4'Label1.Caption = Label1.Caption & " " & Str(Toper(l))Toper(l) = 0Next l'Totoo作品End Sub
Public Sub ClearUpEr()'Totoo作品With Form1.Width = WN * 372 / 2 * 3.Height = HN * 372 / 2 * 3End WithDim Ia As Integer, ib As IntegerDim x(BoxNum) As Integer, y(BoxNum) As Integerx(1) = 0y(1) = 0For a = 0 To 199With Shape1(a).Width = Boxl * (Iret + 1).Height = Boxl * (Iret + 1)End WithIa = Ia + 1If (Ia <> 0) And (a Mod WN = 0) Then Ia = 0: ib = ib + 1x(a) = Boxl * Iay(a) = Boxl * (ib - 1)Shape1(a).Move x(a), y(a)Next a'Totoo作品End Sub
Sub ShapeAdd()'Totoo作品Dim ret As IntegerRndGet ret, 6Select Case retCase 0x(1) = 0: x(2) = x(1): x(3) = 1: x(4) = x(3)y(1) = 0: y(2) = 1: y(3) = y(1): y(4) = y(2)MarkNum = 1 'Totoo作品，中国智造'MsgBox "0"Case 1x(1) = 0: x(2) = 1: x(3) = 2: x(4) = 3y(1) = 0: y(2) = y(1): y(3) = y(2): y(4) = y(3)'MsgBox "1"MarkNum = 2Case 2x(1) = 0: x(2) = 1: x(3) = 1: x(4) = 2y(1) = 0: y(2) = 0: y(3) = 1: y(4) = 1'MsgBox "2"MarkNum = 3Case 3x(1) = 1: x(2) = 0: x(3) = 1: x(4) = 1y(1) = 0: y(2) = 1: y(3) = 1: y(4) = 2'MsgBox "3,1"MarkNum = 4Case 4x(1) = 1: x(2) = x(1): x(3) = x(1): x(4) = 0y(1) = 0: y(2) = 1: y(3) = 2: y(4) = y(3)'MsgBox "4"MarkNum = 5Case 5x(1) = 1: x(2) = 1: x(3) = 0: x(4) = 0y(1) = 0: y(2) = 1: y(3) = 1: y(4) = 2'MsgBox "22"MarkNum = 6Case 6x(1) = 0: x(2) = 0: x(3) = 0: x(4) = 1y(1) = 0: y(2) = 1: y(3) = 2: y(4) = 2'MsgBox "6"MarkNum = 7End SelectFor a = 1 To 4With Shape2(a - 1).Move x(a) * Boxl, y(a) * Boxl.Width = Boxl.Height = BoxlEnd WithNext aDim reta3, reta4 As IntegerFor a = 1 To 4reta3 = x(a)If reta3 > reta4 Thenreta4 = reta3ElseEnd IfNext aRandomizereta3 = Fix(Rnd * (9 - reta4)) + 1For a = 1 To 4x(a) = x(a) + reta3Next a'Totoo作品End Sub
Sub Cleaner()'Totoo作品，中国智造For a = 1 To 10For b = 1 To 20If BF(a, b) = 1 ThenShape1(a + (b - 1) * 10 - 1).FillStyle = 0ElseShape1(a + (b - 1) * 10 - 1).FillStyle = 1End IfNext bNext a

End Sub
Sub CheckTop()'Totoo作品，中国智造On Error GoTo done:For a = 1 To 4If x(a) + 1 < 19 Then On Error Resume NextIf BF(x(a) + 1, y(a) + 2) = 1 Then GoTo done:If y(a) > 18 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 ThenOver:MsgBox "GameOver!": EndEnd If
If 1 = 2 Thendone:For a = 1 To 4If BF(x(a) + 1, y(a) + 1) = 1 ThenGoTo Over:End IfNext aFor a = 1 To 4BF(x(a) + 1, y(a) + 1) = 1Next aCall ShapeAddEnd If
Pass:
End Sub
Public Sub Turn()'Totoo作品，中国智造If MarkNum <> 1 Then
Dim castX, castY, OLx, OLy As IntegerFor a = 1 To 4
mX(a) = y(a) - y(3): mY(a) = x(a) - x(3) If x(a) >= 0 Then If mY(a) = 0 Then OLx = 3 Else OLx = 1 End IfIf y(a) = 0 Then OL = TrueElse If mY(a) = 0 Then OLx = 4 Else OLx = 0 End IfEnd IfIf y(a) >= 0 Then If mX(a) = 0 Then OLy = 3 Else OLy = 1 End IfElse If mX(a) = 0 Then OLy = 4 Else OLy = 0 End IfEnd If
Select Case OLxCase 1 Select Case OLy Case 1, 3: GoTo crossX: Case 0, 4: GoTo CrossY: End SelectCase 0 Select Case OLy Case 1: GoTo CrossY: Case 0: GoTo crossX: End SelectCase 4, 3: GoTo crossX:End Select
If 1 = 2 ThenCrossY:mX(a) = mX(a) * (-1)End IfIf 1 = 2 ThencrossX:
mX(a) = mX(a) * (-1)End IfNext a
For a = 1 To 4castX = mX(a) + 1 + x(3): castY = mY(a) + 1 + y(3)On Error GoTo Pass:If BF(castX, castY) = 1 ThenGoTo Pass:Else If OLx = 3 Then If BF(castX, castY - 1) = 1 Then GoTo Pass: Else If BF(castX, castY + 1) = 1 Then GoTo Pass: End If End If If OLy = 3 Then If BF(castX + 1, castY) = 1 Then GoTo Pass: Else If BF(castX - 1, castY) = 1 Then GoTo Pass: End If End IfEnd IfNext a
For a = 1 To 4y(a) = mY(a) + 1 + y(3)
x(a) = mX(a) + x(3)
Shape2(c - 1).Move x(c) * Boxl, y(c) * BoxlNext aPass:End If'Totoo作品，中国智造End Sub
mod:
'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
Public Socre, Iret, MarkNum As Integer
Public SystemAsk As Boolean, BottomAsk As BooleanPublic Repeat As Boolean, Clean As Boolean
Sub XFull()'Totoo作品，中国智造Dim Ia As Integer, I As IntegerDim mY As Integer, BfRet(1 To 10, 1 To 20) As IntegerDim 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: '记录满格
End If 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, bEnd 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 ThenPass:For d = 1 To 10BfRet(a, 20) = 1Next dEnd 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 IfNext a
End If
End Sub'Totoo作品，中国智造

哈哈

你做的？

Totoo=Aoo34。我做的，没做完

日	一	二	三	四	五	六

写了个半成品，中国方块

扫二维码下载贴吧客户端