rabit/RaBit%27s%20Rapid%20Racers/Form_D3D.frm

VERSION 5.00
Begin VB.Form Form_D3D 
   BorderStyle     =   5  'Sizable ToolWindow
   Caption         =   "RRR"
   ClientHeight    =   7200
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9600
   ClipControls    =   0   'False
   FillStyle       =   0  'Solid
   BeginProperty Font 
      Name            =   "Terminal"
      Size            =   6
      Charset         =   255
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   KeyPreview      =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   480
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   640
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Picture_TrackMap 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ClipControls    =   0   'False
      FillStyle       =   0  'Solid
      ForeColor       =   &H80000008&
      Height          =   6000
      Left            =   0
      ScaleHeight     =   400
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   400
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   6000
   End
End
Attribute VB_Name = "Form_D3D"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'

Public Function Initialise() As Boolean

Dim lAdapter As Long
Dim lD3DCreateFlags As CONST_D3DCREATEFLAGS

Dim fcDevCaps As D3DCAPS8

Dim matProjection As D3DMATRIX
    
    lAdapter = D3DADAPTER_DEFAULT

    On Error GoTo ErrHandler

    ConPrint Const_strConsoleBlockTitlePre + "testing device features:" + Const_strConsoleBlockTitlePost
    ConPrint "  " & clSystem.D3D8.GetAdapterCount & " display adapter(s) found.[brk][brk]"
    
    With tpD3DPresentParameters
    
        If Form_Start.Check_Windowed.Value = 1 Then
        
            clSystem.D3D8.GetAdapterDisplayMode lAdapter, tpUsedDispMode
        
            .BackBufferCount = 1
            .BackBufferFormat = tpUsedDispMode.Format
        
            .Windowed = 1

        Else
        
            clSystem.D3D8.EnumAdapterModes 0, Form_Start.Combo_RefreshRate.ItemData(Form_Start.Combo_RefreshRate.ListIndex), tpUsedDispMode
        
            .BackBufferCount = 1
            .BackBufferFormat = tpUsedDispMode.Format
            .BackBufferWidth = tpUsedDispMode.Width
            .BackBufferHeight = tpUsedDispMode.Height
            .FullScreen_RefreshRateInHz = tpUsedDispMode.RefreshRate
'            .FullScreen_PresentationInterval = 0
            
        End If
        
        .hDeviceWindow = Form_D3D.hWnd

        .AutoDepthStencilFormat = D3DFMT_D16
        .EnableAutoDepthStencil = 1

'        .SwapEffect = D3DSWAPEFFECT_FLIP
        
        If Form_Start.Check_Antialias.Value = 1 Then
        
            .SwapEffect = D3DSWAPEFFECT_DISCARD
            
            If Form_Start.Option_MultisampleType2.Value = True Then
            
                If clSystem.D3D8.CheckDeviceMultiSampleType(lAdapter, D3DDEVTYPE_HAL, D3DFMT_R8G8B8, .Windowed, D3DMULTISAMPLE_2_SAMPLES) Then .MultiSampleType = D3DMULTISAMPLE_2_SAMPLES
            
            ElseIf Form_Start.Option_MultisampleType4.Value = True Then
            
                If clSystem.D3D8.CheckDeviceMultiSampleType(lAdapter, D3DDEVTYPE_HAL, D3DFMT_R8G8B8, .Windowed, D3DMULTISAMPLE_4_SAMPLES) Then .MultiSampleType = D3DMULTISAMPLE_4_SAMPLES
    
            End If
    
        Else
        
            .SwapEffect = D3DSWAPEFFECT_COPY '_VSYNC
        
        End If
    
        If .MultiSampleType > D3DMULTISAMPLE_NONE Then
        
            ConPrint "  antialiasing type is [c02]" & .MultiSampleType & "x multisampling[c07].[brk]"
        
        Else
        
            ConPrint "  antialiasing is [c12]deactivated[c07].[brk]"
        
        End If
        
    End With
    
    '############################
    '## CHECK THE DEVICE CAPABILITIES ##
    '###########################
    
    On Local Error Resume Next
        
    clSystem.D3D8.GetDeviceCaps lAdapter, D3DDEVTYPE_HAL, fcDevCaps
    
    If Err.Number = D3DERR_INVALIDDEVICE Then
        
        'We couldn't get data from the hardware device - probably doesn't exist...
        clSystem.D3D8.GetDeviceCaps lAdapter, D3DDEVTYPE_REF, fcDevCaps
        Err.Clear ' Remove the error value..
    
    End If
    
    ConPrint "  hardware transform and lighting... "
    
    '...for Hardware vertex processing:
    If (fcDevCaps.DevCaps And D3DDEVCAPS_HWTRANSFORMANDLIGHT) Then
        
        lD3DCreateFlags = D3DCREATE_HARDWARE_VERTEXPROCESSING
        ConPrint Const_strConsoleTextOK
        
    Else
        
        lD3DCreateFlags = D3DCREATE_SOFTWARE_VERTEXPROCESSING
        ConPrint Const_strConsoleTextFail
    
    End If
    
    ConPrint "  pure device support... "
    
    '...for Pure Device processing:
    If (fcDevCaps.DevCaps And D3DDEVCAPS_PUREDEVICE) Then
        
        lD3DCreateFlags = lD3DCreateFlags Or D3DCREATE_PUREDEVICE
        ConPrint Const_strConsoleTextOK
    
    Else
        
        ConPrint Const_strConsoleTextFail
    
    End If
    
