VERSION 5.00
Begin VB.Form frmlander 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Lander!"
   ClientHeight    =   8745
   ClientLeft      =   45
   ClientTop       =   360
   ClientWidth     =   7125
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   583
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   475
   StartUpPosition =   1  'CenterOwner
   Begin VB.TextBox txtheight 
      Height          =   375
      Left            =   5280
      Locked          =   -1  'True
      TabIndex        =   8
      Text            =   "500.0"
      Top             =   3000
      Width           =   1695
   End
   Begin VB.TextBox txtvspeed 
      Height          =   375
      Left            =   5280
      Locked          =   -1  'True
      TabIndex        =   7
      Text            =   "0.0"
      Top             =   2040
      Width           =   1695
   End
   Begin VB.TextBox txtfuel 
      Height          =   375
      Left            =   5280
      Locked          =   -1  'True
      TabIndex        =   4
      Text            =   "1000.0"
      Top             =   1080
      Width           =   1695
   End
   Begin VB.CommandButton cmdgo 
      Caption         =   "Start"
      Default         =   -1  'True
      Height          =   495
      Left            =   5280
      TabIndex        =   3
      Top             =   120
      Width           =   1695
   End
   Begin VB.PictureBox picsmash 
      AutoRedraw      =   -1  'True
      BorderStyle     =   0  'None
      Height          =   480
      Left            =   5400
      Picture         =   "frmlander.frx":0000
      ScaleHeight     =   32
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   32
      TabIndex        =   2
      Top             =   6960
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.PictureBox picEarth 
      BackColor       =   &H00000000&
      BorderStyle     =   0  'None
      Height          =   8520
      Left            =   120
      ScaleHeight     =   568
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   336
      TabIndex        =   1
      Top             =   120
      Width           =   5040
   End
   Begin VB.Timer tmrgravity 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   5400
      Top             =   5760
   End
   Begin VB.PictureBox piclander 
      AutoRedraw      =   -1  'True
      BorderStyle     =   0  'None
      Height          =   480
      Left            =   5400
      Picture         =   "frmlander.frx":0842
      ScaleHeight     =   32
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   32
      TabIndex        =   0
      Top             =   6360
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Label lblkeys 
      Caption         =   "Use down arrow for thrusters!"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   5280
      TabIndex        =   14
      Top             =   8040
      Width           =   1815
      WordWrap        =   -1  'True
   End
   Begin VB.Label lblinfo1 
      AutoSize        =   -1  'True
      Caption         =   "For more demonstration Visual Basic Projects, please visit:"
      Height          =   615
      Left            =   5280
      TabIndex        =   13
      Top             =   3480
      Width           =   1800
      WordWrap        =   -1  'True
   End
   Begin VB.Label lblurl 
      AutoSize        =   -1  'True
      Caption         =   "http://www.vb-world.net"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   5280
      TabIndex        =   12
      Top             =   4080
      Width           =   1740
   End
   Begin VB.Label lblemail 
      AutoSize        =   -1  'True
      Caption         =   "john@vb-world.net"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   5280
      TabIndex        =   11
      Top             =   4680
      Width           =   1335
   End
   Begin VB.Label lblinfo2 
      AutoSize        =   -1  'True
      Caption         =   "To contact us, please send email to:"
      Height          =   390
      Left            =   5280
      TabIndex        =   10
      Top             =   4320
      Width           =   1725
      WordWrap        =   -1  'True
   End
   Begin VB.Label lblheight 
      AutoSize        =   -1  'True
      Caption         =   "Height:"
      Height          =   195
      Left            =   5280
      TabIndex        =   9
      Top             =   2640
      Width           =   510
   End
   Begin VB.Label lblvspeed 
      AutoSize        =   -1  'True
      Caption         =   "Vertical Speed:"
      Height          =   195
      Left            =   5280
      TabIndex        =   6
      Top             =   1680
      Width           =   1080
   End
   Begin VB.Label lblfuel 
      AutoSize        =   -1  'True
      Caption         =   "Fuel:"
      Height          =   195
      Left            =   5280
      TabIndex        =   5
      Top             =   720
      Width           =   345
   End
End
Attribute VB_Name = "frmlander"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'API Declares
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Const VK_DOWN = &H28

' Vertical speed of the craft
Private vSpeed As Double
' The y coordinate of the craft
Private LandY As Double
' The amount of fuel left
Private Fuel As Double

Private Sub cmdgo_Click()
tmrgravity.Enabled = True
cmdgo.Enabled = False
End Sub

