d3d 7 light og textures
Jeg sidder med det her eksempel fra en tutorial som jeg har rodet lidt med og lavet om på, men jeg kan ikke finde ud af at sætte lys på. Jeg har fundet tutorials om lys, men af en eller anden grund kan jeg ikke få det til at virke. En enkelt bemærkning eller et eksempel om textures er også velkommen. Hvis nogen lægger et svar med både lys og textures som virker så kan vi nok finde ud af nogle flere point. De 60 er primært for lyset.her kommer hele baduljen som ligger i formen frm:
------------------------------------------------
Option Explicit
Private Const pi As Single = 3.14159265
Private m_dx As DirectX7
Private m_dd As DirectDraw7
Private m_ddPrimarySurface As DirectDrawSurface7
Private m_ddRenderSurface As DirectDrawSurface7
Private m_d3d As Direct3D7
Private m_d3dDevice As Direct3DDevice7
Dim bricks As D3DMATERIAL7
Dim grass As D3DMATERIAL7
Dim dirt As D3DMATERIAL7
Dim roof As D3DMATERIAL7
\' This is an array because we need to pass an array to
\' m_d3dDevice.Clear.
Private m_ViewportRect(0) As D3DRECT
\' True while the program should redraw the triangle.
Private m_Running As Boolean
\' The vertices we will draw.
Private m_NumVertices As Integer
Private m_Vertex() As D3DVERTEX
Private m_VertexClr() As Byte
\' Picture dimensions.
Private m_PictureRect As RECT
\' Rendering surface dimensions.
Private m_RenderRect As RECT
\' The camera\'s position.
Private m_CameraR As Double
Private m_CameraTheta As Double
Private m_CameraDTheta As Double
Private m_CameraY As Double
\'temp
\' Add a triangle to the list.
Private Sub MakeTriangle(ByVal x1 As Single, ByVal y1 As Single, ByVal z1 As Single, ByVal x2 As Single, ByVal y2 As Single, ByVal z2 As Single, ByVal x3 As Single, ByVal y3 As Single, ByVal z3 As Single, color As Byte)
\' Add room for the triangle\'s three vertices.
m_NumVertices = m_NumVertices + 3
ReDim Preserve m_Vertex(1 To m_NumVertices)
ReDim Preserve m_VertexClr(1 To m_NumVertices / 3)
m_VertexClr(m_NumVertices / 3) = color
\' Make the vertices.
With m_Vertex(m_NumVertices - 2)
.x = x1
.y = y1
.z = z1
End With
With m_Vertex(m_NumVertices - 1)
.x = x2
.y = y2
.z = z2
End With
With m_Vertex(m_NumVertices)
.x = x3
.y = y3
.z = z3
End With
End Sub
\' Display the scene.
Private Sub RenderLoop()
Dim status As Long
m_Running = True
Do While m_Running
\' Draw the objects.
RenderObjects
\' Display the results.
status = m_ddPrimarySurface.Blt(m_PictureRect, m_ddRenderSurface, m_RenderRect, DDBLT_WAIT)
If status <> DD_OK Then
MsgBox \"Error \" & Format$(status) & \" displaying the scene.\"
m_Running = False
End If
DoEvents
Loop
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
m_Running = False
frm.Hide
Unload frm
End If
If KeyCode = vbKeyUp Then
m_CameraY = m_CameraY + 1
End If
If KeyCode = vbKeyDown Then
m_CameraY = m_CameraY - 1
End If
If KeyCode = vbKeyLeft Then
m_CameraTheta = m_CameraTheta - 0.1
End If
If KeyCode = vbKeyRight Then
m_CameraTheta = m_CameraTheta + 0.1
End If
If KeyCode = vbKeyA And m_CameraR > 5 Then
m_CameraR = m_CameraR - 0.5
End If
If KeyCode = vbKeyZ Then
m_CameraR = m_CameraR + 0.5
End If
End Sub
Private Sub Form_Load()
\' Initialize DirectDraw.
InitializeDirectDraw
\' Initialize Direct3D.
InitializeDirect3D
\' Initialize the scene.
InitializeScene
\' Initialize the objects we will display.
InitializeObjects
Show
\' Display the scene rotating.
RenderLoop
\' End.
Unload Me
End Sub
\' Draw the objects.
Private Sub RenderObjects()
Dim clr As Single
Dim camera_x As Double
Dim camera_z As Double
Dim matrix_camera As D3DMATRIX
Dim i As Integer
Dim num_triangles As Integer
\' Clear the viewport.
m_d3dDevice.Clear 1, m_ViewportRect(), D3DCLEAR_TARGET, _
m_dx.CreateColorRGB(0#, 0#, 0#), 1, 0
\' Begin the scene.
m_d3dDevice.BeginScene
\' Set the color for the first triangle and the color increment.
clr = 0.6
\' Set the viewing position.
camera_x = m_CameraR * Cos(m_CameraTheta)
camera_z = m_CameraR * Sin(m_CameraTheta)
m_dx.ViewMatrix matrix_camera, _
MakeVector(camera_z, m_CameraY, -camera_x), _
MakeVector(0, 3, 0), MakeVector(0, 1, 0), 0
m_d3dDevice.SetTransform D3DTRANSFORMSTATE_VIEW, matrix_camera
\' Draw the triangles.
num_triangles = m_NumVertices \\ 3
For i = 1 To num_triangles
\'load the color
Select Case m_VertexClr(i)
Case 0
m_d3dDevice.SetMaterial dirt
Case 1
m_d3dDevice.SetMaterial grass
Case 2
m_d3dDevice.SetMaterial bricks
Case 3
m_d3dDevice.SetMaterial roof
End Select
\' Set the ambient color to the next shade of orange.
\' Draw the triangle.
m_d3dDevice.DrawPrimitive D3DPT_TRIANGLELIST, _
D3DFVF_VERTEX, m_Vertex((i - 1) * 3 + 1), 3, D3DDP_DEFAULT
Next i
\' End the scene.
On Error Resume Next
m_d3dDevice.EndScene
End Sub
\' Initalize DirectDraw.
Private Sub InitializeDirectDraw()
Dim surf_desc As DDSURFACEDESC2
\' Create the DirectDraw object and set cooperative level.
Set m_dx = New DirectX7
Set m_dd = m_dx.DirectDrawCreate(\"\")
m_dd.SetCooperativeLevel frm.hWnd, DDSCL_NORMAL
\' Create the primary drawing surface.
surf_desc.lFlags = DDSD_CAPS
surf_desc.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
Set m_ddPrimarySurface = m_dd.CreateSurface(surf_desc)
\' Save the picture\'s size for later use.
m_dx.GetWindowRect frm.hWnd, m_PictureRect
\' Create the render surface making it fit frm.
\' Specify system memory because we may use the RGB rasterizer.
surf_desc.lFlags = DDSD_HEIGHT Or DDSD_WIDTH Or DDSD_CAPS
surf_desc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_3DDEVICE Or DDSCAPS_SYSTEMMEMORY
surf_desc.lWidth = m_PictureRect.Right - m_PictureRect.Left
surf_desc.lHeight = m_PictureRect.Bottom - m_PictureRect.Top
Set m_ddRenderSurface = m_dd.CreateSurface(surf_desc)
\' Save the size of the render surface for later use.
With m_RenderRect
.Left = 0
.Top = 0
.Bottom = surf_desc.lHeight
.Right = surf_desc.lWidth
End With
\' Save a reference to the Direct3D object.
Set m_d3d = m_dd.GetDirect3D
End Sub
\' Initalize Direct3D.
Private Sub InitializeDirect3D()
Dim surf_desc As DDSURFACEDESC2
Dim viewport_desc As D3DVIEWPORT7
\' Ensure that the display mode uses greater than 8-bit color.
m_dd.GetDisplayMode surf_desc
If surf_desc.ddpfPixelFormat.lRGBBitCount <= 8 Then
MsgBox \"This program requires a color mode higher than 8-bit.\"
End
End If
\' Create the Direct3D device. Try for IID_IDirect3DHALDevice
\' first and IID_IDirect3DRGBDevice if it isn\'t available.
On Error Resume Next
Set m_d3dDevice = m_d3d.CreateDevice(\"IID_IDirect3DHALDevice\", m_ddRenderSurface)
If m_d3dDevice Is Nothing Then
Set m_d3dDevice = m_d3d.CreateDevice(\"IID_IDirect3DRGBDevice\", m_ddRenderSurface)
End If
If m_d3dDevice Is Nothing Then
\' We failed to create a device.
MsgBox \"Could not create a Direct3D device.\"
End
End If
\' Define the viewport rectangle.
With viewport_desc
.lWidth = m_PictureRect.Right - m_PictureRect.Left
.lHeight = m_PictureRect.Bottom - m_PictureRect.Top
.minz = 0#
.maxz = 1#
End With
m_d3dDevice.SetViewport viewport_desc
\' Save the viewport rectangle for later use.
With m_ViewportRect(0)
.x1 = 0
.y1 = 0
.x2 = viewport_desc.lWidth
.y2 = viewport_desc.lHeight
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
m_Running = False
End Sub
\' Initalize the scene (lighting, material, etc).
Private Sub InitializeScene()
Static matrix_projection As D3DMATRIX
With bricks
.Ambient.r = 1
.Ambient.g = 0
.Ambient.b = 0
.diffuse.r = 1
.diffuse.g = 0
.diffuse.b = 0
End With
With roof
.Ambient.r = 1
.Ambient.g = 1
.Ambient.b = 0
.diffuse.r = 1
.diffuse.g = 1
.diffuse.b = 0
End With
With dirt
.Ambient.r = 1
.Ambient.g = 1
.Ambient.b = 0
.diffuse.r = 1
.diffuse.g = 1
.diffuse.b = 0
End With
With grass
.Ambient.r = 0
.Ambient.g = 1
.Ambient.b = 0
.diffuse.r = 0
.diffuse.g = 1
.diffuse.b = 0
End With
m_d3dDevice.SetMaterial grass
\' Define the projection\'s clipping planes.
m_dx.ProjectionMatrix matrix_projection, 1, 10000, pi / 2
m_d3dDevice.SetTransform D3DTRANSFORMSTATE_PROJECTION, matrix_projection
\' Initialize the viewing position variables so the point
\' (4, 3, -20) is on the viewpoint\'s path.
m_CameraR = Sqr(20 * 20)
m_CameraTheta = 0
m_CameraY = 3
m_d3dDevice.SetRenderState D3DRENDERSTATE_AMBIENT, m_dx.CreateColorRGBA(0.2, 0.2, 0.2, 0)
m_d3dDevice.LightEnable 0, True
m_d3dDevice.SetRenderState D3DRENDERSTATE_LIGHTING, True
m_d3dDevice.SetRenderState D3DRENDERSTATE_SHADEMODE, D3DSHADE_GOURAUD
End Sub
\' Initalize the objects we will display.
Private Sub InitializeObjects()
\'gulv
MakeTriangle -10, 0, -10, -10, 0, 10, 10, 0, 10, 1 \'overside
MakeTriangle -10, 0, -10, 10, 0, 10, 10, 0, -10, 1
MakeTriangle -10, 0, -10, 10, 0, 10, -10, 0, 10, 0 \'underside
MakeTriangle -10, 0, -10, 10, 0, -10, 10, 0, 10, 0
\'hus
MakeTriangle -8, 0, 0, -8, 6, 0, 0, 0, 0, 2 \'syd
MakeTriangle -8, 6, 0, 0, 6, 0, 0, 0, 0, 2
MakeTriangle -8, 0, 8, -8, 6, 8, -8, 6, 0, 2 \'vest
MakeTriangle -8, 6, 0, -8, 0, 0, -8, 0, 8, 2
MakeTriangle 0, 6, 8, -8, 6, 8, -8, 0, 8, 2 \'nord
MakeTriangle -8, 0, 8, 0, 0, 8, 0, 6, 8, 2
MakeTriangle 0, 0, 0, 0, 6, 0, 0, 6, 8, 2 \'øst
MakeTriangle 0, 0, 0, 0, 6, 8, 0, 0, 8, 2
MakeTriangle -4, 8, 0, 0, 6, 0, -8, 6, 0, 2 \'gavl syd
MakeTriangle -4, 8, 8, -8, 6, 8, 0, 6, 8, 2 \'gavl nord
MakeTriangle -4, 8, -1, -9, 5.5, -1, -4, 8, 9, 3 \'tag vest
MakeTriangle -4, 8, 9, -9, 5.5, -1, -9, 5.5, 9, 3
MakeTriangle 1, 5.5, -1, -4, 8, -1, 1, 5.5, 9, 3 \'tag øst
MakeTriangle -4, 8, 9, 1, 5.5, 9, -4, 8, -1, 3
End Sub
\' Make a vector with the given components.
Private Function MakeVector(a As Double, b As Double, C As Double) As D3DVECTOR
Dim result As D3DVECTOR
With result
.x = a
.y = b
.z = C
End With
MakeVector = result
End Function