Dim fcPRasterCapsFlags As CONST_D3DPRASTERCAPSFLAGS

    fcPRasterCapsFlags = fcDevCaps.RasterCaps

    ConPrint "  colour dithering... "
    
    If (fcPRasterCapsFlags And D3DPRASTERCAPS_DITHER) Then ConPrint Const_strConsoleTextOK Else ConPrint Const_strConsoleTextFail
    
    fcPRasterCapsFlags = fcDevCaps.RasterCaps

    ConPrint "  anisotropic filtering... "
    
    If (fcPRasterCapsFlags And D3DPRASTERCAPS_ANISOTROPY) Then ConPrint Const_strConsoleTextOK Else ConPrint Const_strConsoleTextFail

    ConPrint "  edge antialiasing... "
    
    If (fcPRasterCapsFlags And D3DPRASTERCAPS_ANTIALIASEDGES) Then ConPrint Const_strConsoleTextOK Else ConPrint Const_strConsoleTextFail

    ConPrint "  range-based fog... "
    
    If (fcPRasterCapsFlags And D3DPRASTERCAPS_FOGRANGE) Then ConPrint Const_strConsoleTextOK Else ConPrint Const_strConsoleTextFail

    ' This line creates a device that uses a hardware device if possible; software vertex processing and uses the form as it's target
    Set clD3DDevice = clSystem.D3D8.CreateDevice(lAdapter, D3DDEVTYPE_HAL, Form_D3D.hWnd, lD3DCreateFlags, tpD3DPresentParameters)
                                                            
    ' Configure the rendering device
    clD3DDevice.SetVertexShader Const_lFVF_Vertex '//Tell it what type of vertex we are using
    clD3DDevice.SetRenderState D3DRS_LIGHTING, 1  '//Enable lighting.
    clD3DDevice.SetRenderState D3DRS_ZENABLE, 1
    clD3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE

    If tpD3DPresentParameters.MultiSampleType > 0 Then clD3DDevice.SetRenderState D3DRS_MULTISAMPLE_ANTIALIAS, 1

'    clD3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1
'    clD3DDevice.SetRenderState D3DRS_RANGEFOGENABLE, 1
    
'    clD3DDevice.SetRenderState D3DRS_DITHERENABLE, True
'    clD3DDevice.SetRenderState D3DRS_EDGEANTIALIAS, True
'    clD3DDevice.SetRenderState D3DRS_SPECULARENABLE, True
'    clD3DDevice.SetRenderState D3DRS_FOGENABLE, True
    
    '//configure the world matrices
    
    '//1. The World Matrix
'    D3DXMatrixIdentity matWorld
    clD3DDevice.SetTransform D3DTS_WORLD, tpMatIdentity 'commit this matrix to the device
    
    '//3. The projection Matrix
    D3DXMatrixPerspectiveFovLH matProjection, 0.3 * Const_sgPi, tpUsedDispMode.Height / tpUsedDispMode.Width, 0.1, 300
    clD3DDevice.SetTransform D3DTS_PROJECTION, matProjection

    Initialise = True '//We succeeded
    
    ConPrint "[brk]"
    
    Exit Function
    
ErrHandler:
    
    Initialise = False
    ConPrint "[brk][c03]error returned:[brk]no. " & Err.Number & ": " + Err.Description + "[c15][brk]"

End Function

Public Sub Render()

Dim clCurrentObject As Class_GeoObject
Dim clPlayer As Class_Player

Dim bIsPlayerObject As Boolean

Dim tpMatTemp1 As D3DMATRIX
Dim tpMatTemp2 As D3DMATRIX

Dim l As Long
Dim lPlayerIndex As Long
Dim lVertexCount As Long

Dim tpVecPlayerPosition As D3DVECTOR

    With clD3DDevice

        If Not lplKeyControlFlags(vbKeyQ) Then .Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, clScene.lBackgroundColour, 1#, 0
'        .Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, clScene.lBackgroundColour, 1#, 0
        
'        SetupLighting
        
        .BeginScene
    
'        SetupPixelFog D3DColorXRGB(1#, 1#, 1#), D3DFOG_LINEAR
        
        For l = 1 To clScene.Col_clGeoObjects.Count

            Set clCurrentObject = clScene.Col_clGeoObjects(l)
            
            bIsPlayerObject = LCase(Left(clCurrentObject.strName, 3)) = "pla"
            
            If bIsPlayerObject Then
            
                For lPlayerIndex = 1 To clGame.Col_clPlayers.Count
                
                    Set clPlayer = clGame.Col_clPlayers(lPlayerIndex)
                
                    If bShowPlayer Or clPlayer.lPlayerType <> ePT_LocalHuman Then
    
                        tpMatTemp1 = tpMatIdentity
                        
                        tpVecPlayerPosition = clPlayer.GetPosition
                        
                        D3DXMatrixTranslation tpMatTemp1, clCurrentObject.sgPositionX, -clCurrentObject.sgPositionZ, clCurrentObject.sgPositionY
                        
                        tpMatTemp2 = tpMatIdentity
                        D3DXMatrixRotationY tpMatTemp2, -clPlayer.sgAngleY * Const_sgDeg2Rad
                        D3DXMatrixMultiply tpMatTemp1, tpMatTemp1, tpMatTemp2
        
                        tpMatTemp2 = tpMatIdentity
                        D3DXMatrixTranslation tpMatTemp2, tpVecPlayerPosition.X, tpVecPlayerPosition.Y, tpVecPlayerPosition.Z
                        D3DXMatrixMultiply tpMatTemp1, tpMatTemp1, tpMatTemp2
                        
                        .SetTransform D3DTS_WORLD, tpMatTemp1
                        RenderGeoObject clCurrentObject

                    End If
                
                Next lPlayerIndex

            Else
                
                .SetTransform D3DTS_WORLD, tpMatIdentity
                RenderGeoObject clCurrentObject
                
            End If
    
        Next l

        DrawOverlay
        
        .EndScene
        
        .Present ByVal 0, ByVal 0, 0, ByVal 0

    End With

End Sub

Private Function CheckDisplayMode(Width As Long, Height As Long, Depth As Long) As CONST_D3DFORMAT

Dim i As Long
Dim tpUsedDispMode As D3DDISPLAYMODE
    
    For i = 0 To clSystem.D3D8.GetAdapterModeCount(0) - 1
        
        clSystem.D3D8.EnumAdapterModes 0, i, tpUsedDispMode
        
        If tpUsedDispMode.Width = Width Then
            
            If tpUsedDispMode.Height = Height Then
                
                If tpUsedDispMode.Format = D3DFMT_R5G6B5 Or D3DFMT_X1R5G5B5 Or D3DFMT_X4R4G4B4 Then
                    
                    '16 bit mode
                    If Depth = 16 Then
                        
                        CheckDisplayMode = tpUsedDispMode.Format
                        Exit Function
                    
                    End If
                
                ElseIf tpUsedDispMode.Format = D3DFMT_R8G8B8 Or D3DFMT_X8R8G8B8 Then
                    
                    '32bit mode
                    If Depth = 32 Then
                        
                        CheckDisplayMode = tpUsedDispMode.Format
                        Exit Function
                    
                    End If
            
                End If
            
            End If
        
        End If
    
    Next i

    CheckDisplayMode = D3DFMT_UNKNOWN

