Question

VB俄罗斯方块代码

求一个VB6.0做的俄罗斯方块的代码,要很详细的备注,有的朋友发到我的邮箱
onlyangel520@126.com,谢谢了

若以下回答无法解决问题，邀请你更新回答

Answer 1

Dim Type_Now As Integer '目前方块的类型
Dim Type_Next As Integer '下个方块的类型
Dim intRotate As Integer '方块旋转的状态
Dim fen As Integer '定义分数
Dim ji As Integer '定义级别
Function Get_X_Value()
If GetValue(1, 2) Then 'Get X Value
If MaxX - MinX >= 2 Then
If MaxX - CurX <= 1 Then
Adjust_Left = MaxX - 2 - 1
Else
Adjust_Left = CurX - 1
End If
Get_X_Value = True
Exit Function
End If
End If
Get_X_Value = False
End Function
Function GetValue(nType As Integer, nWid As Integer)
GetCoor
On Error Resume Next
Dim OKCount, EmptyCount As Integer
MinX = Xs(1).cX
MaxX = Xs(1).cX
MinY = Xs(1).cY
MaxY = Xs(1).cY
For i = 2 To 4
If MinX > Xs(i).cX Then MinX = Xs(i).cX
If MaxX < Xs(i).cX Then MaxX = Xs(i).cX
If MinY > Xs(i).cY Then MinY = Xs(i).cY
If MaxY < Xs(i).cY Then MaxY = Xs(i).cY
Next
For i = MinX To MaxX
For j = MinY To MaxY
If Total(i, j) Then
GetValue = False
Exit Function
End If
Next
Next

If nType = 0 Then 'Get Y Value
EmptyCount = 0 'Get MinY
OKCount = 0
For i = MinY - 1 To MinY - (nWid - 1) Step -1

For j = MinX To MaxX
If Total(j, i) = False Then OKCount = OKCount + 1
Next
If OKCount >= picPictureNow.Width And OKCount >= picPictureNow.Height Then
EmptyCount = EmptyCount + 1
OKCount = 0
Else
Exit For
End If
Next
MinY = MinY - EmptyCount
If MinY < 1 Then MinY = 1

EmptyCount = 0 'GetMaxY
OKCount = 0
For i = MaxY + 1 To MaxY + nWid - 1
For j = MinX To MaxX
If Total(j, i) = False Then OKCount = OKCount + 1
Next
If OKCount >= picPictureNow.Width And OKCount >= picPictureNow.Height Then
EmptyCount = EmptyCount + 1
OKCount = 0
Else
Exit For
End If
Next
MaxY = MaxY + EmptyCount
If MaxY > 20 Then MaxY = 20

Else 'Get X Value
EmptyCount = 0 'Get MinX
OKCount = 0
For i = MinX - 1 To MinX - (nWid - 1) Step -1

For j = MinY To MaxY
If Total(i, j) = False Then OKCount = OKCount + 1
Next
If OKCount >= picPictureNow.Width And OKCount >= picPictureNow.Height Then
EmptyCount = EmptyCount + 1
OKCount = 0
Else
Exit For
End If
Next
MinX = MinX - EmptyCount
If MinX < 1 Then MinX = 1

