form1.frm

一款飞机游戏

      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   14
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   13
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   12
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   11
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   10
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   9
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   8
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   7
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   6
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   5
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   4
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   3
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   2
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   80
      Index           =   1
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   80
   End
   Begin VB.Shape enemy 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H008080FF&
      FillStyle       =   0  'Solid
      Height          =   75
      Index           =   0
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   75
   End
   Begin VB.Label lblStart 
      BackStyle       =   0  'Transparent
      Caption         =   "请按空格键开始"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   2040
      TabIndex        =   1
      Top             =   3720
      Width           =   1575
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Dim pointnumber As Integer
Dim r As Boolean
Dim l As Boolean
Dim u As Boolean
Dim d As Boolean
Dim checkpoint(11) As POINTAPI
Dim region As Long '图片框中的飞机区域
Dim position As Integer '敌人随机位置（窗体周长上的位置）
Dim index As Integer '用于在敌人随机位置过程"randomposition"中获取敌人的索引号码
Dim order As Integer '建立敌人的索引号码
Dim m As Integer: Dim n As Integer '用作子程序参数
Dim downside As Integer: Dim rightside As Integer
Dim counting As Integer
Dim project(49) As Boolean
Dim start(49) As Integer '随机获取开始时间
Dim angle As Single
Dim movex(49) As Integer: Dim movey(49) As Integer '敌人每一步的移动距离
Dim presentx(49) As Integer: Dim presenty(49) As Integer '当前敌人指向的方向
Private Type beginplace
  x As Integer
  y As Integer
End Type
Dim enemystart(49) As beginplace
Dim animation As Integer '定义爆炸效果动画的帧，用于timer6
Dim seconds As Integer '计算秒数

Private Sub Form_Activate()
Picture2.Visible = False '设爆炸图片为不可见
Timer2.Enabled = False: Timer3.Enabled = False
For order = 0 To 49
  project(order) = False
Next order
Form1.BackColor = vbBlack '*************绘制星空*******************
For pointnumber = 1 To 60
  Randomize
  PSet (Int(Me.Width * Rnd()), Int(Me.Height * Rnd())), RGB(255 * Int(Rnd() * 2), 255 * Int(Rnd() * 2), 255 * Int(Rnd() * 2))
  pointnumber = pointnumber + 1
Next pointnumber
'*********************************************************************
Picture1.ScaleMode = vbPixels
Picture1.Left = Me.Width \ 2: Picture1.Top = Me.Height \ 2 '设定飞机初始位置
'*************用描点绘出飞机区域**************************
checkpoint(0).x = 3 * Picture1.Width \ (8 * Screen.TwipsPerPixelX): checkpoint(0).y = Picture1.Height \ (5 * Screen.TwipsPerPixelY)
checkpoint(1).x = 3 * Picture1.Width \ (8 * Screen.TwipsPerPixelX): checkpoint(1).y = 3 * Picture1.Height \ (5 * Screen.TwipsPerPixelY)
checkpoint(2).x = 0: checkpoint(2).y = Picture1.Height \ Screen.TwipsPerPixelY - 2
checkpoint(3).x = 3 * Picture1.Width \ (8 * Screen.TwipsPerPixelX) - 1: checkpoint(3).y = Picture1.Height \ Screen.TwipsPerPixelY - 2
checkpoint(4).x = 3 * Picture1.Width \ (8 * Screen.TwipsPerPixelX) - 1: checkpoint(4).y = Picture1.Height \ Screen.TwipsPerPixelY
checkpoint(5).x = 5 * Picture1.Width \ (8 * Screen.TwipsPerPixelX) + 1: checkpoint(5).y = Picture1.Height \ Screen.TwipsPerPixelY
checkpoint(6).x = 5 * Picture1.Width \ (8 * Screen.TwipsPerPixelX) + 1: checkpoint(6).y = Picture1.Height \ Screen.TwipsPerPixelY - 2
checkpoint(7).x = Picture1.Width \ Screen.TwipsPerPixelX: checkpoint(7).y = Picture1.Height \ Screen.TwipsPerPixelY - 2
checkpoint(8).x = 5 * Picture1.Width \ (8 * Screen.TwipsPerPixelX): checkpoint(8).y = 3 * Picture1.Height \ (5 * Screen.TwipsPerPixelY)
checkpoint(9).x = 5 * Picture1.Width \ (8 * Screen.TwipsPerPixelX): checkpoint(9).y = Picture1.Height \ (5 * Screen.TwipsPerPixelY)
checkpoint(10).x = Picture1.Width \ (2 * Screen.TwipsPerPixelX): checkpoint(10).y = 0
checkpoint(11) = checkpoint(0)
'****************************************************
region = CreatePolygonRgn(checkpoint(0), 12, 1)
SetWindowRgn Picture1.hWnd, region, True '将飞机裁剪出来
End Sub

