module1.bas

本程序较为完整的编写了一个名为"潜水艇大战飞机"的游戏,对于想用VB编写游戏的人有辅助作用.

                    If Boss.X <= Shot(M).X And Boss.X + BossBredde >= Shot(M).X Then
                        If Shot(M).Y >= Boss.Y And Shot(M).Y <= Boss.Y + BossHoyde Then
                            Hitboss
                        End If
                    End If
                Case 2
                    If Boss.X <= Shot(M).X + 6 And Boss.X + BossBredde >= Shot(M).X + 6 Then
                        If Shot(M).Y >= Boss.Y And Shot(M).Y <= Boss.Y + BossHoyde Then
                            Hitboss
                        End If
                    End If
                Case 3
                    If Boss.X <= Shot(M).X + 6 And Boss.X + BossBredde >= Shot(M).X + 6 Then
                        If Shot(M).Y + 6 >= Boss.Y And Shot(M).Y + 6 <= Boss.Y + BossHoyde Then
                            Hitboss
                        End If
                    End If
                Case 4
                    If Boss.X <= Shot(M).X And Boss.X + BossBredde >= Shot(M).X Then
                        If Shot(M).Y + 6 >= Boss.Y And Shot(M).Y + 6 <= Boss.Y + BossHoyde Then
                            Hitboss
                        End If
                    End If
                End Select
            End If
            'Now check the subs
            For s = 1 To 30
                Select Case A
                Case 1
                    If Subs(s).X <= Shot(M).X And Subs(s).X + SubBredde >= Shot(M).X Then
                        If Shot(M).Y >= Subs(s).Y And Shot(M).Y <= Subs(s).Y + SubHoyde Then
                            Killsub (s)
                        End If
                    End If
                Case 2
                    If Subs(s).X <= Shot(M).X + 6 And Subs(s).X + SubBredde >= Shot(M).X + 6 Then
                        If Shot(M).Y >= Subs(s).Y And Shot(M).Y <= Subs(s).Y + SubHoyde Then
                            Killsub (s)
                        End If
                    End If
                Case 3
                    If Subs(s).X <= Shot(M).X + 6 And Subs(s).X + SubBredde >= Shot(M).X + 6 Then
                        If Shot(M).Y + 6 >= Subs(s).Y And Shot(M).Y + 6 <= Subs(s).Y + SubHoyde Then
                            Killsub (s)
                        End If
                    End If
                Case 4
                    If Subs(s).X <= Shot(M).X And Subs(s).X + SubBredde >= Shot(M).X Then
                        If Shot(M).Y + 6 >= Subs(s).Y And Shot(M).Y + 6 <= Subs(s).Y + SubHoyde Then
                            Killsub (s)
                        End If
                    End If
                End Select
            Next s
            If Shot(M).Act Then MakeExplo Shot(M).X, Shot(M).Y
            Shot(M).Act = 0
            Shot(M).X = 0
            Shot(M).Y = 0
            NumShots = NumShots - 1
        End If
    Next A
    
End Sub

Public Sub HitShipCheck(M)
Dim Svar
    
    Svar = GetPixel(Form1.Pic2.hdc, Bombs(M).X, Bombs(M).Y)
    
    If Svar <> vbWhite Then
        P1.Health = P1.Health - 1
        With Bombs(M)
        .Act = False
        .Speed = 0
        .X = 0
        .Y = 0
        End With
        PlaySound "hit" 'play the sound
        Debug.Print P1.Health
        'If P1.Health = 1 Then P1.Health = 8
        If P1.Health <= 0 Then
            MainPause = True
            P1.Health = 0
            MsgBox "Game Over", vbOKOnly, Form1.Caption
            Form1.PicExit_Click
        End If
    End If
End Sub
Public Sub Killsub(A)
    With Subs(A)
        If Not .Act Then Exit Sub
        P1.Score = P1.Score + Subs(A).Score 'Add the subs score to the players
        MakeSign Subs(A).Score, Subs(A).X, Subs(A).Y  'Make the Score Sign
        .Score = 0
        .Speed = 0
        .Damaged = 1
        P1.Killed = P1.Killed + 1 'Increase number of killed subs
    End With
    NumSubs = NumSubs - 1
    OkToMakeBoss = True
End Sub
Sub MakeSign(Score, X, Y)
    For A = 1 To UBound(Signs)
        If Signs(A).Tag = 0 Then
            Signs(A).Score = Score
            Signs(A).Tag = 100
            Signs(A).X = X + 10
            Signs(A).Y = Y
            Exit For
        End If
    Next A
End Sub

Public Sub LoadScore()
    Open App.Path & "\data.dat" For Random As #1 Len = 18
    For A = 3 To 30 Step 3
        Get #1, A - 2, HighS(A / 3).PlName
        Get #1, A - 1, HighS(A / 3).plScore
        Get #1, A, HighS(A / 3).plDate
    Next A
    Close #1
End Sub

Public Sub SaveScore()
    On Error Resume Next
    Kill App.Path & "\data.dat"
    Open App.Path & "\data.dat" For Random As #1 Len = 18
    For A = 3 To 30 Step 3
        Put #1, A - 2, HighS(A / 3).PlName
        Put #1, A - 1, HighS(A / 3).plScore
        Put #1, A, HighS(A / 3).plDate
    Next A
    Close #1
