space1.frm

太空船游戏例子源程序

    Speed = 150
    TimerDelay = 40
    Timer1.Interval = 40
    Delay = 5500
    imgBoss.Visible = False
    imgBoss.Left = frmMain.Left + frmMain.Width + 100

  '  ChDrive "C"
  '  ChDir "c:\vb\newship"

    
Dim DatFile As String
DatFile = App.Path & "\gamedat.dat"

    
    Open DatFile For Input As #1
    For X = 0 To 4
       Input #1, HighScores(X).Name
       Input #1, HighScores(X).NumEnemyDead
    Next X
        Close #1

    For X = 0 To 4
        If HighScores(X).Name = "" Then
            HighScores(X).Name = "Name"
            HighScores(X).NumEnemyDead = 0
        End If
    Next X
    
    
    'Sort HighScores
    BubbleSort DESCENDING_ORDER
End Sub

Private Sub imgBoss_Click()

End Sub

Private Sub mnuBoss_Click()
'Load in the Boss image and move it to the correct position
imgBoss.Top = -120
imgBoss.Left = -72
'imgBoss.Height = frmMain.Height
'imgBoss.Width = frmMain.Width
imgBoss.Visible = True
   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
   panInfo.Visible = False
End Sub

Private Sub mnuBossGone_Click()
'Restart the game
imgBoss.Left = frmMain.Left + frmMain.Width + 100
imgBoss.Visible = False
   Picture1.Visible = True
   Picture2.Visible = False
   Picture3(0).Visible = True
   Picture3(1).Visible = True
   Picture3(2).Visible = True
   Picture4(0).Visible = False
   Picture4(1).Visible = False
   Picture4(2).Visible = False
   Picture5.Visible = False
   Picture6.Visible = False
   Picture7.Visible = False

    If NumLives > 1 Then
        frmMain.Timer1.Enabled = True
    End If
   panInfo.Visible = True

End Sub

Private Sub mnuHighScores_Click()
'Pause the game and show the High Scores Screen
Timer1.Enabled = False
frmHighScores.Move (((frmMain.Width - frmHighScores.Width) / 2) + frmMain.Left), (((frmMain.Height - frmHighScores.Height) / 2) + frmMain.Top)

frmHighScores.Show MODAL

If NumLives > 1 Then
    Timer1.Enabled = True
End If

End Sub

Private Sub mnuHowTo_Click()
'Pause the game and show the High Scores Screen
Timer1.Enabled = False
frmHowTo.Move (((frmMain.Width - frmHowTo.Width) / 2) + frmMain.Left), (((frmMain.Height - frmHowTo.Height) / 2) + frmMain.Top)

frmHowTo.Show MODAL

If NumLives > 1 Then
    Timer1.Enabled = True
End If

End Sub

Private Sub mnuNewGame_Click()
'Create a new game by initailizing variables
Dim fWidth, RandomX As Integer
   StartYcord = frmMain.Height - 1500
   StartXcord = frmMain.Width / 2
   Ycord = StartYcord
   Xcord = StartXcord
   NumDeadEnemy = 0
   NumLives = 5
   lblLives.Caption = NumLives
   
   lblLives.Caption = NumLives
   Picture1.Visible = True
   Picture2.Visible = False
   Picture3(0).Visible = True
   Picture3(1).Visible = True
   Picture3(2).Visible = True
   Picture4(0).Visible = False
   Picture4(1).Visible = False
   Picture4(2).Visible = False
   Picture5.Visible = False
   Picture6.Visible = False
   Picture7.Visible = False
   frmMain.Timer1.Enabled = True

    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

    Speed = 150
    TimerDelay = 40
    Timer1.Interval = 40
    Delay = 5500
    imgBoss.Visible = False
    imgBoss.Left = frmMain.Left + frmMain.Width + 100


End Sub

Private Sub mnuOpen_Click()
'Use the common dialog open and read a file in
On Error Resume Next
'Can this dialog be canceled?
CMDialog1.CancelError = True
'Title
CMDialog1.DialogTitle = "Load Game Options"
'Game file suffix
CMDialog1.Filter = "Game Data Files (*.dat)|*.dat"
'Flags
CMDialog1.Flags = OFN_FILEMUSTEXIST
'Action 1 = Open Dialog Box
CMDialog1.Action = 1
'If no Error
If Err = False Then
    'Read file
    Open CMDialog1.filename For Input As #1
    Input #1, Speed
    Input #1, TimerDelay
    Close #1
End If

End Sub

Private Sub mnuOptions_Click()
'Load option form
'Center on Main form
'frmOptions.Move (((frmMain.Width - frmOptions.Width) / 2) + frmMain.Left), (((frmMain.Height - frmOptions.Height) / 2) + frmMain.Top)
'Show MODAL
'frmOptions.Show MODAL
End Sub

Private Sub mnuPause_Click()
'Pause game by checking the game state each time the user clicks
'on the pause option and change it to either true or false depending
'on the current state
If Timer1.Enabled = False Then
    If NumLives > 1 Then
        Timer1.Enabled = True
    End If
    mnuPause.CHECKED = False
ElseIf Timer1.Enabled = True Then
    Timer1.Enabled = False
    mnuPause.CHECKED = True
End If
End Sub

Private Sub mnuPrint_Click()
frmMain.Print

End Sub

Private Sub mnuSave_Click()
'Write a file out to disk
On Error Resume Next
'Set Cancel
CMDialog1.CancelError = True
'Write out Title of Dialog Box
CMDialog1.DialogTitle = "Save Game Options"
'Set File Filter
CMDialog1.Filter = "Game Data Files (*.DAT)|*.dat"
'Set Flags
CMDialog1.Flags = OFN_OVERWRITEPROMPT
'Set Action = 2 SAVE dialog box
CMDialog1.Action = 2
'If No Error
If Err = False Then
    'Open file for Output and write it out
    Open CMDialog1.filename For Output As #1
    Print #1, Speed
    Print #1, TimerDelay
    Close #1