Private Sub Form_Load()
Timer1.Enabled = False
For order = 0 To 49
  enemy(order).Visible = False
Next order
End Sub

Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 37 Then 'left
  l = True
End If
If KeyCode = 39 Then 'right
  r = True
End If
If KeyCode = 40 Then 'down
  d = True
End If
If KeyCode = 38 Then 'up
  u = True
End If
End Sub

Private Sub Picture1_KeyPress(KeyAscii As Integer)
If KeyAscii = 32 Then
  If lblStart.Visible = False Then Exit Sub
  If Picture1.Visible = False Then Picture1.Visible = True
  Picture1.Left = Me.Width \ 2: Picture1.Top = Me.Height \ 2
  lblStart.Visible = False
  Timer1.Enabled = True '可以开始操作飞机
  seconds = 0 '设置初始秒数为0
  Me.Caption = "是男人就挺过20秒（0秒）"
  For order = 0 To 49
    project(order) = False
    index = order
    randomposition
    enemystart(order).x = enemy(order).Left: enemystart(order).y = enemy(order).Top '保存敌人初始位置
  Next order
  counting = 0
  starttime
  Timer2.Enabled = True
  Timer3.Enabled = True
  Timer5.Enabled = True
  Timer7.Enabled = True
End If
End Sub

Private Sub Picture1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 37 Then 'left
  l = False
End If
If KeyCode = 39 Then 'right
  r = False
End If
If KeyCode = 40 Then 'down
  d = False
End If
If KeyCode = 38 Then 'up
  u = False
End If
End Sub

Private Sub Timer1_Timer()
If l = True And Picture1.Left >= 0 Then Picture1.Left = Picture1.Left - 50
If r = True And Picture1.Left <= rightside - 200 Then Picture1.Left = Picture1.Left + 50
If d = True And Picture1.Top <= downside - 250 Then Picture1.Top = Picture1.Top + 50
If u = True And Picture1.Top >= 0 Then Picture1.Top = Picture1.Top - 50
End Sub

Private Sub randomposition()
rightside = 5530: downside = 4150
Randomize
position = Int(2 * rightside + 2 * downside) * Rnd()
If position <= downside Then
  enemy(index).Left = 0: enemy(index).Top = position
Else
  If position > downside And position <= downside + rightside Then
    enemy(index).Left = position - downside: enemy(index).Top = downside
  Else
    If position > rightside + downside And position <= 2 * downside + rightside Then
      enemy(index).Left = rightside: enemy(index).Top = position - downside - rightside
    Else
      enemy(index).Left = position - 2 * downside - rightside: enemy(index).Top = 0
    End If
  End If
End If
End Sub

Private Sub Timer2_Timer()
counting = counting + 1
End Sub

Private Sub Timer3_Timer()
For order = 0 To 49
  If project(order) = False And start(order) = counting Then
    Call direct(order)
    project(order) = True '允许敌人从初始的静止状态开始移动
    enemy(order).Visible = True
  End If
Next order
For order = 0 To 49
  If project(order) = True Then Call attack(order)
Next order
End Sub

Private Sub starttime()
For order = 0 To 49
  Randomize
  start(order) = Int(15 * Rnd()) + 2
Next order
End Sub

Private Sub attack(m)
If enemystart(m).x < presentx(m) Then 'presentx及presenty代表玩家飞机初始位置
   enemy(m).Left = enemy(m).Left + movex(m)
Else
   enemy(m).Left = enemy(m).Left - movex(m)
