game.bas

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

Attribute VB_Name = "Game"
'General
Private Const PlayT% = 90                       'Time of the game
Private Const BlendT% = 2                       'Blend-Time
Private Const TextBlendT% = 2                   'Blend-Time for text
Private Const WorldG! = 1                       'g (used for patrons)

'Private
Private Const EyesHeight! = 2.8                 'height of the eyes
Private Const WalkSpeed% = 6                    'your walk-speed
Private Const PixelPer360% = 1024               'pixel to move with the mouse until a 360

'MG
Private Const MGTimePer360% = 3                 'seconds of the MG until a 360
Private Const MGCollT% = 20                     'seconds until the MG comes again

'MG Holding
Private Const MGLoadT! = 0.4                    'time of taking the MG
Private Const MGLoadDiff! = 1.2                 'start height of taking the MG
Private Const MGPatronsPerSec% = 10             'fire rate of the MG per second (has no effect on the bot, is only used to count down the bullets)
Private Const MGPointsPerSec% = 10              'the points which are subtracted per second while using the MG
Private Const MGPatronsShowPerSec% = 15         'patrons shown per second

'Mann
Private Const ManTimePer360% = 2                'time until the bot makes a 360
Private Const ManFallT% = 1                     'time until bot falls down when fragged
Private Const ManDieT! = 0.5                    'time until bot is fragged from the MG





Private Landscape As New Mk3dObject
Private MG As New Mk3dObject, MGHolding As New Mk3dObject
Private ManAnim As New Mk3dAnimatedObject, ManCalced As New Mk3dObject
Private MGBullets(MGPatronsShowPerSec - 1) As New Mk3dObject
Private MGBulletsDesc(MGPatronsShowPerSec - 1) As MGBulletType
Private Blood As New Mk3dEffectObject


Private MapArea!(1, 1)

Private yPos As D3DVECTOR, yEyes As D3DVECTOR, yAngle As D3DVECTOR

Private MGPos As D3DVECTOR, MGAngle As D3DVECTOR, MGWaitT!

Private MGPatrons!, MGHoldingUseT!, MGHoldingState As MGHoldingStateEnum
Private MGHoldingPos As D3DVECTOR, MGHoldingAngle As D3DVECTOR, MGHoldingLightIndex%
Private ActMGPatrons%, MGPatronsWaitT!

Private ManPos As D3DVECTOR, ManAngle As D3DVECTOR, ManState As ManStateEnum
Private ManRotTo!, ManGoLen!, ManWentLen!, ManWalkDir As D3DVECTOR
Private ManGoT!, ManActionWaitT!, ManShotT!


Private MenuBackgr As DirectDrawSurface7
Private ActPlayT!
Private FrameT!
Private GamePoints!
Private CollDetCount%, CollDet() As D3DVECTOR
Private HitSpecialW(1) As Boolean
Private TextBlendWaitT!, ShowText As Boolean, TextToShow As String
Public GameFont As IFont

Private Type MGBulletType
    MGBulletDir As D3DVECTOR
    MGStartT As Single
    MGFallSpeed As Single
End Type

Private Enum ManStateEnum
    MAN_BLENDIN
    MAN_BLENDOUT
    MAN_ROTATE
    MAN_GO
    MAN_DIE
End Enum

Private Enum MGHoldingStateEnum
    MG_NONE
    MG_BLENDIN
    MG_NORMAL
    MG_FIRE
    MG_BLENDOUT
End Enum

Private Enum MGPatronHitEnum
    MGPATRON_HITNOTHING
    MGPATRON_HITLANDSCAPE
    MGPATRON_HITMAN
End Enum





Public Sub Load(ByVal FirstLoad As Boolean)
    Dim i%, StartT!
    Dim LoadObj(3) As New Mk3dObject, Failed As Boolean

    On Local Error GoTo Failed
    
    'init the landscape
    If Not Landscape.CreateFromFile(App.Path & "\Objects\Landscape.obj", FirstLoad) Then Failed = True
    'init the MG
    If Not MG.CreateFromFile(App.Path & "\Objects\Weapon.obj", False) Then Failed = True
    'init your personal MG
    If Not MGHolding.CreateFromFile(App.Path & "\Objects\Weapon.obj", False) Then Failed = True
    MGHoldingLightIndex = Mk3d.LightAdd(MGHolding.GetLight(0))
    'init patrons
    For i = 0 To UBound(MGBullets)
        If Not MGBullets(i).CreateFromFile(App.Path & "\Objects\Bullet.obj", False) Then Failed = True
    Next i
    'init bot
    If Not LoadObj(0).CreateFromFile(App.Path & "\Objects\Bot Stand.obj", False) Then Failed = True
    LoadObj(0).Central True, False, True
    If Not LoadObj(1).CreateFromFile(App.Path & "\Objects\Bot StepRight.obj", False) Then Failed = True
    LoadObj(1).Central True, False, True
    If Not LoadObj(2).CreateFromFile(App.Path & "\Objects\Bot StepLeft.obj", False) Then Failed = True
    LoadObj(2).Central True, False, True
    If Not LoadObj(3).CreateFromFile(App.Path & "\Objects\Bot Died.obj", False) Then Failed = True
    LoadObj(3).Central True, False, True
    If Not ManAnim.CreateFromObjects(4, LoadObj()) Then Failed = True
    'init blood
    If FirstLoad Then
        Blood.Initsialize 5400               'init vertices for maximum 100 frags
        Blood.EffectFileLoad App.Path & "\Objects\Blood.obj"
        Blood.TextureSet App.Path & "\Textures\Blood.bmp"
        Blood.MaterialSet App.Path & "\Materials\Global.mat", 0
    End If
    
    If Failed Then
        MsgBox "There was an error while loading the 3d-objects.", vbCritical
        Mk3d.ExitDX
        End
    End If
    Exit Sub
    
Failed:
    MsgBox "There was an error while loading the 3d-coordinates.", vbCritical
    Mk3d.ExitDX
    End
End Sub

Public Sub Initsialize()
    Dim i%

    'init startup position
    Open App.Path & "\Data\Startup.dat" For Input As #1
    Input #1, yPos.x
    Input #1, yPos.y
    Input #1, yPos.z
    Input #1, yAngle.x
    Input #1, yAngle.y
    Input #1, MGPos.x
    Input #1, MGPos.y
    Input #1, MGPos.z
    Input #1, MGAngle.x
    Input #1, MGAngle.y
    Input #1, ManPos.x
    Input #1, ManPos.y
    Input #1, ManPos.z
    Input #1, ManAngle.x
    Input #1, ManAngle.y
    Close #1
    
    'init collision detection
    Open App.Path & "\Data\Size.dat" For Input As #1
    Input #1, MapArea(0, 0)                         'x min
    Input #1, MapArea(0, 1)                         'x max
    Input #1, MapArea(1, 0)                         'z min
    Input #1, MapArea(1, 1)                         'z max
    Close #1
    
    Open App.Path & "\Data\Collission.dat" For Input As #1
    Input #1, CollDetCount
    If CollDetCount <> 0 Then ReDim CollDet(CollDetCount - 1)
    For i = 0 To CollDetCount - 1
        Input #1, CollDet(i).x
        Input #1, CollDet(i).y
        Input #1, CollDet(i).z
    Next i
    Close #1
    
    'general
    FrameT = 0
    GamePoints = 0
    HitSpecialW(0) = False
    HitSpecialW(1) = False
    ShowText = True
    TextToShow = "WELCOME TO SHOT IT"
    Mk3d.PrimarySurf.SetForeColor vbWhite
    Mk3d.BackBufferSurf.SetForeColor vbWhite
    'private
    yEyes = yPos
    yEyes.y = yEyes.y + EyesHeight
    'MG
    MG.Central True, True, True
    MG.MoveTo MGPos
    MG.Rotate MGAngle
    MGWaitT = MGCollT
    'MG-Holding
    MGHolding.Central True, True, True
    MGHolding.Rotate Mk3d.VectorMake(0, 1.57075, 0)
    MGPatrons = 0
    ActMGPatrons = 0
    MGPatronsWaitT = 0
    MGHoldingUseT = 0
    MGHoldingPos = Mk3d.VectorMake(0, 0, 0)
    MGHoldingState = MG_NONE
    MGHoldingAngle = Mk3d.VectorMake(0, 0, 0)
    MGHoldingLightIndex = 0
    'blood
    Blood.EffectVcnt = 0
    Blood.EffectFileCentral True, True, True
    'bot
    ManAnim.MoveTo ManPos
    ManAnim.Rotate ManAngle
    
    ManState = MAN_BLENDIN
    ManRotTo = 0
    ManGoLen = 0
    ManWentLen = 0
    ManWalkDir = Mk3d.VectorMake(0, 0, 0)
    ManGoT = 0
    ManActionWaitT = 0
    ManShotT = 0
End Sub