Private Sub Form_Load()
' Set initial values for fuel and vertical speed
Fuel = 700
vSpeed = 0
LandY = 0
txtvspeed.Text = Format(vSpeed, "0.0")
txtfuel.Text = Format(Fuel, "0.0")
txtheight.Text = Format(picEarth.ScaleHeight - piclander.ScaleHeight - 30 - LandY, "0.0")

lblemail = email
lblurl = URL

Dim instructions As String
instructions = "Welcome to Lander!" & vbNewLine
instructions = instructions & "When you start, space will be drawn, and you will start to fall."
instructions = instructions & "Press the down arrow to apply thrusters!" & vbNewLine
instructions = instructions & "You must land at less than 2 to prevent crashing!" & vbNewLine
instructions = instructions & "Press the Start button to start!"
MsgBox instructions
End Sub

Private Sub lblemail_Click()
sendemail
End Sub

Private Sub lblurl_Click()
gotoweb
End Sub

Private Sub tmrgravity_Timer()
Static curtime As Long
Dim timenow As Long
Dim timediff As Long

' curtime=0 if this is the first time that the event has been raised
If curtime = 0 Then
  ' Draw the earth
  picEarth.Line (0, picEarth.ScaleHeight - 30)-(picEarth.ScaleWidth, picEarth.ScaleHeight), vbWhite, BF
  
  Randomize Timer
  Dim starx As Long, stary As Long
  For starx = 0 To picEarth.ScaleWidth
    For stary = 0 To picEarth.ScaleHeight - 30
      If Rnd * 1000 < 5 Then
        SetPixelV picEarth.hdc, starx, stary, vbYellow
      End If
    Next
  Next
    
  timenow = GetTickCount
  curtime = timenow
    
Else
  ' GetTickCount returns number of milliseconds since windows was started
  ' This allows us to guage the length of time since this event was last raised,
  ' allowing us to calculate accelerations
  timenow = GetTickCount
  
  ' If it isn't the first time, put back the previous background
  BitBlt picEarth.hdc, 150, LandY, piclander.ScaleWidth, piclander.ScaleHeight, piclander.hdc, 0, 0, vbSrcInvert
End If

' Get the number of milliseconds since the event was last called
timediff = timenow - curtime

' Calculate new vertical speed based on g ( currently using the value for Earth )
' On Earth, g=10
' On Moon, g=1.7
vSpeed = vSpeed - ((timediff / 1000) * 10)

' Find out if the down key is pressed, so if thrust should be applied
' Also check that there is fuel remaining
If GetAsyncKeyState(VK_DOWN) <> 0 Then
  If Fuel > 0 Then
    ' Apply thrust: 15 is the acceleration produced
    vSpeed = vSpeed + ((timediff / 1000) * 15)
    
    Fuel = Fuel - ((timediff / 1000) * 150)
    
    ' Check that fuel does not go below 0
    If Fuel < 0 Then Fuel = 0
  Else
    Beep
  End If
End If

LandY = LandY - vSpeed

' Update text boxes
txtvspeed.Text = Format(vSpeed, "0.0")
txtfuel.Text = Format(Fuel, "0.0")
txtheight.Text = Format(picEarth.ScaleHeight - piclander.ScaleHeight - 30 - LandY, "0.0")

' Update the 'last called time'
curtime = timenow

' If it has touched down...
If LandY >= picEarth.ScaleHeight - 30 - piclander.ScaleHeight Then
  
  ' Make sure that it is on the surface
  LandY = picEarth.ScaleHeight - 30 - piclander.ScaleHeight
  txtheight.Text = Format(picEarth.ScaleHeight - piclander.ScaleHeight - 30 - LandY, "0.0")
  
  ' Stop the timer and disable the pause button...the game is over!
  tmrgravity.Enabled = False
  
  ' Figure out if it was a safe landing or not, and paint the appropriate craft
  If vSpeed > -2 Then
    ' If it was safe, then the craft remains intact
    BitBlt picEarth.hdc, 150, LandY, piclander.ScaleWidth, piclander.ScaleHeight, piclander.hdc, 0, 0, vbSrcInvert
    MsgBox "Congratulations! You have landed successfully!"
  Else
    ' If it was moving too fast, it blows up!
    BitBlt picEarth.hdc, 150, LandY, piclander.ScaleWidth, piclander.ScaleHeight, picsmash.hdc, 0, 0, vbSrcInvert
    MsgBox "Smash! Oooops!"
  End If

Else

  ' paint the craft into its new position.
  BitBlt picEarth.hdc, 150, LandY, piclander.ScaleWidth, piclander.ScaleHeight, piclander.hdc, 0, 0, vbSrcInvert

End If
End Sub