game.bas

3D射击游戏源码for VB还不错的

                If Not ActMGPatrons = MGPatronsShowPerSec And MGPatronsWaitT = 0 Then
                    'another bullet can be shown
                    MGBullets(ActMGPatrons).MoveTo MGHoldingPos
                    MGBullets(ActMGPatrons).Move Mk3d.VectorRotate(Mk3d.VectorMake(-0.05, 0, 0.3), yAngle)
                    With MGBulletsDesc(ActMGPatrons)
                        .MGBulletDir = Mk3d.VectorMake(GetRandom(-0.025, 0.025), 0, GetRandom(-0.025, 0.025))
                        .MGStartT = Timer
                        .MGFallSpeed = 0
                    End With
                    ActMGPatrons = ActMGPatrons + 1
                End If
                GamePoints = GamePoints - MGPointsPerSec * FrameT
                If GamePoints < 0 Then GamePoints = 0
            End If
            
            'Collision Detection of the shots
            If ManState = MAN_BLENDIN Or ManState = MAN_GO Or ManState = MAN_ROTATE Then
                MGPatronState = MGPATRON_HITNOTHING
                MGPatronPos = yEyes
                Do
                    MGPatronState = GetPatronCollDet(MGPatronPos, 0.4)
                    MGPatronPosBef = MGPatronPos
                    Mk3d.dx.VectorAdd MGPatronPos, MGPatronPos, yLookDir
                Loop While MGPatronState = MGPATRON_HITNOTHING
                
                If MGPatronState = MGPATRON_HITMAN Then
                    ManShotT = ManShotT + FrameT
                    If ManShotT > ManDieT Then
                        ShowText = True
                        If ManState = MAN_BLENDIN Then
                            GamePoints = GamePoints + 150
                            TextToShow = "BOT FAST FRAG: + 150"
                        Else
                            GamePoints = GamePoints + 100
                            TextToShow = "BOT FRAG: + 100"
                        End If
                        ManState = MAN_DIE
                        ManActionWaitT = 0
                        TextBlendWaitT = 0
                    End If
                End If
            End If
        End If
    End If
    
    'calculate the position of the MG which you are holding
    MGHoldingLookDir = Mk3d.VectorRotate(MGHoldingRefer, yAngle)
    MGHoldingLookDir.y = MGHoldingLookDir.y - Corrx
    Mk3d.dx.VectorAdd MGHoldingPos, yEyes, MGHoldingLookDir
    MGHolding.MoveTo MGHoldingPos
    'calculate the angle of the MG which you are holding
    MGHolding.Rotate Mk3d.VectorMake(0, -MGHoldingAngle.y, 0)
    MGHolding.Rotate Mk3d.VectorMake(-MGHoldingAngle.x, 0, 0)
    MGHolding.Rotate Mk3d.VectorMake(yAngle.x, yAngle.y, 0)
    MGHoldingAngle = yAngle
    MGHoldingAngle.x = MGHoldingAngle.x
End Sub