Public Function Run() As Integer
    Dim i%, j%, cnt&, StartT!
    Dim MinLeft%, SecLeft%
    Dim yLookAt As D3DVECTOR, yLookDir As D3DVECTOR, yLookRefer As D3DVECTOR
    Dim MGHoldingRefer As D3DVECTOR
    
    'last settings before the game starts
    'general
    On Local Error Resume Next
    StartT = Timer
    yLookRefer = Mk3d.VectorMake(0, 0, 1)
    MGHoldingRefer = Mk3d.VectorMake(1.1, -0.9, 1.3)            'refers to the camera-position
    Set ManCalced = ManAnim.GetKeyFrameObj(0)
    DoEvents
    
    
    'Game-Loop
    Do
        'general
        cnt = cnt + 1                                           'get the frame-time
        ActPlayT = GetTimeDiff(StartT, Timer)
        FrameT = ActPlayT / cnt
        MinLeft = Int((PlayT - ActPlayT) / 60)
        SecLeft = Int(PlayT - ActPlayT - MinLeft * 60) + 1
        TextBlendWaitT = TextBlendWaitT + FrameT
        If TextBlendWaitT > TextBlendT Then ShowText = False
        yLookDir = Mk3d.VectorRotate(yLookRefer, yAngle)
        DoEvents
        
        'MG-Holding
        GameMGHolding MGHoldingRefer, yLookDir, cnt
        For i = 0 To ActMGPatrons - 1
            With MGBulletsDesc(i)
                .MGFallSpeed = .MGFallSpeed + WorldG * FrameT
                MGBullets(i).Move Mk3d.VectorMake(.MGBulletDir.x, -.MGFallSpeed, .MGBulletDir.z)
            End With
            If MGBullets(i).GetPosition.y < 0 Then
                For j = i To ActMGPatrons - 2
                    MGBullets(j).MoveTo MGBullets(j + 1).GetPosition
                    MGBulletsDesc(j) = MGBulletsDesc(j + 1)
                Next j
                ActMGPatrons = ActMGPatrons - 1
            End If
        Next i
        
        'keyboard
        If GameKeyboard(yLookDir) Then
            Run = Int(GamePoints)
            Exit Function        'exit
        End If
                
        'mouse
        GameMouse
        
        'MG
        GameMG
                
        'bot
        GameMan
        
        'render the szene
        Mk3d.dx.VectorAdd yLookAt, yEyes, yLookDir                    'set the camera
        Mk3d.SetCamera yEyes, yLookAt
        Mk3d.d3dDevice.BeginScene                                     'render the szene
        Mk3d.d3dDevice.Clear 1, Mk3d.d3drcViewport(), D3DCLEAR_TARGET, Mk3d.dx.CreateColorRGB(0, 0, 0), 0, 0
        Mk3d.d3dDevice.Clear 1, Mk3d.d3drcViewport(), D3DCLEAR_ZBUFFER, 0, 1, 0
        Mk3d.Render Landscape
        If Not MGHoldingState = MG_NONE Then Mk3d.Render MGHolding
        For i = 0 To ActMGPatrons - 1
            Mk3d.Render MGBullets(i)
        Next i
        If MGWaitT >= MGCollT Then Mk3d.Render MG
        Mk3d.RenderEffect Blood
        Mk3d.Render ManCalced
        Mk3d.d3dDevice.EndScene
        
        'info
        Mk3d.BackBufferSurf.DrawText 10, 10, "Time: " & MinLeft & ":" & SecLeft, False
        Mk3d.BackBufferSurf.DrawText 10, 40, "Score: " & Int(GamePoints), False
        If ShowText Then Mk3d.BackBufferSurf.DrawText TextCentralX(Len(TextToShow)), Mk3d.VPSize(1) / 2 - 200, TextToShow, False
        If Not MGHoldingState = MG_NONE Then
            Mk3d.BackBufferSurf.DrawText 10, 70, "Bullets: " & Int(MGPatrons), False
            'cross
            Mk3d.BackBufferSurf.DrawLine Mk3d.VPSize(0) / 2, Mk3d.VPSize(1) / 2 - 10, Mk3d.VPSize(0) / 2, Mk3d.VPSize(1) / 2 + 10
            Mk3d.BackBufferSurf.DrawLine Mk3d.VPSize(0) / 2 - 10, Mk3d.VPSize(1) / 2, Mk3d.VPSize(0) / 2 + 10, Mk3d.VPSize(1) / 2
        End If
        
        Mk3d.PrimarySurf.Flip Nothing, DDFLIP_DONOTWAIT
    Loop While ActPlayT < PlayT
    Run = Int(GamePoints)
End Function

Public Sub Menu(ByVal YName As String)
    Dim i%, j%, FirstPlay As Boolean, PressState As Boolean, ReDraw As Boolean
    Dim ActSel%, MaxSel%, ActChoice%
    Dim Score%, RecNames$(4), RecScores%(4), RecInd%
    Dim SurfaceDesc As DDSURFACEDESC2
    Dim KeybState As DIKEYBOARDSTATE
    
    On Local Error Resume Next
    MaxSel = 3
    ReDraw = True
    FirstPlay = True
    
    SurfaceDesc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
    Set MenuBackgr = Mk3d.dd.CreateSurfaceFromFile(App.Path & "\Data\Background.bmp", SurfaceDesc)
    
    Do
        Mk3d.diDeviceKeyb.GetDeviceStateKeyboard KeybState
        ActChoice = -1
        DoEvents
        
        If Not KeybState.Key(200) = 0 Then
            If Not PressState And Not ActSel = 0 Then