📄 form1.frm
字号:
BackStyle = 0 'Transparent
Caption = "速度"
ForeColor = &H00FFFF00&
Height = 495
Index = 0
Left = 0
TabIndex = 25
Top = 3300
Width = 1215
End
Begin VB.Label Label6
Alignment = 2 'Center
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "速度指示器"
ForeColor = &H00FFFF00&
Height = 495
Index = 0
Left = 0
TabIndex = 24
Top = 2900
Width = 1080
End
Begin VB.Label lblspeed
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00404040&
Height = 255
Index = 1
Left = 7440
TabIndex = 17
Top = 2320
Width = 465
End
Begin VB.Label lblspeed
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00404040&
Height = 255
Index = 0
Left = 360
TabIndex = 16
Top = 2320
Width = 465
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "next:"
ForeColor = &H000000FF&
Height = 495
Index = 1
Left = 7080
TabIndex = 9
Top = 1200
Width = 1215
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "next:"
ForeColor = &H000000FF&
Height = 495
Index = 0
Left = 0
TabIndex = 8
Top = 1200
Width = 1215
End
Begin VB.Label lbltime
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "0"
ForeColor = &H00404040&
Height = 600
Index = 1
Left = 7080
TabIndex = 7
Top = 800
Width = 1080
End
Begin VB.Label lblscore
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "0"
ForeColor = &H00404040&
Height = 600
Index = 1
Left = 7080
TabIndex = 6
Top = 400
Width = 1080
End
Begin VB.Label lblline
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "0"
ForeColor = &H00000000&
Height = 600
Index = 1
Left = 7080
TabIndex = 5
Top = 0
Width = 1080
End
Begin VB.Label lbltime
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "0"
ForeColor = &H00404040&
Height = 600
Index = 0
Left = 0
TabIndex = 4
Top = 800
Width = 1080
End
Begin VB.Label lblscore
Alignment = 2 'Center
BackColor = &H80000012&
BackStyle = 0 'Transparent
Caption = "0"
ForeColor = &H00404040&
Height = 600
Index = 0
Left = 0
TabIndex = 3
Top = 400
Width = 1080
End
Begin VB.Label lblline
Alignment = 2 'Center
BackColor = &H80000007&
BackStyle = 0 'Transparent
Caption = "0"
ForeColor = &H00404040&
Height = 600
Index = 0
Left = 0
TabIndex = 2
Top = 0
Width = 1080
End
Begin VB.Menu mnufile
Caption = "文件&f"
Begin VB.Menu mnuopen
Caption = "打开&O"
End
Begin VB.Menu mnusave
Caption = "保存&s"
End
Begin VB.Menu mnu_1
Caption = "-"
End
Begin VB.Menu mnusinglegame
Caption = "单人游戏"
End
Begin VB.Menu mnudoublegame
Caption = "双人擂台"
End
Begin VB.Menu mnu_2
Caption = "-"
End
Begin VB.Menu mnuend
Caption = "结束&e"
End
End
Begin VB.Menu mnuhelp
Caption = "帮助&h"
Begin VB.Menu mnuhelptopic
Caption = "帮助主题"
End
Begin VB.Menu mnuproductintroduction
Caption = "产品介绍"
End
End
Begin VB.Menu mnushortcut1
Caption = "快捷键1"
Begin VB.Menu mnushortcut1start
Caption = "开始"
End
Begin VB.Menu mnushortcut1pause
Caption = "暂停"
End
Begin VB.Menu mnu_3
Caption = "-"
End
Begin VB.Menu mnushortcut1fullscreen
Caption = "全屏"
End
Begin VB.Menu mnushortcut1recover
Caption = "恢复"
End
Begin VB.Menu mnu_4
Caption = "-"
End
Begin VB.Menu mnushortcut1renew
Caption = "重新"
End
End
Begin VB.Menu mnushortcut2
Caption = "快捷键2"
Begin VB.Menu mnushortcut2start
Caption = "开始"
End
Begin VB.Menu mnushortcut2pause
Caption = "暂停"
End
Begin VB.Menu mnu_5
Caption = "-"
End
Begin VB.Menu mnushortcut2fullscreen
Caption = "全屏"
End
Begin VB.Menu mnushortcut2recover
Caption = "恢复"
End
Begin VB.Menu mnu_6
Caption = "-"
End
Begin VB.Menu mnushortcut2renew
Caption = "重新"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim a As New fullscreen_recover '定义全屏幕功能,恢复功能的类对象
Dim left_record As New records, right_record As New records '定义左右部游戏的布局记录
Dim left_dmv As New downmove, right_dmv As New downmove
Dim left_mdltype_number As Integer, right_mdltype_number As Integer '定义左右游戏产生方类型为“产生方块类型的数组”mdltype_memory(50)
Dim mdl_creat As New creat_module_type_color
Dim operate As New operator
Dim terminuscheck As New terminus_check
Dim left_original_vehicical_grade As Integer, right_original_vehical_grade As Integer '用于设置关数所对于的速度,在updown_change事件中改变,在score_show模块中调用
'结束游戏之前警告
Private Function end_precope()
Dim i As Integer
i = MsgBox("你确定要退出吗?", 65, "提醒")
end_precope = i
End Function
'显示玩游戏时,操作速度
Private Sub show_operate_vehicle(lblscore As Label, lbltime As Label, lbloperator As Label, progressbar As progressbar)
Dim i As Double
If Val(lbltime.Caption) = 0 Then
i = 0
Else
i = Val(lblscore.Caption) / Val(lbltime.Caption)
End If
If i > progressbar.Max Then
progressbar.Max = i
End If
'防止速度太快了,将progressbar填满,引起错误
If i < 50 Then
progressbar.Max = 50
End If
progressbar.value = i
lbloperator.Caption = progressbar.value
End Sub
'调节速度
Private Sub vehicle(lblspeed As Label, time As Timer)
Select Case Val(lblspeed.Caption)
Case 1, 2, 3, 4, 5, 6, 7, 8
time.Interval = 550 - Val(lblspeed.Caption) * 50
Case 8
time.Interval = 100
Case 9
time.Interval = 50
Case 10
time.Interval = 10
End Select
End Sub
'用于显示积分情况,同时显示关数,调节速度
Private Sub score_show(lblline As Label, lblscore As Label, lblspeed1 As Label, time As Timer, index As Integer)
lblline.Caption = Val(lblline.Caption) + terminuscheck.line_number '显示积分
lblscore.Caption = Val(lblscore.Caption) + score(terminuscheck.line_number) '显示积行
If index = 1 Then
lblspeed(0).Caption = Int(Val(lblscore.Caption) / 10000) + left_original_vehicical_grade '显示关数
Else
lblspeed(1).Caption = Int(Val(lblscore.Caption) / 10000) + right_original_vehicical_grade '显示关数
End If
vehicle lblspeed1, time '调节速度
End Sub
'左边游戏结束或重新之后要将分数等清空
Private Sub left_score_clear()
lblline(0).Caption = 0
lblscore(0).Caption = 0
lbltime(0).Caption = 0
ProgressBar1(0).value = 0
End Sub
'右边游戏结束或重新之后要将分数等清空
Private Sub right_score_clear()
lblline(1).Caption = 0
lblscore(1).Caption = 0
lbltime(1).Caption = 0
ProgressBar1(1).value = 0
End Sub
'控制方向键
Private Sub operator(KeyCode As Integer)
Select Case KeyCode
Case 37, 38, 39, 40 '控制左边游戏的控制键,用上下左右代替
If cmdrenew(0).Enabled = True Then
Picture1(0).Cls
left_record.refresh Picture1(0)
If KeyCode = 37 Then
left_key left_dmv, left_record, operate
End If
If KeyCode = 38 Then
change_key left_dmv, left_record, operate
End If
If KeyCode = 39 Then
right_key left_dmv, left_record, operate
End If
If KeyCode = 40 Then
down_key left_dmv, left_record, operate
End If
line_delete Picture1(0), left_dmv, left_record, left_mdltype_number, 1
'产生视觉上的美感
End If
Case 67, 88, 83, 90 '控制右边游戏的控制键,用Z,X,C,S代替,Z左,X下,C右,S变形
If cmdrenew(1).Enabled = True Then
Picture1(1).Cls
right_record.refresh Picture1(1)
If KeyCode = 90 Then
left_key right_dmv, right_record, operate
End If
If KeyCode = 83 Then
change_key right_dmv, right_record, operate
End If
If KeyCode = 67 Then
right_key right_dmv, right_record, operate
End If
If KeyCode = 88 Then
down_key right_dmv, right_record, operate
End If
line_delete Picture1(1), right_dmv, right_record, right_mdltype_number, 2
End If
End Select
End Sub
'产生视觉上的美感,判断到达终点之后删行
Private Sub line_delete(picture As PictureBox, dmv As downmove, record As records, mdltype_number As Integer, index As Integer)
dmv.down_move picture
If terminuscheck.terminus_check(dmv.module_top_x, dmv.module_top_y, dmv.module_type, record) = 1 Then
record.records_write dmv.module_top_x, dmv.module_top_y, dmv.module_type, dmv.module_color_type
'到达终点刷新布局记录,先刷新才能后消行
Dim i As Integer
terminuscheck.line_clear_numberline dmv.module_top_x, dmv.module_type, record
For i = 0 To terminuscheck.line_number - 1
record.line_clear terminuscheck.get_clear_line_number(i)
Next i
record.refresh picture
If index = 1 Then
score_show lblline(0), lblscore(0), lblspeed(0), tmrleft, 1
show_operate_vehicle lblscore(0), lbltime(0), lbloperator(0), ProgressBar1(0)
Else
score_show lblline(1), lblscore(1), lblspeed(1), tmrright, 2
show_operate_vehicle lblscore(1), lbltime(1), lbloperator(1), ProgressBar1(1)
End If
'用于显示积分情况,同时显示关数,调节速度
'消行处理
top_show mdltype_number, mdl_creat, dmv '让顶部出现方块
End If
End Sub
'游戏程序的总综合模块
Private Sub altogether_timer(picture As PictureBox, dmv As downmove, record As records, mdltype_number As Integer, index As Integer)
picture.Cls
record.refresh picture '一清屏幕就要refresh
dmv.down_move picture
If index = 1 Then
next_module_show picture2(0), mdltype_number, mdl_creat
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -