form1.frm

游戏代码]射击(导弹)游戏的源程序

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   ClientHeight    =   5940
   ClientLeft      =   1140
   ClientTop       =   1515
   ClientWidth     =   6690
   ForeColor       =   &H00FFFFFF&
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5940
   ScaleWidth      =   6690
   ShowInTaskbar   =   0   'False
   WindowState     =   2  'Maximized
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' I have just written this to acompany the asteroids example
' program. Its a simple PURE VB APP, no api or directx etc.
' Simply shoot the moving baddies, they stop at random intervals
' at this time they cannot be shot. So its a bit more strategic
' than the usual missile command. It has still got a few bugs in it
' so if you feel like fixing it. Go right ahead. You can use
' any bits of this code in your program as you wish.
' NOTE: we have to drawover the lines with black lines (as you
' will see in this code) because if we just use FORM1.REFRESH
' the screen flickers to violently and we cant see any of the
' baddies.

'Visit my web page at http://web.ukonline.co.uk/nutz.r
'or e-mail me on [e-mail]
'Daedalus Games And Daedalus Developments are TradeMarks Of
'Daedalus Development Innovations.

Dim Pi As Double 'To store the value of pi
Dim Radians As Double ' To store the value, to convert between Deg and Rad
Dim OldX As Integer ' Store the oldX value
Dim cx As Double 'Centre x point (of the turret)
Dim cy As Double 'Centre Y point of the turret
Dim ox As Double 'End X point of the turret
Dim oy As Double 'End Y point of the turret
Dim oldox As Double 'Old position of the pointer
Dim oldoy As Double 'old position of the pointre
Dim centrepointx As Integer 'Current X of the cursor
Dim centrepointy As Integer 'Current Y of the cursor
Dim Angle As Integer 'Current angle, from the turret to the pointer
Dim Firing As Boolean 'Are we firing ?
Dim Explosion(100) As ExplosionData 'Data to store the explosions
Dim Baddies(100) As BogeyData 'Data to store the baddies
Dim TopNumberExploding As Integer 'The current number of explosions
Dim TopNumberBaddies As Integer ' The current number of baddies
Dim Running As Boolean 'Are we running ?
Dim Distance As Integer 'Temporary distance variable
Dim Lives As Integer ' Number of lives
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then
    ShutDown ' if we pressed escape, call the shutdown function
End If
End Sub
Sub ShutDown()
    Running = False ' we are no longer running
    ShowCursor 2 'reshow the cursor
    Unload Me 'Obviousley
    End 'Quit out
End Sub
Private Sub Form_Load()
Angle = 180 'Start off at angle 180, straight up
Pi = 3.14159265359 'set the value of pi
Radians = (2 * Pi) / 360 ' set the value to convert deg to rad
cy = Screen.Height ' Set the turrets base point
cx = Screen.Width / 2 ' Set the turrets base point
ShowCursor False ' hide the cursor
Lives = 3 ' Hmm. ..
Form1.Show ' uhuh.
Running = True 'Its time to start RUNNING
Run ' call the run function
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'This function is buggy, only goes al the way to the left, if you move all the way to the right first. Hmm
' cant be bothered to fix it though
Angle = Angle + ((OldX - X) / 50) 'update the angle
If Angle > 240 Then Angle = 240 'make sure its not greater than 240
If Angle < 120 Then Angle = 120 'and not less than 120
OldX = X 'update the oldx value
Distance = (Screen.Height - (Y - Screen.Height)) - (Screen.Height - 1000) 'update the distance from the cx,cy to the cursor
X = Screen.Width / 2 'reset the mouses X value to the centre of the screen
End Sub
Sub Run()
Randomize 'Randomize the RND seed
StartBaddie 'Add the first baddie
Do While Running = True 'If Were Running ?
    ox = cx + (Sin(Angle * Radians)) * 1000 'Update the end point of the turret
    oy = cy + (Cos(Angle * Radians)) * 1000 'Update the end point of the turret
    DrawTurret 'draw the turret
    DrawCrossHair 'draw the crosshair
    If Firing = False Then Form1.Line (ox, oy)-(centrepointx, centrepointy), RGB(0, 0, 0) ' if were not firing, then Clear the lazer line (buggy clears to quickley)
    If Firing = True Then FireLazer: Firing = False 'if we are firing, fire the lazer then stop it
    If Int((200 * Rnd) + 1) = 15 Then StartBaddie 'Start a baddie at a random interval (make 200 bigger to lessen the chance of starting baddies)
    UpdateBaddies 'Update the baddies positions etc
    UpdateExplosions 'Draw and update the explosions
    DoEvents 'Get windows events (i.e mouse position) and key events
