Option Explicit
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Dim SpeedTemp As Long
Private Sub Command1_Click()
If Command1.Caption = "开始游戏" Then
Command1.Caption = "重新开始"
Call StartGame
Else
speed = 1: Text1.Item(1) = 1
total = 0: Text1.Item(0) = 0
Text1.Item(2) = max
Call StartGame
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim i As Integer
If True = TopToBottom.Enabled Then
Select Case KeyCode
Case vbKeyLeft
Call fk_Left
Case vbKeyUp
Call fk_Change
Case vbKeyRight
Call fk_Right
Case vbKeyDown
If TopToBottom.Interval <> 20 Then SpeedTemp = TopToBottom.Interval
TopToBottom.Interval = 20
End Select
End If
If starting = False Then
Select Case KeyCode
Case vbKeyPageDown
If Text1.Item(1) > 1 Then
SpeedTemp = SpeedTemp + 70
Text1.Item(1) = Text1.Item(1) - 1
speed = speed - 1
End If
Case vbKeyPageUp
If Text1.Item(1) < 9 Then
SpeedTemp = SpeedTemp - 70
Text1.Item(1) = Text1.Item(1) + 1
speed = speed + 1
End If
End Select
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If True = starting And vbKeyDown = KeyCode Then
TopToBottom.Interval = SpeedTemp
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call save
End Sub
Private Sub nmexit_Click()
If MsgBox("确定退出游戏", vbQuestion + vbYesNo, Me.Caption) = vbYes Then
Unload Me
End If
End Sub
Private Sub nmhelp_Click()
Dim Msg As String
Msg = "键盘控制方法：" & vbCrLf
Msg = Msg & "1.左右光标键控制方块左右移动；" & vbCrLf
Msg = Msg & "2.上光标键控制方块顺时针旋转90度；" & vbCrLf
Msg = Msg & "3.下光标键控制方块加速向下移动。" & vbCrLf
Msg = Msg & "4.PageUp、PageDown调节开始速度。" & vbCrLf
Msg = Msg & "-----------------------------------" & vbCrLf
Msg = Msg & "
xlin制作 " & vbCrLf
Msg = Msg & "
E-Mail: xlin1033@
MsgBox Msg, vbOKOnly + vbQuestion, Me.Caption
End Sub
Private Sub form_Initialize()
Dim i As Integer, j As Integer
'开始结束标志
starting = False: gameover = False
'初始化工作
Call InitGrid
Call InitNextBox
'初始化comctl32.dll，使应用程序支持WinXP界面风格
Call InitCommonControls
'初始化随即数
Call Randomize
'获取最高得分
Call loadsave
'产生一个方块
Call Create_fk(Next_fk)
'插入到小框架中
Call InSertNext
speed = 1
End Sub
Private Sub StartGame()
Dim i As Long, j As Long
'部分初始化工作
Call loadsave
total = 0
TopToBottom.Interval = 610 - (speed - 1) * 70
SpeedTemp = TopToBottom.Interval
starting = True
TopToBottom.Enabled = False
'重新绘背景
Call InitGrid
'初始背景表格数据
For i = 0 To CLine - 1
For j = 0 To CCol - 1
grid(i, j) = 0
Next
Next
'开始产生方块
GameTimer.Enabled = True
End Sub
Private Sub GameTimer_Timer()
'先前产生的方块成为当前方块
Call NextToNow
'产生下一个方块
Call Create_fk(Next_fk)
'更新刚才产生的方块到小框架中
Call InSertNext
'当前方块插入网格中
Call InSertGrid
'加速下落以后重新还原速度
TopToBottom.Interval = SpeedTemp
'下落过程开始
Call StartOfDown
End Sub
Public Sub TopToBottom_Timer()
Call fk_Down '下落一格
End Sub
Private Sub StartOfDown()
GameTimer.Enabled = False
TopToBottom.Enabled = True
End Sub
Private Function loadsave()
Dim a As Double
Dim strTemp As String
On Error GoTo Errlab
strTemp = App.Path & "\data.bin"
Open strTemp For Binary As #1
Get #1, 8, a
Close #1
frmMain.Text1.Item(2) = a
max = a
loadsave = True
Errlab:
End Function
还要一个模块:
Option Explicit
Private Type m_fk '方块的数据结构
color As Long
StartX As Single
StartY As Single
Data(3, 3) As Long
ChangeType As Integer
Kinds As Integer
fk_Kind As Integer
End Type
Private Mcolor(1 To 13) As Long
Public Now_fk As m_fk '存储当前方块的信息
Public Next_fk As m_fk '存储下一个方块的信息
Public BoxWidth As Long
'格子的宽度
Public Const CLine As Long = 21
'行数
Public Const CCol As Long = 11
'列数
Public starting As Boolean, gameover As Boolean '游戏开始结束标志
Public max As Double '历史最高分数
Public speed As Long '游戏等级（速度）
Public total As Double '当前得分
Public grid(0 To CLine - 1, 0 To CCol - 1) As Long '网格数组，0表示没有方块，有数据表示有方块，数据为颜色值
Public Function InitGrid()
Dim X As Single, i As Single, j As Single
'初始化网格1
frmMain.blackGrid.ScaleMode = 3
' 设置 ScaleMode 为像素。
frmMain.blackGrid.AutoRedraw = True
frmMain.blackGrid.Line (0, 0)-(frmMain.blackGrid.ScaleWidth, frmMain.blackGrid.ScaleHeight), &H80000005, BF
BoxWidth = frmMain.blackGrid.ScaleWidth / CCol
For X = 0 To CCol
frmMain.blackGrid.Line (X * BoxWidth, 0)-(X * BoxWidth, frmMain.blackGrid.ScaleHeight), &HFFC0C0, B
Next
For X = 0 To CLine
frmMain.blackGrid.Line (0, X * BoxWidth)-(frmMain.blackGrid.ScaleWidth, X * BoxWidth), &HFFC0C0, B
Next
For i = 0 To CLine - 1
For j = 0 To CCol - 1
grid(i, j) = 0
Call FillEveryOne(j * BoxWidth, i * BoxWidth, vbWhite)
Next
Next
Mcolor(1) = &H8080&: Mcolor(2) = &H808000: Mcolor(3) = &H4080&
Mcolor(4) = &H8000&: Mcolor(5) = &H80&: Mcolor(6) = &H800000
Mcolor(7) = &H800080: Mcolor(8) = &HFF&: Mcolor(9) = &H80FF&
Mcolor(10) = &H404080: Mcolor(11) = &HFF8080: Mcolor(12) = &HFF00FF
Mcolor(13) = &HFF0000
End Function
Public Function Create_fk(ByRef m_Temp As m_fk, Optional Kind As Integer = 0, Optional ByVal X As Single = -1, Optional ByVal Y As Single = -1) As Boolean
Dim color As Long
Dim i As Integer, j As Integer
On Error GoTo Errlab
'初始化信息
With m_Temp
.color = 0
.StartX = 0
.StartY = 0
For i = 0 To 3
For j = 0 To 3
.Data(i, j) = 0
Next
Next
.ChangeType = 1
.fk_Kind = 1
.Kinds = 1
End With
'产生不同类型的方块
If Kind = 0 Then
m_Temp.Kinds = Int(Rnd * 7) + 1:
m_Temp.color = Mcolor(Int(Rnd * 13) + 1)
color = m_Temp.color
Select Case m_Temp.Kinds
Case 1: m_Temp.fk_Kind = Int(Rnd * 2) + 1
Case 2: m_Temp.fk_Kind = 1
Case 3: m_Temp.fk_Kind = Int(Rnd * 2) + 1
Case 4: m_Temp.fk_Kind = Int(Rnd * 2) + 1
Case 5: m_Temp.fk_Kind = Int(Rnd * 4) + 1
Case 6: m_Temp.fk_Kind = Int(Rnd * 4) + 1
Case 7: m_Temp.fk_Kind = Int(Rnd * 4) + 1
End Select
Else
m_Temp.Kinds = Kind
m_Temp.color = Now_fk.color: color = m_Temp.color
m_Temp.fk_Kind = Now_fk.fk_Kind + 1
If m_Temp.fk_Kind > Now_fk.ChangeType Then m_Temp.fk_Kind = 1
End If
Select Case m_Temp.Kinds
Case 1 '直条
m_Temp.ChangeType = 2
If m_Temp.fk_Kind = 1 Then '|
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -3 * BoxWidth
m_Temp.Data(1, 0) = color: m_Temp.Data(1, 1) = color
m_Temp.Data(1, 2) = color: m_Temp.Data(1, 3) = color
m_Temp.fk_Kind = 1
Else '———
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(0, 2) = color: m_Temp.Data(1, 2) = color
m_Temp.Data(2, 2) = color: m_Temp.Data(3, 2) = color
m_Temp.fk_Kind = 2
End If
Case 2 '方块
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.ChangeType = 1: m_Temp.fk_Kind = 1
m_Temp.Data(1, 1) = color: m_Temp.Data(1, 2) = color
m_Temp.Data(2, 1) = color: m_Temp.Data(2, 2) = color
Case 3 'S型
m_Temp.ChangeType = 2
If m_Temp.fk_Kind = 1 Then
m_Temp.StartX = 5 * BoxWidth: m_Temp.StartY = -1 * BoxWidth
m_Temp.Data(1, 0) = color: m_Temp.Data(2, 0) = color
m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
m_Temp.fk_Kind = 1
Else '|
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(0, 0) = color: m_Temp.Data(0, 1) = color
m_Temp.Data(1, 1) = color: m_Temp.Data(1, 2) = color
m_Temp.fk_Kind = 2
End If
Case 4 'Z型
m_Temp.ChangeType = 2
If m_Temp.fk_Kind = 1 Then '|
m_Temp.StartX = 5 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(0, 1) = color: m_Temp.Data(0, 2) = color
m_Temp.Data(1, 0) = color: m_Temp.Data(1, 1) = color
m_Temp.fk_Kind = 1
Else
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -1 * BoxWidth
m_Temp.Data(0, 0) = color: m_Temp.Data(1, 0) = color
m_Temp.Data(1, 1) = color: m_Temp.Data(2, 1) = color
m_Temp.fk_Kind = 2
End If
Case 5 'J型
m_Temp.ChangeType = 4
Select Case m_Temp.fk_Kind
Case 1 '|
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(2, 0) = color: m_Temp.Data(1, 0) = color
m_Temp.Data(1, 1) = color: m_Temp.Data(1, 2) = color
m_Temp.fk_Kind = 1
Case 2
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
m_Temp.Data(2, 1) = color: m_Temp.Data(2, 2) = color
m_Temp.fk_Kind = 2
Case 3
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(1, 0) = color: m_Temp.Data(1, 1) = color
m_Temp.Data(1, 2) = color: m_Temp.Data(0, 2) = color
m_Temp.fk_Kind = 3
Case 4
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -1 * BoxWidth
m_Temp.Data(0, 0) = color: m_Temp.Data(0, 1) = color
m_Temp.Data(1, 1) = color: m_Temp.Data(2, 1) = color
m_Temp.fk_Kind = 4
End Select
Case 6 'L型
m_Temp.ChangeType = 4
Select Case m_Temp.fk_Kind
Case 1
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -1 * BoxWidth
m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
m_Temp.Data(2, 1) = color: m_Temp.Data(2, 0) = color
m_Temp.fk_Kind = 1
Case 2 '|
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(1, 0) = color: m_Temp.Data(1, 1) = color
m_Temp.Data(1, 2) = color: m_Temp.Data(2, 2) = color
m_Temp.fk_Kind = 2
Case 3
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
m_Temp.Data(2, 1) = color: m_Temp.Data(0, 2) = color
m_Temp.fk_Kind = 3
Case 4
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(1, 0) = color: m_Temp.Data(1, 1) = color
m_Temp.Data(1, 2) = color: m_Temp.Data(0, 0) = color
m_Temp.fk_Kind = 4
End Select
Case 7 '凸型
m_Temp.ChangeType = 4
Select Case m_Temp.fk_Kind
Case 1
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(2, 1) = color: m_Temp.Data(1, 0) = color
m_Temp.Data(1, 1) = color: m_Temp.Data(1, 2) = color
m_Temp.fk_Kind = 1
Case 2
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
m_Temp.Data(2, 1) = color: m_Temp.Data(1, 2) = color
m_Temp.fk_Kind = 2
Case 3
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -2 * BoxWidth
m_Temp.Data(0, 1) = color: m_Temp.Data(1, 0) = color
m_Temp.Data(1, 1) = color: m_Temp.Data(1, 2) = color
m_Temp.fk_Kind = 3
Case 4
m_Temp.StartX = 4 * BoxWidth: m_Temp.StartY = -1 * BoxWidth
m_Temp.Data(0, 1) = color: m_Temp.Data(1, 1) = color
m_Temp.Data(2, 1) = color: m_Temp.Data(1, 0) = color
m_Temp.fk_Kind = 4
End Select
End Select
If X <> -1 And Y <> -1 Then m_Temp.StartX = X: m_Temp.StartY = Y
Create_fk = True
Errlab:
End Function
Public Function NextToNow()
Dim i As Integer, j As Integer
With Now_fk
.color = Next_fk.color
.StartX = Next_fk.StartX
.StartY = Next_fk.StartY
For i = 0 To 3
For j = 0 To 3
.Data(i, j) = Next_fk.Data(i, j)
Next
Next
.ChangeType = Next_fk.ChangeType
.fk_Kind = Next_fk.fk_Kind
.Kinds = Next_fk.Kinds
End With
End Function
Public Function InitNextBox()
Dim X As Single
Dim i As Integer, j As Integer
'初始化网格2
frmMain.bgridnext.ScaleMode = 3
' 设置 ScaleMode 为像素。
frmMain.bgridnext.AutoRedraw = True
BoxWidth = frmMain.bgridnext.ScaleWidth / 4
frmMain.bgridnext.Line (0, 0)-(frmMain.bgridnext.ScaleWidth, frmMain.bgridnext.ScaleHeight), &H80000005, BF
For X = 0 To CCol
frmMain.bgridnext.Line (X * BoxWidth, 0)-(X * BoxWidth, frmMain.bgridnext.ScaleHeight), &HFFC0C0, B
Next
For X = 0 To CLine
frmMain.bgridnext.Line (0, X * BoxWidth)-(frmMain.bgridnext.ScaleWidth, X * BoxWidth), &HFFC0C0, B
Next
End Function
Public Function InSertNext()
Dim i As Integer, j As Integer
Call InitNextBox
For i = 0 To 3
For j = 0 To 3
If Next_fk.Data(i, j) <> 0 Then Call FillEveryOneNext(i * BoxWidth, j * BoxWidth, Next_fk.color)
Next
Next
End Function
Private Function CanMove(ByVal var As Integer) As Boolean
Dim i As Byte, j As Byte
Dim NewX As Single, NewY As Single
Dim counter As Integer
Dim col As Integer, row As Integer
counter = 0
Select Case var
Case 1
i = 3
Do While i > 0
For j = 0 To 3
If Now_fk.Data(j, i) <> 0 Then GoTo lab1
Next
i = i - 1
If j = 4 Then counter = counter + 1
Loop
lab1:
NewX = Now_fk.StartX
NewY = Now_fk.StartY + BoxWidth
If NewY / BoxWidth + (4 - counter) <= CLine Then
For i = 0 To 3
For j = 0 To 3
col = i + NewX / BoxWidth
row = j + NewY / BoxWidth
If col >= 0 And row >= 0 And Now_fk.Data(i, j) <> 0 And col < CCol And row < CLine Then
If grid(row, col) <> 0 Then
If Now_fk.StartY < 0 Then
If MsgBox("游戏结束！", vbInformation + vbOKOnly, "游戏结束") = vbOK Then Call GameIsOver: Exit Function
End If
CanMove = False: Exit Function
End If
End If
Next
Next
CanMove = True
End If
Case 2
For i = 0 To 3
For j = 0 To 3
If Now_fk.Data(i, j) <> 0 Then GoTo lab2
Next
If j = 4 Then counter = counter + 1
Next
lab2:
NewX = Now_fk.StartX - BoxWidth
NewY = Now_fk.StartY
If NewX / BoxWidth + counter >= 0 Then
For i = 0 To 3
For j = 0 To 3
col = i + NewX / BoxWidth
row = j + NewY / BoxWidth
If col >= 0 And row >= 0 And Now_fk.Data(i, j) <> 0 And col < CCol And row < CLine Then
If grid(row, col) <> 0 Then CanMove = False: Exit Function
End If
Next
Next
CanMove = True
End If
Case 3
i = 3
Do While i > 0
For j = 0 To 3
If Now_fk.Data(i, j) <> 0 Then GoTo lab3
Next
i = i - 1
If j = 4 Then counter = counter + 1
Loop
lab3:
NewX = Now_fk.StartX + BoxWidth
NewY = Now_fk.StartY
If NewX / BoxWidth + (4 - counter) <= CCol Then
For i = 0 To 3
For j = 0 To 3
col = i + NewX / BoxWidth
row = j + NewY / BoxWidth
If col >= 0 And row >= 0 And Now_fk.Data(i, j) <> 0 And col < CCol And row < CLine Then
If grid(row, col) <> 0 Then CanMove = False: Exit Function
End If
Next
Next
CanMove = True
End If
End Select
End Function
Public Function fk_Left()
If True = CanMove(2) Then
fk_Clear
Now_fk.StartX = Now_fk.StartX - BoxWidth
InSertGrid
End If
End Function
Public Function fk_Right() As Boolean
If True = CanMove(3) Then
fk_Clear
Now_fk.StartX = Now_fk.StartX + BoxWidth
InSertGrid
End If
End Function
Public Function fk_Down() As Boolean
If True = CanMove(1) Then
fk_Clear
Now_fk.StartY = Now_fk.StartY + BoxWidth
InSertGrid
Else
Call EndOfDown
End If
End Function
Public Function fk_Change()
Dim i As Integer, j As Integer
Dim Temp_fk As m_fk
Dim col As Integer, row As Integer
Dim Lcounter As Integer, Rcounter As Integer
Dim Dcounter As Integer
Call Create_fk(Temp_fk, Now_fk.Kinds, Now_fk.StartX, Now_fk.StartY)
For i = 0 To 3
For j = 0 To 3
If Temp_fk.Data(i, j) <> 0 Then GoTo lab1
Next
If j = 4 Then Lcounter = Lcounter + 1
Next
lab1:
i = 3
Do While i > 0
For j = 0 To 3
If Temp_fk.Data(i, j) <> 0 Then GoTo lab2
Next
i = i - 1
If j = 4 Then Rcounter = Rcounter + 1
Loop
lab2:
i = 3
Do While i > 0
For j = 0 To 3
If Temp_fk.Data(j, i) <> 0 Then GoTo lab3
Next
i = i - 1
If j = 4 Then Dcounter = Dcounter + 1
Loop
lab3:
If Temp_fk.StartX / BoxWidth + Lcounter >= 0 Then
If Temp_fk.StartX / BoxWidth + (4 - Rcounter) <= CCol Then
If Temp_fk.StartY / BoxWidth + (4 - Dcounter) <= CLine Then
For i = 0 To 3
For j = 0 To 3
col = i + Temp_fk.StartX / BoxWidth
row = j + Temp_fk.StartY / BoxWidth
If col >= 0 And row >= 0 And col < CCol And row < CLine And Temp_fk.Data(i, j) <> 0 Then
If grid(row, col) <> 0 Then Exit Function
End If
Next
Next
fk_Clear
With Now_fk
.color = Temp_fk.color
.StartX = Temp_fk.StartX
.StartY = Temp_fk.StartY
For i = 0 To 3
For j = 0 To 3
.Data(i, j) = Temp_fk.Data(i, j)
Next
Next
.ChangeType = Temp_fk.ChangeType
.fk_Kind = Temp_fk.fk_Kind
.Kinds = Temp_fk.Kinds
End With
InSertGrid
End If
End If
End If
End Function
Private Function fk_Clear()
Dim i As Integer, j As Integer
For i = 0 To 3
For j = 0 To 3
If Now_fk.Data(i, j) <> 0 Then Call ClearFill(Now_fk.StartX + i * BoxWidth, Now_fk.StartY + j * BoxWidth, vbWhite)
Next
Next
End Function
Private Function ClearFill(ByVal X As Single, ByVal Y As Single, ByVal color As Long)
frmMain.blackGrid.Line (X + 2, Y + 2)-(X + BoxWidth - 2, Y + BoxWidth - 2), color, BF
End Function
Public Function InSertGrid()
Dim i As Integer, j As Integer
For i = 0 To 3
For j = 0 To 3
If Now_fk.Data(i, j) <> 0 And Now_fk.StartY + j * BoxWidth >= 0 Then Call FillEveryOne(Now_fk.StartX + i * BoxWidth, Now_fk.StartY + j * BoxWidth, Now_fk.color)
Next
Next
End Function
Private Function FillEveryOneNext(ByVal X As Single, ByVal Y As Single, ByVal color As Long)
frmMain.bgridnext.Line (X + 2, Y + 2)-(X + BoxWidth - 2, Y + BoxWidth - 2), color, BF
End Function
Private Function FillEveryOne(ByVal X As Single, ByVal Y As Single, ByVal color As Long)
frmMain.blackGrid.Line (X + 2, Y + 2)-(X + BoxWidth - 2, Y + BoxWidth - 2), color, BF
End Function
Private Function EndOfDown()
Dim i As Byte, j As Byte
Dim col As Integer, row As Integer
For i = 0 To 3
For j = 0 To 3
If Now_fk.Data(i, j) <> 0 Then
col = i + Now_fk.StartX / BoxWidth
row = j + Now_fk.StartY / BoxWidth
If col >= 0 And row >= 0 Then
grid(row, col) = Now_fk.Data(i, j)
End If
End If
Next
Next
For i = 0 To 3
For j = 0 To 3
Now_fk.Data(i, j) = 0
Next
Next
'尝试消去方块
Call Delete_fk
frmMain.TopToBottom.Enabled = False
If False = gameover Then frmMain.GameTimer.Enabled = True
End Function
Private Function Delete_fk()
Dim i As Integer, j As Integer, K As Integer
Dim counter As Integer
Dim color As Long
counter = 0
Do While True
For i = CLine - 1 To 0 Step -1
For j = 0 To CCol - 1
If grid(i, j) = 0 Then Exit For
Next
If j = CCol Then '消去
counter = counter + 1
For K = 0 To CCol - 1
grid(i, K) = 0
Call FillEveryOne(K * BoxWidth, i * BoxWidth, vbWhite)
Next
For K = i - 1 To 0 Step -1
For j = 0 To CCol - 1
grid(K + 1, j) = grid(K, j)
Next
Next
'顶部置空一行
For j = 0 To CCol - 1
grid(0, j) = 0
Next
For K = 0 To CLine - 1
For j = 0 To CCol - 1
If grid(K, j) = 0 Then color = vbWhite Else color = grid(K, j)
Call FillEveryOne(j * BoxWidth, K * BoxWidth, color)
Next
Next
Exit For
End If
Next
If i = -1 Then Exit Do
Loop
If counter > 0 Then
total = total + counter ^ 2 * 100
If counter > 1 Then total = total - 100
frmMain.Text1.Item(0).Text = total
If total > max Then max = total
If total / 5000000 > speed And speed < 9 Then
speed = speed + 1: frmMain.Text1.Item(2) = speed '速度显示控制
'实际速度控制
frmMain.TopToBottom.Interval = frmMain.TopToBottom.Interval - 70
End If
End If
End Function
Private Function GameIsOver()
Dim i As Integer, j As Integer
For i = 0 To CLine - 1
For j = 0 To CCol - 1
grid(i, j) = 0
Call FillEveryOne(j * BoxWidth, i * BoxWidth, vbBlue)
Next
Next
Call save
frmMain.TopToBottom.Enabled = False
frmMain.GameTimer.Enabled = False
gameover = True
starting = False
End Function
Function save()
On Error Resume Next
Dim strTemp As String
strTemp = App.Path & "\data.bin"
Open strTemp For Binary As #1
Put #1, 8, max
Close #1
End Function
2008-05-29 23:03
