initmod.bas

雪人打雪仗的3D第一人称游戏

'   Game Over Text
'-------------------------------------------
    TempFont.Name = "Times New Roman"
    TempFont.Size = 14
    Set FontDesc = TempFont
    Set D3DFont(1) = D3DX.CreateFont(D3DDevice, FontDesc.hFont)    'Create the font
    
    Init3DObj   'Init our 3d objects
    InitLights  'Init our Lights
    InitKeyBoardMouse
    
    Running = True
    
    ThrowCount = 0: DropCount = 0: ExpCount = 0: EvlHealth = 100: TPOWER = 4
    LasttLIMITCheck = GetTickCount()
    LastcDownCheck = GetTickCount()
    
    InitDX = True
    Exit Function
BailOut:
    InitDX = False
End Function
'=================================================================================='
Public Function Init3DObj()
    'Create the Template Mesh's and The Acutal Mesh's
    MyReadMeshFromX "\MultiXFiles\MultiX(Wall).txt", TemplateWallMesh, WallMesh()
    MyReadMeshFromX "\MultiXFiles\MultiX(Gate).txt", TemplateGateMesh, GateMesh()
    MyReadMeshFromX "\MultiXFiles\MultiX(Ground).txt", TemplateWorldMesh, WorldMesh()
    MyReadMeshFromX "\MultiXFiles\MultiX(Snowman).txt", TemplateSnowMesh, SnowMesh()
    MyReadMeshFromX "\MultiXFiles\MultiX(SnowmanEvl).txt", TemplateSnowEvlMesh, SnowEvlMesh()
    MyReadMeshFromX "\MultiXFiles\MultiX(Tree).txt", TemplateTreeMesh, TreeMesh()
    MyReadMeshFromX "\MultiXFiles\MultiX(House).txt", TemplateHouseMesh, HouseMesh()
    MyReadMeshFromX "\MultiXFiles\MultiX(Road).txt", TemplateRoadMesh, RoadMesh()
        
    CreateMesh "\XFiles\SnowBall.x", TemplateThrowMesh, 8, 8
    CreateMesh "\XFiles\Marker(Tree).x", TemplateDropMesh, 16, 16
    
    CreateMesh "\XFiles\FormBackDrop.x", TemplateFormMesh, 128, 128
    ReDim FormMesh(0) As MeshData: FormMesh(0) = TemplateFormMesh
        
    'Create the keyframe Animation Mesh's
    ReadAnimFile "\AnimXFiles\KeyFrame(Snowball).txt", TemplateExpMesh
End Function
'=================================================================================='
Private Function InitLights()
    On Error GoTo BailOut
    Dim Mtrl As D3DMATERIAL8 'Material
    Dim Col As D3DCOLORVALUE 'Color
    'Create color
    Col.a = 1: Col.r = 1: Col.g = 1: Col.B = 1
    'Apply material
    Mtrl.Ambient = Col: Mtrl.diffuse = Col
    D3DDevice.SetMaterial Mtrl
    
    'Create directional light
    Lights(0).Type = D3DLIGHT_DIRECTIONAL
    Lights(0).diffuse.r = 1
    Lights(0).diffuse.g = 1
    Lights(0).diffuse.B = 1
    Lights(0).Direction = MakeVector(0, 0, 50)

    'Apply lights to device
    D3DDevice.SetLight 0, Lights(0)
    
    InitLights = True
    Exit Function
BailOut:
    InitLights = False
End Function
'=================================================================================='
Private Function InitKeyBoardMouse() As Boolean
On Local Error GoTo BailOut:
'-----------------------------------------------------------------------------------
'   Keyboard Init Section
'-----------------------------------------------------------------------------------
    'Create a new DirectX8 Input device
    Set DKI = DX.DirectInputCreate
    'Tell this new device it is going to be a keyboard device
    Set DKIDevice = DKI.CreateDevice("GUID_SysKeyboard")
    'Set the new keyboard devive to the common keyboard format
    DKIDevice.SetCommonDataFormat DIFORMAT_KEYBOARD
    'Set its cooperative level this is basically for telling the keyboard if it has soul right to the input from the keyboard or can the windows environment also use the input
    DKIDevice.SetCooperativeLevel frmMain.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
    DevProp.lHow = DIPH_DEVICE
    DevProp.lData = 10 'set the size of the keybuffer
    DKIDevice.SetProperty DIPROP_BUFFERSIZE, DevProp
    'start using the keyboard device
    DKIDevice.Acquire
