frmform.frm
来自「《Visual Basic 6.0趣味程序导学》光盘」· FRM 代码 · 共 1,205 行 · 第 1/3 页
FRM
1,205 行
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
Public Sub Global_Init()
'全局初始化
picBackGround.Cls
imgPictureNext.Picture = LoadPicture("")
picPictureNow.Visible = False
tmrDrop.Enabled = False
txtMark.Text = "0"
txtGrade.Text = "0"
txtLevel.Text = "0"
cmdStart.Enabled = False
Switch_Run = True
Read_Data
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
cmdStart.Enabled = True
Read_Data
End Sub
Sub Read_Data()
Dim i As Integer
Open App.Path & "\topname.txt" For Input As #1
For i = 1 To 10
Line Input #1, Top_Data(i).TopName
Next i
Close #1
Open App.Path & "\topscore.txt" For Input As #2
For i = 1 To 10
Line Input #2, Top_Data(i).TopScore
Next i
Close #2
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 'Z字形
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 '反Z字形
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()
Dim Grade As Integer
Dim temp As Integer
Grade = 0
'判断是否堆满
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)
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
Grade = Grade + 1
End If
Next i
If Grade <> 0 Then
temp = Val(txtGrade.Text) + Grade
txtGrade.Text = Str(temp)
temp = Val(txtMark.Text)
If Grade = 1 Then temp = temp + 100
If Grade = 2 Then temp = temp + 300
If Grade = 3 Then temp = temp + 700
If Grade = 4 Then temp = temp + 1400
txtMark.Text = Str(temp)
End If
'如果目前方块的顶点位置为1 ，则表示全部堆满
If picPictureNow.Top <= 1 Then
If Val(txtMark.Text) > Val(Top_Data(10).TopScore) Then
Top_Data(10).TopScore = txtMark.Text
Top_Data(10).TopName = InputBox("You became the Top Ten,Please enter your name:", "Congratulations", "Richard")
Switch_Run = False
frmInfo.Show
Else
Select Case MsgBox("你玩完了！想再试试身手吗？", 4 + 32)
Case vbYes
frmForm.mnuGameNew_Click
Case Else
frmForm.Global_Init
cmdExit.Caption = "开始"
End Select
End If
End If
End Sub
'判断方块能否翻转
Function Judge_Rotate()
Select Case Type_Now
Case 1 '长条
If intRotate Mod 2 = 1 Then
If GetValue(0, 4) Then 'Get Y Value
If MaxY - MinY >= 3 Then
Adjust_Top = MinY - 1
Judge_Rotate = True
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?