Private Sub GameMan()
    Dim ManWalkSpeed!, ManRot!, ManAddDir As D3DVECTOR
    Dim ManPosBef As D3DVECTOR, ManGetColl As D3DVECTOR
    
    ManGoT = ManGoT + FrameT
    If ManGoT > 0.5 Then ManGoT = 0
    ManActionWaitT = ManActionWaitT + FrameT
    
    If ManState = MAN_BLENDIN Then
        'bot is shown
        If ManActionWaitT > BlendT Then
            ManState = MAN_ROTATE
            ManRotTo = Rnd * 6.283
            ManGoLen = Rnd * 30 + 5
            ManWentLen = 0
        End If
    ElseIf ManState = MAN_ROTATE Then
        'bot changes angle
        ManRot = GetAngleDiff(ManAngle.y, ManRotTo)
        If Abs(ManRot) < 0.1745 Then        '10 degree
            'bot starts walking
            ManState = MAN_GO
            ManGoT = 0
            ManWalkDir = Mk3d.VectorRotate(Mk3d.VectorMake(0, 0, -1), ManAngle)
        Else
            'bot needs still rotation
            ManRot = 6.283 * Sgn(ManRot) * FrameT / ManTimePer360
            ManAnim.Rotate Mk3d.VectorMake(0, ManRot, 0)
            'ManCalced is also changed because it's only a pointer
            ManAngle.y = ManAngle.y + ManRot
        End If
    ElseIf ManState = MAN_GO Then
        'bot walks
        ManWalkSpeed = WalkSpeed * FrameT
        ManWentLen = ManWentLen + ManWalkSpeed
        Mk3d.dx.VectorScale ManAddDir, ManWalkDir, ManWalkSpeed
        ManPosBef = ManPos
        Mk3d.dx.VectorAdd ManPos, ManPos, ManAddDir

        ManGetColl = GetCollDet(ManPosBef, ManPos, 1.5, True, False)
        If ManGetColl.x = 0 Or ManGetColl.z = 0 Then
            If ManGetColl.x = 0 And ManGetColl.z = 0 Then
                ManRotTo = ManAngle.y + 3.1415
            ElseIf ManGetColl.x = 0 Then
                'bot collids with something, in x-direction
                If Sgn(ManAddDir.x) = 1 Then
                    ManRotTo = GetRandom(3.1415, 6.283)
                Else
                    ManRotTo = GetRandom(0, 3.1415)
                End If
            ElseIf ManGetColl.z = 0 Then
                'bot collids with something, in z-direction
                If Sgn(ManAddDir.z) = 1 Then
                    ManRotTo = GetRandom(-1.57075, 1.57075)
                Else
                    ManRotTo = GetRandom(1.57075, 4.71225)
                End If
            End If
            ManPos = ManPosBef
            ManState = MAN_ROTATE
            ManGoLen = Rnd * 30 + 5
            ManWentLen = 0
            Set ManCalced = ManAnim.GetKeyFrameObj(0)
        ElseIf ManWentLen > ManGoLen Then
            'bot reaches his destination point
            ManState = MAN_ROTATE
            ManRotTo = Rnd * 6.283
            ManGoLen = Rnd * 30 + 5
            ManWentLen = 0
            Set ManCalced = ManAnim.GetKeyFrameObj(0)
        Else
            ManAnim.MoveTo ManPos
            If ManGoT < 0.125 Then
                Set ManCalced = ManAnim.CalcAnimObject(0, 1, ManGoT * 800)
            ElseIf ManGoT < 0.25 Then
                Set ManCalced = ManAnim.CalcAnimObject(1, 0, ManGoT * 800 - 100)
            ElseIf ManGoT < 0.375 Then
                Set ManCalced = ManAnim.CalcAnimObject(0, 2, ManGoT * 800 - 200)
            Else
                Set ManCalced = ManAnim.CalcAnimObject(2, 0, ManGoT * 800 - 300)
            End If
        End If
    ElseIf ManState = MAN_DIE Then
        'bot is dieing
        Set ManCalced = ManAnim.CalcAnimObject(0, 3, ManActionWaitT / ManFallT * 100)
        If ManActionWaitT > ManFallT Then
            Set ManCalced = ManAnim.GetKeyFrameObj(3)
            ManState = MAN_BLENDOUT
            ManActionWaitT = 0
            
            'create the blood
            If Not Blood.EffectVcnt = Blood.EffectVmax Then
                Blood.EffectFileAdd Mk3d.VectorMake(ManPos.x, 0.1, ManPos.z)
            End If
        End If
    Else
        'bot is blended out
        If ManActionWaitT > BlendT Then
            Set ManCalced = ManAnim.GetKeyFrameObj(0)
            ManState = MAN_BLENDIN
            ManActionWaitT = 0
            ManShotT = 0
            ManPos = GetRandomPos
            ManAnim.MoveTo ManPos
        End If
    End If
