rendermod.bas

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

Attribute VB_Name = "RenderMod"
Option Explicit
Private ColFlag As Boolean  'collision flag
Public Function Render() 'normal render state
    Dim W As Integer: ColFlag = False
    
    'Clear the screen so we have a blank canvas to paint on
    D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, 0, 1#, 0
    
    'start the rendering scene *note : anything that is to be rendered must be within the begin and end scene tags
    D3DDevice.BeginScene
        'if they are allowed to be rendered then draw our objects
        For W = 0 To UBound(WallMesh)
            If WallMesh(W).RenderMe Then RenderMesh WallMesh(W), WallMesh(W).MX, WallMesh(W).MY, WallMesh(W).MZ, WallMesh(W).MAngle
        Next W
        For W = 0 To UBound(GateMesh)
            If GateMesh(W).RenderMe Then RenderMesh GateMesh(W), GateMesh(W).MX, GateMesh(W).MY, GateMesh(W).MZ
        Next W
        For W = 0 To UBound(WorldMesh)
            If WorldMesh(W).RenderMe Then RenderMesh WorldMesh(W), WorldMesh(W).MX, WorldMesh(W).MY, WorldMesh(W).MZ
        Next W
        For W = 0 To UBound(TreeMesh)
            If TreeMesh(W).RenderMe Then RenderMesh TreeMesh(W), TreeMesh(W).MX, TreeMesh(W).MY, TreeMesh(W).MZ
        Next W
        For W = 0 To UBound(HouseMesh)
            If HouseMesh(W).RenderMe Then RenderMesh HouseMesh(W), HouseMesh(W).MX, HouseMesh(W).MY, HouseMesh(W).MZ
        Next W
        For W = 0 To UBound(RoadMesh)
            If RoadMesh(W).RenderMe Then RenderMesh RoadMesh(W), RoadMesh(W).MX, RoadMesh(W).MY, RoadMesh(W).MZ
        Next W
        
        'Setup the New Matrix (*move the objects*)
        MatrixSetUp
                
        'Do the FPS count
        If (GetTickCount() - LastTickCount) >= 1000 Then
            LastFrameCount = FrameCount
            FrameCount = 0
            LastTickCount = GetTickCount()
        Else: FrameCount = FrameCount + 1
        End If
        
        'Setup our Text boxes on the screen
        TextRect(0).Top = 1: TextRect(0).bottom = 300: TextRect(0).Left = 1: TextRect(0).Right = 250
        TextRect(1).Top = 1: TextRect(1).Left = ScreenWidth - 200: TextRect(1).bottom = 200: TextRect(1).Right = ScreenWidth
        TextRect(2).Top = ScreenHeight - 200: TextRect(2).bottom = ScreenHeight: TextRect(2).Left = ScreenWidth - 400: TextRect(2).Right = ScreenWidth
        TextRect(3).Top = ScreenHeight - 200: TextRect(3).bottom = ScreenHeight: TextRect(3).Left = 0: TextRect(3).Right = 200
        
        'Write in the text boxes
        D3DX.DrawText D3DFont(0), &HFFFFCC00, "SnowMan's Stats" _
            & vbCrLf & "--------------" _
            & vbCrLf & "Life " & "100" & "/" & "100" _
            & vbCrLf & "Number of Kills : " & nKills, _
            TextRect(0), DT_TOP Or DT_LEFT
        
        D3DX.DrawText D3DFont(0), &HFFFFCC00, " Evil SnowMan's Stats" _
            & vbCrLf & "--------------------" _
            & vbCrLf & "Life " & EvlHealth & "/" & "100", _
            TextRect(1), DT_TOP Or DT_RIGHT
        
        D3DX.DrawText D3DFont(0), &HFFFFCC00, "SavageVB's 3D World" _
            & vbCrLf & "Current FPS : " & LastFrameCount, TextRect(2), DT_BOTTOM Or DT_RIGHT

        '------------------------------------------------------
        '   Count Down Section
        '------------------------------------------------------
        If (GetTickCount() - LastcDownCheck) >= 1000 Then CountDown = CountDown + 1: LastcDownCheck = GetTickCount()
        D3DX.DrawText D3DFont(0), &HFFFFCC00, "Time Left : " _
            & (tLIMIT / 1000) - CountDown & " Seconds", TextRect(3), DT_BOTTOM Or DT_LEFT
        
        'enable the lights
        D3DDevice.LightEnable 0, True
    
    'End the rendering Scene
    D3DDevice.EndScene
    D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Function