Loop
End Sub
Sub UpdateBaddies()
For i = 1 To TopNumberBaddies ' for every baddie
    If Baddies(i).Active = True Then
        'delete the old line,
        Form1.Line (Baddies(i).x1, Baddies(i).y1)-(Baddies(i).x2, Baddies(i).y2), RGB(0, 0, 0)
        Baddies(i).Length = Baddies(i).Length + 5 ' Make the baddie longer
        Baddies(i).x2 = Baddies(i).x1 + (Sin(Baddies(i).Angle * Radians)) * Baddies(i).Length 'update the baddies x coordinate
        Baddies(i).y2 = Baddies(i).y1 + (Cos(Baddies(i).Angle * Radians)) * Baddies(i).Length 'update the baddies y coordinate
        If Baddies(i).y2 >= Screen.Height Then ' if the baddie reaches the bottom of the screen
            Form1.Line (Baddies(i).x1, Baddies(i).y1)-(Baddies(i).x2, Baddies(i).y2), RGB(0, 0, 0) 'clear the line
            Baddies(i).Active = False 'This baddie is killed
            Lives = Lives - 1 'youve just died
            If Lives = 0 Then MsgBox "You Lose": ShutDown 'Game over :(
            GoTo DontDrawLine: 'Dont update this baddies line this time
        End If
        If Baddies(i).x2 < 0 Or Baddies(i).x2 > Screen.Width Then ' if the baddie goes off the sides of the screen
            Baddies(i).Active = False 'kill the baddie
            Form1.Line (Baddies(i).x1, Baddies(i).y1)-(Baddies(i).x2, Baddies(i).y2), RGB(0, 0, 0) 'clear its line
            GoTo DontDrawLine 'dont update this baddies line this time
        End If
        Form1.Line (Baddies(i).x1, Baddies(i).y1)-(Baddies(i).x2, Baddies(i).y2), RGB(0, 0, 255) 'Draw the baddies line
DontDrawLine:
    End If
Next i
End Sub
Sub UpdateExplosions()
For i = 1 To TopNumberExploding 'for each explosion
    If Explosion(i).Active = True Then
        Form1.ForeColor = RGB(0, 0, 0) 'set the color to Black
        Form1.Circle (Explosion(i).CurrX, Explosion(i).CurrY), (Explosion(i).ExplosionStage * 50) 'clear the explosions circle
        Form1.ForeColor = RGB(255, 255, 255) 'set the color back to white
        If Explosion(i).ExplosionStage = 10 Then Explosion(i).ExplosionDirection = 1 ' if the explosions circle is 10 stages wide then start making it smaller
         If Explosion(i).ExplosionDirection = 0 Then ' if its direction is (getting bigger)
            Explosion(i).ExplosionStage = Explosion(i).ExplosionStage + 1 ' make it 1 bigger
         Else ' otherwise
            Explosion(i).ExplosionStage = Explosion(i).ExplosionStage - 1 'make it one smaller
        End If
        If Explosion(i).ExplosionStage = 0 Then 'if its size is 0
            Explosion(i).Active = False 'kill this explosion
        End If
        Form1.Circle (Explosion(i).CurrX, Explosion(i).CurrY), (Explosion(i).ExplosionStage * 50) 'draw the explosion
    End If