EmptyCount = 0 'GetMaxX
OKCount = 0
For i = MaxX + 1 To MaxX + (nWid - 1)
For j = MinY To MaxY
If Total(i, j) = False Then OKCount = OKCount + 1
Next
If OKCount >= picPictureNow.Width And OKCount >= picPictureNow.Height Then
EmptyCount = EmptyCount + 1
OKCount = 0
Else
Exit For
End If
Next
MaxX = MaxX + EmptyCount
If MaxX > 10 Then MaxX = 10
End If
GetValue = True
End Function
Function Get_Y_Value()
If GetValue(0, 2) Then 'Get Y Value
If MaxY - MinY >= 2 Then
If MaxY - (picPictureNow.Top + 1) <= 1 Then
Adjust_Top = MinY - 1
Else
Adjust_Top = picPictureNow.Top
End If
Get_Y_Value = True
Exit Function
End If
End If
Get_Y_Value = False
End Function
Sub Global_Init()
'全局初始化
picBackGround.Cls
imgPictureNext.Picture = LoadPicture("")
picPictureNow.Visible = False
tmrDrop.Enabled = False
End Sub
Sub Init()
'每个方块的初始化过程
picPictureNow.Visible = False
tmrDrop.Enabled = False
Type_Now = Type_Next
picPictureNow.Picture = imgPictureNext.Picture
imgPictureNowBackup.Picture = picPictureNow.Picture
Sel_Next
intRotate = 0
picPictureNow.Left = 4
picPictureNow.Top = 0
picPictureNow.Visible = True
tmrDrop.Enabled = True
End Sub
Sub GetCoor()
'获取一个方块的 4 个点的坐标
For i = 1 To 4 'init
Xs(i).cX = 0
Xs(i).cY = 0
Xs(i).cZ = False
Next
CurX = picPictureNow.Left + 1
Select Case Type_Now
Case 1 '长条
If intRotate Mod 2 = 1 Then
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 1
Xs(1).cZ = True
For i = 2 To 4
Xs(i).cX = CurX + i - 1
Xs(i).cY = picPictureNow.Top + 1
Xs(i).cZ = True
Next
Else
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 4
Xs(1).cZ = True
For i = 2 To 4
Xs(i).cX = CurX
Xs(i).cY = picPictureNow.Top + i - 1
Xs(i).cZ = False
Next
End If
Case 2 '2字
If intRotate Mod 2 = 1 Then
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 3
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 2
Xs(2).cZ = True
For i = 3 To 4
Xs(i).cX = CurX + i - 3
Xs(i).cY = picPictureNow.Top + 5 - i
Xs(i).cZ = False
Next
Else
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 1
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 2
Xs(2).cZ = True
Xs(3).cX = CurX + 2
Xs(3).cY = picPictureNow.Top + 2
Xs(3).cZ = True
Xs(4).cX = CurX + 1
Xs(4).cY = picPictureNow.Top + 1
Xs(4).cZ = False
End If
Case 3 '7字
Select Case intRotate Mod 4
Case 0
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 1
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 3
Xs(2).cZ = True
For i = 3 To 4
Xs(i).cX = CurX + 1
Xs(i).cY = picPictureNow.Top + i - 2
Xs(i).cZ = False
Next
Case 1
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 2
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 2
Xs(2).cZ = True
Xs(3).cX = CurX + 2
Xs(3).cY = picPictureNow.Top + 2
Xs(3).cZ = True
Xs(4).cX = CurX + 2
Xs(4).cY = picPictureNow.Top + 1
Xs(4).cZ = False
Case 2
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 3
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 3
Xs(2).cZ = True
For i = 3 To 4
Xs(i).cX = CurX
Xs(i).cY = picPictureNow.Top + i - 2
Xs(i).cZ = False
Next
Case 3
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 2
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 1
Xs(2).cZ = True
Xs(3).cX = CurX + 2
Xs(3).cY = picPictureNow.Top + 1
Xs(3).cZ = True
Xs(4).cX = CurX
Xs(4).cY = picPictureNow.Top + 1
Xs(4).cZ = False
End Select
Case 4 'T字
Select Case intRotate Mod 4
Case 0
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 2
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 2
Xs(2).cZ = True
Xs(3).cX = CurX + 2
Xs(3).cY = picPictureNow.Top + 2
Xs(3).cZ = True
Xs(4).cX = CurX + 1
Xs(4).cY = picPictureNow.Top + 1
Xs(4).cZ = False
Case 1
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 3
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 2
Xs(2).cZ = True
For i = 3 To 4
Xs(i).cX = CurX
Xs(i).cY = picPictureNow.Top + i - 2
Xs(i).cZ = False
Next
Case 2
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 1
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 2
Xs(2).cZ = True
Xs(3).cX = CurX + 2
Xs(3).cY = picPictureNow.Top + 1
Xs(3).cZ = True
Xs(4).cX = CurX + 1
Xs(4).cY = picPictureNow.Top + 1
Xs(4).cZ = False
Case 3
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 2
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 3
Xs(2).cZ = True
For i = 3 To 4
Xs(i).cX = CurX + 1
Xs(i).cY = picPictureNow.Top + i - 2
Xs(i).cZ = False
Next
End Select
Case 5 '反7字
Select Case intRotate Mod 4
Case 0
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 3
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 1
Xs(2).cZ = True
For i = 3 To 4
Xs(i).cX = CurX
Xs(i).cY = picPictureNow.Top + i - 2
Xs(i).cZ = False
Next
Case 1
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 1
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 1
Xs(2).cZ = True
Xs(3).cX = CurX + 2
Xs(3).cY = picPictureNow.Top + 2
Xs(3).cZ = True
Xs(4).cX = CurX + 2
Xs(4).cY = picPictureNow.Top + 1
Xs(4).cZ = False
Case 2
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 3
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 3
Xs(2).cZ = True
For i = 3 To 4
Xs(i).cX = CurX + 1
Xs(i).cY = picPictureNow.Top + i - 2
Xs(i).cZ = False
Next
Case 3
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 2
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 2
Xs(2).cZ = True
Xs(3).cX = CurX + 2
Xs(3).cY = picPictureNow.Top + 2
Xs(3).cZ = True
Xs(4).cX = CurX
Xs(4).cY = picPictureNow.Top + 1
Xs(4).cZ = False
End Select
Case 6 '反2字
If intRotate Mod 2 = 1 Then
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 2
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 3
Xs(2).cZ = True
For i = 3 To 4
Xs(i).cX = CurX + i - 3
Xs(i).cY = picPictureNow.Top + i - 2
Xs(i).cZ = False
Next
Else
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 2
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 2
Xs(2).cZ = True
Xs(3).cX = CurX + 2
Xs(3).cY = picPictureNow.Top + 1
Xs(3).cZ = True
Xs(4).cX = CurX + 1
Xs(4).cY = picPictureNow.Top + 1
Xs(4).cZ = False
End If
Case 7 '田字
Xs(1).cX = CurX
Xs(1).cY = picPictureNow.Top + 2
Xs(1).cZ = True
Xs(2).cX = CurX + 1
Xs(2).cY = picPictureNow.Top + 2
Xs(2).cZ = True
For i = 3 To 4
Xs(i).cX = CurX + i - 3
Xs(i).cY = picPictureNow.Top + 1
Xs(i).cZ = False
Next
End Select
End Sub
Sub Judge_Full()
'判断是否堆满
R_Value = picPictureNow.Top + 1 'MinY
rx_value = picPictureNow.Top + picPictureNow.Height 'MaxY
For i = rx_value To R_Value Step -1
If Total(1, i) And Total(2, i) And Total(3, i) And Total(4, i) And Total(5, i) And _
Total(6, i) And Total(7, i) And Total(8, i) And Total(9, i) And Total(10, i) Then
'如果一行已经堆满，则将此行上面的图象全部向下移动一点
k = BitBlt(picBackGround.hDC, 0, 20, 200, (i - 1) * 20, picBackGround.hDC, 0, 0, vbSrcCopy)
SUCCESS = sndPlaySound(App.Path + "\45\eat.WAV", &H1)
fen = fen + 10
Text1.Text = fen
SUCCESS = sndPlaySound(App.Path + "\45\11.WAV", &H1)
For j = i To 1 Step -1
For k = 1 To 10
Total(k, j) = Total(k, j - 1)
Next k
Next j
i = i + 1
End If
Next i
If fen >= 1000 Then
tmrDrop.Interval = 200
ji = 3
ElseIf fen >= 50 Then
tmrDrop.Interval = 100
ji = 2
Else: tmrDrop.Interval = 450
ji = 1
End If
Text2.Text = ji
'如果目前方块的顶点位置 <=0 ，则表示全部堆满
If picPictureNow.Top <= 1 Then
SUCCESS = sndPlaySound(App.Path + "\45\Dead.WAV", &H1)
Select Case MsgBox("小样，不行吧！想再试试身手吗？", 4 + 32)
Case vbYes
Command2_Click
Case Else
Global_Init
End Select
End If
End Sub