modmain.bas

一款飞机射击游戏的源代码

                
                Call CrashPacPla(PlayPac(CountA))
                Call ResetPackage(PlayPac(CountA))
            End With
        End If
    Next CountA
    
End Sub
Public Sub DrawBullet()
    For CountA = 1 To MaxBul
        If PlayBul(CountA).IndexR > 0 Then
                If Not LoadBul(PlayBul(CountA).IndexR).IsRotate Then
                    Call BltToBuf(LoadBul(PlayBul(CountA).IndexR).HdcE, LoadBul(PlayBul(CountA).IndexR).HdcBack, PlayBul(CountA).CurX, PlayBul(CountA).CurY, CSng(LoadBul(PlayBul(CountA).IndexR).Width), CSng(LoadBul(PlayBul(CountA).IndexR).Height))
                Else
                    Call RotateToBuf(LoadBul(PlayBul(CountA).IndexR).HdcE, LoadBul(PlayBul(CountA).IndexR).HdcBack, PlayBul(CountA).CurX, PlayBul(CountA).CurY, CSng(LoadBul(PlayBul(CountA).IndexR).Width), CSng(LoadBul(PlayBul(CountA).IndexR).Height), PlayBul(CountA).CurAngle, LoadBul(PlayBul(CountA).IndexR).MaskColor, LoadBul(PlayBul(CountA).IndexR).RotateWidth, 180)
                End If
                '************* rotate
                    '以下为移动 bullet
                If LoadBul(PlayBul(CountA).IndexR).TailColor > 0 And (Not IsPaused) Then Call CreateTail(PlayBul(CountA).CurX + LoadBul(PlayBul(CountA).IndexR).Width \ 2, PlayBul(CountA).CurY + LoadBul(PlayBul(CountA).IndexR).Height \ 2, LoadBul(PlayBul(CountA).IndexR).TailColor, 80, 12)

                Call CrashBulPla(PlayBul(CountA))
                
                    PlayBul(CountA).CurX = PlayBul(CountA).CurX + PlayBul(CountA).CurSpeedX
                    PlayBul(CountA).CurY = PlayBul(CountA).CurY + PlayBul(CountA).CurSpeedY
                    PlayBul(CountA).CurAngle = (PlayBul(CountA).CurAngle + 20) Mod 360
                
                
                
                
                Call ReSetBullet(PlayBul(CountA))
        End If
    Next CountA
