form1.frm

vb实现的赛车小游戏

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4155
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9555
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   4155
   ScaleWidth      =   9555
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command4 
      Caption         =   "减速"
      Height          =   495
      Left            =   6840
      TabIndex        =   7
      Top             =   2400
      Width           =   735
   End
   Begin VB.CommandButton Command3 
      Caption         =   "加速"
      Height          =   495
      Left            =   5880
      TabIndex        =   6
      Top             =   2400
      Width           =   735
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   495
      Left            =   5880
      TabIndex        =   1
      Top             =   3000
      Width           =   1695
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   7200
      Top             =   1200
   End
   Begin VB.CommandButton Command1 
      Caption         =   "开始"
      Height          =   495
      Left            =   5880
      TabIndex        =   0
      Top             =   1680
      Width           =   1695
   End
   Begin VB.Label Label5 
      Caption         =   $"Form1.frx":0000
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2655
      Left            =   360
      TabIndex        =   8
      Top             =   720
      Width           =   3015
   End
   Begin VB.Line Line2 
      X1              =   5180
      X2              =   5180
      Y1              =   600
      Y2              =   3120
   End
   Begin VB.Line Line1 
      X1              =   4470
      X2              =   4470
      Y1              =   600
      Y2              =   3000
   End
   Begin VB.Label Label4 
      Caption         =   "最高记录"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   6480
      TabIndex        =   5
      Top             =   480
      Width           =   1575
   End
   Begin VB.Label Label3 
      Caption         =   "Label3"
      ForeColor       =   &H00C0C000&
      Height          =   255
      Left            =   6480
      TabIndex        =   4
      Top             =   840
      Width           =   1335
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   6480
      TabIndex        =   3
      Top             =   1200
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "得分者  最高分"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   600
      Left            =   5640
      TabIndex        =   2
      Top             =   840
      Width           =   1155
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const D = 100 '方格的宽度
Const BT = 3000 '跑道底部的y坐标
Dim l1(22) As Integer '每层跑道左边有几个方块
Dim l2(22) As Integer '每层跑道右边有几个方块
Dim cx As Single '赛车的在x轴的位置
Dim b As Boolean
Dim score As Long, scoremax As Long
Dim pos As Integer, i As Integer, k As Integer ', List As ListBox 'pos --排名
Dim Ans As Integer

'Dim Name As String  '记录玩家名称
Private Sub Command1_Click()
 If b = True Then
'    cx = Width / 2 - 3 * D / 2
'    cy = Height - D
'    drawcar
'    For i = 1 To 20
'      l1(i) = 0
'      l2(i) = 0
'      drawway (i)
'    Next i
    Timer1.Enabled = True
     b = Not b
    Command1.Caption = "暂停"
 Else
    Command1.Caption = "开始"
    Timer1.Enabled = False
    b = Not b
End If
End Sub

Private Sub drawcar()

  Line (cx, BT - 100)-Step(3 * D, D), BackColor, BF
  Line (cx + D, BT - 200)-Step(D, D), BackColor, BF ' 先擦
  Line (cx, BT - 100)-Step(3 * D, D), RGB(225, 0, 0), BF
  Line (cx + D, BT - 200)-Step(D, D), RGB(225, 0, 0), BF

End Sub

Private Sub drawway(n)

  Line (Width / 2 - 3 * D / 2 - 2 * D, BT - n * D)-Step(7 * D, D), BackColor, BF
'先擦后画
  Line (Width / 2 - 3 * D / 2 - 2 * D, BT - n * D)-Step(l1(n) * D, D), , BF
  Line (Width / 2 - 3 * D / 2 + 5 * D, BT - n * D)-Step(-l2(n) * D, D), , BF

End Sub
Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()
If Timer1.Interval > 12.5 Then
  Timer1.Interval = 0.5 * Timer1.Interval
End If
End Sub

Private Sub Command4_Click()
If Timer1.Interval < 200 Then
  Timer1.Interval = 2 * Timer1.Interval
  End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
    Case 97 'Asc("A")   ', Asc(A)
      cx = cx - D
    Case 115 'Asc("S") ', Asc(S)
      cx = cx + D
  End Select
  drawcar