End Sub




Private Function GetRandomPos() As D3DVECTOR
    Dim Ready As Boolean, StPos As D3DVECTOR, GotColl As D3DVECTOR

    Do
        StPos.x = GetRandom(4, 54)
        StPos.z = GetRandom(10, 60)
        GotColl = GetCollDet(StPos, StPos, 2, True, False)
        If Not GotColl.x = 0 And Not GotColl.z = 0 Then
            Ready = True
            GetRandomPos = StPos
        End If
    Loop While Not Ready
End Function

Private Function GetTimeDiff(ByVal StartTime As Single, ByVal EndTime As Single) As Single
    If EndTime < StartTime Then
        EndTime = EndTime + 86400
    End If
    GetTimeDiff = EndTime - StartTime
End Function

Private Function GetAngleDiff(ByVal Angle1 As Single, ByVal Angle2 As Single) As Single
    Dim Result!
    
    Result = Angle2 - Angle1
    If Result > 3.1415 Then Result = Result - 6.283
    If Result < -3.1415 Then Result = Result + 6.283
    GetAngleDiff = Result
End Function

Private Function GetMoveAngle(KeybState As DIKEYBOARDSTATE) As Single
    'Key 1: ESC
    'Key 28, 156: Enter
    'Key 200: Cursor up
    'Key 203: Cursor left
    'Key 205: Cursor right
    'Key 208: Cursor down
    
    GetMoveAngle = -1
    If Not KeybState.Key(200) = 0 And Not KeybState.Key(203) = 0 Then
        'Cursor up and Cursor left
        GetMoveAngle = 0.785375
        Exit Function
    End If
    If Not KeybState.Key(203) = 0 And Not KeybState.Key(208) = 0 Then
        'Cursor left and Cursor down
        GetMoveAngle = 2.356125
        Exit Function
    End If
    If Not KeybState.Key(208) = 0 And Not KeybState.Key(205) = 0 Then
        'Cursor down and Cursor right
        GetMoveAngle = 3.926875
        Exit Function
    End If
    If Not KeybState.Key(205) = 0 And Not KeybState.Key(200) = 0 Then
        'Cursor right and Cursor up
        GetMoveAngle = 5.497625
        Exit Function
    End If
        
    If Not KeybState.Key(200) = 0 Then
        'Cursor up
        GetMoveAngle = 0
    End If
    If Not KeybState.Key(203) = 0 Then
        'Cursor left
        GetMoveAngle = 1.57075
    End If
    If Not KeybState.Key(208) = 0 Then
        'Cursor down
        GetMoveAngle = 3.1415
    End If
    If Not KeybState.Key(205) = 0 Then
        'Cursor right
        GetMoveAngle = 4.71225
    End If
End Function

