initmod.bas

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

Attribute VB_Name = "InitMod"
Option Explicit

'-----------------------------------------
'   DX Variables
'-----------------------------------------
Public DX As DirectX8
Public D3D As Direct3D8
Public D3DDevice As Direct3DDevice8
Public D3DX As New D3DX8
Public MtrlBuffer As D3DXBuffer

'-----------------------------------------
'   Global Matrix
'-----------------------------------------
Public matView As D3DMATRIX
Public matProj As D3DMATRIX

'-----------------------------------------
'   Screen Stuff
'-----------------------------------------
Public Const ScreenWidth As Integer = 1024
Public Const ScreenHeight As Integer = 768
Public DispMode As D3DDISPLAYMODE
Public D3DWindow As D3DPRESENT_PARAMETERS

Public Running As Boolean 'used to check if the program should be stoped

Public Lights() As D3DLIGHT8 'out lighting array

Public Const RadPerDeg As Single = 1.74532925199433E-02 'this means there are 1.7~~E-02 degrees per radian
Public Const DegPerRad As Single = 57.2957795130823     'this meand there are 57.2~~ radians per degree

Public Const PI    As Single = 3.14159265358979
Public Const D_1   As Single = PI / 180                 '1   degrees in radians
Public Const D_90  As Single = PI / 2                   '90  degrees in radians
Public Const D_180 As Single = PI                       '180 degrees in radians
Public Const D_270 As Single = (PI / 2) * 3             '270 degrees in radians
Public Const D_360 As Single = PI * 2                   '360 degrees in radians

Public DIMouse      As DirectInputDevice8 ' Mouse device
Public DIMState     As DIMOUSESTATE       ' to check mouse movements and clicks
Public MouX         As Single
Public MouY         As Single

Public Const TSPEED     As Single = D_1 + 0.03
Public Const MOUSESPEED As Integer = 1
Public MSPEED       As Integer
Public PSPEED       As Single

Public TPOWER       As Single   'used to move the camera when the snowman turns

Public CamObDist    As Single
Public CamGrDist    As Single
Public Angle As Single, ChrAngle As Single 'stores the direction the snowman and camera are facing
Public Pitch As Single
Public ChrX As Single, ChrY As Single
Public CAMX As Single, CAMY As Single, CAMZ As Single
Public nKills As Integer

'-----------------------------------------
'   Mesh information - 3D objects
'-----------------------------------------

Public Type MeshData
    Matrix   As D3DMATRIX
    Mesh     As D3DXMesh
    Mat()    As D3DMATERIAL8
    Tex()    As Direct3DTexture8
    MatCount As Long
    MX       As Single
    MY       As Single
    MZ       As Single
    MAngle   As Single
    MWidth   As Long
    MLength  As Long
    MHeight  As Long
    RenderMe As Boolean
    LifeSpan As Integer
    Turns    As Integer
End Type

Public WallMesh()    As MeshData
Public GateMesh()    As MeshData
Public TreeMesh()    As MeshData
Public WorldMesh()   As MeshData
Public HouseMesh()   As MeshData
Public RoadMesh()    As MeshData
Public SnowMesh()    As MeshData
Public SnowEvlMesh() As MeshData
Public ThrowMesh()   As MeshData
Public DropMesh()    As MeshData
Public FormMesh()    As MeshData

'--------------------------------------------------------------------------
'   template meshes, used so we only have to load one of each object once
'   from then on we can just assign the template to the new object
'--------------------------------------------------------------------------

Public TemplateWallMesh    As MeshData
Public TemplateGateMesh    As MeshData
Public TemplateTreeMesh    As MeshData
Public TemplateWorldMesh   As MeshData
Public TemplateHouseMesh   As MeshData
Public TemplateRoadMesh    As MeshData
Public TemplateSnowMesh    As MeshData
Public TemplateSnowEvlMesh As MeshData
Public TemplateThrowMesh   As MeshData
Public TemplateDropMesh    As MeshData
Public TemplateFormMesh    As MeshData

Public ThrowCount As Integer, DropCount As Integer, ExpCount As Integer
Public LastThrowTime As Long
Public LastDropTime  As Long
Public Const ThrowSpeed As Integer = 250 'throw a ball every 0.25 seconds
Public Const DropSpeed  As Integer = 250 'drop a christmas tree every 0.25 seconds

