module1.bas

VB+SQL SERVER 密码：2222

Else
If LastRow <> 0 Then
For i = 1 To LastRow * LastCol - 1
Unload Form1.Block(i)
Next i
End If
For i = 1 To Row10 * 5 - 1
Load Form1.Block(i)
Form1.Block(i).Top = -1000
Form1.Block(i).Left = -1000
Next i
For i = Row10 * 5 To Row10 * Col20 - 1
Load Form1.Block(i)
With Form1.Block(i)
.Left = ((i - Row10 * 5) Mod Row10) * 240
.Top = ((i - Row10 * 5) \ Row10) * 240
.Visible = False
.Enabled = False
End With
Next i
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MyScore = 0
MyLevel = StartLevel
iCount = 0
'''''''''
With Form1
.CmdLeft.Enabled = True
.CmdRight.Enabled = True
.CmdRevert.Enabled = True
.CmdDown.Enabled = True
.CmdPause.Enabled = True
.CmdPause.Caption = "暂停(&P)"
.LabelLevel.Caption = MyLevel
.LabelScore.Caption = 0
.Timer1.Interval = 1
For i = 0 To 24
.BlockPreview(i).Visible = False
Next i
End With
LastRow = Row10
LastCol = Col20
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
NextBlockType = Int(Rnd * 7)
NextBlockColor = Int(Rnd * 7)
NextBlockOffset = Int(Rnd * 4)
CreatNextBlock NextBlockType
For i = 1 To NextBlockOffset ''''''''''''''''''''''旋转
RevertIt ''''''''''''''''''''''旋转NextMovingBlock(i)
Next
GeneralANewBlock
'''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

Public Function GeneralANewBlock() As Boolean ''''''''不能创建则失败
Dim BlockType As Long, rndBlockColor As Integer, tmp As Integer
Dim BlockToCreat(1 To 4) As Integer, i As Integer, j As Integer
Dim DispX As Integer '''''''''''''''''''''''''''''''''''''
If NextBlockType = -1 Then Exit Function
ThisBlockType = NextBlockType
For i = 1 To 4
MovingBlock(i) = NextMovingBlock(i)
BlockData(MovingBlock(i)) = NextBlockColor
Form1.Block(MovingBlock(i)).Visible = True
Form1.Block(MovingBlock(i)).BackColor = BlockColor(NextBlockColor)
Next
tmp = Row10 * 5   '''''''''''''''''''''''''
For i = tmp To tmp + Row10 - 1
If BlockData(i) <> 0 Then
NextBlockType = -1
Exit Function
End If
Next
GeneralANewBlock = True
NextBlockType = Int(Rnd * 7)
NextBlockOffset = Int(Rnd * 4)
NextBlockColor = Int(Rnd * 7)
'''''''''''''''''''''''''''''''''''''''''''''''''''
CreatNextBlock NextBlockType
''''''''''''''''''''''''''''''''''''''''''''''''''
For i = 1 To NextBlockOffset
RevertIt ''''''''''''''''''''''旋转NextMovingBlock(i)
Next
ShowPreview
End Function


Public Sub GOHOMEPAGE()
ShellExecute Form1.hwnd, vbNullString, "http://www.ihavenohomepage.com", vbNullString, "c:\", SW_SHOWNORMAL
End Sub

Public Function IsThisDataInArray(Source As Integer) As Boolean
Dim rtn As Boolean, i As Integer
For i = 1 To 4
If Source = MovingBlock(i) Then rtn = True
Next
IsThisDataInArray = rtn
End Function
Public Sub KillALine()
Dim i As Integer, j As Integer, k As Integer, Flag As Boolean
Dim LineFeed As Integer  '''''''''''''''''''''删除的行数
Dim tmpLevel As Integer, tmpScore As Long
tmpLevel = MyLevel
tmpScore = MyScore
Dim ToBeKilled(0 To 4) As Integer, Line As Integer, istep As Integer
'''''''''''''''''''''''''''''''''''''''
For i = 1 To 4
ToBeKilled(i) = 1000 ''''''''''''''''''''使之足够大
Next i
''''''''''''''''''''''''''''''''''''''
Dim LineStart As Integer, LineEnd As Integer
For i = 1 To 4
Line = MovingBlock(i) \ Row10 ''''''''''''''''''测试的行
LineStart = Line * Row10
LineEnd = LineStart + Row10 - 1
For j = LineStart To LineEnd
If BlockData(j) = 0 Then Exit For
Next j
If j = LineEnd + 1 Then
'''''''''''''''''''''''''''''''''''插入排序
'''''''''''''''''''''''''''行数放在ToBeKilled(0 to 4)
''''''若Line不在tobekilled（）里则加入
Flag = False
istep = 1
While Flag = False And istep < 4
If ToBeKilled(istep) > Line Then
Dim ii As Integer
For ii = 3 To istep Step -1
ToBeKilled(ii + 1) = ToBeKilled(ii)
Next ii
ToBeKilled(istep) = Line
ToBeKilled(0) = ToBeKilled(0) + 1
Flag = True
ElseIf ToBeKilled(istep) = Line Then
GoTo EndWhile
End If
istep = istep + 1
Wend
EndWhile:
 ''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''插入排序
