bullettypecopy.bas

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

Attribute VB_Name = "BulletType"
Option Explicit

'''''产生一般的类型
Public Sub CreateBullet(ByVal BulType As Byte, ByVal BulStartX As Single, ByVal BulStartY As Single) ', ByVal IsObjRotate As Boolean, ByVal TypeMove As Byte)
    Dim IndexBul As Byte
    Dim InitSpeed As Single
    Dim CountF As Byte
    'Dim FireType As Byte
    
        For IndexBul = 1 To MaxBul '如果把for next放到里面,虽速度更快，但比较烦琐
                If PlayBul(IndexBul).IndexR = 0 Then
                
                'PlayBul(IndexBul).IndexR = BulType
                'FireType = LoadBul(BulType).TypeMove
                
                InitSpeed = CSng(LoadBul(BulType).SpeedInit)
                InitSpeed = IIf((LoadBul(BulType).SpeedInit = 0), Rnd * 2 + 3, InitSpeed)
                        With PlayBul(IndexBul)
                            .CurX = BulStartX - LoadBul(BulType).Width \ 2
                            .CurY = BulStartY - LoadBul(BulType).Height \ 2
                            .IndexR = BulType     '******************
                            .IsRotate = LoadBul(BulType).IsRotate
                            .CurDelay = 0
                                Select Case LoadBul(BulType).TypeMove  'TypeBul
                                    Case 0
                                        .CurSpeedX = 0
                                        .CurSpeedY = InitSpeed
                                        Exit For
                                    Case 1
                                        .CurSpeedX = InitSpeed * (CountF - 1) \ 2
                                        .CurSpeedY = InitSpeed
                                        If CountF = 2 Then Exit For
                                        CountF = CountF + 2
                                    Case 2
                                        .CurSpeedX = InitSpeed * (CountF - 1) \ 2
                                        .CurSpeedY = InitSpeed
                                        If CountF = 2 Then Exit For
                                        CountF = CountF + 1
                                    Case 3
                                        .CurSpeedX = InitSpeed * Cos(CF(CountF * 30))
                                        .CurSpeedY = InitSpeed * Sin(CF(CountF * 30))
                                        If CountF = 11 Then Exit For
                                        CountF = CountF + 1
                                    Case 4
                                        .CurSpeedX = InitSpeed * Cos(CF(CountF * 18 - 9))
                                        .CurSpeedY = InitSpeed * Sin(CF(CountF * 18 - 9))
                                        CountF = CountF + 1
                                        If CountF = 20 Then Exit For
                                    Case 5
                                        .CurSpeedX = InitSpeed * Cos(CF(CountF * 18 - 9))
                                        .CurSpeedY = InitSpeed * Sin(CF(CountF * 18 - 9))
                                        If CountF Mod 2 = 0 Then
                                            .CurSpeedX = .CurSpeedX * 1.2
                                            .CurSpeedY = .CurSpeedY * 1.2
                                        End If
                                        CountF = CountF + 1
                                        If CountF = 20 Then Exit For
                                    'Case 6
                                        
                                    Case 6
                                        .CurSpeedX = InitSpeed * Tan(CF(CountF * 8 - 32))
                                        .CurSpeedY = InitSpeed
                                        CountF = CountF + 1
                                        If CountF = 9 Then Exit For
                                    Case 7
                                        .CurSpeedX = InitSpeed * Cos(CF(CountF * 8 + 58))
                                        .CurSpeedY = InitSpeed * Sin(CF(CountF * 8 + 58))
                                        CountF = CountF + 1
                                        If CountF = 9 Then Exit For
                                    Case Is >= 8
                                        .CurSpeedX = 0
                                        .CurSpeedY = InitSpeed * (1 + CountF \ 2)
                                        CountF = CountF + 1
                                        If CountF = 6 Then Exit For
                                        
                                End Select
                        End With
                End If
        Next IndexBul
        '后面可能还有,所以用exit for
End Sub
'''产生旋转的类型                    ''该用bultype                           'object的中心
Public Sub CreateRotateBullet(ByVal WhPlayer As Byte, ByVal FireType As Integer, ByVal FireSeatX0 As Single, ByVal FireSeatY0 As Single)
    Dim IndexBul As Byte
    Dim InitSpeed As Single
    Dim ErrX As Single
    Dim ErrY As Single
    
    For IndexBul = 1 To MaxBul
        If PlayBul(IndexBul).IndexR = 0 Then
            InitSpeed = CSng(LoadBul(FireType).SpeedInit)
            InitSpeed = IIf((LoadBul(FireType).SpeedInit = 0), Rnd * 2 + 3, InitSpeed)
            ErrX = CurMyXp(WhPlayer) - FireSeatX0
            ErrY = CurMyYp(WhPlayer) - FireSeatY0
            With PlayBul(IndexBul)
                .CurX = FireSeatX0 - LoadBul(FireType).Width \ 2
                .CurY = FireSeatY0 - LoadBul(FireType).Height \ 2
                .IndexR = FireType
                .CurDelay = 0
                .IsRotate = LoadBul(FireType).IsRotate
                If ErrY = 0 Then
                    .CurSpeedX = InitSpeed * Sgn(ErrX)
                    .CurSpeedY = 0
                ElseIf Abs(ErrX / ErrY) > 0.1 And Abs(ErrX / ErrY) < 10 Then
                    .CurSpeedX = InitSpeed * ErrX / Sqr(ErrX ^ 2 + ErrY ^ 2)
                    .CurSpeedY = .CurSpeedX * ErrY / ErrX
                ElseIf Abs(ErrX) > Abs(ErrY) Then
                    .CurSpeedY = 0
                    .CurSpeedX = InitSpeed * Sgn(ErrX)
                Else
                    .CurSpeedX = 0
                    .CurSpeedY = InitSpeed * Sgn(ErrY)
                End If
            End With
            Exit For
        End If
    Next IndexBul
End Sub

Public Sub CreatePackage(ByVal PacType As Byte, ByVal PacStartX As Single, ByVal PacStartY As Single)
    Dim IndexPac As Byte
    'dim
        For IndexPac = 1 To MaxPac
            With PlayPac(IndexPac)
                If .IndexR = 0 Then
                    .IndexR = PacType
                    .CurX = PacStartX
                    .CurY = PacStartY
                    .CurSpeedX = Sgn(Rnd * 2 - 1.05) * 2
                    .CurSpeedY = Sgn(Rnd * 2 - 1.05) * 2
                    .CurAngle = 0
                    .CurFps = 0
                    .CurDelay = 0
                    .CurTotalFps = 0
                    
                    Exit Sub
                End If
            End With
        Next IndexPac
                    
End Sub