End If
If enemystart(m).y < presenty(m) Then
   enemy(m).Top = enemy(m).Top + movey(m)
Else
   enemy(m).Top = enemy(m).Top - movey(m)
End If
End Sub

Private Sub direct(n)
presentx(n) = Picture1.Left + 50: presenty(n) = Picture1.Top + 50
If presenty(n) - enemy(n).Top <> 0 Then
   angle = Abs((presentx(n) - enemy(n).Left) / (presenty(n) - enemy(n).Top))
   movey(n) = Int(Sqr(2000 / (1 + (angle * angle))))
   movex(n) = Int(Sqr(2000 / (1 + (angle * angle))) * angle)
Else
   movex(n) = Int(Sqr(2000)): movey(0) = 0
End If
End Sub

Private Sub Timer4_Timer() '监视敌人是否已飞出视屏而应从另一侧进入
For order = 0 To 49
  If enemy(order).Left < -1 Then
    enemy(order).Left = rightside
    Call direct(order)
    enemystart(order).x = enemy(order).Left: enemystart(order).y = enemy(order).Top
  End If
  If enemy(order).Left > rightside + 1 Then
    enemy(order).Left = 0
    Call direct(order)
    enemystart(order).x = enemy(order).Left: enemystart(order).y = enemy(order).Top
  End If
  If enemy(order).Top < -1 Then
    enemy(order).Top = downside
    Call direct(order)
    enemystart(order).x = enemy(order).Left: enemystart(order).y = enemy(order).Top
  End If
  If enemy(order).Top > downside + 1 Then
    enemy(order).Top = 0
    Call direct(order)
    enemystart(order).x = enemy(order).Left: enemystart(order).y = enemy(order).Top
  End If
Next order
End Sub

Private Sub Timer5_Timer()
For order = 0 To 49
  If ((enemy(order).Left > Picture1.Left + 40 And enemy(order).Left < Picture1.Left + 200) And (enemy(order).Top > Picture1.Top - 10 And enemy(order).Top < Picture1.Top + 300)) Or ((enemy(order).Left > Picture1.Left - 10 And enemy(order).Left < Picture1.Left + 400) And (enemy(order).Top > Picture1.Top + 300 And enemy(order).Top < Picture1.Top + 400)) Then
    Picture1.Visible = False: Picture2.Visible = True: Timer6.Enabled = True: animation = 1
    Timer5.Enabled = False
    Picture2.Top = Picture1.Top: Picture2.Left = Picture1.Left
  End If
Next order
End Sub

Private Sub Timer6_Timer()
Select Case animation
  Case 1
    Picture2.Picture = LoadPicture(App.Path + "\explosion\1.jpg")
  Case 2
    Picture2.Picture = LoadPicture(App.Path + "\explosion\2.jpg")
  Case 3
    Picture2.Picture = LoadPicture(App.Path + "\explosion\3.jpg")
  Case 4
    Picture2.Picture = LoadPicture(App.Path + "\explosion\4.jpg")
  Case 5
    Picture2.Picture = LoadPicture(App.Path + "\explosion\5.jpg")
  Case 6
    Picture2.Picture = LoadPicture(App.Path + "\explosion\6.jpg")
  Case 7
    Picture2.Picture = LoadPicture(App.Path + "\explosion\7.jpg")
  Case 8
    Picture2.Picture = LoadPicture(App.Path + "\explosion\8.jpg")
  Case 9
    Picture2.Picture = LoadPicture(App.Path + "\explosion\9.jpg")
End Select
animation = animation + 1
If animation > 9 Then
  lblStart.Visible = True
  l = False: r = False: d = False: u = False '避免游戏结束后飞机继续运动
  Picture1.Visible = True: Picture1.SetFocus: Picture1.Top = Me.Height '使游戏结束后飞机不可见（在屏幕外）
  Picture2.Visible = False
  Timer3.Enabled = False
  For order = 0 To 49
    enemy(order).Visible = False
  Next order
  Timer7.Enabled = False
  Timer6.Enabled = False
End If
End Sub

Private Sub Timer7_Timer()
seconds = seconds + 1
Me.Caption = "是男人就挺过20秒（" + Str(seconds) + "秒）"
End Sub