|
Option Explicit
Const D3DFVF_CUSTOMVERTEX As Long = _
(D3DFVF_XYZ Or D3DFVF_NORMAL Or D3DFVF_TEX1)
Const PI As Single = 3.1415
Const PARTS_X As Long = 50
Const PARTS_Y As Long = 10
Const PRIMITIVES As Long = PARTS_X * PARTS_Y * 2
Const VERTICES As Long = PARTS_X * PARTS_Y * 6
Private Type CUSTOMVERTEX
position As D3DVECTOR
normal As D3DVECTOR
tu As Single
tv As Single
End Type
Dim g_DX As New DirectX8
Dim g_D3D As Direct3D8
Dim g_D3DX As New D3DX8
Dim g_D3DDevice As Direct3DDevice8
Dim g_VB As Direct3DVertexBuffer8
Dim g_Texture As Direct3DTexture8
Dim g_LRotate As Boolean
Dim g_Specular As Boolean
Dim g_LightType As Boolean
Dim g_WireFrame As Boolean
Dim FPSTimer As Long
Dim FPSCounter As Integer
Dim FPS As Integer
Dim ConstSpeed As Single
Private Sub Form_Load()
Dim b As Boolean
Me.Show
DoEvents
b = InitD3D(Me.hWnd)
If Not b Then
MsgBox "Unable to CreateDevice"
End
End If
b = InitStereometry()
If Not b Then
MsgBox "Unable to Create VertexBuffer"
End
End If
g_Specular = True
g_LightType = True
Do
DoEvents
CalcFPS
Render
Loop
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Unload Me
If KeyCode = vbKeyS Then g_Specular = Not g_Specular
If KeyCode = vbKeyC Then g_LRotate = Not g_LRotate
If KeyCode = vbKeyL Then g_LightType = Not g_LightType
If KeyCode = vbKeyW Then g_WireFrame = Not g_WireFrame
End Sub
Function InitD3D(hWnd As Long) As Boolean
On Local Error Resume Next
Set g_D3D = g_DX.Direct3DCreate()
If g_D3D Is Nothing Then Exit Function
Dim mode As D3DDISPLAYMODE
g_D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, mode
Dim d3dpp As D3DPRESENT_PARAMETERS
d3dpp.Windowed = 1
d3dpp.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
d3dpp.BackBufferFormat = mode.Format
d3dpp.BackBufferCount = 1
d3dpp.EnableAutoDepthStencil = 1
d3dpp.AutoDepthStencilFormat = D3DFMT_D16
Set g_D3DDevice = g_D3D.CreateDevice(D3DADAPTER_DEFAULT, _
D3DDEVTYPE_HAL, hWnd, _
D3DCREATE_SOFTWARE_VERTEXPROCESSING, d3dpp)
If g_D3DDevice Is Nothing Then Exit Function
g_D3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE
g_D3DDevice.SetRenderState D3DRS_ZENABLE, 1
Set g_Texture = g_D3DX.CreateTextureFromFile(g_D3DDevice, _
App.Path + "\tex.bmp")
InitD3D = True
End Function
Function Normalize(ByRef v As D3DVECTOR)
Dim div As Single
div = Sqr(v.x * v.x + v.y * v.y + v.z * v.z)
v.x = v.x / div
v.y = v.y / div
v.z = v.z / div
End Function
Function GetNormal(ByRef v1 As D3DVECTOR, _
ByRef v2 As D3DVECTOR) As D3DVECTOR
Dim vResult As D3DVECTOR
vResult.x = v1.y * v2.z - v1.z * v2.y
vResult.y = v1.z * v2.x - v1.x * v2.z
vResult.z = v1.x * v2.y - v1.y * v2.x
Normalize vResult
GetNormal = vResult
End Function
Function InitStereometry() As Boolean
Dim Vertex(0 To VERTICES - 1) As CUSTOMVERTEX
Dim VertexSizeInBytes As Long
Dim theta As Single
Dim thetas As Single
VertexSizeInBytes = Len(Vertex(0))
Dim n As Long
Dim m As Long
Dim Tile As Long
Dim VTile As Long
For n = 0 To PARTS_X - 1
theta = (2 * PI * n) / (PARTS_X)
thetas = 2 * PI / (PARTS_X)
For m = 0 To PARTS_Y - 1
Tile = PARTS_X * 6 * m + n * 6
Vertex(Tile + 0).position = vec3(Sin(theta + thetas), _
(m + 1) / PARTS_Y * 3 - 1, Cos(theta + thetas))
Vertex(Tile + 0).tu = 4 * (n + 1) / (PARTS_X)
Vertex(Tile + 0).tv = (m + 1) / PARTS_Y
Vertex(Tile + 1).position = vec3(Sin(theta), _
(m + 1) / PARTS_Y * 3 - 1, Cos(theta))
Vertex(Tile + 1).tu = 4 * n / (PARTS_X)
Vertex(Tile + 1).tv = (m + 1) / PARTS_Y
Vertex(Tile + 2).position = vec3(Sin(theta), _
(m) / PARTS_Y * 3 - 1, Cos(theta))
Vertex(Tile + 2).tu = 4 * n / (PARTS_X)
Vertex(Tile + 2).tv = m / PARTS_Y
Vertex(Tile + 3) = Vertex(Tile + 2)
Vertex(Tile + 4).position = vec3(Sin(theta + thetas), _
(m) / PARTS_Y * 3 - 1, Cos(theta + thetas))
Vertex(Tile + 4).tu = 4 * (n + 1) / (PARTS_X)
Vertex(Tile + 4).tv = m / PARTS_Y
Vertex(Tile + 5) = Vertex(Tile + 0)
Next
Next
Dim v1 As D3DVECTOR
Dim v2 As D3DVECTOR
For n = 0 To PARTS_X - 1
For m = 0 To PARTS_Y - 1
Tile = PARTS_X * 6 * m + n * 6
v1.x = Vertex(Tile + 1).position.x - _
Vertex(Tile + 0).position.x
v1.y = Vertex(Tile + 1).position.y - _
Vertex(Tile + 0).position.y
v1.z = Vertex(Tile + 1).position.z - _
Vertex(Tile + 0).position.z
v2.x = Vertex(Tile + 4).position.x - _
Vertex(Tile + 0).position.x
v2.y = Vertex(Tile + 4).position.y - _
Vertex(Tile + 0).position.y
v2.z = Vertex(Tile + 4).position.z - _
Vertex(Tile + 0).position.z
Vertex(Tile + 0).normal = GetNormal(v1, v2)
Vertex(Tile + 5).normal = Vertex(Tile + 0).normal
Next
Next
Dim Tile11 As Long
Dim Tile10 As Long
Dim Tile01 As Long
For n = 0 To PARTS_X - 1
For m = 0 To PARTS_Y - 1
Tile = PARTS_X * 6 * m + n * 6
Tile11 = PARTS_X * 6 * (m - 1) + (n - 1) * 6
Tile10 = PARTS_X * 6 * m + (n - 1) * 6
Tile01 = PARTS_X * 6 * (m - 1) + n * 6
If Tile01 < 0 Then Tile01 = Tile
If Tile11 < 0 Then Tile11 = _
PARTS_X * 6 * m + (n + PARTS_X - 1) * 6
If Tile10 < 0 Then Tile10 = _
PARTS_X * 6 * m + (n + PARTS_X - 1) * 6
Vertex(Tile + 2).normal = Vertex(Tile11 + 0).normal
Vertex(Tile + 1).normal = Vertex(Tile10 + 0).normal
Vertex(Tile + 3).normal = Vertex(Tile11 + 0).normal
Vertex(Tile + 4).normal = Vertex(Tile01 + 0).normal
Next
Next
Set g_VB = g_D3DDevice.CreateVertexBuffer( _
VertexSizeInBytes * VERTICES, 0, _
D3DFVF_CUSTOMVERTEX, D3DPOOL_DEFAULT)
If g_VB Is Nothing Then Exit Function
D3DVertexBuffer8SetData _
g_VB, 0, VertexSizeInBytes * VERTICES, 0, Vertex(0)
InitStereometry = True
End Function
Sub SetupMatrices()
Dim matView As D3DMATRIX
If g_LRotate Then
D3DXMatrixLookAtLH matView, _
vec3(5, 3, -8), vec3(0, 0, 0), vec3(0, 1, 0)
Else
D3DXMatrixLookAtLH matView, _
vec3(Cos(Timer * 0.5) * 8, 3, -Sin(Timer * 0.5) * 8), _
vec3(0, 0, 0), vec3(0, 1, 0)
End If
g_D3DDevice.SetTransform D3DTS_VIEW, matView
Dim matProj As D3DMATRIX
D3DXMatrixPerspectiveFovLH matProj, PI / 4, 1, 1, 100
g_D3DDevice.SetTransform D3DTS_PROJECTION, matProj
End Sub
Sub SetupLights()
Dim col As D3DCOLORVALUE
Dim mtrl As D3DMATERIAL8
With col: .r = 1: .g = 1: .b = 1: .a = 1: End With
mtrl.diffuse = col
mtrl.Ambient = col
mtrl.specular = col
mtrl.power = 10
g_D3DDevice.SetMaterial mtrl
Dim light As D3DLIGHT8
If g_LightType Then
light.Type = D3DLIGHT_SPOT
Else
light.Type = D3DLIGHT_DIRECTIONAL
End If
light.Ambient.r = 0.1
light.Ambient.g = 0.1
light.Ambient.b = 0.1
light.diffuse.r = 0
light.diffuse.g = 0
light.diffuse.b = 1
light.specular.r = 1
light.specular.g = 1
light.specular.b = 1
light.position.x = 0
light.position.y = -2
light.position.z = -3
If g_LRotate Then
light.Direction.x = Cos(Timer * 0.5)
light.Direction.y = 0.9
light.Direction.z = Sin(Timer * 0.5)
Else
light.Direction.x = Sin(0)
light.Direction.y = 0.9
light.Direction.z = Cos(0)
End If
light.Range = 100
light.Falloff = 0.5
light.Phi = PI / 2
light.theta = PI / 3
light.Attenuation0 = 0.5
g_D3DDevice.SetLight 0, light
g_D3DDevice.LightEnable 0, 1
g_D3DDevice.SetRenderState D3DRS_LIGHTING, 1
If g_Specular Then
g_D3DDevice.SetRenderState D3DRS_SPECULARENABLE, 1
Else
g_D3DDevice.SetRenderState D3DRS_SPECULARENABLE, 0
End If
End Sub
Sub Render()
Me.Caption = "Specular Lighting FPS: " & FPS
Dim v As CUSTOMVERTEX
Dim sizeOfVertex As Long
If g_D3DDevice Is Nothing Then Exit Sub
g_D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or _
D3DCLEAR_ZBUFFER, &H50&, 1, 0
g_D3DDevice.BeginScene
SetupLights
SetupMatrices
If g_WireFrame Then
g_D3DDevice.SetRenderState D3DRS_FILLMODE, 2
g_D3DDevice.SetTexture 0, Nothing
Else
g_D3DDevice.SetRenderState D3DRS_FILLMODE, 3
g_D3DDevice.SetTexture 0, g_Texture
End If
sizeOfVertex = Len(v)
g_D3DDevice.SetStreamSource 0, g_VB, sizeOfVertex
g_D3DDevice.SetVertexShader D3DFVF_CUSTOMVERTEX
g_D3DDevice.DrawPrimitive _
D3DPT_TRIANGLELIST, 0, PARTS_X * PARTS_Y * 2
g_D3DDevice.EndScene
g_D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
Function vec3(x As Single, y As Single, z As Single) As D3DVECTOR
vec3.x = x
vec3.y = y
vec3.z = z
End Function
Sub CalcFPS()
If FPSTimer + 1 <= Timer Then
FPSTimer = Timer
FPS = FPSCounter
FPSCounter = 0
Else
FPSCounter = FPSCounter + 1
End If
If FPS > 0 Then ConstSpeed = 85 / FPS
End Sub
Sub Cleanup()
Set g_VB = Nothing
Set g_D3DDevice = Nothing
Set g_D3D = Nothing
End Sub
|
|