End Sub
Public Sub DrawPlane(ByVal WhPlayer As Byte)
    '该处有条件
    Static BulDelay(1 To 2) As Byte
    '暂时只有         p1
    'If IsLoadP1 Then
    Call GetIsKey(WhPlayer)
    
    If FlashFpsP(WhPlayer) > 0 Then FlashFpsP(WhPlayer) = FlashFpsP(WhPlayer) - 1
    If FlashFpsP(WhPlayer) > 0 And FlashFpsP(WhPlayer) Mod 2 = 0 Then
    Else
        BitBlt HdcViewBuf, CurMyXp(WhPlayer) - LoadPla(WhPlayer).Width \ 2, CurMyYp(WhPlayer) - LoadPla(WhPlayer).Height \ 2, LoadPla(WhPlayer).Width, LoadPla(WhPlayer).Height, PlayPla(WhPlayer).HdcRun, (Int(CurMyFpsP(WhPlayer)) - 1) * LoadPla(WhPlayer).Width, 0, SrcCopy
        BitBlt HdcViewBuf, CurMyXp(WhPlayer) - LoadPla(WhPlayer).Width \ 2, CurMyYp(WhPlayer) - LoadPla(WhPlayer).Height \ 2, LoadPla(WhPlayer).Width, LoadPla(WhPlayer).Height, PlayPla(WhPlayer).HdcBack, (Int(CurMyFpsP(WhPlayer)) - 1) * LoadPla(WhPlayer).Width, 0, SrcScan
    End If
    ''debug p1
    If PlayPla(WhPlayer).CurPower = 0 Then BulDelay(WhPlayer) = (BulDelay(WhPlayer) + 1) Mod 6 Else BulDelay(WhPlayer) = (BulDelay(WhPlayer) + 1) Mod 3
    If IsKeyFireHold(WhPlayer) Then
        BulDelay(WhPlayer) = 1
        If HoldFps(WhPlayer) < 48 Then HoldFps(WhPlayer) = HoldFps(WhPlayer) + 1
    Else
        If HoldFps(WhPlayer) = 48 Then Call CreateMyBullet(WhPlayer, 0, 0, 4, 0): HoldFps(WhPlayer) = 0
        If HoldFps(WhPlayer) > 0 Then HoldFps(WhPlayer) = HoldFps(WhPlayer) - 1
    End If
    If BulDelay(WhPlayer) = 0 Then
            If IsKeyFire(WhPlayer) Then 'Or GetAsyncKeyState(13) Then
                'PlayPla(WhPlayer).CurFireType = 1
                'PlayPla(WhPlayer).CurPower = 4
                
                Call CreateMyBullet(WhPlayer, PlayPla(WhPlayer).CurX + LoadPla(WhPlayer).FireSeatX1, PlayPla(WhPlayer).CurY + LoadPla(WhPlayer).FireSeatY1, PlayPla(WhPlayer).CurFireType, PlayPla(WhPlayer).CurPower, LeftBul)
                Call CreateMyBullet(WhPlayer, PlayPla(WhPlayer).CurX + LoadPla(WhPlayer).FireSeatX2, PlayPla(WhPlayer).CurY + LoadPla(WhPlayer).FireSeatY2, PlayPla(WhPlayer).CurFireType, PlayPla(WhPlayer).CurPower, RightBul)
                
            End If
    End If
    
    'debug a bomb
    If BombStarted(WhPlayer) = False Then
        If PlayPla(WhPlayer).CurBombNum > 0 Then
            If IsKeyBomb(WhPlayer) And (Not IsBomb(WhPlayer)) Then
                PlayPla(WhPlayer).CurBombNum = PlayPla(WhPlayer).CurBombNum - 1
                Call CreateBombStart(WhPlayer, PlayPla(WhPlayer).CurX + LoadPla(WhPlayer).Width \ 2, PlayPla(WhPlayer).CurY + LoadPla(WhPlayer).Height \ 2, 2, &HFF0000)
            End If
        End If
    End If
    'debug 1 plane                              ''以下数据需要修改
            If IsKeyLeft(WhPlayer) Then
                CurMyFpsP(WhPlayer) = CurMyFpsP(WhPlayer) - 0.5
                'If CurMyXp(WhPlayer) > 0 Then CurMyXp(WhPlayer) = CurMyXp(WhPlayer) - 4
                If CurMyXp(WhPlayer) > StartDrawX Then CurMyXp(WhPlayer) = CurMyXp(WhPlayer) - 4
                '' debug
                
                If CurMyFpsP(WhPlayer) <= 1.5 Then CurMyFpsP(WhPlayer) = 1.5
            ElseIf IsKeyRight(WhPlayer) Then
                CurMyFpsP(WhPlayer) = CurMyFpsP(WhPlayer) + 0.5
                'If CurMyXp(WhPlayer) < Map.HeadMapFile.WidthTotal Then CurMyXp(WhPlayer) = CurMyXp(WhPlayer) + 4
                If CurMyXp(WhPlayer) < Map.HeadMapFile.WidthShow + StartDrawX Then CurMyXp(WhPlayer) = CurMyXp(WhPlayer) + 4
                
                If CurMyFpsP(WhPlayer) >= 7.5 Then CurMyFpsP(WhPlayer) = 7.5
            Else
                If CurMyFpsP(WhPlayer) >= 4.3 Then
                    CurMyFpsP(WhPlayer) = CurMyFpsP(WhPlayer) - 0.25
                ElseIf CurMyFpsP(WhPlayer) < 4 Then
                    CurMyFpsP(WhPlayer) = CurMyFpsP(WhPlayer) + 0.25
                End If
            End If
            
            If IsKeyUp(WhPlayer) Then
                If CurMyYp(WhPlayer) > 50 Then CurMyYp(WhPlayer) = CurMyYp(WhPlayer) - 4
