|
Option Explicit
Const D3DFVF_CUSTOMVERTEX As Long = (D3DFVF_XYZ Or D3DFVF_TEX2)
Const PI As Single = 3.1415
Private Type CUSTOMVERTEX
position As D3DVECTOR
tu1 As Single
tv1 As Single
tu2 As Single
tv2 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_Texture1 As Direct3DTexture8
Dim g_Texture2 As Direct3DTexture8
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
Do
DoEvents
CalcFPS
Render
Loop
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Unload Me
End Sub
Function InitD3D(hWnd As Long) As Boolean
Dim mode As D3DDISPLAYMODE
Dim d3dpp As D3DPRESENT_PARAMETERS
On Local Error Resume Next
Set g_D3D = g_DX.Direct3DCreate()
If g_D3D Is Nothing Then Exit Function
g_D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, mode
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_Texture1 = g_D3DX.CreateTextureFromFile( _
g_D3DDevice, App.Path + "\tex1.bmp")
Set g_Texture2 = g_D3DX.CreateTextureFromFile( _
g_D3DDevice, App.Path + "\tex2.bmp")
InitD3D = True
End Function
Function InitStereometry() As Boolean
Dim Vertex(0 To 3) As CUSTOMVERTEX
Dim VertexSizeInBytes As Long
Dim theta As Single
Dim thetas As Single
VertexSizeInBytes = Len(Vertex(0))
Vertex(0).position.x = -1
Vertex(0).position.y = 1
Vertex(0).position.z = 0
Vertex(0).tu1 = 0
Vertex(0).tv1 = 0
Vertex(1).position.x = -1
Vertex(1).position.y = -1
Vertex(1).position.z = 0
Vertex(1).tu1 = 0
Vertex(1).tv1 = 1
Vertex(2).position.x = 1
Vertex(2).position.y = 1
Vertex(2).position.z = 0
Vertex(2).tu1 = 1
Vertex(2).tv1 = 0
Vertex(3).position.x = 1
Vertex(3).position.y = -1
Vertex(3).position.z = 0
Vertex(3).tu1 = 1
Vertex(3).tv1 = 1
Set g_VB = g_D3DDevice.CreateVertexBuffer( _
VertexSizeInBytes * 4, 0, _
D3DFVF_CUSTOMVERTEX, D3DPOOL_DEFAULT)
If g_VB Is Nothing Then Exit Function
D3DVertexBuffer8SetData g_VB, 0, _
4 * VertexSizeInBytes, 0, Vertex(0)
InitStereometry = True
End Function
Sub RotateTexture()
Dim VertexSizeInBytes As Long
Dim speed As Single
Dim Vertices(0 To 3) As CUSTOMVERTEX
speed = 4
VertexSizeInBytes = Len(Vertices(0))
D3DVertexBuffer8GetData g_VB, 0, _
VertexSizeInBytes * 4, 0, Vertices(0)
Vertices(0).tu2 = Cos(Timer * speed) / 1.7 + 0.5
Vertices(0).tv2 = Sin(Timer * speed) / 1.7 + 0.5
Vertices(1).tu2 = Cos(Timer * speed - PI / 2) / 1.7 + 0.5
Vertices(1).tv2 = Sin(Timer * speed - PI / 2) / 1.7 + 0.5
Vertices(2).tu2 = Cos(Timer * speed + PI / 2) / 1.7 + 0.5
Vertices(2).tv2 = Sin(Timer * speed + PI / 2) / 1.7 + 0.5
Vertices(3).tu2 = Cos(Timer * speed + PI) / 1.7 + 0.5
Vertices(3).tv2 = Sin(Timer * speed + PI) / 1.7 + 0.5
D3DVertexBuffer8SetData g_VB, 0, _
4 * VertexSizeInBytes, 0, Vertices(0)
End Sub
Sub SetupMatrices()
Dim matView As D3DMATRIX
Dim matProj As D3DMATRIX
D3DXMatrixLookAtLH matView, vec3(0, 0, -3), _
vec3(0, 0, 0), _
vec3(0, 1, 0)
g_D3DDevice.SetTransform D3DTS_VIEW, matView
D3DXMatrixPerspectiveFovLH matProj, PI / 4, 0.75, 1, 100
g_D3DDevice.SetTransform D3DTS_PROJECTION, matProj
End Sub
Sub Render()
Dim v As CUSTOMVERTEX
Dim sizeOfVertex As Long
Me.Caption = "Multi Texturing FPS: " & FPS
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
SetupMatrices
RotateTexture
g_D3DDevice.SetTexture 0, g_Texture1
g_D3DDevice.SetTexture 1, g_Texture2
g_D3DDevice.SetTextureStageState 0, D3DTSS_COLOROP, _
D3DTOP_SELECTARG1
g_D3DDevice.SetTextureStageState 0, D3DTSS_COLORARG1, _
D3DTA_TEXTURE
g_D3DDevice.SetTextureStageState 1, D3DTSS_COLOROP, _
D3DTOP_MODULATE
g_D3DDevice.SetTextureStageState 1, D3DTSS_COLORARG1, _
D3DTA_TEXTURE
g_D3DDevice.SetTextureStageState 0, D3DTSS_MAGFILTER, _
D3DTEXF_LINEAR
g_D3DDevice.SetTextureStageState 1, D3DTSS_MAGFILTER, _
D3DTEXF_LINEAR
sizeOfVertex = Len(v)
g_D3DDevice.SetStreamSource 0, g_VB, sizeOfVertex
g_D3DDevice.SetVertexShader D3DFVF_CUSTOMVERTEX
g_D3DDevice.DrawPrimitive D3DPT_TRIANGLESTRIP, 0, 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
Private Sub Form_Unload(Cancel As Integer)
Cleanup
End
End Sub
Sub Cleanup()
Set g_VB = Nothing
Set g_Texture1 = Nothing
Set g_Texture2 = Nothing
Set g_D3DDevice = Nothing
Set g_D3D = Nothing
End Sub
|
|