space1.frm

太空船游戏例子源程序

        Else
           Enemys(EnemyHitNum).EYcord = Enemys(EnemyHitNum).EYcord - 10
           flip = True
        End If
    Next loop_index

    Picture7.Move Enemys(EnemyHitNum).EXcord, Enemys(EnemyHitNum).EYcord
    Picture6.Visible = False
    Picture7.Visible = True
    For loop_index = 1 To Delay
        If flip = True Then
           Enemys(EnemyHitNum).EYcord = Enemys(EnemyHitNum).EYcord + 10
           flip = False
        Else
           Enemys(EnemyHitNum).EYcord = Enemys(EnemyHitNum).EYcord - 10
           flip = True
        End If
        Exit For
    Next loop_index%

    Picture7.Visible = False
            'Reinitialize enemy
            If EnemyHitNum = 0 Then
                Picture3(0).Visible = False
                Enemys(0).EXcord = 10
                Enemys(0).EYcord = 10
                Picture3(0).Move Enemys(0).EXcord, Enemys(0).EYcord
                Picture3(0).Visible = True
            End If
       
            If EnemyHitNum = 1 Then
                Picture3(1).Visible = False
                Enemys(1).EXcord = frmMain.Width / 2
                Enemys(1).EYcord = 10
                Picture3(1).Move Enemys(1).EXcord, Enemys(1).EYcord
                Picture3(1).Visible = True
            End If

            If EnemyHitNum = 2 Then
                Picture3(2).Visible = False
                Enemys(2).EXcord = frmMain.Width - Picture3(2).Width
                Enemys(2).EYcord = 10
                Picture3(2).Move Enemys(2).EXcord, Enemys(2).EYcord
                Picture3(2).Visible = True
           End If
                             
            'Increment enemy counter
          NumDeadEnemy = NumDeadEnemy + 1
          lblEnemies.Caption = NumDeadEnemy
End Sub

Private Sub BlowUpShip()
'This routine cause the player PCs to blow up it is accomplished by
'setting the current picture to invisible and then showing the explosions in sucession
'the flip routine is to get a shake effect on the explosion.
Dim flip, loop_index, fWidth, RandomX As Integer
    flip = True
    Picture1.Visible = False
    Picture5.Move Xcord, Ycord
    Picture5.Visible = True
    For loop_index = 1 To Delay
        If flip = True Then
           Ycord = Ycord + 10
           flip = False
        Else
           Ycord = Ycord - 10
           flip = True
        End If
    Next loop_index

    Picture6.Move Xcord, Ycord
    Picture5.Visible = False
    Picture6.Visible = True
    For loop_index = 1 To Delay
        If flip = True Then
           Ycord = Ycord + 10
           flip = False
        Else
           Ycord = Ycord - 10
           flip = True
        End If
    Next loop_index

    Picture7.Move Xcord, Ycord
    Picture6.Visible = False
    Picture7.Visible = True
    For loop_index = 1 To Delay
        If flip = True Then
           Ycord = Ycord + 10
           flip = False
        Else
           Ycord = Ycord - 10
           flip = True
        End If
    Next loop_index
    Picture7.Visible = False

  'Reset start positions
   StartYcord = frmMain.Height - 1500
   StartXcord = frmMain.Width / 2
   Ycord = StartYcord
   Xcord = StartXcord
   'Move picture to start position
    Picture1.Move Xcord, Ycord
    Picture1.Visible = True
    'reset number of lives
    NumLives = NumLives - 1
    lblLives.Caption = NumLives

    'Reset enemies
    fWidth = frmMain.Width - Picture3(2).Width
    Enemys(0).EnemyNum = 0
    Randomize
    RandomX = Int(fWidth * Rnd + 1)
    Enemys(0).EXcord = RandomX
    Enemys(0).EYcord = -50
    Enemys(0).Visible = True

    Enemys(1).EnemyNum = 1
    Randomize
    RandomX = Int(fWidth * Rnd + 1)
    Enemys(1).EXcord = RandomX
    Enemys(1).EYcord = -30
    Enemys(1).Visible = True

    Enemys(2).EnemyNum = 2
    Randomize
    RandomX = Int(fWidth * Rnd + 1)
    Enemys(2).EXcord = RandomX
    Enemys(2).EYcord = -10
    Enemys(2).Visible = True

    'If dead display message and close down game
    If NumLives < 1 Then
       MsgBox "Game Over - The phones have taken over the planet and it's all your fault! Have a nice day.", 48, "Phone Attack"
       Picture1.Visible = False
       Picture2.Visible = False
       Picture3(0).Visible = False
       Picture3(1).Visible = False
       Picture3(2).Visible = False
       Picture4(0).Visible = False
       Picture4(1).Visible = False
       Picture4(2).Visible = False
       Picture5.Visible = False
       Picture6.Visible = False
       Picture7.Visible = False
       frmMain.Timer1.Enabled = False
       frmMain.mnuNewGame.Enabled = True

    End If