End Function

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyEscape Then
    
        If lMenuIndex = 0 Then
        
            lMenuIndex = 1
            lMenuSelectedItem = 0

        Else
        
            lMenuIndex = 0
        
        End If

    ElseIf lMenuIndex = 0 Then
    
'        If KeyCode = vbKeyE Then
'
'            clD3DDevice.SetRenderState D3DRS_LIGHTING, 1  'Enable lighting.
'
'        ElseIf KeyCode = vbKeyD Then
'
'            clD3DDevice.SetRenderState D3DRS_LIGHTING, 0  'Disable lighting.
'
'        ElseIf KeyCode = vbKeyW Then
'
'            clD3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME  'Set wireframe rendering.
'
'        ElseIf KeyCode = vbKeyS Then
'
'            clD3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID  'Set solid rendering.
'
'        Else

        If KeyCode = vbKeyC Then

            lCamMode = lCamMode + 1

            If lCamMode = 6 Then lCamMode = 0

        Else
        
            If lLocalPlayerHandle <> 0 Then
            
                clGame.Col_clPlayers("p" & lLocalPlayerHandle).lPlayerControlFlags = clGame.Col_clPlayers("p" & lLocalPlayerHandle).lPlayerControlFlags Or lplKeyControlFlags(KeyCode)
'                Debug.Print clGame.Col_clPlayers("p" & lLocalPlayerHandle).lPlayerControlFlags
                
            End If

        End If

    Else

        If KeyCode = vbKeyReturn Then
        
Dim lpstrArguments() As String

            lpstrArguments = Split(Col_clMenus(lMenuIndex).Item(lMenuSelectedItem + 1).strCommand, " ")

            If UBound(lpstrArguments) >= 0 Then

                Select Case lpstrArguments(0)
             
                    Case "exit"
    
                        clGame.RemoveAllPlayers
                        DeleteScene
    
                    Case "menu"
    
                        lMenuIndex = Val(lpstrArguments(1))
                        lMenuSelectedItem = 0
                        
                    Case "quit"
             
                        bRunning = False
                        clGame.RemoveAllPlayers
                        DeleteScene
                        
                    Case "single"
    
                        lMenuIndex = 0
                        DoEvents
                        StartSinglePlayerGame

                End Select
            
            End If
        
        ElseIf KeyCode = vbKeyDown Then
        
            lMenuSelectedItem = lMenuSelectedItem + 1
            
            If lMenuSelectedItem >= Col_clMenus(lMenuIndex).Count Then lMenuSelectedItem = 0
         
        ElseIf KeyCode = vbKeyUp Then

            lMenuSelectedItem = lMenuSelectedItem - 1
            
            If lMenuSelectedItem < 0 Then lMenuSelectedItem = Col_clMenus(lMenuIndex).Count - 1
         
        End If

    End If

End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)

'    lplKeyControlFlags(KeyCode) = False

    If lLocalPlayerHandle <> 0 Then clGame.Col_clPlayers("p" & lLocalPlayerHandle).lPlayerControlFlags = clGame.Col_clPlayers("p" & lLocalPlayerHandle).lPlayerControlFlags And Not lplKeyControlFlags(KeyCode)

End Sub

Private Sub Form_Load()

    Me.Show

    bRunning = Initialise()

    If bRunning Then

        SetupOverlay
        
        SetupKeyCommands
        SetupLighting
        
        If Form_Start.Check_Windowed.Value = 1 Then
        
            tpUsedDispMode.Width = Me.ScaleWidth
            tpUsedDispMode.Height = Me.ScaleHeight
        
        End If
        
        ConPrint Const_strConsoleTextLine + _
          Const_strConsoleTextLineIndent + "[c14]key commands:[c15][brk]" + _
          Const_strConsoleTextLine + _
          Const_strConsoleTextLineIndent + "        up ... accelerate forward[brk]" + _
          Const_strConsoleTextLineIndent + "      down ... accelerate backward[brk]" + _
          Const_strConsoleTextLineIndent + "left/right ... rotate steering wheel[brk]" + _
          Const_strConsoleTextLineIndent + "     space ... break[brk]" + _
          Const_strConsoleTextLineIndent + "     shift ... use horn[brk]" + _
          Const_strConsoleTextLineIndent + "         c ... change camera mode[brk]" + _
          Const_strConsoleTextLineIndent + "       esc ... show/hide menu[brk]" + _
          Const_strConsoleTextLine
          
'          Const_strConsoleTextLineIndent + "       w/s ... wireframe/solid render mode[brk]" + _
'          Const_strConsoleTextLineIndent + "       e/d ... enable/disable lighted shading[brk]" + _

        clSystem.DS8SetCooperativeLevel Form_D3D.hWnd

    End If
    
    MainLoop
    
    On Error Resume Next
    
    Set clD3DDevice = Nothing
'    Set D3D = Nothing
'    Set DX = Nothing
    
'    clDSSoundBuffer1.Stop
'    clDSSoundBuffer2.Stop
'    clDSSoundBuffer3.Stop
    
    Form_Start.Command_Start.Enabled = True
    Unload Me

    End

End Sub

Private Sub SetupLighting()

Dim lghtDirectional As D3DLIGHT8
Dim lghtSpot As D3DLIGHT8
Dim lghtPoint1 As D3DLIGHT8
Dim lghtPoint2 As D3DLIGHT8

Dim vecLight As D3DVECTOR

    With lghtDirectional
    
        .Type = D3DLIGHT_DIRECTIONAL
        .Direction = MakeVector(-0.4, -0.8, 0.2)
        .Position = MakeVector(1, 1, 1) ' shouldn't be left as 0
        .Range = 100 ' shouldn't be left as 0
        .diffuse = CreateD3DColorVal(1, 1, 1, 0.9) ' light yellow (sun) light
        .Ambient = .diffuse

    End With
    
    With lghtSpot
        
        .Type = D3DLIGHT_SPOT
        .Range = 30#
        .diffuse = CreateD3DColorVal(1, 0.95, 0.95, 1)