'==================================================================================
Public Function RenderForm(): Dim W As Integer
    Dim matTemp As D3DMATRIX, matCamera As D3DMATRIX, matRotation As D3DMATRIX
    D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, 0, 1#, 0  '//Clear the screen black
    D3DDevice.BeginScene
        For W = 0 To UBound(WallMesh)
            RenderMesh WallMesh(W), WallMesh(W).MX, WallMesh(W).MY, WallMesh(W).MZ, WallMesh(W).MAngle
        Next W
        For W = 0 To UBound(WorldMesh)
            RenderMesh WorldMesh(W), WorldMesh(W).MX, WorldMesh(W).MY, WorldMesh(W).MZ
        Next W
        For W = 0 To UBound(TreeMesh)
            RenderMesh TreeMesh(W), TreeMesh(W).MX, TreeMesh(W).MY, TreeMesh(W).MZ
        Next W
        For W = 0 To UBound(HouseMesh)
            RenderMesh HouseMesh(W), HouseMesh(W).MX, HouseMesh(W).MY, HouseMesh(W).MZ
        Next W
        For W = 0 To UBound(RoadMesh)
            RenderMesh RoadMesh(W), RoadMesh(W).MX, RoadMesh(W).MY, RoadMesh(W).MZ
        Next W
        
        SnowMesh(0).MAngle = SnowMesh(0).MAngle - (TSPEED / 2)
        If SnowMesh(0).MAngle < 0 Then SnowMesh(0).MAngle = D_360 + SnowMesh(0).MAngle
        RenderMesh SnowMesh(0), -12, -40, 1, SnowMesh(0).MAngle
        
        SnowEvlMesh(0).MAngle = SnowEvlMesh(0).MAngle + (TSPEED / 2)
        If SnowEvlMesh(0).MAngle > D_360 Then SnowEvlMesh(0).MAngle = 0 + (SnowEvlMesh(0).MAngle - D_360)
        RenderMesh SnowEvlMesh(0), -38, -40, 1, SnowEvlMesh(0).MAngle
        
        RenderMesh FormMesh(0), -25, -40, 10
        
        TextRect(0).bottom = ScreenHeight - 300
        TextRect(0).Left = 200
        TextRect(0).Right = ScreenWidth - 200
        TextRect(0).Top = 400
        
        D3DX.DrawText D3DFont(1), &HFFFFCC00, "Congratulations you killed " & nKills _
        & " Evil Snowmen" & vbCrLf & vbCrLf & "Please Press Esc to finish", TextRect(0), DT_TOP Or DT_CENTER
        
        D3DXMatrixRotationY matRotation, 0
        D3DXMatrixMultiply matCamera, matCamera, matRotation
        
        D3DXMatrixTranslation matCamera, CAMX, CAMY + 20, -15
        D3DXMatrixMultiply matCamera, matCamera, matView
        
        D3DDevice.SetTransform D3DTS_VIEW, matCamera
        
    D3DDevice.EndScene
    D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Function
'==================================================================================
Private Sub MatrixSetUp()
    
    Dim matTemp As D3DMATRIX, matCamera As D3DMATRIX, matRotation As D3DMATRIX
    Dim TempChrX As Single, TempChrY As Single, TempCAMX As Single, TempCAMY As Single, TempEvlX As Single, TempEvlY As Single
    
    D3DXMatrixIdentity matCamera
    D3DXMatrixIdentity matRotation
    
    TempEvlX = SnowEvlMesh(0).MX
    TempEvlY = SnowEvlMesh(0).MY
    TempChrX = ChrX: TempChrY = ChrY
    TempCAMX = CAMX: TempCAMY = CAMY
    
    DIMouse.GetDeviceStateMouse DIMState
    DKIDevice.GetDeviceStateKeyboard DKIState
    
