moddrawextention.bas

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

    Next DP
    
Call CreatePixel
End Sub

Public Sub CreatePixel()
Dim BP As Byte
    For BP = 1 To MaxPixel
        With BacPixel(BP)
            If .X = 0 Then
                .X = Rnd * Map.HeadMapFile.WidthTotal
                .Y = -Rnd * 50
                .Speed = Int(Rnd * 3) + 2
                Exit Sub
            End If
        End With
    Next BP

End Sub


Public Sub DrawBulletTail()
Dim DBT As Integer
    For DBT = 1 To MaxTail
        With BulTail(DBT)
            If .ColorTail > 0 Then
                SetPixelV HdcViewBuf, .X1, .Y1, .ColorTail
                SetPixelV HdcViewBuf, .X2, .Y2, .ColorTail
                .ColorTail = ChColor(.ColorTail, .DownColorBit, .DownColorPercent) '.ColorTail - &H101010   ' &H161616 '
                '.CurFps = .CurFps + 1
                'If .ColorTail < 0 Then .ColorTail = 0
                'If .CurFps = 20 Then .ColorTail = 0 ''估计两秒调试
            End If
        End With
    Next DBT
    
End Sub

Public Sub CreateTail(BulX As Single, BulY As Single, ColorBulTail As Long, DownColor As Byte, ColorPercent As Byte)
Dim Ct As Integer
    For Ct = 1 To MaxTail
        With BulTail(Ct)
            If .ColorTail = 0 Then
                .ColorTail = ColorBulTail
                .DownColorBit = DownColor
                .DownColorPercent = ColorPercent
                .X1 = BulX + Rnd * 4 - 3
                .X2 = BulX - Rnd * 4 + 3
                .Y1 = BulY + Rnd * 4 - 3
                .Y2 = BulY - Rnd * 4 + 3
                .CurFps = 0
                Exit Sub
            End If
        End With
    Next Ct
    
End Sub

Public Sub DrawBomb()
Dim DB As Byte
Static MS As Byte
    MS = Abs(MS - 1)
    For DB = 1 To MaxBombStart
        With BombStart(DB)
            If .WhichPla > 0 Then
                If .CurFps < 31 Then Call Ellipse(HdcViewBuf, .X - 2, .Y - 3, .X + 3, .Y + 4)
                  
                    .X = .X + .SpeedX
                    .Y = .Y + .SpeedY
                    If .CurFps < 250 Then .CurFps = .CurFps + 1
                
                Select Case .StyleBomb
                    Case 1
                        'If IsTailBombStart Then Exit For
                        ''''''''''''''''''''''''''''''''''''''''debug
                        If .CurFps = 10 Then
                            Call DeleteObject(hBrush)
                            
                            IsTailBombStart = True
                            BombSeatX = .X
                            BombSeatY = .Y
                            BombSeatR = 10
                            BombColour = .ColorTail
                            BombPla = .WhichPla
                            
                            .CurFps = 32
                            .WhichPla = 0
                            Exit For
                            'Call
                            'Call KillBullet
                            '''''''
                        End If
                    Case 2
                        If .CurFps = 15 Then
                            Call DeleteObject(hBrush)
                            Call SetExplode(.X, .Y, MS)
                            Call KillBullet
                        ElseIf .CurFps = 30 Then
                            
                            Call SetExplode(.X, .Y, MS)
                            Call KillBullet
                        ElseIf .CurFps > 30 And .CurFps < 60 Then
                            Call KillBullet
                        ElseIf .CurFps = 60 Then
                        
'''debug
 IsBomb(.WhichPla) = False
 BombStarted(.WhichPla) = False
                            .WhichPla = 0
                        End If
                End Select
            End If
        End With
    Next DB
    
    If IsTailBombStart Then
        BombSeatR = BombSeatR + 2
        If BombSeatR > 40 Then IsBomb(BombPla) = False: BombStarted(BombPla) = False
        'If BombSeatR > 400 Then IsTailBombStart = False '''会导致后一个停止
        Call CreateBombTail(BombSeatX, BombSeatY, BombSeatR, BombColour)
    End If
    
    Call DrawBombTail
