module1.bas

VB+SQL SERVER 密码：2222

Attribute VB_Name = "Module1"
Option Explicit
Public vbMoveLeft As Integer
Public vbMoveRight As Integer
Public vbMoveDown  As Integer
Public vbStepDown As Integer
Public vbRevert As Integer
Public Const SW_SHOWNORMAL = 1
Public Row10 As Integer ''''''''''''''''''''''''
Public LastRow As Integer
Public LastCol As Integer
Public Col20 As Integer ''''''''''''''''''''''''
Public MyScore  As Long
Public MyLevel As Integer
Public StartLevel As Integer
Public UpgradeFrequence As Integer
Public NextBlockType As Integer
Public ThisBlockType As Integer
Public NextBlockColor As Integer
Public NextBlockOffset As Integer
Public iCount As Integer
Public BlockColor(0 To 7) As Long
Public BlockData() As Integer '''0表示没有，other表示color
Public MovingBlock(1 To 4) As Integer '''''''''表示移动Block的Index
Public NextMovingBlock(1 To 4) As Integer '''''下次显示的Block的Index
Public sndupGrade As String
Public sndDown As String
Public sndKillLine As String
Public AppFilePath As String
Public sndDie As String
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Function CloseMe(RoundBlock As Integer, StartBlock As Integer, _
EndBlock As Integer) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'围绕roundblock,从startblock到endblock是否已经有block
'''''''''''''''''''''''''''''''''''''判断Movingblock(1)周围的block
'''''''''''''''''''''''''''''''''''''是否有了
Dim i As Integer, offset As Integer
 offset = StartBlock - RoundBlock
 CloseMe = True
 Select Case offset
 '''''''''''''同行或同列''''''''''''''''''''''斜对位置
 Case -Row10, -Row10 - 1
 If IsThisDataInArray(StartBlock + 1) = False Then
 If BlockData(StartBlock + 1) = 0 Then CloseMe = False
 Else
 CloseMe = False
 End If
 Case Row10, Row10 + 1
 If IsThisDataInArray(StartBlock - 1) = False Then
 If BlockData(StartBlock - 1) = 0 Then CloseMe = False
 Else
 CloseMe = False
 End If
 Case -1, Row10 - 1
 If IsThisDataInArray(StartBlock - Row10) = False Then
 If BlockData(StartBlock - Row10) = 0 Then CloseMe = False
 Else
 CloseMe = False
 End If
 Case 1, 1 - Row10
 If IsThisDataInArray(StartBlock + Row10) = False Then
 If BlockData(StartBlock + Row10) = 0 Then CloseMe = False
 Else
 CloseMe = False
 End If
 ''''''''''''''''''''''''''''''''相差两个
 Case -2 * Row10 ''''''''''''''''''''''''''''''''''''''''
 If BlockData(RoundBlock - Row10 + 2) = 0 And _
 BlockData(RoundBlock - Row10 + 1) = 0 And _
 BlockData(RoundBlock - 2 * Row10 + 2) = 0 And _
 BlockData(RoundBlock - 2 * Row10 + 1) = 0 Then CloseMe = False
 Case -2 ''''''''''''''''''''''''''''''''''''''''''''''''''
  If BlockData(RoundBlock - Row10 - 2) = 0 And _
 BlockData(RoundBlock - Row10 - 1) = 0 And _
 BlockData(RoundBlock - 2 * Row10 - 2) = 0 And _
 BlockData(RoundBlock - 2 * Row10 - 1) = 0 Then CloseMe = False
 Case 2
 If BlockData(RoundBlock + Row10 + 2) = 0 And _
 BlockData(RoundBlock + Row10 + 1) = 0 And _
 BlockData(RoundBlock + 2 * Row10 + 2) = 0 And _
 BlockData(RoundBlock + 2 * Row10 + 1) = 0 Then CloseMe = False
 Case 2 * Row10
  If BlockData(RoundBlock + Row10 - 2) = 0 And _
 BlockData(RoundBlock + Row10 - 1) = 0 And _
 BlockData(RoundBlock + 2 * Row10 - 2) = 0 And _
 BlockData(RoundBlock + 2 * Row10 - 1) = 0 Then CloseMe = False
 End Select
End Function

Public Sub EMAIL_ME()
ShellExecute Form1.hwnd, vbNullString, "Mailto:[e-mail]", vbNullString, "c:\", SW_SHOWNORMAL
End Sub
Public Function CheckAvailable() As Boolean
Dim tmp(0 To 3) As Integer, i As Integer, j As Integer
For i = 0 To 3
tmp(i) = Form2.combosetting(i).ListIndex
Next
''''''''''''''''''''''''''''''''''''''''''''''
For i = 0 To 3
For j = i + 1 To 3
If tmp(j) = tmp(i) Then
Exit Function
End If
Next
Next
CheckAvailable = True
End Function
Public Function CheckMovable(ByVal MoveType As Integer) As Boolean
Dim rtn As Boolean, i As Integer, j As Integer, k As Integer, tmp As Integer
Dim tempArray(1 To 4) As Integer, tempArray1(1 To 4) As Integer
rtn = False
For i = 1 To 4
tempArray1(i) = 30 ''''''''''''''''''''????????????
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''在最顶端不能变形！！！！！！''''''''''''''
Dim BlockTop As Integer
BlockTop = Row10 * 5
''''''''''''''''''''''''''在最顶端不能变形！！！！！！''''''''''''''
Select Case MoveType
'''''''''''''''''''''''''''''''''''''''''''''''''左移
Case vbMoveLeft
For i = 1 To 4
If (MovingBlock(i) Mod Row10 = 0) Or MovingBlock(i) < BlockTop Then Exit For  '''''''''''是否达到最左边
Next
If i = 5 Then
For i = 1 To 4
tempArray(i) = MovingBlock(i) - 1
Next
For i = 1 To 4
If Not IsThisDataInArray(tempArray(i)) Then '''''''''''''是在正在移动的吗
If BlockData(tempArray(i)) <> 0 Then Exit For   ''''''''''''''''已经有了
End If
Next
If i = 5 Then rtn = True
End If
Case vbMoveRight
''''''''''''''''''''''''''''''''''''''''''''''''''右移
For i = 1 To 4
If (MovingBlock(i) Mod Row10 = Row10 - 1) Or MovingBlock(i) < BlockTop Then Exit For   '''''''''''是否达到最最边
Next
If i = 5 Then
For i = 1 To 4
tempArray(i) = MovingBlock(i) + 1
Next
For i = 1 To 4
If Not IsThisDataInArray(tempArray(i)) Then '''''''''''''是在正在移动的吗
If BlockData(tempArray(i)) <> 0 Then Exit For   ''''''''''''''''已经有了
End If
Next
If i = 5 Then rtn = True
End If
Case vbMoveDown
''''''''''''''''''''''''''''''''''''''''''''''''''下移
For i = 1 To 4
If (MovingBlock(i) \ Row10 = Col20 - 1) Then Exit For '''''''''''是否达到最下面
Next
If i = 5 Then
For i = 1 To 4
tempArray(i) = MovingBlock(i) + Row10
Next
For i = 1 To 4
If Not IsThisDataInArray(tempArray(i)) Then '''''''''''''是在正在移动的吗
If BlockData(tempArray(i)) <> 0 Then Exit For ''''''''''''''''已经有了
End If
Next
If i = 5 Then rtn = True
End If
Case vbRevert
''''''''''''''''''''''''''''''''''''''''''''''''''''旋转
''''''''''''''''''''''''''''''''''''''''''''''''''''旋转
'''''''''''''''''''''''''''''''''''''''
If (ThisBlockType = 1) Then Exit Function     ''''''''''''''''''''''''''''方块不变
'''''''''''''''''''''''''''' 顶端不变形''
For i = 1 To 4
If MovingBlock(i) < BlockTop Then Exit For
Next i
''''''''''''''''''''''''''''''''''''
If i <> 5 Then Exit Function
''''''''''''''''''''''''''''''''''''''
For i = 2 To 4
tmp = MovingBlock(i) - MovingBlock(1)
If tmp > -4 And tmp < 4 Then '''''''''''''''''''''''''''在同一行，变成同一列
tempArray(i) = MovingBlock(i) + tmp * (Row10 - 1) ''''改for X*Y
 ''''''''''''''''''''''可能在最顶端或最底端