'        .Direction = MakeVector(Sin(clPlayer.sgAngleY / Const_sgRad2Deg), 0, -Cos(clPlayer.sgAngleY / Const_sgRad2Deg))
'        .Position = MakeVector(clPlayer.sgPosX, clPlayer.sgPosY + 1.5, clPlayer.sgPosZ)
        .Theta = 0.1 * Const_sgPi
        .Phi = 0.4 * Const_sgPi
        .Attenuation0 = 0.05
        .Attenuation1 = 0.05
        .Attenuation2 = 0
        
    End With

    With lghtPoint1
    
        .Type = D3DLIGHT_POINT
        .diffuse = CreateD3DColorVal(1, 1, 1, 0.95)
        .Position = MakeVector(-300, 100, -300)
        .Range = 500#
        .Attenuation0 = 0.01
        .Attenuation1 = 0.01 '1#
        .Attenuation2 = 0#
    
    End With
    
    With lghtPoint2
    
        .Type = D3DLIGHT_POINT
        .diffuse = CreateD3DColorVal(1, 1, 1, 0.95)
        .Position = MakeVector(300, 100, 300)
        .Range = 500#
        .Attenuation0 = 0.01
        .Attenuation1 = 0.01 '1#
        .Attenuation2 = 0#
    
    End With
    
    clD3DDevice.SetLight 0, lghtDirectional
'    clD3DDevice.SetLight 1, lghtSpot
'    clD3DDevice.SetLight 2, lghtPoint1
'    clD3DDevice.SetLight 3, lghtPoint2
    
    clD3DDevice.LightEnable 0, 1
'    clD3DDevice.LightEnable 1, 0
'    clD3DDevice.LightEnable 2, 0
'    clD3DDevice.LightEnable 3, 0
    
'    clD3DDevice.SetRenderState D3DRS_AMBIENT, RGB(160, 160, 160)
    clD3DDevice.SetRenderState D3DRS_AMBIENT, clScene.lAmbientLightColour

End Sub

Private Sub Form_Resize()

    Me.Caption = Const_strApplicationShortName + " - (" & Me.ScaleWidth & " x " & Me.ScaleHeight & ")"

    'tpUsedDispMode.Width = Me.ScaleWidth
    'tpUsedDispMode.Height = Me.ScaleHeight

End Sub

Sub SetupPixelFog(lColor As Long, fcMode As CONST_D3DFOGMODE)
    
Dim sgStartFog As Single
Dim sgEndFog As Single
Dim sgDensity As Single
    
    ' For linear mode
    sgStartFog = 1: sgEndFog = 2
    
    ' For exponential mode
    sgDensity = 0.8
'    sgDensity = 0.1
 
    ' Enable fog blending.
    clD3DDevice.SetRenderState D3DRS_FOGENABLE, 1
 
    ' Set the fog color.
    clD3DDevice.SetRenderState D3DRS_FOGCOLOR, lColor
    
    ' Set fog parameters.
    If fcMode = D3DFOG_LINEAR Then
    
        clD3DDevice.SetRenderState D3DRS_FOGVERTEXMODE, fcMode
        clD3DDevice.SetRenderState D3DRS_FOGTABLEMODE, fcMode
        clD3DDevice.SetRenderState D3DRS_FOGSTART, sgStartFog
        clD3DDevice.SetRenderState D3DRS_FOGEND, sgEndFog
        
    Else
    
        clD3DDevice.SetRenderState D3DRS_FOGVERTEXMODE, fcMode
        clD3DDevice.SetRenderState D3DRS_FOGTABLEMODE, fcMode
        clD3DDevice.SetRenderState D3DRS_FOGDENSITY, sgDensity

    End If

    clD3DDevice.SetRenderState D3DRS_RANGEFOGENABLE, 1

End Sub

Private Sub RenderGeoObject(clGeoObject As Class_GeoObject)

Dim clCurrentVertexBuffer As Direct3DVertexBuffer8
'Dim tpVertexBufferDescription As D3DVERTEXBUFFER_DESC

    With clD3DDevice

        On Local Error Resume Next
    
        .SetTexture 0, gCol_Geo_TexDiffuseTextures("t" & clGeoObject.lMaterialIndex)
    
        If Err.Number = 0 Then GoTo lblContinue
    
lblSetNoTex:
    
        .SetTexture 0, Nothing
    
lblContinue:
    
        On Error GoTo 0
        
        .SetMaterial lptpMatSceneMaterials(clGeoObject.lMaterialIndex)
    
        Set clCurrentVertexBuffer = clGeoObject.D3DVertexBuffer
    
        .SetStreamSource 0, clCurrentVertexBuffer, Len(tpDummyVertex)
        .DrawPrimitive D3DPT_TRIANGLELIST, 0, clGeoObject.lVertexCount / 3

    End With

End Sub

Public Function MainLoop()

    Do While bRunning
        
        clGame.MovePlayers
        RenderSounds
        
        If clGame.Col_clPlayers.Count > 1 Then Form_NetworkListen.SendPlayerData
        
        Render
        
        lFramesCount = lFramesCount + 1
        
        DoEvents
    
    Loop
    