''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''ToBeKilled(0)为总行数
''''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
Next i
If ToBeKilled(0) = 0 Then ''''''''''''''''''不能消行
PlaysndDown
MyScore = MyScore + 5
Form1.LabelScore.Caption = MyScore
GoTo CaculateMyscore:
End If
'''''''''''''''''''''''''''''''''''KillTheseLines
For i = 1 To ToBeKilled(0)
For j = ToBeKilled(i) To 5 Step -1
LineStart = j * Row10
LineEnd = LineStart + Row10 - 1
For k = LineStart To LineEnd
Form1.Block(k).Visible = Form1.Block(k - Row10).Visible
Form1.Block(k).BackColor = Form1.Block(k - Row10).BackColor
BlockData(k) = BlockData(k - Row10)
Next k
Next j
Next i
'''''''''''''''''''''''''''''''''''KillThisLine
'''''''''''''''''''''''''''''''''''删除最顶
For k = Row10 * 4 To Row10 * 5 - 1 'Row10 - 1
Form1.Block(k).Visible = False
BlockData(k) = 0
Next
''''''''''''''''''''''''''''''''''''''''''''''''
LineFeed = ToBeKilled(0)
'''''''''''''''''''''''''''''''''''''''''''''''得分算法
Select Case LineFeed
Case 1
MyScore = MyScore + 100
Case 2
MyScore = MyScore + 210
Case 3
MyScore = MyScore + 350
Case 4
MyScore = MyScore + 500
Case Else
Exit Sub
End Select
''''''''''''''''''''''''''''显示我的得分
CaculateMyscore:
If MyScore \ UpgradeFrequence <> tmpScore \ UpgradeFrequence Then
PlaysndUpGrade
MyLevel = MyLevel + 1
If MyLevel > 9 Then
Form1.LabelLevel.Caption = "高手"
MyLevel = 9
Else
Form1.LabelLevel.Caption = MyLevel
End If
ElseIf MyScore - tmpScore > 10 Then
PlaysndKillLine
End If
Form1.LabelScore.Caption = MyScore
End Sub

Public Sub PlaysndKillLine()
On Error Resume Next
sndPlaySound sndKillLine, 3
End Sub

Public Function RevertIt() As Boolean
Dim tmp As Integer, i As Integer, tempArray(2 To 4) As Integer
For i = 2 To 4
tmp = NextMovingBlock(i) - NextMovingBlock(1)
If tmp > -4 And tmp < 4 Then ''''''''''''''''''''''''''''''''''在同一行，变成同一列
tempArray(i) = NextMovingBlock(i) + tmp * (Row10 - 1)
ElseIf Abs(tmp) = (Row10 - 1) Or Abs(tmp) = (Row10 + 1) Then
''''''''''''''''''''''''''''''''''''''''''''''''''在斜对位置
Select Case tmp
Case -Row10 - 1
tempArray(i) = NextMovingBlock(1) - Row10 + 1
Case 1 - Row10
tempArray(i) = NextMovingBlock(1) + Row10 + 1
Case Row10 - 1
tempArray(i) = NextMovingBlock(1) - Row10 - 1
Case Row10 + 1
tempArray(i) = NextMovingBlock(1) + Row10 - 1
End Select
Else ''''''''''''''''''''''''''''''''''''''''''''在同一列，变成同一行
tempArray(i) = NextMovingBlock(i) - tmp \ Row10 - tmp
End If
Next
For i = 2 To 4
NextMovingBlock(i) = tempArray(i)
Next
End Function


Public Function SetKey(Index As Integer) As Integer
Dim tmp As Integer
tmp = Form2.combosetting(Index).ListIndex
If tmp < 36 Then
If tmp < 26 Then
SetKey = tmp + 65 '''''''''''''''A-----Z
Else
SetKey = tmp + 22 ''''''''''0--------9
End If
ElseIf tmp > 35 And tmp < 40 Then
SetKey = tmp + 1
ElseIf tmp > 41 Then
SetKey = vbKeyNumpad0 + tmp - 42
Else
Select Case tmp
Case 40
SetKey = vbKeySpace '''''''''''Space
Case 41
SetKey = 13 '''''''''''''''''''''''Enter
End Select
End If
End Function

Public Function GetKey(Key As Integer) As Integer
'''''''''''''''''''''''''''''''Key 是键值
''''''''''''''''''''''''''''''SetKey的逆过程
If Key >= vbKeyA And Key <= vbKeyZ Then
GetKey = Key - 65
ElseIf Key >= vbKey0 And Key <= vbKey9 Then
GetKey = Key - 22
ElseIf Key >= vbKeyLeft And Key <= vbKeyDown Then
GetKey = Key - 1
ElseIf Key = vbKeySpace Then
GetKey = 40
ElseIf Key = 13 Then
GetKey = Key
Else
GetKey = Key - vbKeyNumpad0 + 42
End If
End Function


Public Sub ShowPreview()
Dim i As Integer, tmp As Integer, x As Integer, offset As Integer
For i = 0 To 24 '''''''''''''''''''''''''''''''''''
Form1.BlockPreview(i).Visible = False
Next '''''''''''''''''''''''''''''''''''''''''''''''
x = Row10 \ 2 - 3
For i = 1 To 4
tmp = NextMovingBlock(i) - x
'OffSet = (tmp \ Row10) * 5 + tmp Mod Row10
offset = 5 * (tmp \ Row10) + tmp Mod Row10
Form1.BlockPreview(offset).BackColor = BlockColor(NextBlockColor)
Form1.BlockPreview(offset).Visible = True
Next i
End Sub


Public Sub PlaysndUpGrade()
On Error Resume Next
sndPlaySound sndupGrade, 3
End Sub
Public Sub PlaysndDown()
On Error Resume Next
sndPlaySound sndDown, 3
End Sub