End Sub
Public Sub CheckKing()
    If P1.X = 0 And GetAsyncKeyState(vbKeyE) And TheKing.Act = False Then
        'Activate HIM
        PlaySound "elvis2"
        TheKing.Act = True
        TheKing.Tag = 0
        TheKing.X = Bredde + 1
        TheKing.Y = Int((Rnd * 150) + 130)
    End If
End Sub
Public Sub UpdateScore()
Dim MyName As String
Dim Score As Long
    Score = P1.Score
    
    If Score = 0 Then Exit Sub
    
    For A = 1 To 10
        If Score > HighS(A).plScore Then GoTo FantEn
    Next A
    ' No highscore, exit sub
    Exit Sub
FantEn:
    
    'Wanna save?
    Svar = MsgBox("Congratulations! " & P1.Score & " points is a new highscore!" & vbNewLine & "Do you want to write it down?", vbYesNo, "New HighScore: " & A & ". place!")
    If Svar = vbNo Then Exit Sub
    
    'Move previous scores down
    For b = 10 To A + 1 Step -1
        HighS(b).plDate = HighS(b - 1).plDate
        HighS(b).PlName = HighS(b - 1).PlName
        HighS(b).plScore = HighS(b - 1).plScore
    Next b

NewName:
    MyName = InputBox("Please input your name (Max 16 characters)", "New HighScore: " & A & ". place!")
    If Len(MyName) > 16 Then GoTo NewName
    If Len(MyName) = 0 Then GoTo NewName
    
    HighS(A).plDate = Date
    HighS(A).PlName = MyName
    HighS(A).plScore = P1.Score
    frmHigh.Show , Form1
    DontClose = True
End Sub

Public Sub MakePlane()
    If NumPlanes = 10 Then Exit Sub
    
    Randomize
    temp = (Rnd * 130)
    If temp < 20 Then
    
        NumPlanes = NumPlanes + 1
        
        A = 1
        Do Until Not Planes(A).Act Or A = 10
            A = A + 1
        Loop
        With Planes(A)
        
        .Act = True
        
        If Int((Rnd * 2) + 1) = 1 Then
            .X = 0 - PlaneBredde - 2
            .Dire = 2
        Else
            .X = Bredde + 2
            .Dire = 1
        End If
        
        .Y = Int((Rnd * 35) + 5)
        
        .Droped = False
        .Speed = 4
        
        End With
    End If
End Sub

Public Sub DropBombs()
Dim PL As Integer
    For PL = 1 To 10
        If Planes(PL).BombLoad > 0 Then GoTo AllClear
        
        If Planes(PL).Act And Not Planes(PL).Droped Then
            
            'Check if it is smart to drop bombs
            If Planes(PL).X < P1.X + ShipBredde And Planes(PL).X > P1.X Then
                
                If Planes(PL).BombLoad = 0 Then
                    Randomize
                    Planes(PL).BombLoad = Int((Rnd * 7) + 3)
                    Planes(PL).Droped = True
                End If
AllClear:
                
                If NumBombs = 30 Then Exit Sub

                NumBombs = NumBombs + 1
                Planes(PL).BombLoad = Planes(PL).BombLoad - 1
                
                A = 1
                Do Until Not Bombs(A).Act Or A = 30
                    A = A + 1
                Loop
                
                With Bombs(A)
                .Act = True
                
                If Planes(PL).Dire = 1 Then
                    .Speed = Planes(PL).Speed * -1
                Else
                    .Speed = Planes(PL).Speed
                End If
                
                Select Case Planes(PL).Dire
                Case 1: .X = Planes(PL).X + 20
                Case 2: .X = Planes(PL).X + 4
                End Select
                
                .Y = Planes(PL).Y + 14
                
                End With
            End If
        End If
    Next PL
End Sub

Sub MakeExplo(X, Y)
    'play a sound
    PlaySound "explo"
    X = X - 30
    Y = Y - 25
    A = 1
    Do Until Not Explo(A).Act Or A = UBound(Explo)
        A = A + 1
    Loop
    With Explo(A)
        .X = X
        .Y = Y
        .Tag = 0
        .Act = True
    End With
End Sub
Public Sub DoExplo()
    For A = 1 To UBound(Explo)
        If Explo(A).Act Then
            If Explo(A).Tag < 11 Then
                Explo(A).Tag = Explo(A).Tag + 1
            Else
                Explo(A).Act = False
                Explo(A).X = 0
                Explo(A).Y = 0
                Explo(A).Tag = 0
            End If
        End If
    Next A
End Sub
Public Sub DoSigns()
    For A = 1 To UBound(Signs)
        If Signs(A).Tag > 0 Then
            Signs(A).Tag = Signs(A).Tag - 1
            Signs(A).Y = Signs(A).Y - 1
            If (Signs(A).X Mod 5) = 2 Then Signs(A).X = Signs(A).X + 1 'a hack
            Signs(A).X = Signs(A).X - 2 + (Signs(A).X Mod 5) 'wiggle the letters
        Else
            Signs(A).Score = 0
            Signs(A).X = 0
            Signs(A).Y = 0
        End If
    Next A
End Sub