End Sub
Private Sub Form_Load()
Dim Name As String
 cx = Width / 2 - 3 * D / 2
    cy = Height - D
    Call drawcar
    For i = 1 To 20
      l1(i) = 0
      l2(i) = 0
      drawway (i)
    Next i
  b = True
  Open "C:\赛车.txt" For Append As #1
    Close #1
  Open "C:\赛车.txt" For Input As #1
      Do While Not EOF(1)
        Input #1, scoremax
        k = k + 1
      Loop
    Close #1
    If k = 0 Then
       scoremax = 0: Name = ""
    Else
       Open "C:\赛车.txt" For Input As #1
       Input #1, scoremax, Name
       Close #1
    End If
    Label2.Caption = scoremax
    Label3.Caption = Name
End Sub

Private Sub Timer1_Timer()
  Randomize
  For i = 1 To 19
    l1(i) = l1(i + 1)
    l2(i) = l2(i + 1)
    drawway (i)
  Next i
  Do
    l1(20) = Int(Rnd * 5)
    l2(20) = Int(Rnd * 5)
  Loop Until ((l1(20) + l2(20) <= 4) And (l1(20) - l1(19) <= 1) And _
(l2(20) - l2(19) <= 1) And (l1(19) + l2(20) <= 4) And _
(l1(20) + l2(19) <= 4)) '这里生成新一层跑道，
'注意要筛去玩家不可能通过的情况!
drawway (20)
'以上画出跑道
  drawcar
  test
  score = score + 1
End Sub

Private Sub test()
Dim Name As String
  If 3.5 * D - Width / 2 + cx < l1(1) * D Then Timer1.Enabled = False
  If 3.5 * D - Width / 2 + cx + D < l1(2) * D Then Timer1.Enabled = False
  If 3.5 * D - (cx + 3 * D - Width / 2) < l2(1) * D Then Timer1.Enabled = False
  If 3.5 * D - (cx + 2 * D - Width / 2) < l2(2) * D Then Timer1.Enabled = False
  If Timer1.Enabled = False Then
    MsgBox "游戏结束"
'    Open "C:\赛车.txt" For Input As #1
'      Do While Not EOF(1)
'        Input #1, scoremax
'        k = k + 1
'      Loop
'    Close #1
'    If k = 0 Then
'       scoremax = 0
'    Else
'       Open "C:\赛车.txt" For Input As #1
'       Input #1, scoremax
'       Close #1
'    End If
   If score > scoremax Then
'  ' Set List = frmScoreList.lstScore '映射到列表框 frmScoreList.lstscore
'        Do
'            If score >= Val(List.List(pos)) Then
'                TopTen = True
'                Do '循环，设置玩家玩家名称
                    Name = InputBox$("恭喜，您获得了最高分！" & vbCrLf & "请输入你的名称(不超过15个字符)", "游戏结束")
                    'Name = name1
                    If Len(Name) = 0 Then
                        MsgBox "你取消了获得了最高分得分登记！", vbInformation, "注意"
                          score = 0
                          b = True
                          Call Form_Load
                          Timer1.Interval = 100
                        Exit Sub
                    End If
'                    If Len(RTrim(Name)) > 15 Then
'                        Ans = MsgBox("玩家名称的长度不能超过15个字符！" & vbCrLf & "你输入的 " & Name & "" & "将自动改为 " & Left(Name, 15) & "" & "是否同意？", vbQuestion Or vbYesNo, "输入玩家名称")
'                        If Ans = vbYes Then Name = Left(Name, 15)
'                    End If
'               Loop Until Len(RTrim(Name)) <= 15 And Len(RTrim(Name)) > 0 '直到玩家名称的长度符合规定，才退出循环
     Open "C:\赛车.txt" For Output As #1
     Write #1, score, Name
     Close #1
     
     Else
      MsgBox "很遗憾，您没有获得最高分！", vbInformation, "游戏结束"
'       b = True
'        Call Form_Load
'      score = 0
'            End If
'            pos = pos + 1
'        Loop Until pos = 10 Or TopTen = True
'        If TopTen = True Then
'            List.AddItem score, pos - 1
'          '  frmScoreList.lstName.AddItem Name, pos - 1
'            If List.ListCount > 10 Then List.RemoveItem List.ListCount - 1
'            score = 0
'            Call Form_Load
'           ' If frmScoreList.lstName.ListCount > 10 Then frmScoreList.lstName.RemoveItem frmScoreList.lstName.ListCount - 1
'            'Call PutRecord '刷新 记录文件的内容
   End If
   score = 0
      b = True
      Call Form_Load
      Timer1.Interval = 100
     End If
      
End Sub