'-----------------------------------------------------------------------------------
'   Mouse Init Section
'-----------------------------------------------------------------------------------
    'Tell this device it is going to be a Mouse device
    Set DIMouse = DKI.CreateDevice("GUID_SysMouse")
    'set the mouse's format to the common mouse format
    DIMouse.SetCommonDataFormat DIFORMAT_MOUSE
    DIMouse.SetCooperativeLevel frmMain.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE 'DISCL_FOREGROUND Or DISCL_EXCLUSIVE
    DIMouse.Acquire 'start using the mouse
'-----------------------------------------------------------------------------------
    InitKeyBoardMouse = True
    Exit Function
BailOut:
    InitKeyBoardMouse = False
End Function
'=================================================================================='
Public Function MyReadMeshFromX(FileName As String, TemplateMesh As MeshData, InMesh() As MeshData)
    Dim InText, XFileName As String, FileNum, LoopCount, MeshNum, ISizeX As Integer, ISizeY As Integer, IX, IY, IZ, IWid, ILen, IHei As Long, IAngle As Single
    FileNum = FreeFile
    Open App.Path + FileName For Input As FileNum
        Do Until EOF(FileNum)
            Line Input #FileNum, InText
            If (Not (InText = "") Or (InText = ";")) Then
                Select Case InText
                Case "<FileName>"
                    Input #FileNum, XFileName
                Case "<TextureSize>"
                    Input #FileNum, ISizeX, ISizeY
                Case "<Location>"
                    'create a template of this Mesh
                    CreateMesh XFileName, TemplateMesh, ISizeX, ISizeY
                    Input #FileNum, LoopCount
                    For MeshNum = 0 To LoopCount
                        'read from the file all our values for this new mesh
                        Input #FileNum, IX, IY, IZ, IWid, ILen, IHei, IAngle
                        ReDim Preserve InMesh(MeshNum)
                        'Assign the new mesh the template values, this is muxh faster then create a new mesh each time
                        InMesh(MeshNum) = TemplateMesh
                        InMesh(MeshNum).MX = IX 'Assign the x,y,z values
                        InMesh(MeshNum).MY = IY
                        InMesh(MeshNum).MZ = IZ
                        'Setup the Width of an object depending on the angle it is facing
                        If IAngle = 1 Then InMesh(MeshNum).MWidth = ILen Else InMesh(MeshNum).MWidth = IWid
                        'Setup the Length of an object depending on the angle it is facing
                        If IAngle = 1 Then InMesh(MeshNum).MLength = IWid Else InMesh(MeshNum).MLength = ILen
                        InMesh(MeshNum).MHeight = IHei 'setup the height of the object
                        'Setup the Angle of the object
                        If IAngle = 1 Then InMesh(MeshNum).MAngle = D_90 Else InMesh(MeshNum).MAngle = 0
                        InMesh(MeshNum).RenderMe = True
                    Next MeshNum
                End Select
            End If
        Loop
    Close FileNum
