DirectX 8.0 3D
I am learning DX right now and this is one of my better attempts at 3D graphics. Its a multicoloured rotating cube in the world of cyber space. The bright colours show how the cube is made up. The way the light is, you can see the triangles that make up the cube. See the screenshot but the screenshot itself is only 10Kb so its all..."liney", the cube itself has completely smooth rendering. Everythings in a neat module which can be easily modified. Post feedback, and a vote or two owuldnt go amiss either :). Again sorry for the terrible quality picture, at least it loads fast. I assure you the real cube is much better looking. Smoother. ;)
Original Author: Coding Genius
Inputs
Start a visual basic program and open a new standard exe project. Onn the Project menu, click project references and then select DirectX 8.0 type library. There fore you must also have DirectX installed. you can download it in about half an hour from microsoft page. Add a module and a form, call the form "form1"
Returns
Excellent 3D cube with smooth triangles of colour.
Side Effects
Be aware that tis will not work on all computers. It should work on most, it has some but not much enumeration. In the initialisation sub look at the Set D3DDevice = D3D.CreateDevice(...,...,...,D3DCREATE_SOFTWARE_VERTEXPROCESSING)
If you have a good graphics card, try D3DCREATE_PUREDEVICE, If it dousnt support it, try D3DCREATE_HARDWARE_VERTEXPROCESSING. If not, just use what Ive put down but it is slow and nasty.
Code
'Sorry about the 0 commenting, if you want you can read my tutorials on DX they explain it all ( or will, some are still being written).
'Paste this into form1's decleration section
Private Sub Form_KeyPress(KeyAscii As Integer)
Running = False
End Sub
Private Sub Form_Load()
MainLoop
End Sub
'Now for all the complex stuff
'In the Module, paste all this...
Public Dx As DirectX8
Public D3D As Direct3D8
Public D3DDevice As Direct3DDevice8
Public D3DX As D3DX8
Public VBuffer As Direct3DVertexBuffer8
Public Running As Boolean
Public Type LITVERTEX
x As Single
y As Single
z As Single
color As Long
Specular As Long
tu As Single
tv As Single
End Type
Public Const Lit_FVF = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX1)
Public Cube(35) As LITVERTEX
Public Const pi As Single = 3.14159265358979
Public matWorld As D3DMATRIX
Public matView As D3DMATRIX
Public matProj As D3DMATRIX
Public Function Initialise() As Boolean
On Error GoTo ErrHandler
Dim DispMode As D3DDISPLAYMODE
Dim D3DWindow As D3DPRESENT_PARAMETERS
Set Dx = New DirectX8
Set D3D = Dx.Direct3DCreate()
Set D3DX = New D3DX8
DispMode.Format = D3DFMT_R5G6B5
DispMode.Width = 640
DispMode.Height = 480
D3DWindow.SwapEffect = D3DSWAPEFFECT_FLIP
D3DWindow.BackBufferCount = 1
D3DWindow.BackBufferFormat = DispMode.Format
D3DWindow.BackBufferWidth = 640
D3DWindow.BackBufferHeight = 480
D3DWindow.hDeviceWindow = Form1.hWnd
D3DWindow.EnableAutoDepthStencil = 1
If D3D.CheckDeviceFormat(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, DispMode.Format, D3DUSAGE_DEPTHSTENCIL, D3DRTYPE_SURFACE, D3DFMT_D16) = D3D_OK Then
D3DWindow.AutoDepthStencilFormat = D3DFMT_D16
End If
Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Form1.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, _
D3DWindow)
D3DDevice.SetVertexShader Lit_FVF
D3DDevice.SetRenderState D3DRS_LIGHTING, False
D3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE
D3DDevice.SetRenderState D3DRS_ZENABLE, 1
D3DXMatrixIdentity matWorld
D3DDevice.SetTransform D3DTS_WORLD, matWorld
D3DXMatrixLookAtLH matView, MakeVector(0, 5, 9), MakeVector(0, 0, 0), MakeVector(0, 1, 0)
D3DDevice.SetTransform D3DTS_VIEW, matView
D3DXMatrixPerspectiveFovLH matProj, pi / 4, 1, 0.1, 500
D3DDevice.SetTransform D3DTS_PROJECTION, matProj
If InitialiseGeometry() = True Then
Initialise = True
Exit Function
End If
ErrHandler:
Initialise = False
End Function
Public Sub Render()
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, 0, 1#, 0
D3DDevice.BeginScene
D3DDevice.SetStreamSource 0, VBuffer, Len(Cube(0))
D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 12
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
Private Function InitialiseGeometry() As Boolean
On Error GoTo ErrHandler
Const DFC As Single = 1.5
Cube(0) = CreateLitVertex(-1, 1, 1, vbRed, 0, 0, 0)
Cube(1) = CreateLitVertex(1, 1, 1, vbBlue, 0, 0, 0)
Cube(2) = CreateLitVertex(-1, -1, 1, vbGreen, 0, 0, 0)
Cube(3) = CreateLitVertex(1, 1, 1, vbRed, 0, 0, 0)
Cube(4) = CreateLitVertex(-1, -1, 1, vbBlue, 0, 0, 0)
Cube(5) = CreateLitVertex(1, -1, 1, vbGreen, 0, 0, 0)
Cube(6) = CreateLitVertex(-1, 1, -1, vbRed, 0, 0, 0)
Cube(7) = CreateLitVertex(1, 1, -1, vbBlue, 0, 0, 0)
Cube(8) = CreateLitVertex(-1, -1, -1, vbGreen, 0, 0, 0)
Cube(9) = CreateLitVertex(1, 1, -1, vbRed, 0, 0, 0)
Cube(10) = CreateLitVertex(-1, -1, -1, vbBlue, 0, 0, 0)
Cube(11) = CreateLitVertex(1, -1, -1, vbGreen, 0, 0, 0)
Cube(12) = CreateLitVertex(-1, 1, -1, vbRed, 0, 0, 0)
Cube(13) = CreateLitVertex(-1, 1, 1, vbBlue, 0, 0, 0)
Cube(14) = CreateLitVertex(-1, -1, -1, vbGreen, 0, 0, 0)
Cube(15) = CreateLitVertex(-1, 1, 1, vbRed, 0, 0, 0)
Cube(16) = CreateLitVertex(-1, -1, -1, vbBlue, 0, 0, 0)
Cube(17) = CreateLitVertex(-1, -1, 1, vbGreen, 0, 0, 0)
Cube(18) = CreateLitVertex(1, 1, -1, vbRed, 0, 0, 0)
Cube(19) = CreateLitVertex(1, 1, 1, vbBlue, 0, 0, 0)
Cube(20) = CreateLitVertex(1, -1, -1, vbGreen, 0, 0, 0)
Cube(21) = CreateLitVertex(1, 1, 1, vbRed, 0, 0, 0)
Cube(22) = CreateLitVertex(1, -1, -1, vbBlue, 0, 0, 0)
Cube(23) = CreateLitVertex(1, -1, 1, vbGreen, 0, 0, 0)
Cube(24) = CreateLitVertex(-1, 1, 1, vbBlue, 0, 0, 0)
Cube(25) = CreateLitVertex(1, 1, 1, vbRed, 0, 0, 0)
Cube(26) = CreateLitVertex(-1, 1, -1, vbGreen, 0, 0, 0)
Cube(27) = CreateLitVertex(1, 1, 1, vbBlue, 0, 0, 0)
Cube(28) = CreateLitVertex(-1, 1, -1, vbRed, 0, 0, 0)
Cube(29) = CreateLitVertex(1, 1, -1, vbGreen, 0, 0, 0)
Cube(30) = CreateLitVertex(-1, -1, 1, vbBlue, 0, 0, 0)
Cube(31) = CreateLitVertex(1, -1, 1, vbRed, 0, 0, 0)
Cube(32) = CreateLitVertex(-1, -1, -1, vbGreen, 0, 0, 0)
Cube(33) = CreateLitVertex(1, -1, 1, vbBlue, 0, 0, 0)
Cube(34) = CreateLitVertex(-1, -1, -1, vbRed, 0, 0, 0)
Cube(35) = CreateLitVertex(1, -1, -1, vbGreen, 0, 0, 0)
Set VBuffer = D3DDevice.CreateVertexBuffer(Len(Cube(0)) * 36, 0, Lit_FVF, D3DPOOL_DEFAULT)
If VBuffer Is Nothing Then Exit Function
D3DVertexBuffer8SetData VBuffer, 0, Len(Cube(0)) * 36, 0, Cube(0)
InitialiseGeometry = True
Exit Function
ErrHandler:
InitialiseGeometry = False
End Function
Private Function CreateLitVertex(x As Single, y As Single, z As Single, Diffuse As Long, Specular As Long, tu As Single, tv As Single) As LITVERTEX
CreateLitVertex.x = x
CreateLitVertex.y = y
CreateLitVertex.z = z
CreateLitVertex.color = Diffuse
CreateLitVertex.Specular = Specular
CreateLitVertex.tu = tu
CreateLitVertex.tv = tv
End Function
Private Function MakeVector(x As Single, y As Single, z As Single) As D3DVECTOR
MakeVector.x = x
MakeVector.y = y
MakeVector.z = z
End Function
Public Sub MainLoop()
Dim RotateAngle As Single
Dim matTemp As D3DMATRIX
Form1.Show
Running = Initialise
While Running
RotateAngle = RotateAngle + 0.1
If RotateAngle >= 360 Then RotateAngle = RotateAngle - 360
D3DXMatrixIdentity matWorld
D3DXMatrixIdentity matTemp
D3DXMatrixRotationX matTemp, RotateAngle * (pi / 180)
D3DXMatrixMultiply matWorld, matWorld, matTemp
D3DXMatrixIdentity matTemp
D3DXMatrixRotationZ matTemp, RotateAngle * (pi / 180)
D3DXMatrixMultiply matWorld, matWorld, matTemp
D3DDevice.SetTransform D3DTS_WORLD, matWorld
Render
DoEvents
Wend
On Error Resume Next
Set D3DDevice = Nothing
Set D3D = Nothing
Set Dx = Nothing
Unload Form1
End
End Sub
'Thats it. Post your feedback, and again, sorry for the poor quility of the Gif image. The proper thing looks 25x better dont you think.... ;)
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.