'debug
Call CreateTail(PlayPla(WhPlayer).CurX + 8, PlayPla(WhPlayer).CurY + LoadPla(WhPlayer).Height, &HCC, 80, 12)
Call CreateTail(PlayPla(WhPlayer).CurX + 22, PlayPla(WhPlayer).CurY + LoadPla(WhPlayer).Height, &HCC, 80, 12)

                
            ElseIf IsKeyDown(WhPlayer) Then
                If CurMyYp(WhPlayer) < 465 Then CurMyYp(WhPlayer) = CurMyYp(WhPlayer) + 4
                
            End If
            PlayPla(WhPlayer).CurX = CurMyXp(WhPlayer) - LoadPla(WhPlayer).Width \ 2
            PlayPla(WhPlayer).CurY = CurMyYp(WhPlayer) - LoadPla(WhPlayer).Height \ 2
            PlayPla(WhPlayer).CurFps = Int(CurMyFpsP(WhPlayer))

    Call ResetPlane(WhPlayer)
End Sub

Public Sub DrawCrash()
On Error Resume Next
    Dim DCra As Byte
    For DCra = 1 To MaxCra
        If PlayCra(DCra).IndexR > 0 Then                                                                                                    ''调试用
                    Call BltToBuf(LoadCra(PlayCra(DCra).IndexR).HdcE, LoadCra(PlayCra(DCra).IndexR).HdcBack, PlayCra(DCra).CurX - LoadCra(PlayCra(DCra).IndexR).Width \ 2, PlayCra(DCra).CurY - LoadCra(PlayCra(DCra).IndexR).Height \ 2, CSng(LoadCra(PlayCra(DCra).IndexR).Width), CSng(LoadCra(PlayCra(DCra).IndexR).Height), CSng(PlayCra(DCra).CurFps - 1) * LoadCra(PlayCra(DCra).IndexR).Width, 0)
                    PlayCra(DCra).CurDelay = (PlayCra(DCra).CurDelay + 1) Mod LoadCra(PlayCra(DCra).IndexR).DelayFps
                    If PlayCra(DCra).CurDelay = 0 Then
                        PlayCra(DCra).CurFps = PlayCra(DCra).CurFps + 1
                        If PlayCra(DCra).CurFps = LoadCra(PlayCra(DCra).IndexR).AllFps + 1 Then PlayCra(DCra).IndexR = 0
                    End If
            
            'PlayCra(DCra).IndexR = 0
        End If
    Next DCra
End Sub