'-----------------------------------------
'   Animation Data, keyframe animation
'-----------------------------------------

Public Type AnimFrames
    AnimFMesh As D3DXMesh
    AnimMat() As D3DMATERIAL8
    AnimTex() As Direct3DTexture8
    AnimMCount As Long
    AnimTIndex As Long
    AnimTLength As Long
End Type

Public Type AnimMeshData
    AnimMatrix As D3DMATRIX
    AnimDMesh() As AnimFrames
    AnimTCurrent As Long
    AnimX As Single
    AnimY As Single
    AnimZ As Single
    AnimAngle As Single
    RenderMe As Boolean
End Type

Public TemplateExpMesh As AnimMeshData
Public ExpMesh() As AnimMeshData

'-----------------------------------------
'   Evil Snowman Variables
'-----------------------------------------
Public LastEvlAIChoice As Long
Public LastAIMove As Long
Public EvlAI As String
Public dNum As Integer 'direction number
Public EvlHealth As Integer

'-----------------------------------------
'   FPS Variables
'-----------------------------------------
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public FrameCount As Long
Public LastFrameCount As Long
Public LastTickCount As Long

'-----------------------------------------
'   OnScreen Text
'-----------------------------------------
Public D3DFont(1) As D3DXFont
Public FontDesc As IFont
Public TextRect(3) As RECT
Public TempFont As New StdFont

'-----------------------------------------
'   Game Time Limit variables
'-----------------------------------------
Public Const tLIMIT As Long = 300000 '5 minutes
Public LasttLIMITCheck As Long
Public LastcDownCheck As Long
Public CountDown As Long
'=================================================================================='
Public Function DTR(Deg As Single) As Single
    DTR = Deg * DegPerRad
End Function
'=================================================================================='
Public Function RTD(Rad As Single) As Single
    RTD = Rad * RadPerDeg
End Function
'=================================================================================='
Private Function SetDispMode()
    DispMode.Format = D3DFMT_R5G6B5
    DispMode.Width = ScreenWidth
    DispMode.Height = ScreenHeight
    D3DWindow.SwapEffect = D3DSWAPEFFECT_FLIP
    D3DWindow.Windowed = 0
    D3DWindow.BackBufferCount = 1
    D3DWindow.BackBufferFormat = D3DFMT_R5G6B5
    D3DWindow.BackBufferWidth = ScreenWidth
    D3DWindow.BackBufferHeight = ScreenHeight
    D3DWindow.hDeviceWindow = frmMain.hWnd
    D3DWindow.EnableAutoDepthStencil = 1
    D3DWindow.AutoDepthStencilFormat = D3DFMT_D16
    Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, frmMain.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3DWindow)
End Function
'=================================================================================='
Public Function InitDX() As Boolean
    On Error GoTo BailOut
    
    Set DX = New DirectX8
    Set D3D = DX.Direct3DCreate()
    Set D3DX = New D3DX8
    
    SetDispMode 'set up the Screen display settings
    
    D3DDevice.SetRenderState D3DRS_LIGHTING, 1  'enable the lighting
    D3DDevice.SetRenderState D3DRS_ZENABLE, 1   'enable the ZBuffer
    D3DDevice.SetRenderState D3DRS_AMBIENT, &HDDDDDD    'Setup the ambient scene lighting
    
    'the following to line make our textures look better, try to comment them out and see what happens
    D3DDevice.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
    D3DDevice.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
           
    'setup our view of the world
    D3DXMatrixIdentity matView
    D3DXMatrixLookAtLH matView, MakeVector(0, -D_360, D_1), MakeVector(0, 0, 0), MakeVector(0, 1, 0)
    D3DDevice.SetTransform D3DTS_WORLD, matView 'tell the world how we are looking at it
    
    D3DXMatrixPerspectiveFovLH matProj, PI / 4, PI * 0.3, 5, 750
    D3DDevice.SetTransform D3DTS_PROJECTION, matProj
    
'-------------------------------------------
'   InGame Text
'-------------------------------------------
    TempFont.Name = "Times New Roman"
    TempFont.Size = 10
    Set FontDesc = TempFont
    Set D3DFont(0) = D3DX.CreateFont(D3DDevice, FontDesc.hFont)    'Create the font
'-------------------------------------------