End Sub

Private Sub BubbleSort(ByVal nOrder As Integer)
Dim Index, TEMP, NextElement, gIterations, TheBucket As Integer
Dim CurName As String
    NextElement = LBound(HighScores) + 1
    While (NextElement <= UBound(HighScores))
    TheBucket = HighScores(NextElement).NumEnemyDead
    CurName = HighScores(NextElement).Name
        Index = NextElement
        Do
            If Index > LBound(HighScores) Then
                If nOrder = ASCENDING_ORDER Then
                    If TheBucket < HighScores(Index - 1).NumEnemyDead Then
                        HighScores(Index).NumEnemyDead = HighScores(Index - 1).NumEnemyDead
                        HighScores(Index).Name = HighScores(Index - 1).Name
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                ElseIf nOrder = DESCENDING_ORDER Then
                   If TheBucket >= HighScores(Index - 1).NumEnemyDead Then
                        HighScores(Index).NumEnemyDead = HighScores(Index - 1).NumEnemyDead
                        HighScores(Index).Name = HighScores(Index - 1).Name
                        Index = Index - 1
                    Else
                        Exit Do
                    End If
                End If
            Else
                Exit Do
            End If
    
            gIterations = gIterations + 1
    
        Loop
        HighScores(Index).NumEnemyDead = TheBucket
        HighScores(Index).Name = CurName
        NextElement = NextElement + 1
        gIterations = gIterations + 1
    Wend


End Sub

Private Sub ExitItem_Click()
'Exit Program
Dim NameString As String
Dim X, SaveIndex As Integer
SaveIndex = True

'Find out if this is a high score?
For X = 0 To 4
    If NumDeadEnemy > HighScores(X).NumEnemyDead Then
        SaveIndex = X
        Exit For
    End If
Next X

'If it is write it to file
If SaveIndex > True Then

        'Get Game players first name
        frmNameEntry.Move (((frmMain.Width - frmNameEntry.Width) / 2) + frmMain.Left), (((frmMain.Height - frmNameEntry.Height) / 2) + frmMain.Top)
        frmNameEntry.Show MODAL
        NameString = frmNameEntry.txtName.Text
        Unload frmNameEntry
        'Save name to array
        HighScores(SaveIndex).Name = NameString
        HighScores(SaveIndex).NumEnemyDead = NumDeadEnemy

        'Sort HighScores  array
        BubbleSort DESCENDING_ORDER
        
        Dim DatFile As String
        DatFile = App.Path & "\gamedat.dat"

        
        'Write array out to file
        Open DatFile For Output As #1
        For X = 0 To 4
                Print #1, HighScores(X).Name
                Print #1, HighScores(X).NumEnemyDead
        Next X
        Close #1

        'Show HighScores
        frmHighScores.Move (((frmMain.Width - frmHighScores.Width) / 2) + frmMain.Left), (((frmMain.Height - frmHighScores.Height) / 2) + frmMain.Top)
        
        frmHighScores.Show MODAL
        