End Function
'==================================================================================
Public Function CreateMesh(FileName As String, InMesh As MeshData, SizeX As Integer, SizeY As Integer)
Dim TextureName As String, q As Integer
    Set InMesh.Mesh = D3DX.LoadMeshFromX(App.Path & FileName, D3DXMESH_MANAGED, D3DDevice, Nothing, MtrlBuffer, InMesh.MatCount)
    ReDim InMesh.Mat(InMesh.MatCount - 1) As D3DMATERIAL8   'setup the materials array
    ReDim InMesh.Tex(InMesh.MatCount - 1) As Direct3DTexture8   'setup the texture array
    For q = 0 To InMesh.MatCount - 1
        D3DX.BufferGetMaterial MtrlBuffer, q, InMesh.Mat(q)
        'setup the ambient lighting
        InMesh.Mat(q).Ambient = InMesh.Mat(q).diffuse
        'get the texture name from the 3D object
        TextureName = D3DX.BufferGetTextureName(MtrlBuffer, q)
        'assign the texture to the new 3d object
        If TextureName <> "" Then Set InMesh.Tex(q) = D3DX.CreateTextureFromFileEx(D3DDevice, App.Path & "\Textures\" & TextureName, SizeX, SizeY, D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)
    Next q
    Set MtrlBuffer = Nothing 'Clear the Material buffer
End Function
'==================================================================================
Public Function ReadAnimFile(FileName As String, TemplateMesh As AnimMeshData)
    Dim InText As String, XFileName As String
    Dim nFrames As Integer, aLength As Integer, FileNum As Integer
    Dim SizeX As Integer, SizeY As Integer, mNum As Long
    FileNum = FreeFile
    Open App.Path + FileName For Input As FileNum
        Do Until EOF(FileNum)
            Line Input #FileNum, InText
            If (Not (InText = "") Or (InText = ";")) Then
                Select Case InText
                Case "<NumFrames>":  Input #FileNum, nFrames
                Case "<AnimLength>": Input #FileNum, aLength
                Case "<FileName>"
                    ReDim TemplateMesh.AnimDMesh(nFrames) As AnimFrames
                    For mNum = 0 To nFrames
                        Input #FileNum, XFileName, SizeX, SizeY
                        'create a template of the animation
                        CreateNewAnimMesh XFileName, TemplateMesh, mNum, SizeX, SizeY
                        If mNum = 0 Then TemplateMesh.AnimDMesh(mNum).AnimTIndex = 0 Else TemplateMesh.AnimDMesh(mNum).AnimTIndex = aLength * (mNum / (nFrames + 1))
                        If mNum = nFrames Then TemplateMesh.AnimDMesh(mNum).AnimTLength = aLength Else TemplateMesh.AnimDMesh(mNum).AnimTLength = aLength * ((mNum + 1) / (nFrames + 1))
                        TemplateMesh.AnimTCurrent = 0
                    Next mNum
                End Select
            End If
        Loop
    Close FileNum
End Function
'==================================================================================
Public Function CreateNewAnimMesh(FileName As String, TempMesh As AnimMeshData, fNum As Long, SizeX As Integer, SizeY As Integer)
Dim TextureName As String, q As Integer
    Set TempMesh.AnimDMesh(fNum).AnimFMesh = D3DX.LoadMeshFromX(App.Path & FileName, D3DXMESH_MANAGED, D3DDevice, Nothing, MtrlBuffer, TempMesh.AnimDMesh(fNum).AnimMCount)
    ReDim TempMesh.AnimDMesh(fNum).AnimMat(TempMesh.AnimDMesh(fNum).AnimMCount - 1) As D3DMATERIAL8
    ReDim TempMesh.AnimDMesh(fNum).AnimTex(TempMesh.AnimDMesh(fNum).AnimMCount - 1) As Direct3DTexture8
    For q = 0 To TempMesh.AnimDMesh(fNum).AnimMCount - 1
        D3DX.BufferGetMaterial MtrlBuffer, q, TempMesh.AnimDMesh(fNum).AnimMat(q)
        TempMesh.AnimDMesh(fNum).AnimMat(q).Ambient = TempMesh.AnimDMesh(fNum).AnimMat(q).diffuse
        TextureName = D3DX.BufferGetTextureName(MtrlBuffer, q)
        If TextureName <> "" Then Set TempMesh.AnimDMesh(fNum).AnimTex(q) = D3DX.CreateTextureFromFileEx(D3DDevice, App.Path & "\Textures\" & TextureName, SizeX, SizeY, D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)
    Next q
    Set MtrlBuffer = Nothing
End Function
'==================================================================================
Public Function CreateSnowMeshObj(TemplateMesh As MeshData, InMesh() As MeshData, InMeshNum As Integer, InZ As Integer, InW As Integer, InH As Integer, InL As Integer, InLifeSpan As Integer, InTurns As Integer, SrcX As Single, SrcY As Single, SrcAngle As Single)
    'this function is used to create an object whilst the program is running eg a snowball
    InMesh(InMeshNum) = TemplateMesh
    InMesh(InMeshNum).MX = SrcX
    InMesh(InMeshNum).MY = SrcY
    InMesh(InMeshNum).MZ = InZ
    InMesh(InMeshNum).MWidth = InW
    InMesh(InMeshNum).MLength = InL
    InMesh(InMeshNum).MHeight = InH
    InMesh(InMeshNum).MAngle = -SrcAngle
    InMesh(InMeshNum).LifeSpan = InLifeSpan
    InMesh(InMeshNum).Turns = InTurns
    InMesh(InMeshNum).RenderMe = True
End Function
'==================================================================================
Public Function CreateAnimMeshObj(TemplateMesh As AnimMeshData, InMesh As AnimMeshData, SrcX As Single, SrcY As Single, SrcZ As Single, SrcAngle As Single)
    InMesh = TemplateMesh
    InMesh.AnimX = SrcX
    InMesh.AnimY = SrcY
    InMesh.AnimZ = SrcZ
    InMesh.AnimAngle = SrcAngle
    InMesh.RenderMe = True
End Function
'==================================================================================
Public Function MakeVector(X As Single, Y As Single, Z As Single) As D3DVECTOR
    MakeVector.X = X: MakeVector.Y = Y: MakeVector.Z = Z
End Function
'==================================================================================