⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 this game is programmed by visual basic language,please check it,thank you very much!
💻 FRM
📖 第 1 页 / 共 3 页
字号:
      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 + -