End If
End Sub

Private Sub PutEnemy()
'Put the enemy on the screen
 Dim loop_index, RandomX, fWidth As Integer

        'Set the max width of the form so that the enemy
        'does not appear off the form
        fWidth = frmMain.Width - Picture3(2).Width

        Randomize
         
        RandomX = Int(100 * Rnd + 1)
        If Int(100 * Rnd + 1) > 50 Then
            Enemys(0).EXcord = Enemys(0).EXcord + RandomX
        Else
            Enemys(0).EXcord = Enemys(0).EXcord - RandomX
        End If
        Enemys(0).EYcord = Enemys(0).EYcord + Speed
        Picture3(0).Move Enemys(0).EXcord, Enemys(0).EYcord
        Picture3(0).Visible = True
        
        Randomize
        RandomX = Int(100 * Rnd + 1)
        If Int(100 * Rnd + 1) > 50 Then
            Enemys(1).EXcord = Enemys(1).EXcord + RandomX
        Else
            Enemys(1).EXcord = Enemys(1).EXcord - RandomX
        End If
        Enemys(1).EYcord = Enemys(1).EYcord + Speed
        Picture3(1).Move Enemys(1).EXcord, Enemys(1).EYcord
        Picture3(1).Visible = True
        
        Randomize
        RandomX = Int(100 * Rnd + 1)
        If Int(100 * Rnd + 1) > 50 Then
            Enemys(2).EXcord = Enemys(2).EXcord + RandomX
        Else
            Enemys(2).EXcord = Enemys(2).EXcord - RandomX
        End If
        Enemys(2).EYcord = Enemys(2).EYcord + Speed
        Picture3(2).Move Enemys(2).EXcord, Enemys(2).EYcord
        Picture3(2).Visible = True
        
        For loop_index = 0 To TotalEnemys - 1
             
            If ((Enemys(loop_index).EXcord > Xcord - (Picture1.Width)) And (Enemys(loop_index).EXcord < Xcord + (Picture1.Width))) And (Enemys(loop_index).EYcord > Ycord - (Picture1.Height)) And (Enemys(loop_index).EYcord < Ycord + (Picture1.Height)) Then
                Picture1.Visible = False
                Call BlowUpShip
                Exit For
            End If

        Next loop_index
        
        For loop_index = 0 To TotalEnemys - 1 Step 1


        If (Enemys(loop_index).EYcord > frmMain.ScaleHeight) Then
            If Enemys(loop_index).EnemyNum = 0 Then
                Picture3(0).Visible = False
                Randomize
                RandomX = Int(fWidth * Rnd + 1)
                Enemys(0).EXcord = RandomX
                Enemys(0).EYcord = -50
                Picture3(0).Move Enemys(0).EXcord, Enemys(0).EYcord
                Picture3(0).Visible = True
            End If
       
            If Enemys(loop_index).EnemyNum = 1 Then
                Picture3(1).Visible = False
                Randomize
                RandomX = Int(fWidth * Rnd + 1)
                Enemys(1).EXcord = RandomX
                Enemys(1).EYcord = -30
                Picture3(1).Move Enemys(1).EXcord, Enemys(1).EYcord
                Picture3(1).Visible = True
            End If

            If Enemys(loop_index).EnemyNum = 2 Then
                Picture3(2).Visible = False
                Randomize
                RandomX = Int(fWidth * Rnd + 1)
                Enemys(2).EXcord = RandomX
                Enemys(2).EYcord = -10
                Picture3(2).Move Enemys(2).EXcord, Enemys(2).EYcord
                Picture3(2).Visible = True
           End If
    
           Exit For
       
        End If
            
        Next loop_index


End Sub

Private Sub Timer1_Timer()
'This is the main loop that controls all game action and puts the
'Enemies on the screen
Dim loop_index, loop_num As Integer

    'Put Enemies
    Call PutEnemy

    'Increment counter
    Counter = Counter + 1

    If Counter > 10 Then
     
        'Counter = 0

        'Loop Through Lasers moving them and check for a hit on player
        For loop_index = 0 To TotalEnemys - 1

        EnemyLasers(loop_index).LEXcord = Enemys(loop_index).EXcord
        EnemyLasers(loop_index).LEYcord = Enemys(loop_index).EYcord + Picture3(loop_index).Height * 2
        Picture4(loop_index).Move EnemyLasers(loop_index).LEXcord, EnemyLasers(loop_index).LEYcord

        Picture4(loop_index).Visible = True

        For loop_num = EnemyLasers(loop_index).LEYcord To frmMain.ScaleHeight Step 200
            'Check to see if you intersected the player
            If ((loop_num > Ycord) And (loop_num < Ycord + Picture1.Height) And (EnemyLasers(loop_index).LEXcord > Xcord - (Picture1.Width / 2)) And (EnemyLasers(loop_index).LEXcord < Xcord + (Picture1.Width / 2))) Then
                Picture1.Visible = False
                Picture4(loop_index).Visible = False
                'Blow up player
                Call BlowUpShip
                Exit For
            End If


            Picture4(loop_index).Move EnemyLasers(loop_index).LEXcord, loop_num

        Next loop_num

        Next loop_index
        Counter = 0
    Else
        'Turn Lasers off
        For loop_index = 0 To TotalEnemys - 1
        Picture4(loop_index).Visible = False
        Next loop_index
        
    End If

End Sub