CheckCollision i 'check if this explosion hit any of the baddies
Next i
End Sub
Sub FireLazer()
Form1.Line (ox, oy)-(centrepointx, centrepointy), RGB(0, 255, 0) 'draw the lazer
curre = FindFreeExplosion 'find a free slot in the explosion array
Explosion(curre).Active = True 'set that explosion to active
Explosion(curre).CurrX = centrepointx 'the explosion centre point = the pointers centre point
Explosion(curre).CurrY = centrepointy 'the explosion centre point = the pointers centre point
Explosion(curre).ExplosionStage = 0 ' start at 0
Explosion(curre).ExplosionDirection = 0 'set its direction to (getting bigger)
If curre > TopNumberExploding Then
    TopNumberExploding = curre 'if this explosion number is bigger than the top explosion, make the topexplosion bigger
End If
End Sub
Sub StartBaddie()
    currb = FindFreeBaddie 'find a free slot in baddie array
    Baddies(currb).Angle = Int((90 * Rnd) - 45) 'make its direction random between 90 degrees and 100
    Baddies(currb).Length = 0 'set its length to 0
    Baddies(currb).Active = True 'make it active
    Baddies(currb).x1 = Int((Screen.Width * Rnd) + 1) 'set it at a random point along the top of the screen
    Baddies(currb).y1 = 0 'start it at the top of te screen
    TopNumberBaddies = currb 'if this baddie number is bigger than the top baddie, make the topbaddie bigger
End Sub
Sub DrawTurret()
    Form1.Line (cx, cy)-(oldox, oldoy), RGB(0, 0, 0) 'clear the old turret line
    Form1.Line (cx, cy)-(ox, oy) 'draw the new turret line
    oldox = ox 'set the old value
    oldoy = oy 'set the old value
End Sub
Function FindFreeExplosion() As Integer
For i = 1 To 100
    If Explosion(i).Active = False Then ' if we found a free slot
        FindFreeExplosion = i
        Exit For
    End If
Next i
End Function
Function FindFreeBaddie() As Integer
For i = 1 To 100
    If Baddies(i).Active = False Then ' if we found a free slot
        FindFreeBaddie = i
        Exit For
    End If
Next i
End Function

Function FindNextExplosion(Number) As Integer
For i = Number To 1
    If Explosion(i).Active = True Then ' find the first active explosion in the array, starting from the end
        FindNextExplosion = i
        Exit For
    End If
Next i
End Function

Sub DrawCrossHair()
'clear the old crosshair
Form1.Line (centrepointx - 100, centrepointy)-(centrepointx + 100, centrepointy), RGB(0, 0, 0)
Form1.Line (centrepointx, centrepointy - 100)-(centrepointx, centrepointy + 100), RGB(0, 0, 0)
'set the crosshairs coordinates
centrepointx = cx + (Sin(Angle * Radians)) * Distance
centrepointy = cy + (Cos(Angle * Radians)) * Distance
'Draw the new crosshair at the new coords
Form1.Line (centrepointx - 100, centrepointy)-(centrepointx + 100, centrepointy), RGB(255, 0, 0)
Form1.Line (centrepointx, centrepointy - 100)-(centrepointx, centrepointy + 100), RGB(255, 0, 0)
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Firing = True ' we are firing
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'weve stopped firing
Firing = False
End Sub
Sub CheckCollision(ExplosionNumber)
For i = 1 To TopNumberBaddies 'check through all badies
    If Baddies(i).x2 > (Explosion(ExplosionNumber).CurrX - (Explosion(ExplosionNumber).ExplosionStage * 50)) And Baddies(i).x2 < (Explosion(ExplosionNumber).CurrX + (Explosion(ExplosionNumber).ExplosionStage * 50)) Then 'if the baddies x coord is inside the explosion AND
        If Baddies(i).y2 > (Explosion(ExplosionNumber).CurrY - (Explosion(ExplosionNumber).ExplosionStage * 50)) And Baddies(i).y2 < (Explosion(ExplosionNumber).CurrY + (Explosion(ExplosionNumber).ExplosionStage * 50)) Then ' the baddies y coord is in the explosion THEN
            Form1.Line (Baddies(i).x1, Baddies(i).y1)-(Baddies(i).x2, Baddies(i).y2), RGB(0, 0, 0) 'Clear the baddies line
            Baddies(i).Active = False 'kill the baddie
        End If
    End If
Next i
End Sub