Private Function GetCollDet(ActPos As D3DVECTOR, NewPos As D3DVECTOR, ByVal MaxDiff As Single, ByVal CheckYou As Boolean, ByVal CheckMan As Boolean) As D3DVECTOR
    Dim i%, Diff As D3DVECTOR, ChPosX As D3DVECTOR, ChPosZ As D3DVECTOR
    
    'only x and z have to be checked
    GetCollDet = Mk3d.VectorMake(1, 1, 1)
    
    'check if the point is inside the world
    If NewPos.x < MapArea(0, 0) + MaxDiff Or NewPos.x > MapArea(0, 1) - MaxDiff Then
        GetCollDet.x = 0
    End If
    If NewPos.z < MapArea(1, 0) + MaxDiff Or NewPos.z > MapArea(1, 1) - MaxDiff Then
        GetCollDet.z = 0
    End If
    If GetCollDet.x = 0 And GetCollDet.z = 0 Then Exit Function
    
    'checks if the point comes too close to a tree or to a wall
    Mk3d.dx.VectorSubtract Diff, NewPos, ActPos
    ChPosX = ActPos
    ChPosX.x = ChPosX.x + Diff.x
    ChPosZ = ActPos
    ChPosZ.z = ChPosZ.z + Diff.z
    For i = 0 To CollDetCount - 1
        If InArea(NewPos, CollDet(i), MaxDiff) Then
            If Not GetCollDet.x = 0 Then
                If InArea(ChPosX, CollDet(i), MaxDiff) Then GetCollDet.x = 0
            End If
            If Not GetCollDet.z = 0 Then
                If InArea(ChPosZ, CollDet(i), MaxDiff) Then GetCollDet.z = 0
            End If
            If GetCollDet.x = 0 And GetCollDet.z = 0 Then Exit Function
        End If
    Next i
    
    'checks if the point is too close to your positon
    If CheckYou Then
        If InArea(ChPosX, yPos, MaxDiff) Then GetCollDet.x = 0
        If InArea(ChPosZ, yPos, MaxDiff) Then GetCollDet.z = 0
    End If
    If GetCollDet.x = 0 And GetCollDet.z = 0 Then Exit Function
    
    'checks if the point is too close to the bot's position
    If CheckMan And Not ManState = MAN_BLENDOUT Then
        If InArea(ChPosX, ManPos, MaxDiff) Then GetCollDet.x = 0
        If InArea(ChPosZ, ManPos, MaxDiff) Then GetCollDet.z = 0
    End If
End Function

Private Function GetPatronCollDet(PatronPos As D3DVECTOR, ByVal MaxDiff As Single) As MGPatronHitEnum
    Dim i%
    Dim HitNow As Boolean
    
    If InArea(PatronPos, Mk3d.VectorMake(3.5, 0, 12.5), 1) And Not HitSpecialW(0) Then
        'hit Special Window 1
        HitSpecialW(0) = True
        HitNow = True
    End If
    If InArea(PatronPos, Mk3d.VectorMake(3.5, 0, 57.5), 1) And Not HitSpecialW(1) Then
        'hit Special Window 2
        HitSpecialW(1) = True
        HitNow = True
    End If
    If HitSpecialW(0) And HitSpecialW(1) And HitNow And ActPlayT < 10 Then
        GamePoints = GamePoints + 100
        TextBlendWaitT = 0
        ShowText = True
        TextToShow = "WINDOW SPECIAL: + 100"
    End If
    
    If InArea(PatronPos, ManPos, MaxDiff) And PatronPos.y < 3 Then
        GetPatronCollDet = MGPATRON_HITMAN
        Exit Function
    End If
    If PatronPos.x < MapArea(0, 0) Or PatronPos.x > MapArea(0, 1) Or PatronPos.y < 0 Or PatronPos.y > 3 Or PatronPos.z < MapArea(1, 0) Or PatronPos.z > MapArea(1, 1) Then
        GetPatronCollDet = MGPATRON_HITLANDSCAPE
        Exit Function
    End If
    For i = 0 To CollDetCount - 1
        If InArea(PatronPos, CollDet(i), MaxDiff) And PatronPos.y < 6 Then
            GetPatronCollDet = MGPATRON_HITLANDSCAPE
            Exit Function
        End If
    Next i
    GetPatronCollDet = MGPATRON_HITNOTHING
End Function

Private Function GetRandom(ByVal Min As Single, ByVal Max As Single) As Single
    GetRandom = Rnd * (Max - Min) + Min
End Function

Private Function InArea(Pos As D3DVECTOR, AreaPos As D3DVECTOR, ByVal AreaSize As Single) As Boolean
    If Pos.x > AreaPos.x - AreaSize And Pos.x < AreaPos.x + AreaSize And Pos.z > AreaPos.z - AreaSize And Pos.z < AreaPos.z + AreaSize Then
        InArea = True
    End If
End Function