'======================================================================================
'   Movement by Keyboard Section
'======================================================================================
    
    If DKIState.Key(30) <> 0 Then
        If DKIState.Key(42) <> 0 Then MSPEED = 3 Else MSPEED = 2
        ChrX = ChrX + (Sin(ChrAngle + D_90) * MSPEED)
        ChrY = ChrY + (Cos(ChrAngle + D_90) * MSPEED)
        CAMX = CAMX + (Sin(ChrAngle + D_90) * MSPEED)
        CAMY = CAMY + (Cos(ChrAngle + D_90) * MSPEED)
    ElseIf DKIState.Key(32) <> 0 Then
        If DKIState.Key(42) <> 0 Then MSPEED = 3 Else MSPEED = 2
        ChrX = ChrX - (Sin(ChrAngle + D_90) * MSPEED)
        ChrY = ChrY - (Cos(ChrAngle + D_90) * MSPEED)
        CAMX = CAMX - (Sin(ChrAngle + D_90) * MSPEED)
        CAMY = CAMY - (Cos(ChrAngle + D_90) * MSPEED)
    End If
    
    If DKIState.Key(200) <> 0 Then
        'Move the camera and character (Snowman) forwards
        If DKIState.Key(42) <> 0 Then MSPEED = 3 Else MSPEED = 2
        ChrX = ChrX - (Sin(D_360 - ChrAngle) * MSPEED)
        ChrY = ChrY + (Cos(D_360 - ChrAngle) * MSPEED)
        CAMX = CAMX - (Sin(D_360 - ChrAngle) * MSPEED)
        CAMY = CAMY + (Cos(D_360 - ChrAngle) * MSPEED)
    ElseIf DKIState.Key(208) <> 0 Then
        'Move the camera and character (Snowman) backwards
        If DKIState.Key(42) <> 0 Then MSPEED = 3 Else MSPEED = 2
        ChrX = ChrX + (Sin(D_360 - ChrAngle) * MSPEED)
        ChrY = ChrY - (Cos(D_360 - ChrAngle) * MSPEED)
        CAMX = CAMX + (Sin(D_360 - ChrAngle) * MSPEED)
        CAMY = CAMY - (Cos(D_360 - ChrAngle) * MSPEED)
    End If
    
'======================================================================================
'    Collision detection for Snowman Section
'======================================================================================
    Dim I As Integer
    For I = 0 To UBound(HouseMesh())
        If MeshColDetect(HouseMesh(I), SnowMesh(0), ChrX, ChrY) Then ChrX = TempChrX: ChrY = TempChrY: CAMX = TempCAMX: CAMY = TempCAMY: Exit For
    Next I
    For I = 0 To UBound(TreeMesh())
        If MeshColDetect(TreeMesh(I), SnowMesh(0), ChrX, ChrY) Then ChrX = TempChrX: ChrY = TempChrY: CAMX = TempCAMX: CAMY = TempCAMY: Exit For
    Next I
    For I = 0 To UBound(WallMesh())
        If MeshColDetect(WallMesh(I), SnowMesh(0), ChrX, ChrY) Then ChrX = TempChrX: ChrY = TempChrY: CAMX = TempCAMX: CAMY = TempCAMY: Exit For
    Next I
    For I = 0 To UBound(GateMesh())
        If MeshColDetect(GateMesh(I), SnowMesh(0), ChrX, ChrY) Then ChrX = TempChrX: ChrY = TempChrY: CAMX = TempCAMX: CAMY = TempCAMY: Exit For
    Next I
    If SnowEvlMesh(0).RenderMe Then If MeshColDetect(SnowEvlMesh(0), SnowMesh(0), ChrX, ChrY) Then ChrX = TempChrX: ChrY = TempChrY: CAMX = TempCAMX: CAMY = TempCAMY
    SnowMesh(0).MX = -ChrX: SnowMesh(0).MY = -ChrY
    
'======================================================================================
'   Movement by Mouse Section
'======================================================================================
    If MouX < 100 Then
        CAMX = CAMX - (Cos(-Angle) * TPOWER)
        CAMY = CAMY - (Sin(-Angle) * TPOWER)
        Angle = Angle + TSPEED
        If Angle > D_360 Then Angle = 0 + (Angle - D_360)
    ElseIf MouX > (frmMain.Width - 100) Then
        Angle = Angle - TSPEED
        If Angle < 0 Then Angle = D_360 + Angle
        CAMX = CAMX + (Cos(-Angle) * TPOWER)
        CAMY = CAMY + (Sin(-Angle) * TPOWER)
    End If
    
'======================================================================================
'    Turning Section
'======================================================================================
    If DKIState.Key(205) <> 0 Then
        'Rotate the snowman to the right while moving the camera to the left
        Angle = Angle - TSPEED: ChrAngle = ChrAngle - TSPEED
        If Angle < 0 Then Angle = D_360 + Angle
        If ChrAngle < 0 Then ChrAngle = D_360 + ChrAngle
        CAMX = CAMX + (Cos(-Angle) * TPOWER)
        CAMY = CAMY + (Sin(-Angle) * TPOWER)
    End If
    
    If DKIState.Key(203) <> 0 Then
        'Rotate the Snowman to the left while moving the camera to the right
        CAMX = CAMX - (Cos(-Angle) * TPOWER)