End Sub
Public Sub CreateBombTail(bsX As Single, bsY As Single, R As Single, bColour As Long)
Dim CBT As Integer
Dim Ang As Single

    For CBT = CurTail + 1 To MaxBombTail
        If RunBombTail(CBT).WhichPla = 0 Then
            With RunBombTail(CBT)
                .ColorTail = bColour
                .X = (bsX - 3 + Rnd * 3) + R * Cos(CF(Ang))
                .Y = (bsY + 3 - Rnd * 3) + R * Sin(CF(Ang))
                If Abs(.X - MidX) < MidX Or Abs(.Y - MidY) < MidY Then .WhichPla = 3
                
            End With
            'If Ang >= 357 Then Exit For
            'Ang = Ang + 3
            CurTail = CBT: Exit Sub
        End If
    Next CBT
End Sub
Public Sub DrawBombTail()
Dim DBT As Integer
    For DBT = 1 To MaxBombTail
        With RunBombTail(DBT)
            If .WhichPla > 0 Then
                SetPixelV HdcViewBuf, .X, .Y, .ColorTail
                .ColorTail = ChColor(.ColorTail, 160, 20)
                If .ColorTail = 0 Then .WhichPla = 0
            End If
        End With
    Next DBT
    
End Sub

Public Sub CreateBombStart(WhichPla As Byte, PlaneX As Single, PlaneY As Single, BombStyle As Byte, BombColor As Long)
Dim CBS As Byte
Dim BSCount As Byte
    BombStarted(WhichPla) = True
    IsBomb(WhichPla) = True
    hBrush = CreateSolidBrush(BombColor)
    
    Call SelectObject(HdcViewBuf, hBrush)
    Select Case BombStyle
        Case 1
            For CBS = CurBStart + 1 To MaxBombStart
                With BombStart(CBS)        '总共只有两个，采用强占方式
                    If .WhichPla = 0 Then
                        .WhichPla = WhichPla
                        .X = PlaneX
                        .Y = PlaneY
                        .SpeedX = 0
                        .SpeedY = -20
                        .CurFps = 0
                        .ColorTail = BombColor
                        .StyleBomb = BombStyle
                        
                        CurBStart = CBS: Exit Sub
                    End If
                End With
            Next CBS
        Case 2
            For CBS = CurBStart + 1 To MaxBombStart
                With BombStart(CBS)
                    If .WhichPla = 0 Then
                        .WhichPla = WhichPla
                        .X = PlaneX
                        .Y = PlaneY
                        .SpeedX = (4 + 4 * Rnd) * Cos(CF(BSCount * 20))
                        .SpeedY = -(4 + 4 * Rnd) * Sin(CF(BSCount * 20))
                        .CurFps = 0
                        .ColorTail = BombColor
                        .StyleBomb = BombStyle
                        
                        If BSCount = 9 Then CurBStart = CBS: Exit Sub
                        BSCount = BSCount + 1
                    End If
                End With
            Next CBS
        Case Else: Exit Sub
        End Select
End Sub
Public Sub KillBullet()
Dim KB As Byte
    For KB = 1 To MaxBul
        PlayBul(KB).IndexR = 0
    Next KB
    
End Sub

Public Sub DrawRandomPic(SeatY As Integer, SeatMapBufX As Integer, SeatMapbuf As Integer, PicIndex As Byte)
    BitBlt HdcMapRandom, SeatMapBufX, SeatMapbuf, PicRandom(PicIndex).Width, 1, PicRandom(PicIndex).HdcL, 0, SeatY, vbSrcCopy
End Sub


Public Function ChColor(ByVal InputColor As Long, DownColorByte As Byte, ColorPercent As Byte) As Long
'On Error Resume Next
Dim R As Byte, G As Byte, B As Byte ''注意这里用来表示系统颜色，而不是rgb色
Dim IColo As Integer
    R = InputColor \ &H10000
    G = (InputColor Mod &H10000) \ &H100
    B = InputColor Mod &H100
    R = R - R / ColorPercent
    G = G - G / ColorPercent
    B = B - B / ColorPercent
    If CInt(R) + CInt(G) + CInt(B) - DownColorByte < 0 Then ChColor = 0 Else ChColor = RGB(B, G, R)
End Function