Public Sub DrawExplode()
On Error Resume Next
    Dim DE As Byte
    For DE = 1 To MaxExp
        If PlayExp(DE).IndexR > 0 Then
                    Call BltToBuf(LoadExp(PlayExp(DE).IndexR).HdcE, LoadExp(PlayExp(DE).IndexR).HdcBack, PlayExp(DE).CurX - LoadExp(PlayExp(DE).IndexR).Width \ 2, PlayExp(DE).CurY - LoadExp(PlayExp(DE).IndexR).Height \ 2, LoadExp(PlayExp(DE).IndexR).Width, LoadExp(PlayExp(DE).IndexR).Height, (PlayExp(DE).CurFps - 1) * LoadExp(PlayExp(DE).IndexR).Width, 0)
                    PlayExp(DE).CurDelay = (PlayExp(DE).CurDelay + 1) Mod LoadExp(PlayExp(DE).IndexR).DelayFps   '''''
                    If PlayExp(DE).CurDelay = 0 Then
                        PlayExp(DE).CurFps = PlayExp(DE).CurFps + 1
                        If PlayExp(DE).CurFps = LoadExp(PlayExp(DE).IndexR).AllFps + 1 Then PlayExp(DE).IndexR = 0
                    End If
                 
        End If
    Next DE
            'PlayExp(DE).CurDelay = (PlayExp(DE).CurDelay + 1) Mod 4
End Sub
'*************************以下是 Set
Public Sub SetObjBullet(PObj As RunObject, LObj As SaveObject)
    Dim CN As Byte
    For CN = 1 To 3
        If LObj.FireSet(CN).DelayFps = 0 Then Exit Sub
        
        If PObj.CurTotFps Mod LObj.FireSet(CN).DelayFps = 0 Or PObj.CurFireFps(CN) > 0 Then
            ''If SoundBul = 0 And PObj.CurFireFps(CN) = 0 Then SoundBul = 1: GameSound.PlaySound CStr(LoadBul(LObj.FireSet(CN).FireType).Sound), 1
            If Not LoadBul(LObj.FireSet(CN).FireType).IsFollow Then
                Call CreateBullet(LObj.FireSet(CN).FireType, PObj.CurX + LObj.FireSet(CN).FireSeat.X, PObj.CurY + LObj.FireSet(CN).FireSeat.Y, PObj.CurFireFps(CN))
                ''If SoundBul = 0 Then SoundBul = 1: GameSound.PlaySound CStr(LoadBul(LObj.FireSet(CN).FireType).Sound), 1
            Else
                If PObj.CurFireFps(CN) = 0 Then Call CreateRotateBullet(PObj.FollowPlayer, LObj.FireSet(CN).FireType, PObj.CurX + LObj.Width \ 2, PObj.CurY + LObj.Height \ 2)
                ''If SoundBul = 0 Then SoundBul = 1: GameSound.PlaySound CStr(LoadBul(LObj.FireSet(CN).FireType).Sound), 1
            End If
        End If
    Next CN

End Sub
Public Sub SetStaBullet(PSta As RunStaticObject, LSta As SaveStaticEObject)
    Dim SB As Byte
        For SB = 1 To 3
            If LSta.FireSet(SB).DelayFps = 0 Then Exit Sub
                                                            'debug
            'If PSta.CurTotFps Mod LSta.FireSet(SB).DelayFps = 0 Or PSta.CurFireFps(SB) > 0 Then
                '''If SoundBul = 0 Then SoundBul = 1: GameSound.PlaySound CStr(LoadBul(LSta.FireSet(SB).FireType).Sound), 1
                If Not LoadBul(LSta.FireSet(SB).FireType).IsFollow Then
                    If PSta.CurTotFps Mod LSta.FireSet(SB).DelayFps = 0 Or PSta.CurFireFps(SB) > 0 Then Call CreateBullet(LSta.FireSet(SB).FireType, PSta.CurX + LSta.FireSet(SB).FireSeat.X, PSta.CurY + LSta.FireSet(SB).FireSeat.Y, PSta.CurFireFps(SB))
                Else
                    If PSta.CurTotFps Mod LSta.FireSet(SB).DelayFps = 0 Then
                        Select Case RunEffect
                            Case 1, 3
                                Call CreateRotateBullet(PSta.FollowPlayer, LSta.FireSet(SB).FireType, PSta.CurX + LSta.Width \ 2, PSta.CurY + LSta.Height \ 2)
                            Case 2
                                Call CreateRotateBullet(PSta.FollowPlayer, LSta.FireSet(SB).FireType, PSta.CurX + LSta.RotateWidth \ 2, PSta.CurY + LSta.RotateWidth \ 2)
                        End Select
                    End If
                End If
            'End If
        Next SB
        '