End Function
1	VERSION 5.00
2	Begin VB.Form Form_D3D
3	BorderStyle = 5 'Sizable ToolWindow
4	Caption = "RRR"
5	ClientHeight = 7200
6	ClientLeft = 60
7	ClientTop = 345
8	ClientWidth = 9600
9	ClipControls = 0 'False
10	FillStyle = 0 'Solid
11	BeginProperty Font
12	Name = "Terminal"
13	Size = 6
14	Charset = 255
15	Weight = 700
16	Underline = 0 'False
17	Italic = 0 'False
18	Strikethrough = 0 'False
19	EndProperty
20	KeyPreview = -1 'True
21	MinButton = 0 'False
22	ScaleHeight = 480
23	ScaleMode = 3 'Pixel
24	ScaleWidth = 640
25	ShowInTaskbar = 0 'False
26	StartUpPosition = 3 'Windows Default
27	Begin VB.PictureBox Picture_TrackMap
28	Appearance = 0 'Flat
29	AutoSize = -1 'True
30	BackColor = &H80000005&
31	BorderStyle = 0 'None
32	ClipControls = 0 'False
33	FillStyle = 0 'Solid
34	ForeColor = &H80000008&
35	Height = 6000
36	Left = 0
37	ScaleHeight = 400
38	ScaleMode = 3 'Pixel
39	ScaleWidth = 400
40	TabIndex = 0
41	Top = 0
42	Visible = 0 'False
43	Width = 6000
44	End
45	End
46	Attribute VB_Name = "Form_D3D"
47	Attribute VB_GlobalNameSpace = False
48	Attribute VB_Creatable = False
49	Attribute VB_PredeclaredId = True
50	Attribute VB_Exposed = False
51	Option Explicit
52	'
53
54	Public Function Initialise() As Boolean
55
56	Dim lAdapter As Long
57	Dim lD3DCreateFlags As CONST_D3DCREATEFLAGS
58
59	Dim fcDevCaps As D3DCAPS8
60
61	Dim matProjection As D3DMATRIX
62
63	lAdapter = D3DADAPTER_DEFAULT
64
65	On Error GoTo ErrHandler
66
67	ConPrint Const_strConsoleBlockTitlePre + "testing device features:" + Const_strConsoleBlockTitlePost
68	ConPrint " " & clSystem.D3D8.GetAdapterCount & " display adapter(s) found.[brk][brk]"
69
70	With tpD3DPresentParameters
71
72	If Form_Start.Check_Windowed.Value = 1 Then
73
74	clSystem.D3D8.GetAdapterDisplayMode lAdapter, tpUsedDispMode
75
76	.BackBufferCount = 1
77	.BackBufferFormat = tpUsedDispMode.Format
78
79	.Windowed = 1
80
81	Else
82
83	clSystem.D3D8.EnumAdapterModes 0, Form_Start.Combo_RefreshRate.ItemData(Form_Start.Combo_RefreshRate.ListIndex), tpUsedDispMode
84
85	.BackBufferCount = 1
86	.BackBufferFormat = tpUsedDispMode.Format
87	.BackBufferWidth = tpUsedDispMode.Width
88	.BackBufferHeight = tpUsedDispMode.Height
89	.FullScreen_RefreshRateInHz = tpUsedDispMode.RefreshRate
90	' .FullScreen_PresentationInterval = 0
91
92	End If
93
94	.hDeviceWindow = Form_D3D.hWnd
95
96	.AutoDepthStencilFormat = D3DFMT_D16
97	.EnableAutoDepthStencil = 1
98
99	' .SwapEffect = D3DSWAPEFFECT_FLIP
100
101	If Form_Start.Check_Antialias.Value = 1 Then
102
103	.SwapEffect = D3DSWAPEFFECT_DISCARD
104
105	If Form_Start.Option_MultisampleType2.Value = True Then
106
107	If clSystem.D3D8.CheckDeviceMultiSampleType(lAdapter, D3DDEVTYPE_HAL, D3DFMT_R8G8B8, .Windowed, D3DMULTISAMPLE_2_SAMPLES) Then .MultiSampleType = D3DMULTISAMPLE_2_SAMPLES
108
109	ElseIf Form_Start.Option_MultisampleType4.Value = True Then
110
111	If clSystem.D3D8.CheckDeviceMultiSampleType(lAdapter, D3DDEVTYPE_HAL, D3DFMT_R8G8B8, .Windowed, D3DMULTISAMPLE_4_SAMPLES) Then .MultiSampleType = D3DMULTISAMPLE_4_SAMPLES
112
113	End If
114
115	Else
116
117	.SwapEffect = D3DSWAPEFFECT_COPY '_VSYNC
118
119	End If
120
121	If .MultiSampleType > D3DMULTISAMPLE_NONE Then
122
123	ConPrint " antialiasing type is [c02]" & .MultiSampleType & "x multisampling[c07].[brk]"
124
125	Else
126
127	ConPrint " antialiasing is [c12]deactivated[c07].[brk]"
128
129	End If
130
131	End With
132
133	'############################
134	'## CHECK THE DEVICE CAPABILITIES ##
135	'###########################
136
137	On Local Error Resume Next
138
139	clSystem.D3D8.GetDeviceCaps lAdapter, D3DDEVTYPE_HAL, fcDevCaps
140
141	If Err.Number = D3DERR_INVALIDDEVICE Then
142
143	'We couldn't get data from the hardware device - probably doesn't exist...
144	clSystem.D3D8.GetDeviceCaps lAdapter, D3DDEVTYPE_REF, fcDevCaps
145	Err.Clear ' Remove the error value..
146
147	End If
148
149	ConPrint " hardware transform and lighting... "
150
151	'...for Hardware vertex processing:
152	If (fcDevCaps.DevCaps And D3DDEVCAPS_HWTRANSFORMANDLIGHT) Then
153
154	lD3DCreateFlags = D3DCREATE_HARDWARE_VERTEXPROCESSING
155	ConPrint Const_strConsoleTextOK
156
157	Else
158
159	lD3DCreateFlags = D3DCREATE_SOFTWARE_VERTEXPROCESSING
160	ConPrint Const_strConsoleTextFail
161
162	End If
163
164	ConPrint " pure device support... "
165
166	'...for Pure Device processing:
167	If (fcDevCaps.DevCaps And D3DDEVCAPS_PUREDEVICE) Then
168
169	lD3DCreateFlags = lD3DCreateFlags Or D3DCREATE_PUREDEVICE
170	ConPrint Const_strConsoleTextOK
171
172	Else
173
174	ConPrint Const_strConsoleTextFail
175
176	End If
177
178	Dim fcPRasterCapsFlags As CONST_D3DPRASTERCAPSFLAGS
179
180	fcPRasterCapsFlags = fcDevCaps.RasterCaps
181
182	ConPrint " colour dithering... "
183
184	If (fcPRasterCapsFlags And D3DPRASTERCAPS_DITHER) Then ConPrint Const_strConsoleTextOK Else ConPrint Const_strConsoleTextFail
185
186	fcPRasterCapsFlags = fcDevCaps.RasterCaps
187
188	ConPrint " anisotropic filtering... "
189
190	If (fcPRasterCapsFlags And D3DPRASTERCAPS_ANISOTROPY) Then ConPrint Const_strConsoleTextOK Else ConPrint Const_strConsoleTextFail
191
192	ConPrint " edge antialiasing... "
193
194	If (fcPRasterCapsFlags And D3DPRASTERCAPS_ANTIALIASEDGES) Then ConPrint Const_strConsoleTextOK Else ConPrint Const_strConsoleTextFail
195
196	ConPrint " range-based fog... "
197
198	If (fcPRasterCapsFlags And D3DPRASTERCAPS_FOGRANGE) Then ConPrint Const_strConsoleTextOK Else ConPrint Const_strConsoleTextFail
199
200	' This line creates a device that uses a hardware device if possible; software vertex processing and uses the form as it's target
201	Set clD3DDevice = clSystem.D3D8.CreateDevice(lAdapter, D3DDEVTYPE_HAL, Form_D3D.hWnd, lD3DCreateFlags, tpD3DPresentParameters)
202
203	' Configure the rendering device
204	clD3DDevice.SetVertexShader Const_lFVF_Vertex '//Tell it what type of vertex we are using
205	clD3DDevice.SetRenderState D3DRS_LIGHTING, 1 '//Enable lighting.
206	clD3DDevice.SetRenderState D3DRS_ZENABLE, 1
207	clD3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE
208
209	If tpD3DPresentParameters.MultiSampleType > 0 Then clD3DDevice.SetRenderState D3DRS_MULTISAMPLE_ANTIALIAS, 1
210
211	' clD3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, 1
212	' clD3DDevice.SetRenderState D3DRS_RANGEFOGENABLE, 1
213
214	' clD3DDevice.SetRenderState D3DRS_DITHERENABLE, True
215	' clD3DDevice.SetRenderState D3DRS_EDGEANTIALIAS, True
216	' clD3DDevice.SetRenderState D3DRS_SPECULARENABLE, True
217	' clD3DDevice.SetRenderState D3DRS_FOGENABLE, True
218
219	'//configure the world matrices
220
221	'//1. The World Matrix
222	' D3DXMatrixIdentity matWorld
223	clD3DDevice.SetTransform D3DTS_WORLD, tpMatIdentity 'commit this matrix to the device
224
225	'//3. The projection Matrix
226	D3DXMatrixPerspectiveFovLH matProjection, 0.3 * Const_sgPi, tpUsedDispMode.Height / tpUsedDispMode.Width, 0.1, 300
227	clD3DDevice.SetTransform D3DTS_PROJECTION, matProjection
228
229	Initialise = True '//We succeeded
230
231	ConPrint "[brk]"
232
233	Exit Function
234
235	ErrHandler:
236
237	Initialise = False
238	ConPrint "[brk][c03]error returned:[brk]no. " & Err.Number & ": " + Err.Description + "[c15][brk]"
239
240	End Function
241
242	Public Sub Render()
243
244	Dim clCurrentObject As Class_GeoObject
245	Dim clPlayer As Class_Player
246
247	Dim bIsPlayerObject As Boolean
248
249	Dim tpMatTemp1 As D3DMATRIX
250	Dim tpMatTemp2 As D3DMATRIX
251
252	Dim l As Long
253	Dim lPlayerIndex As Long
254	Dim lVertexCount As Long
255
256	Dim tpVecPlayerPosition As D3DVECTOR
257
258	With clD3DDevice
259
260	If Not lplKeyControlFlags(vbKeyQ) Then .Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, clScene.lBackgroundColour, 1#, 0
261	' .Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, clScene.lBackgroundColour, 1#, 0
262
263	' SetupLighting
264
265	.BeginScene
266
267	' SetupPixelFog D3DColorXRGB(1#, 1#, 1#), D3DFOG_LINEAR
268
269	For l = 1 To clScene.Col_clGeoObjects.Count
270
271	Set clCurrentObject = clScene.Col_clGeoObjects(l)
272
273	bIsPlayerObject = LCase(Left(clCurrentObject.strName, 3)) = "pla"
274
275	If bIsPlayerObject Then
276
277	For lPlayerIndex = 1 To clGame.Col_clPlayers.Count
278
279	Set clPlayer = clGame.Col_clPlayers(lPlayerIndex)
280
281	If bShowPlayer Or clPlayer.lPlayerType <> ePT_LocalHuman Then
282
283	tpMatTemp1 = tpMatIdentity
284
285	tpVecPlayerPosition = clPlayer.GetPosition
286
287	D3DXMatrixTranslation tpMatTemp1, clCurrentObject.sgPositionX, -clCurrentObject.sgPositionZ, clCurrentObject.sgPositionY
288
289	tpMatTemp2 = tpMatIdentity
290	D3DXMatrixRotationY tpMatTemp2, -clPlayer.sgAngleY * Const_sgDeg2Rad
291	D3DXMatrixMultiply tpMatTemp1, tpMatTemp1, tpMatTemp2
292
293	tpMatTemp2 = tpMatIdentity
294	D3DXMatrixTranslation tpMatTemp2, tpVecPlayerPosition.X, tpVecPlayerPosition.Y, tpVecPlayerPosition.Z
295	D3DXMatrixMultiply tpMatTemp1, tpMatTemp1, tpMatTemp2
296
297	.SetTransform D3DTS_WORLD, tpMatTemp1
298	RenderGeoObject clCurrentObject
299
300	End If
301
302	Next lPlayerIndex
303
304	Else
305
306	.SetTransform D3DTS_WORLD, tpMatIdentity
307	RenderGeoObject clCurrentObject
308
309	End If
310
311	Next l
312
313	DrawOverlay
314
315	.EndScene
316
317	.Present ByVal 0, ByVal 0, 0, ByVal 0
318
319	End With
320
321	End Sub
322
323	Private Function CheckDisplayMode(Width As Long, Height As Long, Depth As Long) As CONST_D3DFORMAT
324
325	Dim i As Long
326	Dim tpUsedDispMode As D3DDISPLAYMODE
327
328	For i = 0 To clSystem.D3D8.GetAdapterModeCount(0) - 1
329
330	clSystem.D3D8.EnumAdapterModes 0, i, tpUsedDispMode
331
332	If tpUsedDispMode.Width = Width Then
333
334	If tpUsedDispMode.Height = Height Then
335
336	If tpUsedDispMode.Format = D3DFMT_R5G6B5 Or D3DFMT_X1R5G5B5 Or D3DFMT_X4R4G4B4 Then
337
338	'16 bit mode
339	If Depth = 16 Then
340
341	CheckDisplayMode = tpUsedDispMode.Format
342	Exit Function
343
344	End If
345
346	ElseIf tpUsedDispMode.Format = D3DFMT_R8G8B8 Or D3DFMT_X8R8G8B8 Then
347
348	'32bit mode
349	If Depth = 32 Then
350
351	CheckDisplayMode = tpUsedDispMode.Format
352	Exit Function
353
354	End If
355
356	End If
357
358	End If
359
360	End If
361
362	Next i
363
364	CheckDisplayMode = D3DFMT_UNKNOWN
365
366	End Function
367
368	Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
369
370	If KeyCode = vbKeyEscape Then
371
372	If lMenuIndex = 0 Then
373
374	lMenuIndex = 1
375	lMenuSelectedItem = 0
376
377	Else
378
379	lMenuIndex = 0
380
381	End If
382
383	ElseIf lMenuIndex = 0 Then
384
385	' If KeyCode = vbKeyE Then
386	'
387	' clD3DDevice.SetRenderState D3DRS_LIGHTING, 1 'Enable lighting.
388	'
389	' ElseIf KeyCode = vbKeyD Then
390	'
391	' clD3DDevice.SetRenderState D3DRS_LIGHTING, 0 'Disable lighting.
392	'
393	' ElseIf KeyCode = vbKeyW Then
394	'
395	' clD3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME 'Set wireframe rendering.
396	'
397	' ElseIf KeyCode = vbKeyS Then
398	'
399	' clD3DDevice.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID 'Set solid rendering.
400	'
401	' Else
402
403	If KeyCode = vbKeyC Then
404
405	lCamMode = lCamMode + 1
406
407	If lCamMode = 6 Then lCamMode = 0
408
409	Else
410
411	If lLocalPlayerHandle <> 0 Then
412
413	clGame.Col_clPlayers("p" & lLocalPlayerHandle).lPlayerControlFlags = clGame.Col_clPlayers("p" & lLocalPlayerHandle).lPlayerControlFlags Or lplKeyControlFlags(KeyCode)
414	' Debug.Print clGame.Col_clPlayers("p" & lLocalPlayerHandle).lPlayerControlFlags
415
416	End If
417
418	End If
419
420	Else
421
422	If KeyCode = vbKeyReturn Then
423
424	Dim lpstrArguments() As String
425
426	lpstrArguments = Split(Col_clMenus(lMenuIndex).Item(lMenuSelectedItem + 1).strCommand, " ")
427
428	If UBound(lpstrArguments) >= 0 Then
429
430	Select Case lpstrArguments(0)
431
432	Case "exit"
433
434	clGame.RemoveAllPlayers
435	DeleteScene
436
437	Case "menu"
438
439	lMenuIndex = Val(lpstrArguments(1))
440	lMenuSelectedItem = 0
441
442	Case "quit"
443
444	bRunning = False
445	clGame.RemoveAllPlayers
446	DeleteScene
447
448	Case "single"
449
450	lMenuIndex = 0
451	DoEvents
452	StartSinglePlayerGame
453
454	End Select
455
456	End If
457
458	ElseIf KeyCode = vbKeyDown Then
459
460	lMenuSelectedItem = lMenuSelectedItem + 1
461
462	If lMenuSelectedItem >= Col_clMenus(lMenuIndex).Count Then lMenuSelectedItem = 0
463
464	ElseIf KeyCode = vbKeyUp Then
465
466	lMenuSelectedItem = lMenuSelectedItem - 1
467
468	If lMenuSelectedItem < 0 Then lMenuSelectedItem = Col_clMenus(lMenuIndex).Count - 1
469
470	End If
471
472	End If
473
474	End Sub
475
476	Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
477
478	' lplKeyControlFlags(KeyCode) = False
479
480	If lLocalPlayerHandle <> 0 Then clGame.Col_clPlayers("p" & lLocalPlayerHandle).lPlayerControlFlags = clGame.Col_clPlayers("p" & lLocalPlayerHandle).lPlayerControlFlags And Not lplKeyControlFlags(KeyCode)
481
482	End Sub
483
484	Private Sub Form_Load()
485
486	Me.Show
487
488	bRunning = Initialise()
489
490	If bRunning Then
491
492	SetupOverlay
493
494	SetupKeyCommands
495	SetupLighting
496
497	If Form_Start.Check_Windowed.Value = 1 Then
498
499	tpUsedDispMode.Width = Me.ScaleWidth
500	tpUsedDispMode.Height = Me.ScaleHeight
501
502	End If
503
504	ConPrint Const_strConsoleTextLine + _
505	Const_strConsoleTextLineIndent + "[c14]key commands:[c15][brk]" + _
506	Const_strConsoleTextLine + _
507	Const_strConsoleTextLineIndent + " up ... accelerate forward[brk]" + _
508	Const_strConsoleTextLineIndent + " down ... accelerate backward[brk]" + _
509	Const_strConsoleTextLineIndent + "left/right ... rotate steering wheel[brk]" + _
510	Const_strConsoleTextLineIndent + " space ... break[brk]" + _
511	Const_strConsoleTextLineIndent + " shift ... use horn[brk]" + _
512	Const_strConsoleTextLineIndent + " c ... change camera mode[brk]" + _
513	Const_strConsoleTextLineIndent + " esc ... show/hide menu[brk]" + _
514	Const_strConsoleTextLine
515
516	' Const_strConsoleTextLineIndent + " w/s ... wireframe/solid render mode[brk]" + _
517	' Const_strConsoleTextLineIndent + " e/d ... enable/disable lighted shading[brk]" + _
518
519	clSystem.DS8SetCooperativeLevel Form_D3D.hWnd
520
521	End If
522
523	MainLoop
524
525	On Error Resume Next
526
527	Set clD3DDevice = Nothing
528	' Set D3D = Nothing
529	' Set DX = Nothing
530
531	' clDSSoundBuffer1.Stop
532	' clDSSoundBuffer2.Stop
533	' clDSSoundBuffer3.Stop
534
535	Form_Start.Command_Start.Enabled = True
536	Unload Me
537
538	End
539
540	End Sub
541
542	Private Sub SetupLighting()
543
544	Dim lghtDirectional As D3DLIGHT8
545	Dim lghtSpot As D3DLIGHT8
546	Dim lghtPoint1 As D3DLIGHT8
547	Dim lghtPoint2 As D3DLIGHT8
548
549	Dim vecLight As D3DVECTOR
550
551	With lghtDirectional
552
553	.Type = D3DLIGHT_DIRECTIONAL
554	.Direction = MakeVector(-0.4, -0.8, 0.2)
555	.Position = MakeVector(1, 1, 1) ' shouldn't be left as 0
556	.Range = 100 ' shouldn't be left as 0
557	.diffuse = CreateD3DColorVal(1, 1, 1, 0.9) ' light yellow (sun) light
558	.Ambient = .diffuse
559
560	End With
561
562	With lghtSpot
563
564	.Type = D3DLIGHT_SPOT
565	.Range = 30#
566	.diffuse = CreateD3DColorVal(1, 0.95, 0.95, 1)
567	' .Direction = MakeVector(Sin(clPlayer.sgAngleY / Const_sgRad2Deg), 0, -Cos(clPlayer.sgAngleY / Const_sgRad2Deg))
568	' .Position = MakeVector(clPlayer.sgPosX, clPlayer.sgPosY + 1.5, clPlayer.sgPosZ)
569	.Theta = 0.1 * Const_sgPi
570	.Phi = 0.4 * Const_sgPi
571	.Attenuation0 = 0.05
572	.Attenuation1 = 0.05
573	.Attenuation2 = 0
574
575	End With
576
577	With lghtPoint1
578
579	.Type = D3DLIGHT_POINT
580	.diffuse = CreateD3DColorVal(1, 1, 1, 0.95)
581	.Position = MakeVector(-300, 100, -300)
582	.Range = 500#
583	.Attenuation0 = 0.01
584	.Attenuation1 = 0.01 '1#
585	.Attenuation2 = 0#
586
587	End With
588
589	With lghtPoint2
590
591	.Type = D3DLIGHT_POINT
592	.diffuse = CreateD3DColorVal(1, 1, 1, 0.95)
593	.Position = MakeVector(300, 100, 300)
594	.Range = 500#
595	.Attenuation0 = 0.01
596	.Attenuation1 = 0.01 '1#
597	.Attenuation2 = 0#
598
599	End With
600
601	clD3DDevice.SetLight 0, lghtDirectional
602	' clD3DDevice.SetLight 1, lghtSpot
603	' clD3DDevice.SetLight 2, lghtPoint1
604	' clD3DDevice.SetLight 3, lghtPoint2
605
606	clD3DDevice.LightEnable 0, 1
607	' clD3DDevice.LightEnable 1, 0
608	' clD3DDevice.LightEnable 2, 0
609	' clD3DDevice.LightEnable 3, 0
610
611	' clD3DDevice.SetRenderState D3DRS_AMBIENT, RGB(160, 160, 160)
612	clD3DDevice.SetRenderState D3DRS_AMBIENT, clScene.lAmbientLightColour
613
614	End Sub
615
616	Private Sub Form_Resize()
617
618	Me.Caption = Const_strApplicationShortName + " - (" & Me.ScaleWidth & " x " & Me.ScaleHeight & ")"
619
620	'tpUsedDispMode.Width = Me.ScaleWidth
621	'tpUsedDispMode.Height = Me.ScaleHeight
622
623	End Sub
624
625	Sub SetupPixelFog(lColor As Long, fcMode As CONST_D3DFOGMODE)
626
627	Dim sgStartFog As Single
628	Dim sgEndFog As Single
629	Dim sgDensity As Single
630
631	' For linear mode
632	sgStartFog = 1: sgEndFog = 2
633
634	' For exponential mode
635	sgDensity = 0.8
636	' sgDensity = 0.1
637
638	' Enable fog blending.
639	clD3DDevice.SetRenderState D3DRS_FOGENABLE, 1
640
641	' Set the fog color.
642	clD3DDevice.SetRenderState D3DRS_FOGCOLOR, lColor
643
644	' Set fog parameters.
645	If fcMode = D3DFOG_LINEAR Then
646
647	clD3DDevice.SetRenderState D3DRS_FOGVERTEXMODE, fcMode
648	clD3DDevice.SetRenderState D3DRS_FOGTABLEMODE, fcMode
649	clD3DDevice.SetRenderState D3DRS_FOGSTART, sgStartFog
650	clD3DDevice.SetRenderState D3DRS_FOGEND, sgEndFog
651
652	Else
653
654	clD3DDevice.SetRenderState D3DRS_FOGVERTEXMODE, fcMode
655	clD3DDevice.SetRenderState D3DRS_FOGTABLEMODE, fcMode
656	clD3DDevice.SetRenderState D3DRS_FOGDENSITY, sgDensity
657
658	End If
659
660	clD3DDevice.SetRenderState D3DRS_RANGEFOGENABLE, 1
661
662	End Sub
663
664	Private Sub RenderGeoObject(clGeoObject As Class_GeoObject)
665
666	Dim clCurrentVertexBuffer As Direct3DVertexBuffer8
667	'Dim tpVertexBufferDescription As D3DVERTEXBUFFER_DESC
668
669	With clD3DDevice
670
671	On Local Error Resume Next
672
673	.SetTexture 0, gCol_Geo_TexDiffuseTextures("t" & clGeoObject.lMaterialIndex)
674
675	If Err.Number = 0 Then GoTo lblContinue
676
677	lblSetNoTex:
678
679	.SetTexture 0, Nothing
680
681	lblContinue:
682
683	On Error GoTo 0
684
685	.SetMaterial lptpMatSceneMaterials(clGeoObject.lMaterialIndex)
686
687	Set clCurrentVertexBuffer = clGeoObject.D3DVertexBuffer
688
689	.SetStreamSource 0, clCurrentVertexBuffer, Len(tpDummyVertex)
690	.DrawPrimitive D3DPT_TRIANGLELIST, 0, clGeoObject.lVertexCount / 3
691
692	End With
693
694	End Sub
695
696	Public Function MainLoop()
697
698	Do While bRunning
699
700	clGame.MovePlayers
701	RenderSounds
702
703	If clGame.Col_clPlayers.Count > 1 Then Form_NetworkListen.SendPlayerData
704
705	Render
706
707	lFramesCount = lFramesCount + 1
708
709	DoEvents
710
711	Loop
712
713	End Function
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26