End If
    
    'Exit program
    End
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim XIncrement, LXCord, LYCord, loop_index, loopnum, YIncrement As Integer
'Dim Key As String
    XIncrement = Speed
    YIncrement = Speed

    If NumLives < 1 Then
        Exit Sub
    End If
    'Key = Chr$(KeyASCII)
    'If right arrow pressed move player to the right
    If (KeyCode = KEY_RIGHT) Then
        'Check for intersection with the ends of the form
        If Picture1.Left >= frmMain.Width - (Picture1.Width * 2) Then
            'Do Nothing
        Else
            'Increment in the x direction
            Xcord = Xcord + XIncrement
        End If
    End If
    
    'Now do the same for the left arrow
    If (KeyCode = KEY_LEFT) Then
        If Picture1.Left <= 0 Then
            'Do Nothing
        Else
            Xcord = Xcord - XIncrement
        End If
    End If
    
    'If (KeyCode = KEY_UP) Then
        'YCord = YCord - YIncrement%
    'End If
    
    'If (KeyCode = KEY_DOWN) Then
        'YCord = YCord + YIncrement%
    'End If

    'Move the Player
    Picture1.Move Xcord, Ycord
    
    'Check for space key to see if player is firing lasers
    If (KeyCode = KEY_SPACE) Then

        'set up lasers
        LXCord = Xcord
        LYCord = Ycord - Picture1.Height
        'Move lasers
        Picture2.Move LXCord, LYCord
        Picture2.Visible = True
        'Loop till lasers blow up enemy or hit top of screen
        For loop_index = Picture2.Top To 0 Step -Speed
            Picture2.Move LXCord, loop_index
            'Did you hit an enemy?
            For loopnum = 0 To TotalEnemys - 1 Step 1
                If ((loop_index > Enemys(loopnum).EYcord) And (loop_index < Enemys(loopnum).EYcord + Picture3(loopnum).Height) And (LXCord > Enemys(loopnum).EXcord - Picture3(loopnum).Width) And (LXCord < Enemys(loopnum).EXcord + Picture3(loopnum).Width)) Then
                    Picture2.Visible = False
                    EnemyHitNum = Enemys(loopnum).EnemyNum
                    'Blow enemy up
                    Call BlowUpEnemy
                    'Reset laser
                    LXCord = frmMain.Width
                    LYCord = frmMain.Height
                    Exit For
                End If
            Next loopnum

        Next loop_index

        Picture2.Visible = False
        
    End If
    'Call Move enemy so that enemy moves while the player fires
    Call PutEnemy

End Sub

Private Sub Form_Load()
   Dim index_loop, fWidth, RandomX, X As Integer
   'This section loads the icons into the picture controls
   'the directory must coded into the string if the image is not
   'in the current directory. Another way to accomplish the same thing
   'is to load the picture by setting the picture property in the
   'control itself this would compile the image into the executable
   'saving you the trouble of distributing the icons separtely.
   'This is what I have done to the picture object and this is why this
   'code is commented out.
   
   'picture1.Picture = LoadPicture("c:\vb\ship\pc04.ICO")
   'Picture2.Picture = LoadPicture("C:\vb\ship\laser1.ico")
   'Picture3(0).Picture = LoadPicture("C:\vb\ship\phone01.ico")
   'Picture3(1).Picture = LoadPicture("C:\vb\ship\phone15.ico")
   'Picture3(2).Picture = LoadPicture("C:\vb\ship\phone01.ico")
   'picture4(0).Picture = LoadPicture("C:\vb\ship\laser4.ico")
   'picture4(1).Picture = LoadPicture("C:\vb\ship\laser4.ico")
   'picture4(2).Picture = LoadPicture("C:\vb\ship\laser4.ico")
   'Picture5.Picture = LoadPicture("C:\vb\ship\xplo1.ico")
   'Picture6.Picture = LoadPicture("C:\vb\ship\xplo2.ico")
   'Picture7.Picture = LoadPicture("C:\vb\ship\xplo3.ico")
                   
   StartYcord = frmMain.Height - 1500
   StartXcord = frmMain.Width / 2
   Ycord = StartYcord
   Xcord = StartXcord
   NumDeadEnemy = 0
   NumLives = 5
   lblLives.Caption = NumLives
   
   Picture1.Move StartXcord, StartYcord
   Picture1.Visible = True


   For index_loop = 0 To 3
       EnemyLasers(index_loop).EnemyNum = index_loop - 1
       EnemyLasers(index_loop).LEXcord = 0
       EnemyLasers(index_loop).LEYcord = 0
       EnemyLasers(index_loop).Visible = False
   Next index_loop

    fWidth = frmMain.Width - Picture3(2).Width

    Enemys(0).EnemyNum = 0
    Randomize
    RandomX = Int(fWidth * Rnd + 1)
    Enemys(0).EXcord = RandomX
    Enemys(0).EYcord = -50
    Enemys(0).Visible = True

    Enemys(1).EnemyNum = 1
    Randomize
    RandomX = Int(fWidth * Rnd + 1)
    Enemys(1).EXcord = RandomX
    Enemys(1).EYcord = -30
    Enemys(1).Visible = True

    Enemys(2).EnemyNum = 2
    Randomize
    RandomX = Int(fWidth * Rnd + 1)
    Enemys(2).EXcord = RandomX
    Enemys(2).EYcord = -10
    Enemys(2).Visible = True

    TotalEnemys = 3

    EnemyHitNum = 0