End Sub
Public Sub SetCrash(ByVal SeatX As Single, ByVal SeatY As Single) '''因为很小，loadmybul可以忽略不计
    Dim Crh As Byte
    For Crh = CurCra + 1 To MaxCra
        If PlayCra(Crh).IndexR = 0 Then
            PlayCra(Crh).IndexR = 1 ' Int(1 + Rnd * MaxLoadCra) 'crash是随机调用的，不需要确切值
            PlayCra(Crh).CurX = SeatX
            PlayCra(Crh).CurY = SeatY
            PlayCra(Crh).CurFps = 1
            PlayCra(Crh).CurDelay = 0
            If SoundCra = 0 Then SoundCra = 1: GameSound.PlaySound CStr(LoadCra(PlayCra(Crh).IndexR).Sound), 2
            
            CurCra = Crh: Exit Sub
        End If
    Next Crh
End Sub
Public Sub SetExplode(ByVal SeatX As Single, ByVal SeatY As Single, Optional ByVal IsSound As Byte = 0)
    Dim Exd As Byte
    For Exd = CurExp + 1 To MaxExp
        If PlayExp(Exd).IndexR = 0 Then '调试用
            PlayExp(Exd).IndexR = Int(1 + Rnd * MaxLoadExp) '' Rnd * 3 + 1 'Explode随机调用，不需确切值
            PlayExp(Exd).CurX = SeatX   ''位置也随机调用
            PlayExp(Exd).CurY = SeatY
            PlayExp(Exd).CurFps = 1 ' LoadExp(PlayExp(Exd).IndexR).AllFps ''即delay=5
            PlayExp(Exd).CurDelay = 0       '暂时设定为 5
            'If IsSound Then GameSound.PlaySound CStr(LoadExp(PlayExp(Exd).IndexR).Sound), 1
            If SoundExp = 0 Then SoundExp = 1: GameSound.PlaySound CStr(LoadExp(PlayExp(Exd).IndexR).Sound), 1
            CurExp = Exd: Exit Sub
        End If
    Next Exd
    
End Sub

'*************************以下是 reset
Public Sub ReSetObject(PObj As RunObject)
    If PObj.CurLife < 0 Or PObj.CurTotFps > 20000 Then   '最多存在60''
        Call SetExplode(PObj.CurX + LoadObj(PObj.IndexR).Width \ 2, PObj.CurY + LoadObj(PObj.IndexR).Height \ 2, 1)
        Call SetExplode(PObj.CurX + (0.5 - Rnd) * LoadObj(PObj.IndexR).Width \ 2, PObj.CurY + (0.5 - Rnd) * LoadObj(PObj.IndexR).Height \ 2, 1)
        Call SetExplode(PObj.CurX + (0.5 - Rnd) * LoadObj(PObj.IndexR).Width \ 2, PObj.CurY + (0.5 - Rnd) * LoadObj(PObj.IndexR).Height \ 2, 1)
        Call SetExplode(PObj.CurX + (0.5 - Rnd) * LoadObj(PObj.IndexR).Width \ 2, PObj.CurY + (0.5 - Rnd) * LoadObj(PObj.IndexR).Height \ 2, 1)
        Call SetExplode(PObj.CurX + (0.5 - Rnd) * LoadObj(PObj.IndexR).Width \ 2, PObj.CurY + (0.5 - Rnd) * LoadObj(PObj.IndexR).Height \ 2, 1)
        Call SetExplode(PObj.CurX + (0.5 - Rnd) * LoadObj(PObj.IndexR).Width \ 2, PObj.CurY + (0.5 - Rnd) * LoadObj(PObj.IndexR).Height \ 2, 1)
        Call SetExplode(PObj.CurX + (0.5 - Rnd) * LoadObj(PObj.IndexR).Width \ 2, PObj.CurY + (0.5 - Rnd) * LoadObj(PObj.IndexR).Height \ 2, 1)
        
        If PObj.PackageType Then Call CreatePackage(PObj.PackageType, PObj.CurX + LoadObj(PObj.IndexR).Width \ 2, PObj.CurY + LoadObj(PObj.IndexR).Height \ 2)
        If SoundObj = 0 Then SoundObj = 1: GameSound.PlaySound CStr(LoadObj(PObj.IndexR).Sound), 1
        PObj.IndexR = 0
    'ElseIf Abs(PObj.CurX - MidX) < MidX And Abs(PObj.CurY - MidY) < MidY Then
    '    PObj.IsCanExit = 1
    ElseIf Abs(PObj.CurX + LoadObj(PObj.IndexR).Width \ 2 - MidX) > MidX + LoadObj(PObj.IndexR).Width \ 2 Or PObj.CurY > 480 Then
    '    If PObj.IsCanExit = 1 Then          '''''''上面错了
        If SoundObj = 0 Then SoundObj = 1: GameSound.PlaySound CStr(LoadObj(PObj.IndexR).Sound), 1
            PObj.IndexR = 0
    '    End If
    End If
End Sub
Public Sub ReSetStaticObj(PSta As RunStaticObject)
    If PSta.CurLife < 0 Or PSta.CurTotFps > 2000 Then
        Call SetExplode(PSta.CurX + LoadSta(PSta.IndexR).Width \ 2, PSta.CurY + LoadSta(PSta.IndexR).Height \ 2, 1)
        Call SetExplode(PSta.CurX + (0.5 - Rnd) * LoadSta(PSta.IndexR).Width \ 2, PSta.CurY + (0.5 - Rnd) * LoadSta(PSta.IndexR).Height \ 2, 1)
        Call SetExplode(PSta.CurX + (0.5 - Rnd) * LoadSta(PSta.IndexR).Width \ 2, PSta.CurY + (0.5 - Rnd) * LoadSta(PSta.IndexR).Height \ 2, 1)
        Call SetExplode(PSta.CurX + (0.5 - Rnd) * LoadSta(PSta.IndexR).Width \ 2, PSta.CurY + (0.5 - Rnd) * LoadSta(PSta.IndexR).Height \ 2, 1)
        Call SetExplode(PSta.CurX + (0.5 - Rnd) * LoadSta(PSta.IndexR).Width \ 2, PSta.CurY + (0.5 - Rnd) * LoadSta(PSta.IndexR).Height \ 2, 1)
        If PSta.PackageType Then Call CreatePackage(PSta.PackageType, PSta.CurX + LoadSta(PSta.IndexR).Width \ 2, PSta.CurY + LoadSta(PSta.IndexR).Height \ 2)
        If SoundSta = 0 Then SoundSta = 1: GameSound.PlaySound CStr(LoadSta(PSta.IndexR).Sound), 1
        PSta.IndexR = 0
    'ElseIf Abs(PSta.CurX - MidX) < MidX And Abs(PSta.CurY - MidY) < MidY Then
    '    PSta.IsCanExit = 1
    ElseIf Abs(PSta.CurX + LoadSta(PSta.IndexR).Width \ 2 - MidX) > MidX + LoadSta(PSta.IndexR).Width \ 2 Or PSta.CurY > 480 Then '''''''''''debug
        'If PSta.IsCanExit = 1 Then
            PSta.IndexR = 0
        'End If
    End If