If tempArray(i) < 0 Or tempArray(i) > (Col20 * Row10 - 1) Then Exit For
If IsThisDataInArray(tempArray(i)) = False Then
If (tempArray(i) Mod Row10 <> MovingBlock(1) Mod Row10) Or (BlockData(tempArray(i)) <> 0) Then Exit For
''''''''''''''''''''''''''''''''''是否在同一列？
End If
ElseIf Abs(tmp) = (Row10 - 1) Or Abs(tmp) = (Row10 + 1) Then '''''''''''''''''在斜对位置
 '??????????????????????????????????????????????
 ''''temparray(i)=????????????????????
Select Case tmp
Case -Row10 - 1
tempArray(i) = MovingBlock(1) - Row10 + 1
Case 1 - Row10
tempArray(i) = MovingBlock(1) + Row10 + 1
Case Row10 - 1
tempArray(i) = MovingBlock(1) - Row10 - 1
Case Row10 + 1
tempArray(i) = MovingBlock(1) + Row10 - 1
End Select
 '??????????????????????????????????????????????
If tempArray(i) < 0 Or tempArray(i) > (Row10 * Col20 - 1) Then Exit For
If IsThisDataInArray(tempArray(i)) = False Then
Dim temp As Integer
temp = Abs((tempArray(i) Mod Row10) - (MovingBlock(1) Mod Row10)) + Abs((tempArray(i) \ Row10) - (MovingBlock(1) \ Row10))
If (temp > 4) Or (BlockData(tempArray(i)) <> 0) Then Exit For '''''''''''''''???????????????????????
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''在斜对位置
Else '''''''''''''''''''''''''''在同一列，变成同一行
tempArray(i) = MovingBlock(i) - tmp \ Row10 - tmp
 '''''''''''''''''''''''''''''''''''''''''''''''''''可能在最顶端或最底端