End Sub
Public Sub ReSetBullet(PBul As RunBullet)
    If Abs(PBul.CurX - MidX) > MidX Then
        PBul.IndexR = 0
    ElseIf Abs(PBul.CurY - MidY) > MidY Then
        PBul.IndexR = 0
    End If
End Sub
Public Sub ResetPackage(PPac As RunPac)
    With PPac
        If Abs(.CurX - MidX) > MidX And .CurTotalFps > 1000 Then
            .IndexR = 0
        ElseIf Abs(.CurY - MidY) > MidY And .CurTotalFps > 1000 Then
            .IndexR = 0
        End If
    End With
End Sub
Public Sub ResetPlane(ByVal WhPlay As Byte)
'If CurContinueAll = 0 Then Exit Sub
    If PlayPla(WhPlay).CurLife < 0 Then
        GameSound.PlaySound CStr(LoadPla(WhPlay).Sound), 1
        Call SetExplode(CurMyXp(WhPlay), CurMyYp(WhPlay), 1)
        Call SetExplode(CurMyXp(WhPlay) - Rnd * 4, CurMyYp(WhPlay) - Rnd * 4)
        Call SetExplode(CurMyXp(WhPlay) + Rnd * 4, CurMyYp(WhPlay) + Rnd * 4)
        Call SetExplode(CurMyXp(WhPlay) + Rnd * 4, CurMyYp(WhPlay) - Rnd * 4)
        CurContinueP(WhPlay) = CurContinueP(WhPlay) - 1
        PlayPla(WhPlay).CurLife = LoadPla(WhPlay).Life
        PlayPla(WhPlay).CurPower = 0
        PlayPla(WhPlay).CurFireType = 1
        If WhPlay = 1 Then
            PlayPla(WhPlay).CurX = MidX - 80
        Else
            PlayPla(WhPlay).CurX = MidX + 80
        End If
            CurMyXp(WhPlay) = PlayPla(WhPlay).CurX + LoadPla(WhPlay).Width \ 2
            CurMyYp(WhPlay) = 400
            PlayPla(WhPlay).CurY = 400
            PlayPla(WhPlay).CurBombNum = 3
        FlashFpsP(WhPlay) = 80
     
        If CurContinueP(WhPlay) = 0 Then
            IsLoadP(WhPlay) = False
            ScoreP(WhPlay) = 0
            Call ResetKey(WhPlay)
        End If
    End If
End Sub

'***************************以下是 Crash a /b
Public Sub CrashObjMybul(PObj As RunObject, LObj As SaveObject)
    Dim Cr As Byte
    Dim CrN As Byte