If tempArray(i) < 0 Or tempArray(i) > (Row10 * Col20 - 1) Then Exit For
If IsThisDataInArray(tempArray(i)) = False Then
If (tempArray(i) \ Row10 <> MovingBlock(1) \ Row10) Or BlockData(tempArray(i)) <> 0 Then Exit For
End If
End If
If CloseMe(MovingBlock(1), MovingBlock(i), tempArray(i)) = True Or tempArray(i) \ Row10 < 5 Then Exit Function ''''若周围有，则不能转动
Next
If i = 5 Then rtn = True '''''''''''''''''''''''''''''''''小于5不能旋转
End Select
CheckMovable = rtn
End Function
Public Sub CreatNextBlock(BlockType As Integer)
Dim offset As Integer
offset = (5 * Row10) \ 2 - 1 ''''''''''''''''''''''''''''''''?
''''''''''''''''''''''''''''''''row10+1+row10\2-2
Select Case NextBlockType
'''''''''''''''''''''''''''''''求出NextMovingBlock(i)
Case 0
NextMovingBlock(1) = offset
NextMovingBlock(2) = offset - 2
NextMovingBlock(3) = offset - 1
NextMovingBlock(4) = offset + 1

Case 1 '''''''''''''''''''''''''''''''''''''''''''方块不变形
NextMovingBlock(1) = offset
NextMovingBlock(2) = offset + 1
NextMovingBlock(3) = offset + Row10
NextMovingBlock(4) = offset + Row10 + 1

Case 2
NextMovingBlock(1) = offset + Row10
NextMovingBlock(2) = offset + Row10 - 1
NextMovingBlock(3) = offset + Row10 + 1
NextMovingBlock(4) = offset + 2 * Row10

Case 3
NextMovingBlock(1) = offset
NextMovingBlock(2) = offset - 2
NextMovingBlock(3) = offset - 1
NextMovingBlock(4) = offset + Row10

Case 4
NextMovingBlock(1) = offset
NextMovingBlock(2) = offset + 1
NextMovingBlock(3) = offset + 2
NextMovingBlock(4) = offset + Row10

Case 5
NextMovingBlock(1) = offset + Row10
NextMovingBlock(2) = offset + Row10 - 1
NextMovingBlock(3) = offset + 2 * Row10
NextMovingBlock(4) = offset + 2 * Row10 + 1

Case 6
NextMovingBlock(1) = offset + Row10
NextMovingBlock(2) = offset + Row10 + 1
NextMovingBlock(3) = offset + 2 * Row10
NextMovingBlock(4) = offset + 2 * Row10 - 1
'''''''''''''''''''''''''''''''求出NextMovingBlock(i)
End Select
End Sub

Public Sub GeneralNewGame(LastRow As Integer, LastCol As Integer)
Dim i As Integer, offset As Integer
ReDim BlockData(0 To Row10 * Col20 - 1)
''''''''''''''''''''''''''''''''''''''''''''''''''设置各个控件位置
With Form1
offset = 240 * Row10 + 80 - .Picture1.Width
.Picture1.Width = 240 * Row10 + 80
.Picture1.Height = 240 * (Col20 - 5) + 75
.Width = .Picture1.Width + 2155
.Height = .Picture1.Height + 720
.CmdDown.Left = .CmdDown.Left + offset
.CmdLeft.Left = .CmdLeft.Left + offset
.CmdRight.Left = .CmdRight.Left + offset
.CmdRevert.Left = .CmdRevert.Left + offset
.LabNext.Left = .LabNext.Left + offset
.Label3.Left = .Label3.Left + offset
.Label4.Left = .Label4.Left + offset
.LabelLevel.Left = .LabelLevel.Left + offset
.LabelScore.Left = .LabelScore.Left + offset
'.AniGif1.Left = .AniGif1.Left + offset
'.AniGif2.Left = .AniGif2.Left + offset
.Picture2.Left = .Picture2.Left + offset
End With
''''''''''''''''''''''''''''''''''''''''''''''''''设置各个控件位置
If (LastRow = Row10) And (LastCol = Col20) Then
For i = 1 To Row10 * Col20 - 1
Form1.Block(i).Visible = False
Next i