Initial commit: ROW Client source code
Game client codebase including: - CharacterActionControl: Character and creature management - GlobalScript: Network, items, skills, quests, utilities - RYLClient: Main client application with GUI and event handlers - Engine: 3D rendering engine (RYLGL) - MemoryManager: Custom memory allocation - Library: Third-party dependencies (DirectX, boost, etc.) - Tools: Development utilities 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
1064
Library/dxx8/samples/Multimedia/VBSamples/Common/DplayCon.frm
Normal file
1064
Library/dxx8/samples/Multimedia/VBSamples/Common/DplayCon.frm
Normal file
File diff suppressed because it is too large
Load Diff
BIN
Library/dxx8/samples/Multimedia/VBSamples/Common/DplayCon.frx
Normal file
BIN
Library/dxx8/samples/Multimedia/VBSamples/Common/DplayCon.frx
Normal file
Binary file not shown.
@@ -0,0 +1,572 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "CD3DAnimation"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: D3DAnimation.cls
|
||||
' Content: D3D Visual Basic Framework Animation Class
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
|
||||
Public ObjectName As String
|
||||
|
||||
Private Type KEYHEADER
|
||||
keytype As Long
|
||||
keycount As Long
|
||||
End Type
|
||||
|
||||
Private Type RMROTATEKEY
|
||||
time As Long
|
||||
nFloats As Long
|
||||
w As Single
|
||||
x As Single
|
||||
y As Single
|
||||
z As Single
|
||||
End Type
|
||||
|
||||
Private Type D3DMATRIXKEY
|
||||
time As Long
|
||||
nFloats As Long
|
||||
matrix As D3DMATRIX
|
||||
End Type
|
||||
|
||||
|
||||
Const kAnimGrowSize = 10
|
||||
|
||||
Dim m_RotateKeys() As D3DROTATEKEY
|
||||
Dim m_ScaleKeys() As D3DVECTORKEY
|
||||
Dim m_PositionKeys() As D3DVECTORKEY
|
||||
Dim m_RMRotateKeys() As RMROTATEKEY
|
||||
Dim m_MatrixKeys() As D3DMATRIXKEY
|
||||
|
||||
Dim m_NumRotateKeys As Long
|
||||
Dim m_NumScaleKeys As Long
|
||||
Dim m_NumPositionKeys As Long
|
||||
Dim m_NumMatrixKeys As Long
|
||||
Dim m_strFrameName As String
|
||||
Dim m_frame As CD3DFrame
|
||||
Dim m_iMatrixKey As Long
|
||||
|
||||
|
||||
Dim m_Children() As CD3DAnimation
|
||||
Dim m_NumChildren As Long
|
||||
Dim m_MaxChildren As Long
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ParseAnimSet
|
||||
' Desc: called from D3DUtil_LoadFromFile
|
||||
'-----------------------------------------------------------------------------
|
||||
Friend Sub ParseAnimSet(FileData As DirectXFileData, parentFrame As CD3DFrame)
|
||||
On Local Error Resume Next
|
||||
ObjectName = FileData.GetName()
|
||||
|
||||
Dim ChildData As DirectXFileData
|
||||
Dim NewAnim As CD3DAnimation
|
||||
Dim ChildObj As DirectXFileObject
|
||||
Dim ChildRef As DirectXFileReference
|
||||
|
||||
Set ChildObj = FileData.GetNextObject()
|
||||
|
||||
Do While Not ChildObj Is Nothing
|
||||
|
||||
Set ChildData = ChildObj
|
||||
If Err.Number = 0 Then
|
||||
|
||||
If ChildData.GetType = "TID_D3DRMAnimation" Then
|
||||
Set NewAnim = New CD3DAnimation
|
||||
AddChild NewAnim
|
||||
NewAnim.ParseAnim ChildData, Me, parentFrame
|
||||
End If
|
||||
End If
|
||||
|
||||
Err.Clear
|
||||
Set ChildRef = ChildObj
|
||||
|
||||
If Err.Number = 0 Then
|
||||
Set ChildData = ChildRef.Resolve
|
||||
|
||||
Set NewAnim = New CD3DAnimation
|
||||
AddChild NewAnim
|
||||
NewAnim.ParseAnim ChildData, Me, parentFrame
|
||||
End If
|
||||
|
||||
Err.Clear
|
||||
|
||||
Set ChildObj = FileData.GetNextObject()
|
||||
Loop
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetChild
|
||||
' Desc: return child Animation
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Public Function GetChild(i As Long) As CD3DAnimation
|
||||
Set GetChild = m_Children(i)
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetChildCount
|
||||
' Desc: return number of child animations
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Public Function GetChildCount() As Long
|
||||
GetChildCount = m_NumChildren
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: AddChild
|
||||
' Desc: Add child animation
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Public Sub AddChild(child As CD3DAnimation)
|
||||
If child Is Nothing Then Exit Sub
|
||||
|
||||
If m_MaxChildren = 0 Then
|
||||
m_MaxChildren = kAnimGrowSize
|
||||
ReDim m_Children(m_MaxChildren)
|
||||
ElseIf m_NumChildren >= m_MaxChildren Then
|
||||
m_MaxChildren = m_MaxChildren + kAnimGrowSize
|
||||
ReDim Preserve m_Children(m_MaxChildren)
|
||||
End If
|
||||
|
||||
Set m_Children(m_NumChildren) = child
|
||||
m_NumChildren = m_NumChildren + 1
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetFrame
|
||||
' Desc: set Frame to be animated
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub SetFrame(frame As CD3DFrame)
|
||||
Set m_frame = frame
|
||||
m_strFrameName = frame.ObjectName
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetFrame
|
||||
' Desc: return frame being animated
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function GetFrame() As CD3DFrame
|
||||
Set GetFrame = m_frame
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ParseAnim
|
||||
' Desc: Called by ParseAnimSet
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Friend Sub ParseAnim(FileData As DirectXFileData, parentAnimation As CD3DAnimation, parentFrame As CD3DFrame)
|
||||
On Local Error Resume Next
|
||||
ObjectName = FileData.GetName()
|
||||
|
||||
Dim dataSize As Long
|
||||
Dim KeyHead As KEYHEADER
|
||||
Dim size As Long
|
||||
Dim newFrame As CD3DFrame
|
||||
Dim ChildObj As DirectXFileObject
|
||||
Dim ChildData As DirectXFileData
|
||||
Dim ChildReference As DirectXFileReference
|
||||
Dim strChunkType As String
|
||||
Dim i As Long
|
||||
|
||||
Set ChildObj = FileData.GetNextObject()
|
||||
|
||||
Do While Not ChildObj Is Nothing
|
||||
|
||||
Set ChildReference = ChildObj
|
||||
If Err.Number = 0 Then
|
||||
|
||||
Set ChildData = ChildReference.Resolve()
|
||||
|
||||
|
||||
If ChildData.GetType = "TID_D3DRMFrame" Then
|
||||
m_strFrameName = ChildData.GetName()
|
||||
Set m_frame = parentFrame.FindChildObject(m_strFrameName, 0)
|
||||
End If
|
||||
|
||||
Set ChildReference = Nothing
|
||||
End If
|
||||
Err.Clear
|
||||
|
||||
Set ChildData = ChildObj
|
||||
If Err.Number = 0 Then
|
||||
|
||||
strChunkType = ChildData.GetType
|
||||
Select Case strChunkType
|
||||
Case "TID_D3DRMFrame"
|
||||
Set newFrame = New CD3DFrame
|
||||
newFrame.InitFromXOF g_dev, ChildData, parentFrame
|
||||
Set newFrame = Nothing
|
||||
|
||||
Case "TID_D3DRMAnimationOptions"
|
||||
|
||||
Case "TID_D3DRMAnimationKey"
|
||||
dataSize = ChildData.GetDataSize("")
|
||||
ChildData.GetDataFromOffset "", 0, 8, KeyHead
|
||||
|
||||
Select Case KeyHead.keytype
|
||||
Case 0 'ROTATEKEY
|
||||
ReDim m_RMRotateKeys(KeyHead.keycount)
|
||||
ReDim m_RotateKeys(KeyHead.keycount)
|
||||
size = Len(m_RMRotateKeys(0)) * KeyHead.keycount
|
||||
ChildData.GetDataFromOffset "", 8, size, m_RMRotateKeys(0)
|
||||
m_NumRotateKeys = KeyHead.keycount
|
||||
|
||||
'NOTE x files are w x y z and QUATERNIONS are x y z w
|
||||
'so we loop through on load and copy the values
|
||||
For i = 0 To m_NumRotateKeys - 1
|
||||
With m_RotateKeys(i)
|
||||
.time = m_RMRotateKeys(i).time
|
||||
If g_InvertRotateKey Then
|
||||
.quat.w = -m_RMRotateKeys(i).w
|
||||
Else
|
||||
.quat.w = m_RMRotateKeys(i).w
|
||||
End If
|
||||
.quat.x = m_RMRotateKeys(i).x
|
||||
.quat.y = m_RMRotateKeys(i).y
|
||||
.quat.z = m_RMRotateKeys(i).z
|
||||
End With
|
||||
Next
|
||||
ReDim m_RMRotateKeys(0)
|
||||
|
||||
Case 1 'SCALE KEY
|
||||
ReDim m_ScaleKeys(KeyHead.keycount)
|
||||
size = Len(m_ScaleKeys(0)) * KeyHead.keycount
|
||||
ChildData.GetDataFromOffset "", 8, size, m_ScaleKeys(0)
|
||||
m_NumScaleKeys = KeyHead.keycount
|
||||
|
||||
Case 2 'POSITION KEY
|
||||
ReDim m_PositionKeys(KeyHead.keycount)
|
||||
size = Len(m_PositionKeys(0)) * KeyHead.keycount
|
||||
ChildData.GetDataFromOffset "", 8, size, m_PositionKeys(0)
|
||||
m_NumPositionKeys = KeyHead.keycount
|
||||
|
||||
Case 4 'MATRIX KEY
|
||||
ReDim m_MatrixKeys(KeyHead.keycount)
|
||||
size = Len(m_MatrixKeys(0)) * KeyHead.keycount
|
||||
ChildData.GetDataFromOffset "", 8, size, m_MatrixKeys(0)
|
||||
m_NumMatrixKeys = KeyHead.keycount
|
||||
|
||||
End Select
|
||||
|
||||
|
||||
End Select
|
||||
End If
|
||||
|
||||
Set ChildData = Nothing
|
||||
Set ChildReference = Nothing
|
||||
|
||||
Set ChildObj = FileData.GetNextObject()
|
||||
Loop
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ComputeP1234
|
||||
' Desc: Aux function to compute 4 nearest keys
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub ComputeP1234(j As Long, maxNum As Long, ByRef p1 As Long, ByRef p2 As Long, ByRef p3 As Long, ByRef p4 As Long)
|
||||
|
||||
p1 = j: p2 = j: p3 = j: p4 = j
|
||||
|
||||
If j > 0 Then
|
||||
p1 = j - 2: p2 = j - 1
|
||||
End If
|
||||
If j = 1 Then
|
||||
p1 = j - 1: p2 = j - 1
|
||||
End If
|
||||
If j < (maxNum) - 1 Then p4 = j + 1
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetTime
|
||||
' Desc: Sets the matrix of the frame being animated
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub SetTime(t As Single)
|
||||
Dim t2 As Single
|
||||
Dim i As Long, j As Long
|
||||
Dim p1 As Long, p2 As Long, p3 As Long, p4 As Long
|
||||
Dim f1 As Single, f2 As Single, f3 As Single, f4 As Single
|
||||
Dim rM As D3DMATRIX, rQuat As D3DQUATERNION, rPos As D3DVECTOR, rScale As D3DVECTOR
|
||||
|
||||
Dim a As D3DVECTOR, b As D3DVECTOR
|
||||
Dim q1 As D3DQUATERNION, q2 As D3DQUATERNION
|
||||
Dim s As Single
|
||||
|
||||
Dim child As CD3DAnimation
|
||||
Dim LastT As Single
|
||||
|
||||
'Check children
|
||||
For i = 1 To m_NumChildren
|
||||
Set child = m_Children(i - 1)
|
||||
If Not child Is Nothing Then
|
||||
child.SetTime t
|
||||
End If
|
||||
Set child = Nothing
|
||||
Next
|
||||
|
||||
If m_frame Is Nothing Then Exit Sub
|
||||
|
||||
'set components to identity incase we dont have any keys.
|
||||
D3DXMatrixIdentity rM
|
||||
rScale = vec3(1, 1, 1)
|
||||
|
||||
D3DXQuaternionIdentity rQuat
|
||||
|
||||
|
||||
t2 = t
|
||||
|
||||
'loop matrix keys
|
||||
If m_NumMatrixKeys > 0 Then
|
||||
t2 = t
|
||||
LastT = m_MatrixKeys(m_NumMatrixKeys - 1).time
|
||||
If t > LastT Then
|
||||
i = t \ LastT
|
||||
t2 = t - i * LastT
|
||||
Else
|
||||
|
||||
End If
|
||||
|
||||
|
||||
'optimizations
|
||||
Dim tAt As Single, tNext1 As Single, tNext2 As Single
|
||||
|
||||
If m_iMatrixKey < m_NumMatrixKeys - 2 Then
|
||||
tAt = m_MatrixKeys(m_iMatrixKey).time
|
||||
tNext1 = m_MatrixKeys(m_iMatrixKey + 1).time
|
||||
tNext2 = m_MatrixKeys(m_iMatrixKey + 2).time
|
||||
If tAt < t2 And t2 <= tNext1 Then Exit Sub
|
||||
|
||||
If tNext1 < t2 And t2 <= tNext2 Then
|
||||
m_iMatrixKey = m_iMatrixKey + 1
|
||||
If m_iMatrixKey > m_NumMatrixKeys Then m_iMatrixKey = 0
|
||||
m_frame.SetMatrix m_MatrixKeys(m_iMatrixKey).matrix
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
'linear search
|
||||
For i = 1 To m_NumMatrixKeys
|
||||
If m_MatrixKeys(i - 1).time > t2 Then
|
||||
m_frame.SetMatrix m_MatrixKeys(i - 1).matrix
|
||||
m_iMatrixKey = i - 1
|
||||
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
|
||||
End If
|
||||
|
||||
'.................
|
||||
|
||||
|
||||
'loop position keys
|
||||
If m_NumPositionKeys > 0 Then
|
||||
t2 = t
|
||||
LastT = m_PositionKeys(m_NumPositionKeys - 1).time
|
||||
If t > LastT Then
|
||||
i = t \ LastT
|
||||
t2 = t - i * LastT
|
||||
End If
|
||||
End If
|
||||
|
||||
'Check Position Keys
|
||||
For i = 1 To m_NumPositionKeys
|
||||
j = i - 1
|
||||
|
||||
If m_PositionKeys(j).time > t2 Then
|
||||
|
||||
ComputeP1234 j, m_NumPositionKeys, p1, p2, p3, p4
|
||||
f1 = m_PositionKeys(p1).time
|
||||
f2 = m_PositionKeys(p2).time
|
||||
f3 = m_PositionKeys(p3).time
|
||||
f4 = m_PositionKeys(p4).time
|
||||
|
||||
|
||||
If ((f3 - f2) = 0) Then
|
||||
s = 1
|
||||
Else
|
||||
s = (t2 - f2) / (f3 - f2)
|
||||
End If
|
||||
|
||||
a = m_PositionKeys(p2).vec
|
||||
b = m_PositionKeys(p3).vec
|
||||
|
||||
|
||||
D3DXVec3Lerp rPos, a, b, s
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
|
||||
|
||||
'loop scale keys
|
||||
If m_NumScaleKeys > 0 Then
|
||||
t2 = t
|
||||
LastT = m_ScaleKeys(m_NumScaleKeys - 1).time
|
||||
If t > LastT Then
|
||||
i = t \ LastT
|
||||
t2 = t - i * LastT
|
||||
End If
|
||||
End If
|
||||
|
||||
|
||||
'Check Scale Keys
|
||||
For i = 1 To m_NumScaleKeys
|
||||
j = i - 1
|
||||
If m_ScaleKeys(j).time > t2 Then
|
||||
|
||||
ComputeP1234 j, m_NumScaleKeys, p1, p2, p3, p4
|
||||
f1 = m_ScaleKeys(p1).time
|
||||
f2 = m_ScaleKeys(p2).time
|
||||
f3 = m_ScaleKeys(p3).time
|
||||
f4 = m_ScaleKeys(p4).time
|
||||
|
||||
If ((f3 - f2) = 0) Then
|
||||
s = 1
|
||||
Else
|
||||
s = (t2 - f2) / (f3 - f2)
|
||||
End If
|
||||
|
||||
a = m_ScaleKeys(p2).vec
|
||||
b = m_ScaleKeys(p3).vec
|
||||
|
||||
|
||||
D3DXVec3Lerp rScale, a, b, s
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
|
||||
'loop rotate keys
|
||||
If m_NumRotateKeys > 0 Then
|
||||
t2 = t
|
||||
LastT = m_RotateKeys(m_NumRotateKeys - 1).time
|
||||
If t > LastT Then
|
||||
i = t \ LastT
|
||||
t2 = t - i * LastT
|
||||
End If
|
||||
End If
|
||||
|
||||
'Check Rotate Keys
|
||||
For i = 1 To m_NumRotateKeys
|
||||
j = i - 1
|
||||
|
||||
If m_RotateKeys(j).time > t2 Then
|
||||
|
||||
|
||||
|
||||
ComputeP1234 j, m_NumRotateKeys, p1, p2, p3, p4
|
||||
f1 = m_RotateKeys(p1).time
|
||||
f2 = m_RotateKeys(p2).time
|
||||
f3 = m_RotateKeys(p3).time
|
||||
f4 = m_RotateKeys(p4).time
|
||||
|
||||
If ((f3 - f2) = 0) Then
|
||||
s = 1
|
||||
Else
|
||||
s = (t2 - f2) / (f3 - f2)
|
||||
End If
|
||||
|
||||
q1 = m_RotateKeys(p2).quat
|
||||
q2 = m_RotateKeys(p3).quat
|
||||
|
||||
D3DXQuaternionSlerp rQuat, q1, q2, s
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
Dim temp1 As D3DMATRIX
|
||||
Dim temp2 As D3DMATRIX
|
||||
Dim temp3 As D3DMATRIX
|
||||
|
||||
D3DXMatrixScaling temp1, rScale.x, rScale.y, rScale.z
|
||||
D3DXMatrixRotationQuaternion temp2, rQuat
|
||||
D3DXMatrixTranslation temp3, rPos.x, rPos.y, rPos.z
|
||||
D3DXMatrixMultiply rM, temp1, temp2
|
||||
D3DXMatrixMultiply rM, rM, temp3
|
||||
|
||||
m_frame.SetMatrix rM
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: AddRotateKey
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Sub AddRotateKey(t As Long, quat As D3DQUATERNION)
|
||||
|
||||
ReDim Preserve m_RotateKeys(m_NumRotateKeys)
|
||||
|
||||
With m_RotateKeys(m_NumRotateKeys)
|
||||
.time = t
|
||||
.quat = quat
|
||||
End With
|
||||
m_NumRotateKeys = m_NumRotateKeys + 1
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: AddScaleKey
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Sub AddScaleKey(t As Long, scalevec As D3DVECTOR)
|
||||
|
||||
ReDim Preserve m_ScaleKeys(m_NumScaleKeys)
|
||||
|
||||
|
||||
|
||||
With m_ScaleKeys(m_NumScaleKeys)
|
||||
.time = t
|
||||
.vec = scalevec
|
||||
End With
|
||||
|
||||
m_NumScaleKeys = m_NumScaleKeys + 1
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: AddPositionKey
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub AddPositionKey(t As Long, posvec As D3DVECTOR)
|
||||
|
||||
ReDim Preserve m_PositionKeys(m_NumPositionKeys)
|
||||
|
||||
|
||||
|
||||
With m_PositionKeys(m_NumPositionKeys)
|
||||
.time = t
|
||||
.vec = posvec
|
||||
End With
|
||||
m_NumPositionKeys = m_NumPositionKeys + 1
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
1016
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dFrame.cls
Normal file
1016
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dFrame.cls
Normal file
File diff suppressed because it is too large
Load Diff
745
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dMesh.cls
Normal file
745
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dMesh.cls
Normal file
@@ -0,0 +1,745 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "CD3DMesh"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: D3DMesh.cls
|
||||
' Content: D3D VB Framework Mesh
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
|
||||
Option Explicit
|
||||
|
||||
Private Type BoneComboIdList
|
||||
List(4) As Long
|
||||
End Type
|
||||
|
||||
|
||||
' Base Objects
|
||||
Public mesh As D3DXMesh 'if not skinned, regular mesh object
|
||||
Public skinmesh As D3DXSkinMesh 'if skinned - skinned mesh object
|
||||
Public bUseMaterials As Boolean 'Use materials in object
|
||||
Public bUseMaterialOverride As Boolean 'Use only override material
|
||||
Public ObjectName As String 'Name of object
|
||||
Public bSkinned As Boolean 'Inidicates if the object is a skin
|
||||
|
||||
' Culling objects
|
||||
Dim m_SphereCenter As D3DVECTOR 'center of bounding sphere
|
||||
Public SphereRadius As Single 'radius of bounding sphere
|
||||
Public bHasSphere As Boolean 'Inidcatges if bounding sphere is calculated
|
||||
|
||||
' Material and Adjacency information
|
||||
Dim m_MaterialOverride As D3DMATERIAL8 'Override material to use if bUseMaterialOverride set
|
||||
Dim m_NumMaterials As Long 'Number of materials in object
|
||||
Dim m_Materials() As D3DMATERIAL8 'Material List
|
||||
Dim m_Textures() As Direct3DTexture8 'Texture List
|
||||
Dim m_TextureNames() As String 'Texture List Names
|
||||
Dim m_AdjBuffer As D3DXBuffer 'Adjacency buffer for the mesh
|
||||
|
||||
|
||||
' Bone and skinning informatin
|
||||
Dim m_BoneNames As D3DXBuffer 'Names of Frame objects that are bones
|
||||
Dim m_BoneMatrices As D3DXBuffer 'Matrix object per bone
|
||||
Dim m_BoneComboTable As D3DXBuffer 'Groupings of bone material and triangles
|
||||
Dim m_BoneFrames() As CD3DFrame 'Frame objects that are bones
|
||||
Dim m_maxFaceInfl As Long 'Number of matrices that will influence a vertex
|
||||
Dim m_worldMatHandles(4) As Long 'handle to multiple world matrices
|
||||
Dim m_BoneOffsetMat() As D3DMATRIX 'Bone offset matrices from D3DXBuffers
|
||||
Dim m_NumBoneCombos As Long 'Size of bonecombo table
|
||||
Dim m_BoneCombos() As D3DXBONECOMBINATION 'Combo table as returned from D3DX
|
||||
Dim m_BoneComboIds() As BoneComboIdList 'BoneId portion of combotable
|
||||
Dim m_BoneCount As Long 'Number of bones
|
||||
Dim m_bonesAttached As Boolean 'Indicates if bones have been attached to the mesh
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Init
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Init()
|
||||
bUseMaterials = True
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' SphereCenter()
|
||||
' returns Sphere Center since D3DVECTOR can not be public variable return value
|
||||
'-----------------------------------------------------------------------------
|
||||
Property Get SphereCenter() As D3DVECTOR
|
||||
SphereCenter = m_SphereCenter
|
||||
End Property
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitFromFile
|
||||
' Desc: Tries first to load mesh in current directory or using explicit path
|
||||
' If that fails loads mesh from SDK media path
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Public Function InitFromFile(dev As Direct3DDevice8, Name As String) As Boolean
|
||||
Dim mtrlBuffer As D3DXBuffer
|
||||
Dim strPath As String
|
||||
Destroy
|
||||
|
||||
' On Local Error Resume Next
|
||||
Set m_AdjBuffer = Nothing
|
||||
bSkinned = False
|
||||
|
||||
Set mesh = g_d3dx.LoadMeshFromX(Name, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials)
|
||||
If Err.Number <> 0 Then
|
||||
Err.Clear
|
||||
On Local Error GoTo errOut
|
||||
strPath = g_mediaPath + Name
|
||||
Set mesh = g_d3dx.LoadMeshFromX(strPath, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials)
|
||||
|
||||
End If
|
||||
|
||||
Call InitMaterials(g_dev, mtrlBuffer)
|
||||
|
||||
InitFromFile = True
|
||||
Exit Function
|
||||
|
||||
errOut:
|
||||
InitFromFile = False
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitFromXOF
|
||||
' Desc: Load mesh from data provided by XOF api
|
||||
' Called from D3DUtil_LoadFromFile
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Public Function InitFromXOF(dev As Direct3DDevice8, meshdata As DirectXFileData) As Boolean
|
||||
Dim mtrlBuffer As D3DXBuffer
|
||||
Dim bonename As String
|
||||
Dim i As Long
|
||||
Dim q As Long
|
||||
|
||||
|
||||
Destroy
|
||||
|
||||
|
||||
Set m_AdjBuffer = Nothing
|
||||
Set m_BoneMatrices = Nothing
|
||||
Set m_BoneNames = Nothing
|
||||
Set mesh = Nothing
|
||||
Set skinmesh = Nothing
|
||||
Set m_BoneMatrices = Nothing
|
||||
Set m_BoneComboTable = Nothing
|
||||
|
||||
ObjectName = meshdata.GetName()
|
||||
|
||||
' On Local Error GoTo errOut
|
||||
bSkinned = False
|
||||
|
||||
'Users can set this variable to TRUE try the skinned load path
|
||||
If g_bLoadSkins = True Then
|
||||
Set skinmesh = g_d3dx.LoadSkinMeshFromXof(meshdata, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials, m_BoneNames, m_BoneMatrices)
|
||||
|
||||
|
||||
Dim pAdj As Long, AdjOut As D3DXBuffer
|
||||
pAdj = m_AdjBuffer.GetBufferPointer
|
||||
|
||||
m_BoneCount = skinmesh.GetNumBones()
|
||||
|
||||
If m_BoneCount = 0 Then
|
||||
|
||||
''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
' a skinned mesh with no bones is just a regular mesh
|
||||
''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
bSkinned = False
|
||||
Set mesh = skinmesh.GetOriginalMesh()
|
||||
'Set skinmesh = Nothing
|
||||
|
||||
Else
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''
|
||||
' code specific to x files with skinning data in them
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
bSkinned = True
|
||||
|
||||
Set mesh = skinmesh.ConvertToBlendedMesh(D3DXMESH_SYSTEMMEM, ByVal pAdj, ByVal 0, m_NumBoneCombos, m_BoneComboTable, ByVal 0&, Nothing)
|
||||
Set m_AdjBuffer = Nothing
|
||||
Set m_AdjBuffer = AdjOut
|
||||
Set AdjOut = Nothing
|
||||
|
||||
'retrieve number of influence (matrices) that a vertices could have
|
||||
'we support up to 4 corresponding to the 4 world matrices that can be set
|
||||
m_maxFaceInfl = skinmesh.GetMaxFaceInfluences()
|
||||
|
||||
m_worldMatHandles(0) = D3DTS_WORLD
|
||||
m_worldMatHandles(1) = D3DTS_WORLD1
|
||||
m_worldMatHandles(2) = D3DTS_WORLD2
|
||||
m_worldMatHandles(3) = D3DTS_WORLD3
|
||||
|
||||
ReDim m_BoneCombos(m_NumBoneCombos)
|
||||
ReDim m_BoneComboIds(m_NumBoneCombos)
|
||||
|
||||
' fill in our private table for bone combo data
|
||||
' this inidicates which bones (matrices) need to be blended
|
||||
' for a given subset in the mesh
|
||||
For q = 0 To m_NumBoneCombos - 1
|
||||
g_d3dx.BufferGetBoneCombo m_BoneComboTable, q, m_BoneCombos(q)
|
||||
g_d3dx.BufferGetBoneComboBoneIds m_BoneComboTable, q, m_maxFaceInfl, m_BoneComboIds(q).List(0)
|
||||
Next
|
||||
Set m_BoneComboTable = Nothing
|
||||
|
||||
' fill in our private table for bone offset matrices
|
||||
' these are the matrices that give the intitial displacement of mesh subsets
|
||||
' release the d3dx buffer to save memory
|
||||
ReDim m_BoneOffsetMat(m_BoneCount)
|
||||
g_d3dx.BufferGetData m_BoneMatrices, 0, Len(m_BoneOffsetMat(0)), m_BoneCount, m_BoneOffsetMat(0)
|
||||
Set m_BoneMatrices = Nothing
|
||||
|
||||
|
||||
End If
|
||||
Else
|
||||
|
||||
Set mesh = g_d3dx.LoadMeshFromXof(meshdata, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials)
|
||||
|
||||
End If
|
||||
|
||||
|
||||
Call InitMaterials(g_dev, mtrlBuffer)
|
||||
|
||||
InitFromXOF = True
|
||||
Exit Function
|
||||
|
||||
errOut:
|
||||
InitFromXOF = False
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: AttatchBonesToMesh
|
||||
' Desc: Called to attach bones to a skin.
|
||||
' The BoneNames table is used to search out bone frames
|
||||
' in the children of the given parent frame
|
||||
'
|
||||
' This must be done for any skinning animation to work
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Friend Sub AttatchBonesToMesh(parent As CD3DFrame)
|
||||
' get links to all the frames (bones)
|
||||
Dim i As Long
|
||||
Dim bonename As String
|
||||
ReDim m_BoneFrames(m_BoneCount)
|
||||
For i = 0 To m_BoneCount - 1
|
||||
bonename = g_d3dx.BufferGetBoneName(m_BoneNames, i)
|
||||
Set m_BoneFrames(i) = parent.FindChildObject(bonename, 0)
|
||||
If m_BoneFrames(i) Is Nothing Then
|
||||
Debug.Print "unable to find " + bonename
|
||||
Stop
|
||||
End If
|
||||
Next
|
||||
m_bonesAttached = True
|
||||
Set m_BoneNames = Nothing
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Optimize
|
||||
' Desc: Re-organize the mesh for better performance
|
||||
'
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Sub Optimize()
|
||||
Dim s As Long
|
||||
Dim adjBuf1() As Long
|
||||
Dim adjBuf2() As Long
|
||||
Dim facemap() As Long
|
||||
Dim newmesh As D3DXMesh
|
||||
Dim vertexMap As D3DXBuffer
|
||||
|
||||
s = m_AdjBuffer.GetBufferSize
|
||||
ReDim adjBuf1(s / 4)
|
||||
ReDim adjBuf2(s / 4)
|
||||
|
||||
s = mesh.GetNumFaces
|
||||
ReDim facemap(s)
|
||||
|
||||
g_d3dx.BufferGetData m_AdjBuffer, 0, 4, s * 3, adjBuf1(0)
|
||||
|
||||
Set newmesh = mesh.Optimize(D3DXMESHOPT_ATTRSORT Or D3DXMESHOPT_VERTEXCACHE, adjBuf1(0), adjBuf2(0), facemap(0), vertexMap)
|
||||
|
||||
If Not newmesh Is Nothing Then
|
||||
Set mesh = Nothing
|
||||
Set mesh = newmesh
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitMaterials
|
||||
' Desc: Helper function for creating mesh materials
|
||||
' called after initialization
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub InitMaterials(d3ddevice As Direct3DDevice8, mtrlBuffer As D3DXBuffer)
|
||||
Dim i As Long
|
||||
|
||||
If m_NumMaterials <= 0 Then Exit Sub
|
||||
|
||||
ReDim m_Materials(m_NumMaterials)
|
||||
ReDim m_Textures(m_NumMaterials)
|
||||
ReDim m_TextureNames(m_NumMaterials)
|
||||
|
||||
For i = 0 To m_NumMaterials - 1
|
||||
'copy material out of material buffer into our own structure
|
||||
g_d3dx.BufferGetMaterial mtrlBuffer, i, m_Materials(i)
|
||||
|
||||
If g_bLoadNoAlpha Then m_Materials(i).diffuse.a = 1
|
||||
|
||||
m_Materials(i).Ambient = m_Materials(i).diffuse
|
||||
|
||||
m_TextureNames(i) = g_d3dx.BufferGetTextureName(mtrlBuffer, i)
|
||||
|
||||
If g_bUseTextureLoadCallback Then
|
||||
Set m_Textures(i) = g_TextureLoadCallback.TextureLoadCallback(m_TextureNames(i))
|
||||
Else
|
||||
Set m_Textures(i) = D3DUtil_CreateTextureInPool(g_dev, m_TextureNames(i), D3DFMT_UNKNOWN)
|
||||
End If
|
||||
Next
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetFVF
|
||||
' Desc: Change the FVF of the current mesh
|
||||
'----------------------------------------------------------------------------
|
||||
Public Sub SetFVF(dev As Direct3DDevice8, fvf As Long)
|
||||
|
||||
Dim tempMesh As D3DXMesh
|
||||
Dim verts() As D3DVERTEX
|
||||
|
||||
If mesh Is Nothing Then Exit Sub
|
||||
|
||||
Set tempMesh = mesh.CloneMeshFVF(D3DXMESH_MANAGED, fvf, dev)
|
||||
|
||||
|
||||
Set mesh = tempMesh
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GenerateNormals
|
||||
' Desc: if the current mesh Flexible Vertex Format (FVF) has normals in it
|
||||
' that are not initialized. This function will fill them.
|
||||
' if no normals are present in the FVF this function will fire an
|
||||
' exception
|
||||
'----------------------------------------------------------------------------
|
||||
Public Sub ComputeNormals()
|
||||
Dim bm As D3DXBaseMesh
|
||||
Set bm = mesh
|
||||
g_d3dx.ComputeNormals bm
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FlipNormals
|
||||
' Desc: Convenience function that flips normals for a D3DVERTEX mesh (default)
|
||||
'----------------------------------------------------------------------------
|
||||
Public Sub FlipNormals()
|
||||
Dim count As Long
|
||||
Dim size As Long
|
||||
Dim i As Long
|
||||
|
||||
Dim verts() As D3DVERTEX
|
||||
|
||||
Dim vb As Direct3DVertexBuffer8
|
||||
Set vb = mesh.GetVertexBuffer()
|
||||
|
||||
|
||||
|
||||
|
||||
size = g_d3dx.GetFVFVertexSize(mesh.GetFVF())
|
||||
count = mesh.GetNumVertices()
|
||||
|
||||
|
||||
|
||||
If mesh.GetFVF() = D3DFVF_VERTEX Then
|
||||
ReDim verts(count)
|
||||
|
||||
D3DVertexBuffer8GetData vb, 0, size * count, 0, verts(0)
|
||||
|
||||
For i = 0 To count - 1
|
||||
verts(i).nx = -verts(i).nx
|
||||
verts(i).ny = -verts(i).ny
|
||||
verts(i).nz = -verts(i).nz
|
||||
Next
|
||||
|
||||
D3DVertexBuffer8SetData vb, 0, size * count, 0, verts(0)
|
||||
Else
|
||||
Stop
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Translate
|
||||
' Desc: all vertices are moved by x,y,z
|
||||
' note that object will still rotate about 0,0,0
|
||||
'
|
||||
'----------------------------------------------------------------------------
|
||||
Public Sub Translate(x As Single, y As Single, z As Single)
|
||||
Dim count As Long
|
||||
Dim size As Long
|
||||
Dim i As Long
|
||||
|
||||
Dim verts() As D3DVERTEX
|
||||
|
||||
Dim vb As Direct3DVertexBuffer8
|
||||
Set vb = mesh.GetVertexBuffer()
|
||||
|
||||
|
||||
|
||||
size = g_d3dx.GetFVFVertexSize(mesh.GetFVF())
|
||||
count = mesh.GetNumVertices()
|
||||
|
||||
|
||||
If mesh.GetFVF() = D3DFVF_VERTEX Then
|
||||
ReDim verts(count)
|
||||
|
||||
D3DVertexBuffer8GetData vb, 0, size * count, 0, verts(0)
|
||||
|
||||
For i = 0 To count - 1
|
||||
verts(i).x = verts(i).x + x
|
||||
verts(i).y = verts(i).y + y
|
||||
verts(i).z = verts(i).z + z
|
||||
Next
|
||||
|
||||
D3DVertexBuffer8SetData vb, 0, size * count, 0, verts(0)
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetLocalBox
|
||||
' Desc: Returns the extent of the mesh in the local coordinate system
|
||||
'----------------------------------------------------------------------------
|
||||
Public Sub GetLocalBox(MinExt As D3DVECTOR, MaxExt As D3DVECTOR)
|
||||
g_d3dx.ComputeBoundingBoxFromMesh mesh, MinExt, MaxExt
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Destroy
|
||||
' Desc: release any reference to frame and texture objects
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Destroy()
|
||||
|
||||
'Releases all objects (does leave 1 element in the array)
|
||||
ReDim m_Textures(0)
|
||||
ReDim m_Materials(0)
|
||||
ReDim m_TextureNames(0)
|
||||
ReDim m_BoneFrames(0)
|
||||
ReDim m_BoneOffsetMat(0)
|
||||
ReDim m_BoneCombos(0)
|
||||
m_NumMaterials = 0
|
||||
bUseMaterials = True
|
||||
Set mesh = Nothing
|
||||
Set skinmesh = Nothing
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ComputeBoundingVolumes
|
||||
' Desc: Makes BoundingSphere valid
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub ComputeBoundingVolumes()
|
||||
g_d3dx.ComputeBoundingSphereFromMesh mesh, m_SphereCenter, SphereRadius
|
||||
bHasSphere = True
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RenderEx
|
||||
' Desc: Render Mesh
|
||||
' Params:
|
||||
' dev the device to draw to
|
||||
' bDrawOpaqueSubsets draws all triangles that do not have alpha
|
||||
' bDrawOpaqueSubsets draws all triangles that have alpha
|
||||
' (note Blending renderstates are modified)
|
||||
'
|
||||
' Note: do not use for skinned meshes
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub RenderEx(dev As Direct3DDevice8, bDrawOpaqueSubsets As Boolean, bDrawAlphaSubsets As Boolean)
|
||||
If mesh Is Nothing Then Exit Sub
|
||||
Dim i As Long
|
||||
|
||||
'If bSkinned = True Then Exit Sub
|
||||
|
||||
' Frist, draw the subsets without alpha
|
||||
If (bDrawOpaqueSubsets) Then
|
||||
For i = 0 To m_NumMaterials - 1
|
||||
|
||||
|
||||
|
||||
If (bUseMaterials) Then
|
||||
If m_Materials(i).diffuse.a = 1# Then
|
||||
g_dev.SetMaterial m_Materials(i)
|
||||
|
||||
If g_bDontDrawTextures Then
|
||||
g_dev.SetTexture 0, Nothing
|
||||
Else
|
||||
g_dev.SetTexture 0, m_Textures(i)
|
||||
End If
|
||||
|
||||
mesh.DrawSubset i
|
||||
End If
|
||||
ElseIf (bUseMaterialOverride) Then
|
||||
If m_MaterialOverride.diffuse.a = 1# Then
|
||||
If g_bDontDrawTextures Then
|
||||
g_dev.SetTexture 0, Nothing
|
||||
Else
|
||||
g_dev.SetTexture 0, m_Textures(i)
|
||||
End If
|
||||
g_dev.SetMaterial m_MaterialOverride
|
||||
mesh.DrawSubset i
|
||||
End If
|
||||
Else
|
||||
mesh.DrawSubset i
|
||||
End If
|
||||
|
||||
Next
|
||||
End If
|
||||
|
||||
|
||||
' Then, draw the subsets with alpha
|
||||
If (bDrawAlphaSubsets And (bUseMaterialOverride Or bUseMaterials)) Then
|
||||
For i = 0 To m_NumMaterials - 1
|
||||
|
||||
If (bUseMaterials) Then
|
||||
If (m_Materials(i).diffuse.a < 1#) Then
|
||||
g_dev.SetMaterial m_Materials(i)
|
||||
g_dev.SetTexture 0, m_Textures(i)
|
||||
mesh.DrawSubset i
|
||||
End If
|
||||
ElseIf (bUseMaterialOverride) Then
|
||||
If (m_MaterialOverride.diffuse.a < 1#) Then
|
||||
g_dev.SetMaterial m_MaterialOverride
|
||||
g_dev.SetTexture 0, m_Textures(i)
|
||||
mesh.DrawSubset i
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Render
|
||||
' Desc: Render the mesh to the given device
|
||||
'
|
||||
' Note: Do not use for skinned meshes
|
||||
'
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Render(dev As Direct3DDevice8)
|
||||
Dim i As Long
|
||||
|
||||
If mesh Is Nothing Then Exit Sub
|
||||
|
||||
If bSkinned = True Then Exit Sub
|
||||
|
||||
If (bUseMaterials) Then
|
||||
For i = 0 To m_NumMaterials - 1
|
||||
g_dev.SetMaterial m_Materials(i)
|
||||
g_dev.SetTexture 0, m_Textures(i)
|
||||
mesh.DrawSubset i
|
||||
Next
|
||||
Else
|
||||
For i = 0 To m_NumMaterials - 1
|
||||
mesh.DrawSubset i
|
||||
Next
|
||||
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RenderSkin
|
||||
' Desc: Render the Mesh as skin
|
||||
' Note: The mesh must have been loaded as a skin and bones must have been attached
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub RenderSkin()
|
||||
|
||||
If Not bSkinned Then Exit Sub
|
||||
|
||||
Dim ipAttr As Long 'bonecombo attribute
|
||||
Dim matId As Long 'matrix id
|
||||
|
||||
Dim i As Long
|
||||
Dim mat2 As D3DMATRIX
|
||||
Dim mat1 As D3DMATRIX
|
||||
Dim mat0 As D3DMATRIX
|
||||
|
||||
|
||||
g_dev.SetRenderState D3DRS_VERTEXBLEND, m_maxFaceInfl - 1
|
||||
|
||||
For ipAttr = 0 To m_NumBoneCombos - 1
|
||||
For i = 0 To m_maxFaceInfl - 1
|
||||
matId = m_BoneComboIds(ipAttr).List(i)
|
||||
|
||||
'If we get a MatId of -1 then all the vertex weights are 0
|
||||
'and we dont need to set the transform for this bone
|
||||
If matId <> -1 Then
|
||||
mat0 = m_BoneFrames(matId).GetUpdatedMatrix()
|
||||
mat1 = m_BoneOffsetMat(matId)
|
||||
D3DXMatrixMultiply mat2, mat1, mat0
|
||||
g_dev.SetTransform m_worldMatHandles(i), mat2
|
||||
End If
|
||||
Next
|
||||
g_dev.SetTexture 0, m_Textures(m_BoneCombos(ipAttr).AttribId)
|
||||
g_dev.SetMaterial m_Materials(m_BoneCombos(ipAttr).AttribId)
|
||||
|
||||
mesh.DrawSubset ipAttr
|
||||
|
||||
Next
|
||||
|
||||
g_dev.SetRenderState D3DRS_VERTEXBLEND, 0
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetMaterialCount
|
||||
'
|
||||
'---------------------------------------------------------------------------
|
||||
Public Function GetMaterialCount() As Long
|
||||
GetMaterialCount = m_NumMaterials
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetMaterialOverride
|
||||
' Desc: Sets the materail to be used in place of the ones loaded from file
|
||||
' Note: to disable set bUseMaterialOverride to false
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub SetMaterialOverride(m As D3DMATERIAL8)
|
||||
m_MaterialOverride = m
|
||||
bUseMaterialOverride = True
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetMaterialOverride
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub GetMaterialOverride(m As D3DMATERIAL8)
|
||||
m = m_MaterialOverride
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ClassName
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function ClassName() As String
|
||||
ClassName = "CD3DMesh"
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InvalidateDeviceObjects
|
||||
' Desc: Release reference to device dependent objects
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub InvalidateDeviceObjects()
|
||||
'all framework objects are managed so nothing to do here
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RestoreDeviceObjects
|
||||
' Desc: If we had any video memory objects they would need
|
||||
' to be reloaded here
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub RestoreDeviceObjects(dev As Direct3DDevice8)
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitFromD3DXMesh
|
||||
' Desc: Allow mesh objects to be created from external D3DXMesh objects
|
||||
'
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub InitFromD3DXMesh(d3dxmeshIn As D3DXMesh)
|
||||
bUseMaterials = False
|
||||
ReDim m_Materials(1)
|
||||
ReDim m_Textures(1)
|
||||
m_NumMaterials = 1
|
||||
Set mesh = d3dxmeshIn
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetMaterialCount
|
||||
' Desc: If a mesh was initialized with InitFromD3DXMesh
|
||||
' This function can allocate space for Materials and Textures
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub SetMaterialCount(n As Long)
|
||||
m_NumMaterials = n
|
||||
ReDim Preserve m_Materials(n)
|
||||
ReDim Preserve m_Textures(n)
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetMaterialTexture
|
||||
' Desc: Sets the texture for a given material subset
|
||||
' Note: use nothing to remove a texture
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub SetMaterialTexture(n As Long, tex As Direct3DTexture8)
|
||||
Set m_Textures(n) = tex
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetMaterialTexture
|
||||
' Desc: returns a given texture for a material subset
|
||||
'-----------------------------------------------------------------------------
|
||||
Function GetMaterialTexture(n As Long) As Direct3DTexture8
|
||||
Set GetMaterialTexture = m_Textures(n)
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetMaterial
|
||||
' Desc: Sets the material properties for a given material subset
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub SetMaterial(n As Long, material As D3DMATERIAL8)
|
||||
m_Materials(n) = material
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetMaterial
|
||||
' Desc: returns material properties for a material subset
|
||||
'-----------------------------------------------------------------------------
|
||||
Function GetMaterial(n As Long) As D3DMATERIAL8
|
||||
GetMaterial = m_Materials(n)
|
||||
End Function
|
||||
|
||||
|
||||
334
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dPick.cls
Normal file
334
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dPick.cls
Normal file
@@ -0,0 +1,334 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "CD3DPick"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: D3DPick.cls
|
||||
' Content: D3D Visual Basic Framework Pick object
|
||||
' See raypack and viewport pick entrypoints
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
|
||||
Dim m_item() As D3D_PICK_RECORD
|
||||
Dim m_frame() As CD3DFrame
|
||||
Dim m_mesh() As CD3DMesh
|
||||
Dim m_count As Long
|
||||
Dim m_maxsize As Long
|
||||
Const kGrowSize = 10
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetCount
|
||||
' Dest: returns number of items picked
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function GetCount() As Long
|
||||
GetCount = m_count
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetRecord
|
||||
' Desc: returns the properties of a given pick item
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub GetRecord(i As Long, ByRef a As Single, ByRef b As Single, ByRef dist As Single, ByRef triFaceid As Long)
|
||||
a = m_item(i).a
|
||||
b = m_item(i).b
|
||||
dist = m_item(i).dist
|
||||
triFaceid = m_item(i).triFaceid
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetFrame
|
||||
' Desc: returns the frame of a given pick item
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function GetFrame(i As Long) As CD3DFrame
|
||||
Set GetFrame = m_frame(i)
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetMesh
|
||||
' Desc: returns the mesh of a given pick item
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function GetMesh(i As Long) As CD3DMesh
|
||||
Set GetMesh = m_mesh(i)
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FindNearest
|
||||
' Desc: returns the index of the pick with the smallest distance (closest to viewer)
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function FindNearest() As Long
|
||||
Dim q As Long, mindist As Single, i As Long
|
||||
q = -1
|
||||
mindist = 1E+38
|
||||
For i = 0 To m_count - 1
|
||||
If m_item(i).dist < mindist Then
|
||||
q = i
|
||||
mindist = m_item(i).dist
|
||||
End If
|
||||
Next
|
||||
FindNearest = q
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FindFurthest
|
||||
' Desc: returns the index of the pick with the largest distance
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function FindFurthest() As Long
|
||||
Dim q As Long, maxdist As Single, i As Long
|
||||
q = -1
|
||||
maxdist = -1E+38
|
||||
For i = 0 To m_count - 1
|
||||
If m_item(i).dist < maxdist Then
|
||||
q = i
|
||||
maxdist = m_item(i).dist
|
||||
End If
|
||||
Next
|
||||
FindFurthest = q
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Destroy
|
||||
' Desc: Release all references
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function Destroy()
|
||||
ReDim m_mesh(0)
|
||||
ReDim m_frame(0)
|
||||
m_count = 0
|
||||
m_maxsize = 0
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ViewportPick
|
||||
' Params:
|
||||
' frame parent of frame heirarchy to pick from
|
||||
' x x screen coordinate in pixels
|
||||
' y y screen coordinate in pixels
|
||||
'
|
||||
' Note: After call GetCount to see if any objets where hit
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function ViewportPick(frame As CD3DFrame, x As Single, y As Single)
|
||||
Destroy
|
||||
|
||||
Dim viewport As D3DVIEWPORT8
|
||||
Dim world As D3DMATRIX
|
||||
Dim proj As D3DMATRIX
|
||||
Dim view As D3DMATRIX
|
||||
|
||||
'NOTE the following functions will fail on PURE HAL devices
|
||||
'use ViewportPickEx if working with pureHal devices
|
||||
|
||||
g_dev.GetViewport viewport
|
||||
world = g_identityMatrix
|
||||
g_dev.GetTransform D3DTS_VIEW, view
|
||||
g_dev.GetTransform D3DTS_PROJECTION, proj
|
||||
|
||||
ViewportPick = ViewportPickEx(frame, viewport, proj, view, world, x, y)
|
||||
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ViewportPickEx
|
||||
' Desc: Aux function for ViewportPick
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function ViewportPickEx(frame As CD3DFrame, viewport As D3DVIEWPORT8, proj As D3DMATRIX, view As D3DMATRIX, world As D3DMATRIX, x As Single, y As Single) As Boolean
|
||||
|
||||
If frame.Enabled = False Then Exit Function
|
||||
|
||||
Dim vIn As D3DVECTOR, vNear As D3DVECTOR, vFar As D3DVECTOR, vDir As D3DVECTOR
|
||||
Dim bHit As Boolean, i As Long
|
||||
|
||||
If frame Is Nothing Then Exit Function
|
||||
|
||||
|
||||
Dim currentMatrix As D3DMATRIX
|
||||
Dim NewWorldMatrix As D3DMATRIX
|
||||
|
||||
currentMatrix = frame.GetMatrix
|
||||
|
||||
'Setup our basis matrix for this frame
|
||||
D3DXMatrixMultiply NewWorldMatrix, currentMatrix, world
|
||||
|
||||
vIn.x = x: vIn.y = y
|
||||
|
||||
'Compute point on Near Clip plane at cursor
|
||||
vIn.z = 0
|
||||
D3DXVec3Unproject vNear, vIn, viewport, proj, view, NewWorldMatrix
|
||||
|
||||
'compute point on far clip plane at cursor
|
||||
vIn.z = 1
|
||||
D3DXVec3Unproject vFar, vIn, viewport, proj, view, NewWorldMatrix
|
||||
|
||||
'Comput direction vector
|
||||
D3DXVec3Subtract vDir, vFar, vNear
|
||||
|
||||
|
||||
|
||||
Dim item As D3D_PICK_RECORD
|
||||
|
||||
|
||||
'Check all child meshes
|
||||
'Even if we got a hit we continue as the next mesh may be closer
|
||||
Dim childMesh As CD3DMesh
|
||||
For i = 0 To frame.GetChildMeshCount() - 1
|
||||
|
||||
Set childMesh = frame.GetChildMesh(i)
|
||||
|
||||
If Not childMesh Is Nothing Then
|
||||
g_d3dx.Intersect childMesh.mesh, vNear, vDir, item.hit, item.triFaceid, item.a, item.b, item.dist, 0
|
||||
End If
|
||||
|
||||
If item.hit <> 0 Then
|
||||
InternalAddItem frame, childMesh, item
|
||||
item.hit = 0
|
||||
End If
|
||||
bHit = True
|
||||
Next
|
||||
|
||||
'check pick for all child frame
|
||||
Dim childFrame As CD3DFrame
|
||||
For i = 0 To frame.GetChildFrameCount() - 1
|
||||
Set childFrame = frame.GetChildFrame(i)
|
||||
bHit = bHit Or _
|
||||
ViewportPickEx(childFrame, viewport, proj, view, NewWorldMatrix, x, y)
|
||||
Next
|
||||
|
||||
ViewportPickEx = bHit
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RayPick
|
||||
' Desc: given a ray cast it into a scene graph
|
||||
' Params:
|
||||
' frame parent of frame heirarchy to pick from
|
||||
' vOrig origen of the ray to cast
|
||||
' vDir direction of the ray
|
||||
'
|
||||
' Note: the following functions will fail on PURE HAL devices
|
||||
' use RayPickEx if working with pureHal devices
|
||||
' Call getCount to see if the ray hit any objects
|
||||
'
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function RayPick(frame As CD3DFrame, vOrig As D3DVECTOR, vDir As D3DVECTOR)
|
||||
Destroy
|
||||
|
||||
Dim world As D3DMATRIX
|
||||
|
||||
|
||||
g_dev.GetTransform D3DTS_WORLD, world
|
||||
|
||||
RayPick = RayPickEx(frame, world, vOrig, vDir)
|
||||
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RayPickEx
|
||||
' Desc: Aux function for RayPickEx
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function RayPickEx(frame As CD3DFrame, worldmatrix As D3DMATRIX, vOrig As D3DVECTOR, vDir As D3DVECTOR) As Boolean
|
||||
|
||||
Dim NewWorldMatrix As D3DMATRIX 'world matrix for this stack frame
|
||||
Dim InvWorldMatrix As D3DMATRIX 'world matrix for this stack frame
|
||||
Dim currentMatrix As D3DMATRIX
|
||||
Dim i As Long, det As Single, bHit As Boolean
|
||||
Dim vNewDir As D3DVECTOR, vNewOrig As D3DVECTOR
|
||||
|
||||
If frame Is Nothing Then Exit Function
|
||||
|
||||
currentMatrix = frame.GetMatrix
|
||||
|
||||
'Setup our basis matrix for this frame
|
||||
D3DXMatrixMultiply NewWorldMatrix, currentMatrix, worldmatrix
|
||||
D3DXMatrixInverse InvWorldMatrix, det, NewWorldMatrix
|
||||
|
||||
|
||||
' we want to compute vdir and vOrig in model space
|
||||
' note we use TransformNormal so we dont translate vDir
|
||||
' just rotate it into a new dir
|
||||
Call D3DXVec3TransformNormal(vNewDir, vDir, InvWorldMatrix)
|
||||
Call D3DXVec3TransformCoord(vNewOrig, vOrig, InvWorldMatrix)
|
||||
|
||||
|
||||
Dim item As D3D_PICK_RECORD
|
||||
|
||||
|
||||
'Check all child meshes
|
||||
'Even if we got a hit we continue as the next mesh may be closer
|
||||
Dim childMesh As CD3DMesh
|
||||
For i = 0 To frame.GetChildMeshCount() - 1
|
||||
|
||||
Set childMesh = frame.GetChildMesh(i)
|
||||
|
||||
If Not childMesh Is Nothing Then
|
||||
Call D3DXVec3Scale(vDir, vDir, 1000) 'Workaround for d3dx Intersect bug
|
||||
g_d3dx.Intersect childMesh.mesh, vNewOrig, vDir, item.hit, item.triFaceid, item.a, item.b, item.dist, 0
|
||||
End If
|
||||
|
||||
If item.hit <> 0 Then
|
||||
InternalAddItem frame, childMesh, item
|
||||
item.hit = 0
|
||||
End If
|
||||
bHit = True
|
||||
Next
|
||||
|
||||
'check pick for all child frame
|
||||
Dim childFrame As CD3DFrame
|
||||
For i = 0 To frame.GetChildFrameCount() - 1
|
||||
Set childFrame = frame.GetChildFrame(i)
|
||||
bHit = bHit Or _
|
||||
RayPickEx(childFrame, NewWorldMatrix, vOrig, vDir)
|
||||
Next
|
||||
|
||||
RayPickEx = bHit
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' InternalAddItem
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub InternalAddItem(parentFrame As CD3DFrame, mesh As CD3DMesh, item As D3D_PICK_RECORD)
|
||||
Dim maxsize As Long
|
||||
If m_maxsize = 0 Then
|
||||
ReDim m_item(kGrowSize)
|
||||
ReDim m_mesh(kGrowSize)
|
||||
ReDim m_frame(kGrowSize)
|
||||
m_maxsize = kGrowSize
|
||||
ElseIf m_count >= m_maxsize Then
|
||||
ReDim Preserve m_item(m_maxsize + kGrowSize)
|
||||
ReDim Preserve m_frame(m_maxsize + kGrowSize)
|
||||
ReDim Preserve m_mesh(m_maxsize + kGrowSize)
|
||||
m_maxsize = m_maxsize + kGrowSize
|
||||
End If
|
||||
|
||||
Set m_mesh(m_count) = mesh
|
||||
Set m_frame(m_count) = parentFrame
|
||||
m_item(m_count) = item
|
||||
|
||||
m_count = m_count + 1
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
1107
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dinit.bas
Normal file
1107
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dinit.bas
Normal file
File diff suppressed because it is too large
Load Diff
670
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dshader.bas
Normal file
670
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dshader.bas
Normal file
@@ -0,0 +1,670 @@
|
||||
Attribute VB_Name = "D3DShaders"
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: D3DShader.bas
|
||||
' Content: Shader constants
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
|
||||
' destination/source parameter register type
|
||||
Global Const D3DSI_COMMENTSIZE_SHIFT = 16
|
||||
Global Const D3DSI_COMMENTSIZE_MASK = &H7FFF0000
|
||||
|
||||
|
||||
|
||||
'---------------------------------------------------------------------
|
||||
' Vertex Shaders
|
||||
'
|
||||
'
|
||||
'Vertex Shader Declaration
|
||||
'
|
||||
'The declaration portion of a vertex shader defines the static external
|
||||
'interface of the shader. The information in the declaration includes:
|
||||
'
|
||||
'- Assignments of vertex shader input registers to data streams. These
|
||||
'assignments bind a specific vertex register to a single component within a
|
||||
'vertex stream. A vertex stream element is identified by a byte offset
|
||||
'within the stream and a type. The type specifies the arithmetic data type
|
||||
'plus the dimensionality (1, 2, 3, or 4 values). Stream data which is
|
||||
'less than 4 values are always expanded out to 4 values with zero or more
|
||||
'0.F values and one 1.F value.
|
||||
'
|
||||
'- Assignment of vertex shader input registers to implicit data from the
|
||||
'primitive tessellator. This controls the loading of vertex data which is
|
||||
'not loaded from a stream, but rather is generated during primitive
|
||||
'tessellation prior to the vertex shader.
|
||||
'
|
||||
'- Loading data into the constant memory at the time a shader is set as the
|
||||
'current shader. Each token specifies values for one or more contiguous 4
|
||||
'DWORD constant registers. This allows the shader to update an arbitrary
|
||||
'subset of the constant memory, overwriting the device state (which
|
||||
'contains the current values of the constant memory). Note that these
|
||||
'values can be subsequently overwritten (between DrawPrimitive calls)
|
||||
'during the time a shader is bound to a device via the
|
||||
'SetVertexShaderConstant method.
|
||||
'
|
||||
'
|
||||
'Declaration arrays are single-dimensional arrays of DWORDs composed of
|
||||
'multiple tokens each of which is one or more DWORDs. The single-DWORD
|
||||
'token value 0xFFFFFFFF is a special token used to indicate the end of the
|
||||
'declaration array. The single DWORD token value 0x00000000 is a NOP token
|
||||
'with is ignored during the declaration parsing. Note that 0x00000000 is a
|
||||
'valid value for DWORDs following the first DWORD for multiple word tokens.
|
||||
'
|
||||
'[31:29] TokenType
|
||||
' 0x0 - NOP (requires all DWORD bits to be zero)
|
||||
' 0x1 - stream selector
|
||||
' 0x2 - stream data definition (map to vertex input memory)
|
||||
' 0x3 - vertex input memory from tessellator
|
||||
' 0x4 - constant memory from shader
|
||||
' 0x5 - extension
|
||||
' 0x6 - reserved
|
||||
' 0x7 - end-of-array (requires all DWORD bits to be 1)
|
||||
'
|
||||
'NOP Token (single DWORD token)
|
||||
' [31:29] 0x0
|
||||
' [28:00] 0x0
|
||||
'
|
||||
'Stream Selector (single DWORD token)
|
||||
' [31:29] 0x1
|
||||
' [28] indicates whether this is a tessellator stream
|
||||
' [27:04] 0x0
|
||||
' [03:00] stream selector (0..15)
|
||||
'
|
||||
'Stream Data Definition (single DWORD token)
|
||||
' Vertex Input Register Load
|
||||
' [31:29] 0x2
|
||||
' [28] 0x0
|
||||
' [27:20] 0x0
|
||||
' [19:16] type (dimensionality and data type)
|
||||
' [15:04] 0x0
|
||||
' [03:00] vertex register address (0..15)
|
||||
' Data Skip (no register load)
|
||||
' [31:29] 0x2
|
||||
' [28] 0x1
|
||||
' [27:20] 0x0
|
||||
' [19:16] count of DWORDS to skip over (0..15)
|
||||
' [15:00] 0x0
|
||||
' Vertex Input Memory from Tessellator Data (single DWORD token)
|
||||
' [31:29] 0x3
|
||||
' [28] indicates whether data is normals or u/v
|
||||
' [27:24] 0x0
|
||||
' [23:20] vertex register address (0..15)
|
||||
' [19:16] type (dimensionality)
|
||||
' [15:04] 0x0
|
||||
' [03:00] vertex register address (0..15)
|
||||
'
|
||||
'Constant Memory from Shader (multiple DWORD token)
|
||||
' [31:29] 0x4
|
||||
' [28:25] count of 4*DWORD constants to load (0..15)
|
||||
' [24:07] 0x0
|
||||
' [06:00] constant memory address (0..95)
|
||||
'
|
||||
'Extension Token (single or multiple DWORD token)
|
||||
' [31:29] 0x5
|
||||
' [28:24] count of additional DWORDs in token (0..31)
|
||||
' [23:00] extension-specific information
|
||||
'
|
||||
'End-of-array token (single DWORD token)
|
||||
' [31:29] 0x7
|
||||
' [28:00] 0x1fffffff
|
||||
'
|
||||
'The stream selector token must be immediately followed by a contiguous set of stream data definition tokens. This token sequence fully defines that stream, including the set of elements within the stream, the order in which the elements appear, the type of each element, and the vertex register into which to load an element.
|
||||
'Streams are allowed to include data which is not loaded into a vertex register, thus allowing data which is not used for this shader to exist in the vertex stream. This skipped data is defined only by a count of DWORDs to skip over, since the type information is irrelevant.
|
||||
'The token sequence:
|
||||
'Stream Select: stream=0
|
||||
'Stream Data Definition (Load): type=FLOAT3; register=3
|
||||
'Stream Data Definition (Load): type=FLOAT3; register=4
|
||||
'Stream Data Definition (Skip): count=2
|
||||
'Stream Data Definition (Load): type=FLOAT2; register=7
|
||||
'
|
||||
'defines stream zero to consist of 4 elements, 3 of which are loaded into registers and the fourth skipped over. Register 3 is loaded with the first three DWORDs in each vertex interpreted as FLOAT data. Register 4 is loaded with the 4th, 5th, and 6th DWORDs interpreted as FLOAT data. The next two DWORDs (7th and 8th) are skipped over and not loaded into any vertex input register. Register 7 is loaded with the 9th and 10th DWORDS interpreted as FLOAT data.
|
||||
'Placing of tokens other than NOPs between the Stream Selector and Stream Data Definition tokens is disallowed.'
|
||||
'
|
||||
'
|
||||
|
||||
' Vertex Shader 1.0 register limits. D3D device must provide at least
|
||||
' specified number of registers
|
||||
'
|
||||
Global Const D3DVS_INPUTREG_MAX_V1_1 = 16
|
||||
Global Const D3DVS_TEMPREG_MAX_V1_1 = 12
|
||||
' This max required number. Device could have more registers. Check caps.
|
||||
Global Const D3DVS_CONSTREG_MAX_V1_1 = 96
|
||||
Global Const D3DVS_TCRDOUTREG_MAX_V1_1 = 8
|
||||
Global Const D3DVS_ADDRREG_MAX_V1_1 = 1
|
||||
Global Const D3DVS_ATTROUTREG_MAX_V1_1 = 2
|
||||
Global Const D3DVS_MAXINSTRUCTIONCOUNT_V1_1 = 128
|
||||
|
||||
' Pixel Shader DX8 register limits. D3D device will have at most these
|
||||
' specified number of registers
|
||||
'
|
||||
Global Const D3DPS_INPUTREG_MAX_DX8 = 8
|
||||
Global Const D3DPS_TEMPREG_MAX_DX8 = 8
|
||||
Global Const D3DPS_CONSTREG_MAX_DX8 = 8
|
||||
Global Const D3DPS_TEXTUREREG_MAX_DX8 = 8
|
||||
|
||||
|
||||
Enum D3DVSD_TOKENTYPE
|
||||
D3DVSD_TOKEN_NOP = 0 ' NOP or extension
|
||||
D3DVSD_TOKEN_STREAM = 1 ' stream selector
|
||||
D3DVSD_TOKEN_STREAMDATA = 2 ' stream data definition (map to vertex input memory)
|
||||
D3DVSD_TOKEN_TESSELLATOR = 3 ' vertex input memory from tessellator
|
||||
D3DVSD_TOKEN_constMEM = 4 ' global constant memory from shader
|
||||
D3DVSD_TOKEN_EXT = 5 ' extension
|
||||
D3DVSD_TOKEN_END = 7 ' end-of-array (requires all DWORD bits to be 1)
|
||||
End Enum
|
||||
|
||||
|
||||
'3322 2222 2222 1111 1111 11
|
||||
'1098 7654 3210 9876 5432 1098 7654 3210
|
||||
|
||||
|
||||
|
||||
Global Const D3DVSD_TOKENTYPESHIFT = 29
|
||||
Global Const D3DVSD_TOKENTYPEMASK = &HE0000000 ' (7 << D3DVSD_TOKENTYPESHIFT)
|
||||
|
||||
Global Const D3DVSD_STREAMNUMBERSHIFT = 0
|
||||
Global Const D3DVSD_STREAMNUMBERMASK = &HF& '(0xF << D3DVSD_STREAMNUMBERSHIFT)
|
||||
|
||||
Global Const D3DVSD_DATALOADTYPESHIFT = 28
|
||||
Global Const D3DVSD_DATALOADTYPEMASK = &H10000000 '(0x1 << D3DVSD_DATALOADTYPESHIFT)
|
||||
|
||||
Global Const D3DVSD_DATATYPESHIFT = 16
|
||||
Global Const D3DVSD_DATATYPEMASK = &HF& * 2 ^ D3DVSD_DATATYPESHIFT '0xF<< D3DVSD_DATATYPESHIFT)
|
||||
|
||||
Global Const D3DVSD_SKIPCOUNTSHIFT = 16
|
||||
Global Const D3DVSD_SKIPCOUNTMASK = &HF& * 2 ^ D3DVSD_SKIPCOUNTSHIFT '(0xF << D3DVSD_SKIPCOUNTSHIFT)
|
||||
|
||||
Global Const D3DVSD_VERTEXREGSHIFT = 0
|
||||
Global Const D3DVSD_VERTEXREGMASK = &HF& * 2 ^ D3DVSD_VERTEXREGSHIFT '(0xF << D3DVSD_VERTEXREGSHIFT)
|
||||
|
||||
Global Const D3DVSD_VERTEXREGINSHIFT = 20
|
||||
Global Const D3DVSD_VERTEXREGINMASK = &HF& * 2 ^ D3DVSD_VERTEXREGINSHIFT '(0xF << D3DVSD_VERTEXREGINSHIFT)
|
||||
|
||||
Global Const D3DVSD_CONSTCOUNTSHIFT = 25
|
||||
Global Const D3DVSD_CONSTCOUNTMASK = &HF& * 2 ^ D3DVSD_CONSTCOUNTSHIFT ' (0xF << D3DVSD_global constCOUNTSHIFT)
|
||||
|
||||
Global Const D3DVSD_CONSTADDRESSSHIFT = 0
|
||||
Global Const D3DVSD_CONSTADDRESSMASK = &H7F& '(0x7F << D3DVSDCONSTADDRESSSHIFT)
|
||||
|
||||
Global Const D3DVSD_CONSTRSSHIFT = 16
|
||||
Global Const D3DVSD_CONSTRSMASK = &H1FFF0000 '(0x1FFF << D3DVSDCONSTRSSHIFT)
|
||||
|
||||
Global Const D3DVSD_EXTCOUNTSHIFT = 24
|
||||
Global Const D3DVSD_EXTCOUNTMASK = &H1F& * 2 ^ D3DVSD_EXTCOUNTSHIFT '(0x1F << D3DVSD_EXTCOUNTSHIFT)
|
||||
|
||||
Global Const D3DVSD_EXTINFOSHIFT = 0
|
||||
Global Const D3DVSD_EXTINFOMASK = &HFFFFFF '(0xFFFFFF << D3DVSD_EXTINFOSHIFT)
|
||||
|
||||
|
||||
' bit declarations for _Type fields
|
||||
Global Const D3DVSDT_FLOAT1 = 0& ' 1D float expanded to (value, 0., 0., 1.)
|
||||
Global Const D3DVSDT_FLOAT2 = 1& ' 2D float expanded to (value, value, 0., 1.)
|
||||
Global Const D3DVSDT_FLOAT3 = 2& ' 3D float expanded to (value, value, value, 1.)
|
||||
Global Const D3DVSDT_FLOAT4 = 3& ' 4D float
|
||||
Global Const D3DVSDT_D3DCOLOR = 4& ' 4D packed unsigned bytes mapped to 0. to 1. range // Input is in D3DCOLOR format (ARGB) expanded to (R, G, B, A)
|
||||
Global Const D3DVSDT_UBYTE4 = 5& ' 4D unsigned byte
|
||||
Global Const D3DVSDT_SHORT2 = 6& ' 2D signed short expanded to (value, value, 0., 1.)
|
||||
Global Const D3DVSDT_SHORT4 = 7& ' 4D signed short
|
||||
|
||||
' assignments of vertex input registers for fixed function vertex shader
|
||||
'
|
||||
Global Const D3DVSDE_POSITION = 0&
|
||||
Global Const D3DVSDE_BLENDWEIGHT = 1&
|
||||
Global Const D3DVSDE_BLENDINDICES = 2&
|
||||
Global Const D3DVSDE_NORMAL = 3&
|
||||
Global Const D3DVSDE_PSIZE = 4&
|
||||
Global Const D3DVSDE_DIFFUSE = 5&
|
||||
Global Const D3DVSDE_SPECULAR = 6&
|
||||
Global Const D3DVSDE_TEXCOORD0 = 7&
|
||||
Global Const D3DVSDE_TEXCOORD1 = 8&
|
||||
Global Const D3DVSDE_TEXCOORD2 = 9&
|
||||
Global Const D3DVSDE_TEXCOORD3 = 10&
|
||||
Global Const D3DVSDE_TEXCOORD4 = 11&
|
||||
Global Const D3DVSDE_TEXCOORD5 = 12&
|
||||
Global Const D3DVSDE_TEXCOORD6 = 13&
|
||||
Global Const D3DVSDE_TEXCOORD7 = 14&
|
||||
Global Const D3DVSDE_POSITION2 = 15&
|
||||
Global Const D3DVSDE_NORMAL2 = 16&
|
||||
|
||||
' Maximum supported number of texture coordinate sets
|
||||
Global Const D3DDP_MAXTEXCOORD = 8
|
||||
|
||||
'---------------------------------------------------------------------
|
||||
'
|
||||
' Pixel Shader (PS) & Vertex Shader (VS) Instruction Token Definition
|
||||
'
|
||||
' **** Version Token ****
|
||||
' [07:00] minor version number
|
||||
' [15:08] major version number
|
||||
' [31:16]
|
||||
' PS 0xFFFF
|
||||
' VS 0xFFFE
|
||||
'
|
||||
' **** End Token ****
|
||||
' [31:00] 0x0000FFFF
|
||||
'
|
||||
' **** Comment Token ****
|
||||
' [15:00] 0xFFFE
|
||||
' [30:16] DWORD Length (up to 2^15 DWORDS = 128KB)
|
||||
' [31] 0x0
|
||||
'
|
||||
' **** Instruction Token ****
|
||||
' [15:00] Opcode (D3DSIO_*)
|
||||
' [23:16] Opcode-Specific Controls
|
||||
' [30:24] Reserved 0x0
|
||||
' [31] 0x0
|
||||
'
|
||||
' **** Destination Parameter Token ****
|
||||
' [07:00] Register Number (offset in register file)
|
||||
' [15:08] Reserved 0x0
|
||||
' [19:16] Write Mask
|
||||
' [16] Component 0 (X;Red)
|
||||
' [17] Component 1 (Y;Green)
|
||||
' [18] Component 2 (Z;Blue)
|
||||
' [19] Component 3 (W;Alpha)
|
||||
' [23:20]
|
||||
' PS Result Modifier (bias;..)
|
||||
' VS Reserved 0x0
|
||||
' [27:24]
|
||||
' PS Result Shift Scale (signed )
|
||||
' VS Reserved 0x0
|
||||
' [30:28] Register Type
|
||||
' [0x0] Temporary Register File
|
||||
' [0x1] Reserved
|
||||
' [0x2] Reserved
|
||||
' [0x3]
|
||||
' VS Address Register (reg num must be zero)
|
||||
' PS Reserved
|
||||
' [0x4]
|
||||
' VS Rasterizer Output Register File
|
||||
' PS Reserved
|
||||
' [0x5]
|
||||
' VS Attribute Output Register File
|
||||
' PS Reserved
|
||||
' [0x6]
|
||||
' VS Texture Coordinate Register File
|
||||
' PS Reserved
|
||||
' [0x7] Reserved
|
||||
' [31] 0x1
|
||||
'
|
||||
' **** Source Parameter Token *****
|
||||
' [12:00] Register Number (offset in register file)
|
||||
' [14:13]
|
||||
' VS Relative Address Register Component
|
||||
' PS Reserved 0x0
|
||||
' [15]
|
||||
' VS Relative Address
|
||||
' PS Reserved 0x0
|
||||
' [23:16] Source Component Swizzle
|
||||
' [17:16] Component 0 Swizzle
|
||||
' [19:18] Component 1 Swizzle
|
||||
' [21:20] Component 2 Swizzle
|
||||
' [23:22] Component 3 Swizzle
|
||||
' [27:24] Source Modifier
|
||||
' [0x0] None
|
||||
' [0x1] Negate
|
||||
' [0x2] Complement
|
||||
' [0x3-0xf] Reserved
|
||||
' [30:28] Register Type
|
||||
' [0x0] Temporary Register File
|
||||
' [0x1] Input Register File
|
||||
' [0x2] global constant Register File
|
||||
' [0x3-0x7] Reserved
|
||||
' [31] 0x1
|
||||
'
|
||||
|
||||
'
|
||||
' Instruction Token Bit Definitions
|
||||
'
|
||||
Global Const D3DSI_OPCODE_MASK = &HFFFF&
|
||||
|
||||
Enum D3DSHADER_INSTRUCTION_OPCODE_TYPE
|
||||
|
||||
D3DSIO_NOP = 0 ' PS/VS
|
||||
D3DSIO_MOV = 1 ' PS/VS
|
||||
D3DSIO_ADD = 2 ' PS/VS
|
||||
D3DSIO_SUB = 3 ' PS
|
||||
D3DSIO_MAD = 4 ' PS/VS
|
||||
D3DSIO_MUL = 5 ' PS/VS
|
||||
D3DSIO_RCP = 6 ' VS
|
||||
D3DSIO_RSQ = 7 ' VS
|
||||
D3DSIO_DP3 = 8 ' PS/VS
|
||||
D3DSIO_DP4 = 9 ' VS
|
||||
D3DSIO_MIN = 10 ' VS
|
||||
D3DSIO_MAX = 11 ' VS
|
||||
D3DSIO_SLT = 12 ' VS
|
||||
D3DSIO_SGE = 13 ' VS
|
||||
D3DSIO_EXP = 14 ' VS
|
||||
D3DSIO_LOG = 15 ' VS
|
||||
D3DSIO_LIT = 16 ' VS
|
||||
D3DSIO_DST = 17 ' VS
|
||||
D3DSIO_LRP = 18 ' PS
|
||||
D3DSIO_FRC = 19 ' VS
|
||||
D3DSIO_M4x4 = 20 ' VS
|
||||
D3DSIO_M4x3 = 21 ' VS
|
||||
D3DSIO_M3x4 = 22 ' VS
|
||||
D3DSIO_M3x3 = 23 ' VS
|
||||
D3DSIO_M3x2 = 24 ' VS
|
||||
|
||||
D3DSIO_TEXCOORD = 64 ' PS
|
||||
D3DSIO_TEXKILL = 65 ' PS
|
||||
D3DSIO_TEX = 66 ' PS
|
||||
D3DSIO_TEXBEM = 67 ' PS
|
||||
D3DSIO_TEXBEML = 68 ' PS
|
||||
D3DSIO_TEXREG2AR = 69 ' PS
|
||||
D3DSIO_TEXREG2GB = 70 ' PS
|
||||
D3DSIO_TEXM3x2PAD = 71 ' PS
|
||||
D3DSIO_TEXM3x2TEX = 72 ' PS
|
||||
D3DSIO_TEXM3x3PAD = 73 ' PS
|
||||
D3DSIO_TEXM3x3TEX = 74 ' PS
|
||||
D3DSIO_TEXM3x3DIFF = 75 ' PS
|
||||
D3DSIO_TEXM3x3SPEC = 76 ' PS
|
||||
D3DSIO_TEXM3x3VSPEC = 77 ' PS
|
||||
D3DSIO_EXPP = 78 ' VS
|
||||
D3DSIO_LOGP = 79 ' VS
|
||||
D3DSIO_CND = 80 ' PS
|
||||
D3DSIO_DEF = 81 ' PS
|
||||
|
||||
D3DSIO_COMMENT = &HFFFE&
|
||||
D3DSIO_END = &HFFFF&
|
||||
End Enum
|
||||
|
||||
'
|
||||
' Co-Issue Instruction Modifier - if set then this instruction is to be
|
||||
' issued in parallel with the previous instruction(s) for which this bit
|
||||
' is not set.
|
||||
'
|
||||
Global Const D3DSI_COISSUE = &H40000000
|
||||
|
||||
|
||||
'
|
||||
' Parameter Token Bit Definitions
|
||||
'
|
||||
Global Const D3DSP_REGNUM_MASK = &HFFF&
|
||||
|
||||
' destination parameter write mask
|
||||
Global Const D3DSP_WRITEMASK_0 = &H10000 ' Component 0 (X;Red)
|
||||
Global Const D3DSP_WRITEMASK_1 = &H20000 ' Component 1 (Y;Green)
|
||||
Global Const D3DSP_WRITEMASK_2 = &H40000 ' Component 2 (Z;Blue)
|
||||
Global Const D3DSP_WRITEMASK_3 = &H80000 ' Component 3 (W;Alpha)
|
||||
Global Const D3DSP_WRITEMASK_ALL = &HF0000 ' All Components
|
||||
|
||||
' destination parameter modifiers
|
||||
Global Const D3DSP_DSTMOD_SHIFT = 20
|
||||
Global Const D3DSP_DSTMOD_MASK = &HF00000
|
||||
|
||||
Enum D3DSHADER_PARAM_DSTMOD_TYPE
|
||||
|
||||
D3DSPDM_NONE = 0 * 2 ^ D3DSP_DSTMOD_SHIFT '0<<D3DSP_DSTMOD_SHIFT, ' nop
|
||||
D3DSPDM_SATURATE = 1 * 2 ^ D3DSP_DSTMOD_SHIFT '1<<D3DSP_DSTMOD_SHIFT, 'clamp 0 to 1 range
|
||||
|
||||
End Enum
|
||||
|
||||
' destination parameter
|
||||
Global Const D3DSP_DSTSHIFT_SHIFT = 24
|
||||
Global Const D3DSP_DSTSHIFT_MASK = &HF000000
|
||||
|
||||
' destination/source parameter register type
|
||||
Global Const D3DSP_REGTYPE_SHIFT = 28
|
||||
Global Const D3DSP_REGTYPE_MASK = &H70000000
|
||||
|
||||
Global Const D3DVSD_STREAMTESSSHIFT = 28
|
||||
Global Const D3DVSD_STREAMTESSMASK = 2 ^ D3DVSD_STREAMTESSSHIFT '(1 << D3DVSD_STREAMTESSSHIFT)
|
||||
|
||||
Enum D3DSHADER_PARAM_REGISTER_TYPE
|
||||
|
||||
D3DSPR_TEMP = &H0& '0<<D3DSP_REGTYPE_SHIFT, ' Temporary Register File
|
||||
D3DSPR_INPUT = &H20000000 '1<<D3DSP_REGTYPE_SHIFT, ' Input Register File
|
||||
D3DSPR_CONST = &H40000000 '2<<D3DSP_REGTYPE_SHIFT, ' global constant Register File
|
||||
D3DSPR_ADDR = &H60000000 '3<<D3DSP_REGTYPE_SHIFT, ' Address Register (VS)
|
||||
D3DSPR_TEXTURE = &H60000000 '3<<D3DSP_REGTYPE_SHIFT, ' Texture Register File (PS)
|
||||
D3DSPR_RASTOUT = &H80000000 '4<<D3DSP_REGTYPE_SHIFT, ' Rasterizer Register File
|
||||
D3DSPR_ATTROUT = &HA0000000 '5<<D3DSP_REGTYPE_SHIFT, ' Attribute Output Register File
|
||||
D3DSPR_TEXCRDOUT = &HC0000000 '6<<D3DSP_REGTYPE_SHIFT, ' Texture Coordinate Output Register File
|
||||
End Enum
|
||||
|
||||
' Register offsets in the Rasterizer Register File
|
||||
'
|
||||
Enum D3DVS_RASTOUT_OFFSETS
|
||||
D3DSRO_POSITION = 0
|
||||
D3DSRO_FOG = 1
|
||||
D3DSRO_POINT_SIZE = 2
|
||||
End Enum
|
||||
|
||||
' Source operand addressing modes
|
||||
|
||||
Global Const D3DVS_ADDRESSMODE_SHIFT = 13
|
||||
Global Const D3DVS_ADDRESSMODE_MASK = (2 ^ D3DVS_ADDRESSMODE_SHIFT)
|
||||
|
||||
Enum D3DVS_ADRRESSMODE_TYPE
|
||||
D3DVS_ADDRMODE_ABSOLUTE = 0 '(0 << D3DVS_ADDRESSMODE_SHIFT),
|
||||
D3DVS_ADDRMODE_RELATIVE = 2 ^ D3DVS_ADDRESSMODE_SHIFT '(1 << D3DVS_ADDRESSMODE_SHIFT) ' Relative to register A0
|
||||
End Enum
|
||||
|
||||
' Source operand swizzle definitions
|
||||
'
|
||||
Global Const D3DVS_SWIZZLE_SHIFT = 16
|
||||
Global Const D3DVS_SWIZZLE_MASK = &HFF0000
|
||||
|
||||
' The following bits define where to take component X:
|
||||
|
||||
Global Const D3DVS_X_X = (0 * 2 ^ D3DVS_SWIZZLE_SHIFT) '(0 << D3DVS_SWIZZLE_SHIFT)
|
||||
Global Const D3DVS_X_Y = (1 * 2 ^ D3DVS_SWIZZLE_SHIFT) '(1 << D3DVS_SWIZZLE_SHIFT)
|
||||
Global Const D3DVS_X_Z = (2 * 2 ^ D3DVS_SWIZZLE_SHIFT) '(2 << D3DVS_SWIZZLE_SHIFT)
|
||||
Global Const D3DVS_X_W = (3 * 2 ^ D3DVS_SWIZZLE_SHIFT) '(3 << D3DVS_SWIZZLE_SHIFT)
|
||||
|
||||
' The following bits define where to take component Y:
|
||||
|
||||
Global Const D3DVS_Y_X = (0 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 2)) ' (0 << (D3DVS_SWIZZLE_SHIFT + 2))
|
||||
Global Const D3DVS_Y_Y = (1 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 2)) ' (1 << (D3DVS_SWIZZLE_SHIFT + 2))
|
||||
Global Const D3DVS_Y_Z = (2 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 2)) ' (2 << (D3DVS_SWIZZLE_SHIFT + 2))
|
||||
Global Const D3DVS_Y_W = (3 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 2)) ' (3 << (D3DVS_SWIZZLE_SHIFT + 2))
|
||||
|
||||
' The following bits define where to take component Z:
|
||||
|
||||
Global Const D3DVS_Z_X = (0 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 4)) '(0 << (D3DVS_SWIZZLE_SHIFT + 4))
|
||||
Global Const D3DVS_Z_Y = (1 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 4)) '(1 << (D3DVS_SWIZZLE_SHIFT + 4))
|
||||
Global Const D3DVS_Z_Z = (2 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 4)) '(2 << (D3DVS_SWIZZLE_SHIFT + 4))
|
||||
Global Const D3DVS_Z_W = (3 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 4)) '(3 << (D3DVS_SWIZZLE_SHIFT + 4))
|
||||
|
||||
' The following bits define where to take component W:
|
||||
|
||||
Global Const D3DVS_W_X = (0 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 6)) '(0 << (D3DVS_SWIZZLE_SHIFT + 6))
|
||||
Global Const D3DVS_W_Y = (1 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 6)) '(1 << (D3DVS_SWIZZLE_SHIFT + 6))
|
||||
Global Const D3DVS_W_Z = (2 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 6)) '(2 << (D3DVS_SWIZZLE_SHIFT + 6))
|
||||
Global Const D3DVS_W_W = (3 * 2 ^ (D3DVS_SWIZZLE_SHIFT + 6)) '(3 << (D3DVS_SWIZZLE_SHIFT + 6))
|
||||
|
||||
' Value when there is no swizzle (X is taken from X, Y is taken from Y,
|
||||
' Z is taken from Z, W is taken from W
|
||||
'
|
||||
Global Const D3DVS_NOSWIZZLE = (D3DVS_X_X Or D3DVS_Y_Y Or D3DVS_Z_Z Or D3DVS_W_W)
|
||||
|
||||
' source parameter swizzle
|
||||
Global Const D3DSP_SWIZZLE_SHIFT = 16
|
||||
Global Const D3DSP_SWIZZLE_MASK = &HFF0000
|
||||
|
||||
Global Const D3DSP_NOSWIZZLE = _
|
||||
((0 * 2 ^ (D3DSP_SWIZZLE_SHIFT + 0)) Or _
|
||||
(1 * 2 ^ (D3DSP_SWIZZLE_SHIFT + 2)) Or _
|
||||
(2 * 2 ^ (D3DSP_SWIZZLE_SHIFT + 4)) Or _
|
||||
(3 * 2 ^ (D3DSP_SWIZZLE_SHIFT + 6)))
|
||||
|
||||
' pixel-shader swizzle ops
|
||||
Global Const D3DSP_REPLICATEALPHA = _
|
||||
((3 * 2 ^ (D3DSP_SWIZZLE_SHIFT + 0)) Or _
|
||||
(3 * 2 ^ (D3DSP_SWIZZLE_SHIFT + 2)) Or _
|
||||
(3 * 2 ^ (D3DSP_SWIZZLE_SHIFT + 4)) Or _
|
||||
(3 * 2 ^ (D3DSP_SWIZZLE_SHIFT + 6)))
|
||||
|
||||
|
||||
' source parameter modifiers
|
||||
Global Const D3DSP_SRCMOD_SHIFT = 24
|
||||
Global Const D3DSP_SRCMOD_MASK = &HF000000
|
||||
|
||||
Enum D3DSHADER_PARAM_SRCMOD_TYPE
|
||||
D3DSPSM_NONE = 0 * 2 ^ D3DSP_SRCMOD_SHIFT '0<<D3DSP_SRCMOD_SHIFT, ' nop
|
||||
D3DSPSM_NEG = 1 * 2 ^ D3DSP_SRCMOD_SHIFT ' negate
|
||||
D3DSPSM_BIAS = 2 * 2 ^ D3DSP_SRCMOD_SHIFT ' bias
|
||||
D3DSPSM_BIASNEG = 3 * 2 ^ D3DSP_SRCMOD_SHIFT ' bias and negate
|
||||
D3DSPSM_SIGN = 4 * 2 ^ D3DSP_SRCMOD_SHIFT ' sign
|
||||
D3DSPSM_SIGNNEG = 5 * 2 ^ D3DSP_SRCMOD_SHIFT ' sign and negate
|
||||
D3DSPSM_COMP = 6 * 2 ^ D3DSP_SRCMOD_SHIFT ' complement
|
||||
End Enum
|
||||
|
||||
|
||||
|
||||
'''''''''''''''''''''''''''''''''''
|
||||
'PIXELSHADER FUNCTIONS
|
||||
'''''''''''''''''''''''''''''''''''
|
||||
|
||||
|
||||
' pixel shader version token
|
||||
Function D3DPS_VERSION(Major As Long, Minor As Long) As Long
|
||||
D3DPS_VERSION = (&HFFFF0000 Or ((Major) * 2 ^ 8) Or (Minor))
|
||||
End Function
|
||||
|
||||
|
||||
' vertex shader version token
|
||||
Function D3DVS_VERSION(Major As Long, Minor As Long) As Long
|
||||
D3DVS_VERSION = (&HFFFE0000 Or ((Major) * 2 ^ 8) Or (Minor))
|
||||
End Function
|
||||
|
||||
|
||||
' extract major/minor from version cap
|
||||
Function D3DSHADER_VERSION_MAJOR(Version As Long) As Long
|
||||
D3DSHADER_VERSION_MAJOR = (((Version) \ 8) And &HFF&)
|
||||
End Function
|
||||
|
||||
Function D3DSHADER_VERSION_MINOR(Version As Long) As Long
|
||||
D3DSHADER_VERSION_MINOR = (((Version)) And &HFF&)
|
||||
End Function
|
||||
|
||||
|
||||
Function D3DSHADER_COMMENT(DWordSize As Long) As Long
|
||||
D3DSHADER_COMMENT = ((((DWordSize) * 2 ^ D3DSI_COMMENTSIZE_SHIFT) And D3DSI_COMMENTSIZE_MASK) Or D3DSIO_COMMENT)
|
||||
End Function
|
||||
|
||||
|
||||
' pixel/vertex shader end token
|
||||
Function D3DPS_END() As Long
|
||||
D3DPS_END = &HFFFF&
|
||||
End Function
|
||||
|
||||
Function D3DVS_END() As Long
|
||||
D3DVS_END = &HFFFF&
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
'''''''''''''''''''''''''''''''''''
|
||||
'VERTEXSHADER FUNCTIONS
|
||||
'''''''''''''''''''''''''''''''''''
|
||||
|
||||
|
||||
Function D3DVSD_MAKETOKENTYPE(tokenType As Long) As Long
|
||||
Dim out As Long
|
||||
Select Case tokenType
|
||||
Case D3DVSD_TOKEN_NOP '0
|
||||
out = 0
|
||||
Case D3DVSD_TOKEN_STREAM '1 ' stream selector
|
||||
out = &H20000000
|
||||
Case D3DVSD_TOKEN_STREAMDATA '2 ' stream data definition (map to vertex input memory)
|
||||
out = &H40000000
|
||||
Case D3DVSD_TOKEN_TESSELLATOR ' 3 ' vertex input memory from tessellator
|
||||
out = &H60000000
|
||||
Case D3DVSD_TOKEN_constMEM '4 ' global constant memory from shader
|
||||
out = &H80000000
|
||||
Case D3DVSD_TOKEN_EXT '5 ' extension
|
||||
out = &HA0000000
|
||||
Case D3DVSD_TOKEN_END '7 ' end-of-array (requires all DWORD bits to be 1)
|
||||
out = &HFFFFFFFF
|
||||
End Select
|
||||
D3DVSD_MAKETOKENTYPE = out And D3DVSD_TOKENTYPEMASK
|
||||
End Function
|
||||
|
||||
|
||||
' macros for generation of CreateVertexShader Declaration token array
|
||||
|
||||
' Set current stream
|
||||
' _StreamNumber [0..(MaxStreams-1)] stream to get data from
|
||||
'
|
||||
Function D3DVSD_STREAM(StreamNumber As Long) As Long
|
||||
D3DVSD_STREAM = (D3DVSD_MAKETOKENTYPE(D3DVSD_TOKEN_STREAM) Or (StreamNumber))
|
||||
End Function
|
||||
|
||||
|
||||
' Set tessellator stream
|
||||
'
|
||||
Function D3DVSD_STREAM_TESS() As Long
|
||||
D3DVSD_STREAM_TESS = (D3DVSD_MAKETOKENTYPE(D3DVSD_TOKEN_STREAM) Or (D3DVSD_STREAMTESSMASK))
|
||||
End Function
|
||||
|
||||
|
||||
' bind single vertex register to vertex element from vertex stream
|
||||
'
|
||||
' VertexRegister [0..15] address of the vertex register
|
||||
' dataType [D3DVSDT_*] dimensionality and arithmetic data type
|
||||
Function D3DVSD_REG(VertexRegister As Long, dataType As Long) As Long
|
||||
D3DVSD_REG = (D3DVSD_MAKETOKENTYPE(D3DVSD_TOKEN_STREAMDATA) Or _
|
||||
((dataType) * 2 ^ D3DVSD_DATATYPESHIFT) Or (VertexRegister))
|
||||
End Function
|
||||
|
||||
' Skip DWORDCount DWORDs (vb longs) in vertex
|
||||
'
|
||||
Function D3DVSD_SKIP(DWORDCount As Long) As Long
|
||||
D3DVSD_SKIP = (D3DVSD_MAKETOKENTYPE(D3DVSD_TOKEN_STREAMDATA) Or &H10000000 Or _
|
||||
((DWORDCount) * 2 ^ D3DVSD_SKIPCOUNTSHIFT))
|
||||
End Function
|
||||
|
||||
' load data into vertex shader global constant memory
|
||||
'
|
||||
' _constantAddress [0..95] - address of global constant array to begin filling data
|
||||
' _Count [0..15] - number of global constant vectors to load (4 DWORDs each)
|
||||
' followed by 4*_Count DWORDS of data
|
||||
'
|
||||
Function D3DVSD_CONST(constantAddress As Long, count As Long) As Long
|
||||
D3DVSD_CONST = (D3DVSD_MAKETOKENTYPE(D3DVSD_TOKEN_constMEM) Or _
|
||||
((count) * 2 ^ D3DVSD_CONSTCOUNTSHIFT) Or (constantAddress))
|
||||
End Function
|
||||
|
||||
' enable tessellator generated normals
|
||||
'
|
||||
' VertexRegisterIn [0..15] address of vertex register whose input stream
|
||||
' will be used in normal computation
|
||||
' VertexRegisterOut [0..15] address of vertex register to output the normal to
|
||||
'
|
||||
Function D3DVSD_TESSNORMAL(VertexRegisterIn As Long, VertexRegisterOut As Long) As Long
|
||||
D3DVSD_TESSNORMAL = (D3DVSD_MAKETOKENTYPE(D3DVSD_TOKEN_TESSELLATOR) Or _
|
||||
((VertexRegisterIn) * 2 ^ D3DVSD_VERTEXREGINSHIFT) Or _
|
||||
((&H2&) * 2 ^ D3DVSD_DATATYPESHIFT) Or (VertexRegisterOut))
|
||||
End Function
|
||||
|
||||
|
||||
' enable tessellator generated surface parameters
|
||||
'
|
||||
' VertexRegister [0..15] address of vertex register to output parameters
|
||||
'
|
||||
Function D3DVSD_TESSUV(VertexRegister As Long) As Long
|
||||
D3DVSD_TESSUV = (D3DVSD_MAKETOKENTYPE(D3DVSD_TOKEN_TESSELLATOR) Or &H10000000 Or _
|
||||
((&H1&) * 2 ^ D3DVSD_DATATYPESHIFT) Or (VertexRegister))
|
||||
End Function
|
||||
|
||||
' Generates END token
|
||||
'
|
||||
Function D3DVSD_END() As Long
|
||||
D3DVSD_END = &HFFFFFFFF
|
||||
End Function
|
||||
|
||||
Function D3DVSD_NOP() As Long
|
||||
D3DVSD_NOP = 0
|
||||
End Function
|
||||
|
||||
|
||||
1182
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dutil.bas
Normal file
1182
Library/dxx8/samples/Multimedia/VBSamples/Common/d3dutil.bas
Normal file
File diff suppressed because it is too large
Load Diff
57
Library/dxx8/samples/Multimedia/VBSamples/Common/media.bas
Normal file
57
Library/dxx8/samples/Multimedia/VBSamples/Common/media.bas
Normal file
@@ -0,0 +1,57 @@
|
||||
Attribute VB_Name = "MediaDir"
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: media.bas
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
'Registry constants
|
||||
Private Const KEY_READ = 131097
|
||||
Private Const REG_SZ = 1
|
||||
Private Const HKEY_LOCAL_MACHINE = &H80000002
|
||||
'Registry API's
|
||||
Private Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long
|
||||
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
|
||||
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
|
||||
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
|
||||
|
||||
Public Function FindMediaDir(ByVal sFile As String, Optional ByVal fUseCMedia As Boolean = False) As String
|
||||
If Dir$(sFile, vbNormal) <> vbNullString Then 'This file is the current folder
|
||||
FindMediaDir = AddDirSep(CurDir)
|
||||
Exit Function
|
||||
End If
|
||||
If fUseCMedia Then
|
||||
FindMediaDir = AddDirSep(GetDXSampleFolder) & "media\"
|
||||
Else
|
||||
FindMediaDir = AddDirSep(GetDXSampleFolder) & "vbsamples\media\"
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Function AddDirSep(ByVal sPath As String) As String
|
||||
AddDirSep = sPath
|
||||
If Right$(sPath, 1) <> "\" Then
|
||||
AddDirSep = sPath & "\"
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Function GetDXSampleFolder() As String
|
||||
Dim lHandle As Long
|
||||
Dim lNewHandle As Long, sValue As String
|
||||
Dim lNewKey As Long
|
||||
|
||||
RegConnectRegistry vbNullString, HKEY_LOCAL_MACHINE, lHandle
|
||||
RegOpenKeyEx lHandle, "SOFTWARE\Microsoft\DirectX SDK", 0, KEY_READ, lNewHandle
|
||||
sValue = Space$(255)
|
||||
RegQueryValueEx lNewHandle, "DX81SDK Samples Path", 0, REG_SZ, sValue, 255
|
||||
If sValue <> Space$(255) Then
|
||||
sValue = Left$(sValue, InStr(sValue, Chr$(0)) - 1)
|
||||
Else
|
||||
sValue = vbNullString
|
||||
End If
|
||||
RegCloseKey lNewHandle
|
||||
RegCloseKey lHandle
|
||||
GetDXSampleFolder = sValue
|
||||
End Function
|
||||
@@ -0,0 +1,358 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmSelectDevice
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "Select Device"
|
||||
ClientHeight = 2805
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 5865
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 2805
|
||||
ScaleWidth = 5865
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.Frame optRenderingModeoptRenderingMode
|
||||
Caption = "Rendering Mode"
|
||||
Height = 1335
|
||||
Left = 120
|
||||
TabIndex = 7
|
||||
Top = 1320
|
||||
Width = 4575
|
||||
Begin VB.ComboBox cboFullScreenMode
|
||||
Enabled = 0 'False
|
||||
Height = 315
|
||||
Left = 2040
|
||||
Style = 2 'Dropdown List
|
||||
TabIndex = 10
|
||||
Top = 720
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.OptionButton optRenderingMode
|
||||
Caption = "&Fullscreen mode"
|
||||
Height = 375
|
||||
Index = 1
|
||||
Left = 240
|
||||
TabIndex = 9
|
||||
Top = 690
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.OptionButton optRenderingMode
|
||||
Caption = "Use desktop &window"
|
||||
Height = 375
|
||||
Index = 0
|
||||
Left = 240
|
||||
TabIndex = 8
|
||||
Top = 240
|
||||
Value = -1 'True
|
||||
Width = 1815
|
||||
End
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Caption = "Cancel"
|
||||
Height = 375
|
||||
Left = 4800
|
||||
TabIndex = 4
|
||||
Top = 720
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdOk
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 375
|
||||
Left = 4800
|
||||
TabIndex = 3
|
||||
Top = 240
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Frame Frame1
|
||||
Caption = "Rendering device"
|
||||
Height = 1095
|
||||
Left = 120
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 4575
|
||||
Begin VB.ComboBox cboDevice
|
||||
Height = 315
|
||||
Left = 1440
|
||||
Style = 2 'Dropdown List
|
||||
TabIndex = 6
|
||||
Top = 600
|
||||
Width = 2775
|
||||
End
|
||||
Begin VB.ComboBox cboAdapter
|
||||
Height = 315
|
||||
Left = 1440
|
||||
Style = 2 'Dropdown List
|
||||
TabIndex = 2
|
||||
Top = 240
|
||||
Width = 2775
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
AutoSize = -1 'True
|
||||
Caption = "D3D &device:"
|
||||
Height = 195
|
||||
Left = 360
|
||||
TabIndex = 5
|
||||
Top = 660
|
||||
Width = 900
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
AutoSize = -1 'True
|
||||
Caption = "&Adapter:"
|
||||
Height = 195
|
||||
Left = 360
|
||||
TabIndex = 1
|
||||
Top = 300
|
||||
Width = 600
|
||||
End
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmSelectDevice"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
|
||||
Dim m_callback As Object
|
||||
|
||||
Public Sub SelectDevice(callback As Object)
|
||||
|
||||
If callback Is Nothing Then Exit Sub
|
||||
Set m_callback = callback
|
||||
|
||||
Dim dm As D3DDISPLAYMODE
|
||||
|
||||
If g_d3dpp.Windowed = 0 Then
|
||||
|
||||
m_callback.InvalidateDeviceObjects
|
||||
|
||||
D3DUtil_ResetWindowed
|
||||
|
||||
m_callback.RestoreDeviceObjects
|
||||
|
||||
End If
|
||||
|
||||
Me.Show 1
|
||||
|
||||
Set m_callback = Nothing
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub cboAdapter_Click()
|
||||
|
||||
Dim devtype As CONST_D3DDEVTYPE
|
||||
|
||||
If (cboDevice.ListIndex = 1) Then
|
||||
devtype = D3DDEVTYPE_REF
|
||||
Else
|
||||
devtype = D3DDEVTYPE_HAL
|
||||
End If
|
||||
|
||||
Call UpdateModes(cboAdapter.ListIndex, devtype)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub cboDevice_Change()
|
||||
|
||||
Dim devtype As CONST_D3DDEVTYPE
|
||||
|
||||
If (cboDevice.ListIndex = 1) Then
|
||||
devtype = D3DDEVTYPE_REF
|
||||
Else
|
||||
devtype = D3DDEVTYPE_HAL
|
||||
End If
|
||||
|
||||
Call UpdateModes(cboAdapter.ListIndex, devtype)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub cmdCancel_Click()
|
||||
|
||||
Set m_callback = Nothing
|
||||
Unload Me
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOk_Click()
|
||||
|
||||
On Local Error Resume Next
|
||||
|
||||
Dim bAdapterChanged As Boolean
|
||||
Dim bRasterizerChanged As Boolean
|
||||
Dim bRef As Boolean
|
||||
Dim lWindowed As Long
|
||||
Dim AdapterID As Long
|
||||
Dim ModeID As Long
|
||||
Dim devtype As CONST_D3DDEVTYPE
|
||||
|
||||
AdapterID = cboAdapter.ListIndex
|
||||
ModeID = cboFullScreenMode.ListIndex
|
||||
|
||||
' see if user changed adapters
|
||||
If g_lCurrentAdapter <> AdapterID Then bAdapterChanged = True
|
||||
|
||||
bRef = g_Adapters(g_lCurrentAdapter).bReference
|
||||
|
||||
If (cboDevice.ListIndex = 1) Then
|
||||
devtype = D3DDEVTYPE_REF
|
||||
Else
|
||||
devtype = D3DDEVTYPE_HAL
|
||||
End If
|
||||
|
||||
' see if user changed rasterizers
|
||||
If (devtype = D3DDEVTYPE_REF And bRef = False) Then bRasterizerChanged = True
|
||||
If (devtype = D3DDEVTYPE_HAL And bRef = True) Then bRasterizerChanged = True
|
||||
|
||||
|
||||
If optRenderingMode(1).Value = True Then
|
||||
lWindowed = 0
|
||||
Else
|
||||
lWindowed = 1
|
||||
End If
|
||||
|
||||
' if they didnt change adapters or switch to refrast, then we can just use reset
|
||||
If bAdapterChanged = False And bRasterizerChanged = False Then
|
||||
|
||||
'If trying to go Fullscreen
|
||||
If lWindowed = 0 Then
|
||||
|
||||
'call g_dev.reset
|
||||
Call D3DUtil_ResizeFullscreen(g_focushwnd, cboFullScreenMode.ListIndex)
|
||||
|
||||
Else
|
||||
|
||||
Call D3DUtil_ResizeWindowed(g_focushwnd)
|
||||
|
||||
End If
|
||||
|
||||
'tell user needs to restore device objects
|
||||
m_callback.RestoreDeviceObjects
|
||||
|
||||
'exit modal dialog
|
||||
Unload Me
|
||||
Exit Sub
|
||||
|
||||
End If
|
||||
|
||||
Set g_dev = Nothing
|
||||
|
||||
D3DUtil_ReleaseAllTexturesFromPool
|
||||
|
||||
'tell user to lose reference counts in its objects device objects
|
||||
m_callback.InvalidateDeviceObjects
|
||||
m_callback.DeleteDeviceObjects
|
||||
|
||||
'Reinitialize D3D
|
||||
If lWindowed = 0 Then
|
||||
D3DUtil_InitFullscreen g_focushwnd, AdapterID, ModeID, devtype, True
|
||||
Else
|
||||
D3DUtil_InitWindowed g_focushwnd, AdapterID, devtype, True
|
||||
End If
|
||||
If g_dev Is Nothing Then
|
||||
'The app still hit an error. Both HAL and REF devices weren't created. The app will have to exit at this point.
|
||||
MsgBox "No suitable device was found to initialize D3D. Application will now exit.", vbCritical
|
||||
End
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
'tell user to re-create device objects
|
||||
m_callback.InitDeviceObjects
|
||||
|
||||
'tell user to restore device objects
|
||||
m_callback.RestoreDeviceObjects
|
||||
|
||||
'exit modal dialog
|
||||
Unload Me
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
|
||||
Call UpdateAdapters
|
||||
Call UpdateDevices(g_lCurrentAdapter)
|
||||
Call UpdateModes(g_lCurrentAdapter, g_Adapters(g_lCurrentAdapter).DeviceType)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub UpdateAdapters()
|
||||
|
||||
Dim i As Long, j As Long
|
||||
Dim sDescription As String
|
||||
|
||||
cboAdapter.Clear
|
||||
|
||||
For i = 0 To g_lNumAdapters - 1
|
||||
|
||||
sDescription = vbNullString
|
||||
' For j = 0 To 511
|
||||
' sDescription = sDescription & Chr$(g_Adapters(i).d3dai.Description(j))
|
||||
' Next
|
||||
' sDescription = Replace$(sDescription, Chr$(0), " ")
|
||||
sDescription = StrConv(g_Adapters(i).d3dai.Description, vbUnicode)
|
||||
cboAdapter.AddItem sDescription
|
||||
Next
|
||||
|
||||
cboAdapter.ListIndex = g_lCurrentAdapter
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub UpdateDevices(adapter As Long)
|
||||
|
||||
Dim i As Long
|
||||
|
||||
cboDevice.Clear
|
||||
|
||||
cboDevice.AddItem "HAL"
|
||||
cboDevice.AddItem "REF"
|
||||
|
||||
'If g_Adapters(g_lCurrentAdapter).bReference Then
|
||||
If g_Adapters(adapter).bReference Then
|
||||
cboDevice.ListIndex = 1
|
||||
Else
|
||||
cboDevice.ListIndex = 0
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub UpdateModes(adapter As Long, devtype As CONST_D3DDEVTYPE)
|
||||
|
||||
Dim i As Long
|
||||
Dim pAdapter As D3DUTIL_ADAPTERINFO
|
||||
Dim sModeString As String
|
||||
|
||||
cboFullScreenMode.Clear
|
||||
|
||||
With g_Adapters(adapter).DevTypeInfo(devtype)
|
||||
For i = 0 To .lNumModes - 1
|
||||
sModeString = .Modes(i).lWidth & " x "
|
||||
sModeString = sModeString & .Modes(i).lHeight & " x "
|
||||
If .Modes(i).format = D3DFMT_X8R8G8B8 Or _
|
||||
.Modes(i).format = D3DFMT_A8R8G8B8 Or _
|
||||
.Modes(i).format = D3DFMT_R8G8B8 Then
|
||||
sModeString = sModeString & "32"
|
||||
Else
|
||||
sModeString = sModeString & "16"
|
||||
End If
|
||||
|
||||
cboFullScreenMode.AddItem sModeString
|
||||
Next
|
||||
If cboFullScreenMode.ListCount > 0 Then cboFullScreenMode.ListIndex = .lCurrentMode
|
||||
End With
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub optRenderingMode_Click(Index As Integer)
|
||||
|
||||
If Index = 1 Then
|
||||
cboFullScreenMode.Enabled = True
|
||||
Else
|
||||
cboFullScreenMode.Enabled = False
|
||||
End If
|
||||
|
||||
End Sub
|
||||
@@ -0,0 +1,163 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "cAudio"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'We will keep our Audio vars here
|
||||
Private dmPerf As DirectMusicPerformance8
|
||||
Private dmLoad As DirectMusicLoader8
|
||||
Private dmMusic As DirectMusicSegment8
|
||||
Private dmMusicPath As DirectMusicAudioPath8
|
||||
|
||||
Private dmSegBank As cAudioFile
|
||||
Private dmSegHit As cAudioFile
|
||||
Private dmScore As cAudioFile
|
||||
|
||||
Public PlaySounds As Boolean
|
||||
Public PlayMusic As Boolean
|
||||
|
||||
Private mlSoundVolume As Long
|
||||
Private mlMusicVolume As Long
|
||||
|
||||
Private Sub InitializeBackgroundMusic(ByVal sPath As String)
|
||||
If dmMusicPath Is Nothing Then 'We haven't created our path yet
|
||||
Set dmMusicPath = dmPerf.CreateStandardAudioPath(DMUS_APATH_SHARED_STEREOPLUSREVERB, 128, True)
|
||||
End If
|
||||
If Not (dmMusic Is Nothing) Then
|
||||
dmMusic.Unload dmMusicPath
|
||||
Set dmMusic = Nothing
|
||||
End If
|
||||
Set dmMusic = dmLoad.LoadSegment(sPath)
|
||||
dmMusic.Download dmMusicPath
|
||||
dmMusic.SetStandardMidiFile
|
||||
End Sub
|
||||
|
||||
Public Sub StartBackgroundMusic()
|
||||
If Not PlayMusic Then Exit Sub
|
||||
If Not (dmMusic Is Nothing) Then
|
||||
'Keep repeating over and over again
|
||||
dmMusic.SetRepeats INFINITE
|
||||
dmPerf.PlaySegmentEx dmMusic, DMUS_SEGF_DEFAULT, 0, dmMusicPath, dmMusicPath
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub StopBackgroundMusic()
|
||||
If Not (dmMusic Is Nothing) Then
|
||||
'Lets just stop
|
||||
dmPerf.StopEx dmMusic, 0, 0
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub PlayBankSound()
|
||||
If Not PlaySounds Then Exit Sub
|
||||
'Play the sound that happens when the puck hits the side wall
|
||||
dmSegBank.Play dmPerf
|
||||
End Sub
|
||||
|
||||
Public Sub PlayHitSound()
|
||||
If Not PlaySounds Then Exit Sub
|
||||
'Play the sound that happens when a paddle hits the puck
|
||||
dmSegHit.Play dmPerf
|
||||
End Sub
|
||||
|
||||
Public Sub PlayScoreSound()
|
||||
If Not PlaySounds Then Exit Sub
|
||||
'Play the sound that happens when we score
|
||||
dmScore.Play dmPerf
|
||||
End Sub
|
||||
|
||||
Public Property Let MusicVolume(ByVal lVol As Long)
|
||||
mlMusicVolume = lVol
|
||||
'Actually set the volume
|
||||
If Not (dmMusicPath Is Nothing) Then dmMusicPath.SetVolume lVol, 0
|
||||
End Property
|
||||
|
||||
Public Property Get MusicVolume() As Long
|
||||
MusicVolume = mlMusicVolume
|
||||
End Property
|
||||
|
||||
Public Property Let SoundVolume(ByVal lVol As Long)
|
||||
mlSoundVolume = lVol
|
||||
'Actually set the volume
|
||||
If Not (dmPerf Is Nothing) Then
|
||||
If Not (dmPerf.GetDefaultAudioPath Is Nothing) Then dmPerf.GetDefaultAudioPath.SetVolume lVol, 0
|
||||
End If
|
||||
End Property
|
||||
|
||||
Public Property Get SoundVolume() As Long
|
||||
SoundVolume = mlSoundVolume
|
||||
End Property
|
||||
|
||||
Public Function InitAudio() As Boolean
|
||||
|
||||
Dim lCount As Long, dma As DMUS_AUDIOPARAMS
|
||||
|
||||
InitAudio = True
|
||||
On Error GoTo FailedInit
|
||||
'Create our objects
|
||||
Set dmPerf = dx.DirectMusicPerformanceCreate
|
||||
Set dmLoad = dx.DirectMusicLoaderCreate
|
||||
|
||||
'Create a default audio path
|
||||
dmPerf.InitAudio frmAir.hwnd, DMUS_AUDIOF_ALL, dma, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
|
||||
|
||||
'Create the sound objects
|
||||
Set dmSegBank = New cAudioFile
|
||||
Set dmSegHit = New cAudioFile
|
||||
Set dmScore = New cAudioFile
|
||||
'Load each of the sounds
|
||||
dmSegBank.InitSounds dmPerf, dmLoad, App.path & "\sounds\", "bank", ".wav"
|
||||
dmSegHit.InitSounds dmPerf, dmLoad, App.path & "\sounds\", "hit", ".wav"
|
||||
dmScore.InitSounds dmPerf, dmLoad, App.path & "\sounds\", "score", ".wav", True
|
||||
|
||||
InitializeBackgroundMusic App.path & "\sounds\music.mid"
|
||||
'Init the volume
|
||||
SoundVolume = mlSoundVolume
|
||||
MusicVolume = mlMusicVolume
|
||||
Exit Function
|
||||
|
||||
FailedInit:
|
||||
InitAudio = False
|
||||
End Function
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
PlaySounds = True
|
||||
Set dmSegBank = Nothing
|
||||
Set dmSegHit = Nothing
|
||||
Set dmScore = Nothing
|
||||
Set dmMusic = Nothing
|
||||
Set dmPerf = Nothing
|
||||
Set dmLoad = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Terminate()
|
||||
'On Error Resume Next
|
||||
'Unload all of our sounds off of the audio path and destroy them
|
||||
StopBackgroundMusic
|
||||
Set dmSegBank = Nothing
|
||||
Set dmSegHit = Nothing
|
||||
Set dmScore = Nothing
|
||||
If Not (dmMusic Is Nothing) Then
|
||||
dmMusic.Unload dmMusicPath
|
||||
Set dmMusic = Nothing
|
||||
End If
|
||||
|
||||
Set dmMusicPath = Nothing
|
||||
If Not (dmPerf Is Nothing) Then
|
||||
'Closedown
|
||||
dmPerf.CloseDown
|
||||
End If
|
||||
'Destroy the rest of the objects
|
||||
Set dmPerf = Nothing
|
||||
Set dmLoad = Nothing
|
||||
End Sub
|
||||
@@ -0,0 +1,79 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "cAudioFile"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'Here we will control a 'set' of audio files
|
||||
Private mlNumSounds As Long
|
||||
Private dmSegments() As DirectMusicSegment8
|
||||
Private moPath As DirectMusicAudioPath8
|
||||
|
||||
Public Sub InitSounds(dmPerf As DirectMusicPerformance8, dmLoader As DirectMusicLoader8, ByVal sPath As String, ByVal sFirstPart As String, ByVal sExtenstion As String, Optional fSingleFile As Boolean = False)
|
||||
Dim sFile As String
|
||||
Dim lCount As Long
|
||||
|
||||
'Here we will take a 'group' of files (that group could only be 1 file)
|
||||
'and load them into our array
|
||||
Set moPath = dmPerf.GetDefaultAudioPath
|
||||
lCount = 1
|
||||
If fSingleFile Then
|
||||
sFile = Dir$(sPath & sFirstPart & sExtenstion)
|
||||
Else
|
||||
sFile = Dir$(sPath & sFirstPart & format$(CStr(lCount), "00") & sExtenstion)
|
||||
End If
|
||||
Do While sFile <> vbNullString
|
||||
ReDim Preserve dmSegments(1 To lCount)
|
||||
Set dmSegments(lCount) = dmLoader.LoadSegment(sPath & sFile)
|
||||
dmSegments(lCount).Download moPath
|
||||
lCount = lCount + 1
|
||||
If fSingleFile Then
|
||||
sFile = vbNullString
|
||||
Else
|
||||
sFile = Dir$
|
||||
End If
|
||||
Loop
|
||||
mlNumSounds = lCount - 1
|
||||
End Sub
|
||||
|
||||
Public Sub Play(dmPerf As DirectMusicPerformance8)
|
||||
Dim lRnd As Long
|
||||
|
||||
'Pick a valid sound randomly and play it
|
||||
Randomize
|
||||
lRnd = CLng(Rnd * mlNumSounds) + 1
|
||||
Do While lRnd < 1 Or lRnd > mlNumSounds
|
||||
lRnd = CLng(Rnd * mlNumSounds) + 1
|
||||
Loop
|
||||
dmPerf.PlaySegmentEx dmSegments(lRnd), DMUS_SEGF_SECONDARY, 0
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
'This should already have happened for us from VB, but just in case
|
||||
Erase dmSegments
|
||||
mlNumSounds = 0
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Terminate()
|
||||
Dim lCount As Long
|
||||
'Let's clean everything up
|
||||
For lCount = 1 To mlNumSounds
|
||||
'Unload and release all the segments
|
||||
If Not (dmSegments(lCount) Is Nothing) Then
|
||||
dmSegments(lCount).Unload moPath
|
||||
Set dmSegments(lCount) = Nothing
|
||||
End If
|
||||
Next
|
||||
'Clear up any data left over
|
||||
Erase dmSegments
|
||||
End Sub
|
||||
@@ -0,0 +1,213 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "cCamera"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'Here we will encapsulate all of the code needed for the camera
|
||||
|
||||
Private Enum DefaultCameraViews
|
||||
DefaultView
|
||||
OverHeadView
|
||||
SideOverheadView1
|
||||
SideOverheadView2
|
||||
OpponentView
|
||||
CustomView
|
||||
End Enum
|
||||
|
||||
'Here are the constants for the default view
|
||||
Private Const mnDefaultX As Single = 0
|
||||
Private Const mnDefaultY As Single = 10
|
||||
Private Const mnDefaultZ As Single = -25
|
||||
'Here are the constants for the overhead views
|
||||
Private Const mnOverheadX As Single = 0
|
||||
Private Const mnOverheadY As Single = 28
|
||||
Private Const mnOverheadZ As Single = -1
|
||||
'Here are the constants for the side overhead views
|
||||
Private Const mnSide1X As Single = 25
|
||||
Private Const mnSide1Y As Single = 12.5
|
||||
Private Const mnSide1Z As Single = 0
|
||||
Private Const mnSide2X As Single = -25
|
||||
Private Const mnSide2Y As Single = 12.5
|
||||
Private Const mnSide2Z As Single = 0
|
||||
'Here are the constants for the opponent views
|
||||
Private Const mnOpponentX As Single = 0
|
||||
Private Const mnOpponentY As Single = 10
|
||||
Private Const mnOpponentZ As Single = 25
|
||||
|
||||
'Local variables for the properties of the puck
|
||||
Private moPosition As D3DVECTOR 'Current position of the camera
|
||||
Private moVelocity As D3DVECTOR 'Current velocity of the camera
|
||||
Private moDest As D3DVECTOR 'Destination of the camera
|
||||
Private mlCameraTime As Long 'Last time the puck was updated
|
||||
Private moLastPosition As D3DVECTOR 'Last position of the camera
|
||||
'The default camera views
|
||||
Public CameraView As Long
|
||||
|
||||
'Position property
|
||||
Public Property Let Position(oPos As D3DVECTOR)
|
||||
moPosition = oPos
|
||||
End Property
|
||||
|
||||
Public Property Get Position() As D3DVECTOR
|
||||
Position = moPosition
|
||||
End Property
|
||||
|
||||
'Velocity property
|
||||
Public Property Let Velocity(oVel As D3DVECTOR)
|
||||
moVelocity = oVel
|
||||
End Property
|
||||
|
||||
Public Property Get Velocity() As D3DVECTOR
|
||||
Velocity = moVelocity
|
||||
End Property
|
||||
|
||||
'LastPosition prop
|
||||
Public Property Let LastPosition(oLastPos As D3DVECTOR)
|
||||
moLastPosition = oLastPos
|
||||
End Property
|
||||
|
||||
Public Property Get LastPosition() As D3DVECTOR
|
||||
LastPosition = moLastPosition
|
||||
End Property
|
||||
|
||||
'Dest property
|
||||
Public Property Let Dest(oPos As D3DVECTOR)
|
||||
moDest = oPos
|
||||
End Property
|
||||
|
||||
Public Property Get Dest() As D3DVECTOR
|
||||
Dest = moDest
|
||||
End Property
|
||||
|
||||
'Methods
|
||||
Public Sub UpdatePosition()
|
||||
Dim RealVelocity As D3DVECTOR
|
||||
Dim DistancePointX As Single
|
||||
Dim DistancePointY As Single
|
||||
Dim DistancePointZ As Single
|
||||
|
||||
'Here we will update the position of the camera
|
||||
'and move it based on the velocity assigned.
|
||||
If mlCameraTime = 0 Then mlCameraTime = timeGetTime
|
||||
'First calculate the 'real' velocity (based on the time)
|
||||
RealVelocity.x = ((timeGetTime - mlCameraTime) / 100) * moVelocity.x
|
||||
RealVelocity.y = ((timeGetTime - mlCameraTime) / 100) * moVelocity.y
|
||||
RealVelocity.z = ((timeGetTime - mlCameraTime) / 100) * moVelocity.z
|
||||
'Let's save our current position
|
||||
moLastPosition = moPosition
|
||||
'Now let's see if moving our position will move us past our destination
|
||||
'if it does, move us to our destination
|
||||
|
||||
'First check the X axis
|
||||
DistancePointX = Sqr((moDest.x - moPosition.x) * (moDest.x - moPosition.x))
|
||||
If DistancePointX < RealVelocity.x Then
|
||||
moPosition.x = moDest.x 'We've arrived
|
||||
moVelocity.x = 0
|
||||
Else
|
||||
moPosition.x = moPosition.x + RealVelocity.x 'We haven't got to our destination yet, keep going
|
||||
End If
|
||||
'Now check the Y axis
|
||||
DistancePointY = Sqr((moDest.y - moPosition.y) * (moDest.y - moPosition.y))
|
||||
If DistancePointY < RealVelocity.y Then
|
||||
moPosition.y = moDest.y 'We've arrived
|
||||
moVelocity.y = 0
|
||||
Else
|
||||
moPosition.y = moPosition.y + RealVelocity.y 'We haven't got to our destination yet, keep going
|
||||
End If
|
||||
'Now check the Z axis
|
||||
DistancePointZ = Sqr((moDest.z - moPosition.z) * (moDest.z - moPosition.z))
|
||||
If DistancePointZ < RealVelocity.z Then
|
||||
moPosition.z = moDest.z 'We've arrived
|
||||
moVelocity.z = 0
|
||||
Else
|
||||
moPosition.z = moPosition.z + RealVelocity.z 'We haven't got to our destination yet, keep going
|
||||
End If
|
||||
'Make sure our velocity is going in the right direction
|
||||
If DistancePointX < Sqr((moDest.x - moPosition.x) * (moDest.x - moPosition.x)) Then
|
||||
'It's not, reverse it
|
||||
moVelocity.x = moVelocity.x * -1
|
||||
End If
|
||||
If DistancePointY < Sqr((moDest.y - moPosition.y) * (moDest.y - moPosition.y)) Then
|
||||
'It's not, reverse it
|
||||
moVelocity.y = moVelocity.y * -1
|
||||
End If
|
||||
If DistancePointZ < Sqr((moDest.z - moPosition.z) * (moDest.z - moPosition.z)) Then
|
||||
'It's not, reverse it
|
||||
moVelocity.z = moVelocity.z * -1
|
||||
End If
|
||||
mlCameraTime = timeGetTime
|
||||
End Sub
|
||||
|
||||
Public Sub NextCameraPosition(ByVal lPlayerID As Long)
|
||||
If CameraView = CustomView Then
|
||||
CameraView = DefaultView
|
||||
Else
|
||||
CameraView = CameraView + 1
|
||||
If CameraView = CustomView Then
|
||||
CameraView = DefaultView
|
||||
End If
|
||||
End If
|
||||
UpdateToNewPosition lPlayerID
|
||||
End Sub
|
||||
|
||||
Public Sub SetCameraPosition(ByVal lCameraPos As Long, ByVal lPlayerID As Long)
|
||||
CameraView = lCameraPos
|
||||
If CameraView <> CustomView Then UpdateToNewPosition lPlayerID
|
||||
End Sub
|
||||
|
||||
Private Sub UpdateToNewPosition(ByVal lPlayerID As Long)
|
||||
|
||||
Select Case CameraView
|
||||
Case DefaultView
|
||||
If lPlayerID = 0 Then
|
||||
moDest.x = mnDefaultX
|
||||
moDest.y = mnDefaultY
|
||||
moDest.z = mnDefaultZ
|
||||
Else 'Default view should be the opponents view
|
||||
moDest.x = mnOpponentX
|
||||
moDest.y = mnOpponentY
|
||||
moDest.z = mnOpponentZ
|
||||
End If
|
||||
Case OpponentView
|
||||
If lPlayerID = 1 Then
|
||||
moDest.x = mnDefaultX
|
||||
moDest.y = mnDefaultY
|
||||
moDest.z = mnDefaultZ
|
||||
Else 'Default view should be the opponents view
|
||||
moDest.x = mnOpponentX
|
||||
moDest.y = mnOpponentY
|
||||
moDest.z = mnOpponentZ
|
||||
End If
|
||||
Case OverHeadView
|
||||
moDest.x = mnOverheadX
|
||||
moDest.y = mnOverheadY
|
||||
moDest.z = mnOverheadZ
|
||||
Case SideOverheadView1
|
||||
moDest.x = mnSide1X
|
||||
moDest.y = mnSide1Y
|
||||
moDest.z = mnSide1Z
|
||||
Case SideOverheadView2
|
||||
moDest.x = mnSide2X
|
||||
moDest.y = mnSide2Y
|
||||
moDest.z = mnSide2Z
|
||||
End Select
|
||||
'Set up a default velocity
|
||||
moVelocity.x = 3
|
||||
moVelocity.y = 3
|
||||
moVelocity.z = 3
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
CameraView = DefaultView
|
||||
End Sub
|
||||
@@ -0,0 +1,46 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "cFade"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'This is an 'effects' class, that will fade a scene in or out
|
||||
'by increasing the alpha channel on all objects
|
||||
Public FadeInterval As Single
|
||||
Public AmFading As Boolean
|
||||
Public CanFade As Boolean
|
||||
Private mlPixelShaderHandle As Long
|
||||
|
||||
'Methods used during fading
|
||||
|
||||
'This will update the global params for fading the scene in, or out
|
||||
'Fading is simply accomplished by adding or subtracting the amount of light in the scene until
|
||||
'it reaches a desired level. Since the background is black anyway, we could have also
|
||||
'simply slowly turned up the alpha on each of the objects, this is just the way I chose.
|
||||
Public Sub Fade(ByVal nInterval As Long)
|
||||
If Not CanFade Then Exit Sub
|
||||
FadeInterval = nInterval
|
||||
AmFading = True
|
||||
End Sub
|
||||
|
||||
Public Sub UpdateFade(oPuck As cPuck, oPaddle() As cPaddle, oTable As cTable, oRoom As cRoom)
|
||||
Dim fDoneFading As Boolean
|
||||
fDoneFading = True
|
||||
fDoneFading = oPuck.FadeMesh(FadeInterval) And oPaddle(0).FadeMesh(FadeInterval) And oPaddle(1).FadeMesh(FadeInterval) And oTable.FadeMesh(FadeInterval) And oRoom.FadeMesh(FadeInterval)
|
||||
AmFading = Not fDoneFading
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
'By default we will allow fading
|
||||
CanFade = True
|
||||
End Sub
|
||||
|
||||
@@ -0,0 +1,397 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "cInput"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'Here we will control all of the input, from any source
|
||||
'List of camera views (same enum listed in the camera class)
|
||||
Private Enum DefaultCameraViews
|
||||
DefaultView
|
||||
OverHeadView
|
||||
SideOverheadView1
|
||||
SideOverheadView2
|
||||
OpponentView
|
||||
CustomView
|
||||
End Enum
|
||||
|
||||
'*NOTE*
|
||||
'
|
||||
'I may want to add Force Feedback support, if i do, I would do so here.
|
||||
|
||||
'Mouse constants
|
||||
Private Const mlJoystickRange As Long = 35
|
||||
Private Const mnMaxZThresh As Single = 35
|
||||
Private Const mnMaxYThresh As Single = 50
|
||||
Private Const mnMaxXThresh As Single = 35
|
||||
|
||||
'DirectInput variables, etc
|
||||
Private Const glBufferSize As Long = 10
|
||||
'DInput objects
|
||||
Private di As DirectInput8
|
||||
Private diMouse As DirectInputDevice8
|
||||
Private diKeyboard As DirectInputDevice8
|
||||
Private diJoystick As DirectInputDevice8
|
||||
'Is the camera moving?
|
||||
Private mfMovingCamera As Boolean
|
||||
|
||||
'Local properties to determine what controls should be used
|
||||
Public UseMouse As Boolean
|
||||
Public UseKeyboard As Boolean
|
||||
Public UseJoystick As Boolean
|
||||
Public JoystickGuid As String
|
||||
Public JoystickSensitivity As Single
|
||||
Public MouseSensitivity As Single
|
||||
Public KeyboardSensitivity As Single
|
||||
|
||||
Public Property Get InputObject() As DirectInput8
|
||||
Set InputObject = di
|
||||
End Property
|
||||
|
||||
Public Function InitDirectInput(oForm As Form) As Boolean
|
||||
|
||||
Dim diProp As DIPROPLONG
|
||||
Dim diProp_Dead As DIPROPLONG
|
||||
Dim diProp_Range As DIPROPRANGE
|
||||
Dim diProp_Saturation As DIPROPLONG
|
||||
|
||||
On Error GoTo FailedInput
|
||||
|
||||
InitDirectInput = True
|
||||
'Create the DirectInput object, and all of the devices we need.
|
||||
If UseMouse Then
|
||||
Set diMouse = di.CreateDevice("guid_SysMouse")
|
||||
diMouse.SetCommonDataFormat DIFORMAT_MOUSE
|
||||
diMouse.SetCooperativeLevel oForm.hwnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE
|
||||
|
||||
' Set the buffer size
|
||||
diProp.lHow = DIPH_DEVICE
|
||||
diProp.lObj = 0
|
||||
diProp.lData = glBufferSize
|
||||
Call diMouse.SetProperty("DIPROP_BUFFERSIZE", diProp)
|
||||
'Acquire the mouse
|
||||
diMouse.Acquire
|
||||
End If
|
||||
|
||||
If UseKeyboard Then
|
||||
Set diKeyboard = di.CreateDevice("GUID_SysKeyboard")
|
||||
|
||||
diKeyboard.SetCommonDataFormat DIFORMAT_KEYBOARD
|
||||
diKeyboard.SetCooperativeLevel oForm.hwnd, DISCL_FOREGROUND Or DISCL_NONEXCLUSIVE
|
||||
'Acquire the keyboard
|
||||
diKeyboard.Acquire
|
||||
End If
|
||||
|
||||
If UseJoystick Then
|
||||
On Error Resume Next
|
||||
Set diJoystick = di.CreateDevice(JoystickGuid)
|
||||
If Err Then 'This joystick doesn't exist anymore
|
||||
UseJoystick = False
|
||||
Exit Function
|
||||
End If
|
||||
On Error GoTo FailedInput
|
||||
diJoystick.SetCommonDataFormat DIFORMAT_JOYSTICK
|
||||
diJoystick.SetCooperativeLevel oForm.hwnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE
|
||||
|
||||
'Set deadzone to 10 percent
|
||||
With diProp_Dead
|
||||
.lData = mlJoystickRange \ 20
|
||||
.lHow = DIPH_BYOFFSET
|
||||
.lObj = DIJOFS_X
|
||||
diJoystick.SetProperty "DIPROP_DEADZONE", diProp_Dead
|
||||
.lObj = DIJOFS_Y
|
||||
diJoystick.SetProperty "DIPROP_DEADZONE", diProp_Dead
|
||||
End With
|
||||
|
||||
'Set saturation zones to 5 percent
|
||||
With diProp_Saturation
|
||||
.lData = mlJoystickRange \ 40
|
||||
.lHow = DIPH_BYOFFSET
|
||||
.lObj = DIJOFS_X
|
||||
diJoystick.SetProperty "DIPROP_SATURATION", diProp_Saturation
|
||||
.lObj = DIJOFS_Y
|
||||
diJoystick.SetProperty "DIPROP_SATURATION", diProp_Saturation
|
||||
End With
|
||||
|
||||
'Just in case this device doesn't let us set the range
|
||||
On Error Resume Next
|
||||
'Set range for all axes
|
||||
With diProp_Range
|
||||
.lHow = DIPH_DEVICE
|
||||
.lMin = -mlJoystickRange
|
||||
.lMax = mlJoystickRange
|
||||
End With
|
||||
diJoystick.SetProperty "DIPROP_RANGE", diProp_Range
|
||||
On Error GoTo FailedInput
|
||||
|
||||
diJoystick.Acquire
|
||||
End If
|
||||
|
||||
Exit Function
|
||||
|
||||
FailedInput:
|
||||
InitDirectInput = False
|
||||
|
||||
End Function
|
||||
|
||||
Private Sub ProcessMouseData(oPaddle As cPaddle, oPuck As cPuck)
|
||||
'This is where we respond to any change in mouse state. Usually this will be an axis movement
|
||||
'or button press or release
|
||||
|
||||
Dim diDeviceData(1 To glBufferSize) As DIDEVICEOBJECTDATA
|
||||
Dim lNumItems As Long
|
||||
Dim lCount As Integer
|
||||
Dim lTempX As Single, lTempZ As Single
|
||||
|
||||
On Error GoTo INPUTLOST 'In case we lost the mouse
|
||||
diMouse.Acquire 'Just in case
|
||||
lNumItems = diMouse.GetDeviceData(diDeviceData, 0)
|
||||
On Error GoTo 0 'Reset our error
|
||||
|
||||
' Process data
|
||||
For lCount = 1 To lNumItems
|
||||
Select Case diDeviceData(lCount).lOfs
|
||||
Case DIMOFS_X 'We moved the X axis
|
||||
If mfMovingCamera Then
|
||||
With goCamera.Position
|
||||
If lTempZ = 0 Then lTempZ = .z
|
||||
lTempX = .X + (diDeviceData(lCount).lData * MouseSensitivity)
|
||||
goCamera.SetCameraPosition CustomView, oPaddle.PaddleID
|
||||
If Abs(lTempX) > mnMaxXThresh Then
|
||||
'Whoops too much
|
||||
lTempX = mnMaxXThresh * (lTempX / Abs(lTempX))
|
||||
End If
|
||||
End With
|
||||
Else
|
||||
With oPaddle.Position
|
||||
If lTempZ = 0 Then lTempZ = .z
|
||||
lTempX = .X + (diDeviceData(lCount).lData * MouseSensitivity)
|
||||
End With
|
||||
End If
|
||||
Case DIMOFS_Y 'We moved the Y axis
|
||||
If mfMovingCamera Then
|
||||
With goCamera.Position
|
||||
If lTempX = 0 Then lTempX = .X
|
||||
lTempZ = .z - (diDeviceData(lCount).lData * MouseSensitivity)
|
||||
goCamera.SetCameraPosition CustomView, oPaddle.PaddleID
|
||||
If Abs(lTempZ) > mnMaxZThresh Then
|
||||
'Whoops too much
|
||||
lTempZ = mnMaxZThresh * (lTempZ / Abs(lTempZ))
|
||||
End If
|
||||
End With
|
||||
Else
|
||||
With oPaddle.Position
|
||||
If lTempX = 0 Then lTempX = .X
|
||||
lTempZ = .z - (diDeviceData(lCount).lData * MouseSensitivity)
|
||||
End With
|
||||
End If
|
||||
Case DIMOFS_BUTTON1
|
||||
mfMovingCamera = (diDeviceData(lCount).lData And &H80 = &H80)
|
||||
End Select
|
||||
Next lCount
|
||||
'Ok, this sequence is done, process the info, and move on
|
||||
If lTempX <> 0 And lTempZ <> 0 Then
|
||||
If mfMovingCamera Then
|
||||
goCamera.Position = vec3(lTempX, goCamera.Position.Y, lTempZ)
|
||||
Else
|
||||
oPaddle.LastPosition = oPaddle.Position
|
||||
oPaddle.Position = vec3(lTempX, oPaddle.Position.Y, lTempZ)
|
||||
oPaddle.Velocity = vec3(oPaddle.Position.X - oPaddle.LastPosition.X, oPaddle.Velocity.Y, oPaddle.Position.z - oPaddle.LastPosition.z)
|
||||
oPaddle.LastVelocityTick = timeGetTime
|
||||
End If
|
||||
End If
|
||||
MakeSurePaddleIsOnBoard oPaddle
|
||||
Exit Sub
|
||||
|
||||
INPUTLOST:
|
||||
If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = DIERR_NOTACQUIRED) Then
|
||||
'We no longer have the mouse..
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub ProcessKeyBoardData(oPaddle As cPaddle, oPuck As cPuck)
|
||||
|
||||
'This is where we respond to any change in keyboard state. Usually this will be an axis movement
|
||||
'or button press or release
|
||||
|
||||
Dim diKeys As DIKEYBOARDSTATE
|
||||
Dim lTempX As Single, lTempZ As Single
|
||||
|
||||
On Error GoTo INPUTLOST 'In case we lost focus
|
||||
diKeyboard.Acquire 'Just in case
|
||||
diKeyboard.GetDeviceStateKeyboard diKeys
|
||||
|
||||
If KeyPressed(diKeys, DIK_LEFTARROW) Or KeyPressed(diKeys, DIK_NUMPAD4) Then
|
||||
oPaddle.LastPosition = oPaddle.Position
|
||||
With oPaddle.Position
|
||||
lTempX = .X - KeyboardSensitivity
|
||||
oPaddle.Position = vec3(lTempX, .Y, .z)
|
||||
End With
|
||||
oPaddle.Velocity = vec3(oPaddle.Position.X - oPaddle.LastPosition.X, oPaddle.Velocity.Y, oPaddle.Velocity.z)
|
||||
oPaddle.LastVelocityTick = timeGetTime
|
||||
End If
|
||||
If KeyPressed(diKeys, DIK_RIGHTARROW) Or KeyPressed(diKeys, DIK_NUMPAD6) Then
|
||||
oPaddle.LastPosition = oPaddle.Position
|
||||
With oPaddle.Position
|
||||
lTempX = .X + KeyboardSensitivity
|
||||
oPaddle.Position = vec3(lTempX, .Y, .z)
|
||||
End With
|
||||
oPaddle.Velocity = vec3(oPaddle.Position.X - oPaddle.LastPosition.X, oPaddle.Velocity.Y, oPaddle.Velocity.z)
|
||||
oPaddle.LastVelocityTick = timeGetTime
|
||||
End If
|
||||
If KeyPressed(diKeys, DIK_UPARROW) Or KeyPressed(diKeys, DIK_NUMPAD8) Then
|
||||
oPaddle.LastPosition = oPaddle.Position
|
||||
With oPaddle.Position
|
||||
lTempZ = .z + KeyboardSensitivity
|
||||
oPaddle.Position = vec3(.X, .Y, lTempZ)
|
||||
End With
|
||||
oPaddle.Velocity = vec3(oPaddle.Velocity.X, oPaddle.Velocity.Y, oPaddle.Position.z - oPaddle.LastPosition.z)
|
||||
oPaddle.LastVelocityTick = timeGetTime
|
||||
End If
|
||||
If KeyPressed(diKeys, DIK_DOWNARROW) Or KeyPressed(diKeys, DIK_NUMPAD2) Then
|
||||
oPaddle.LastPosition = oPaddle.Position
|
||||
With oPaddle.Position
|
||||
lTempZ = .z - KeyboardSensitivity
|
||||
oPaddle.Position = vec3(.X, .Y, lTempZ)
|
||||
End With
|
||||
oPaddle.Velocity = vec3(oPaddle.Velocity.X, oPaddle.Velocity.Y, oPaddle.Position.z - oPaddle.LastPosition.z)
|
||||
oPaddle.LastVelocityTick = timeGetTime
|
||||
End If
|
||||
|
||||
MakeSurePaddleIsOnBoard oPaddle
|
||||
Exit Sub
|
||||
|
||||
INPUTLOST:
|
||||
If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = DIERR_NOTACQUIRED) Then
|
||||
'We no longer have the mouse..
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub ProcessJoystickData(oPaddle As cPaddle, oPuck As cPuck)
|
||||
|
||||
'This is where we respond to any change in keyboard state. Usually this will be an axis movement
|
||||
'or button press or release
|
||||
|
||||
Dim diJoy As DIJOYSTATE
|
||||
Dim lTempX As Single, lTempZ As Single
|
||||
|
||||
On Error GoTo INPUTLOST 'In case we lost focus
|
||||
diJoystick.Acquire 'Just in case
|
||||
diJoystick.Poll
|
||||
diJoystick.GetDeviceStateJoystick diJoy
|
||||
|
||||
If diJoy.X <> 0 Then
|
||||
oPaddle.LastPosition = oPaddle.Position
|
||||
With oPaddle.Position
|
||||
lTempX = .X + (diJoy.X * JoystickSensitivity)
|
||||
oPaddle.Position = vec3(lTempX, .Y, .z)
|
||||
End With
|
||||
oPaddle.Velocity = vec3(oPaddle.Position.X - oPaddle.LastPosition.X, oPaddle.Velocity.Y, oPaddle.Velocity.z)
|
||||
oPaddle.LastVelocityTick = timeGetTime
|
||||
End If
|
||||
If diJoy.Y <> 0 Then
|
||||
oPaddle.LastPosition = oPaddle.Position
|
||||
With oPaddle.Position
|
||||
lTempZ = .z - (diJoy.Y * JoystickSensitivity)
|
||||
oPaddle.Position = vec3(.X, .Y, lTempZ)
|
||||
End With
|
||||
oPaddle.Velocity = vec3(oPaddle.Velocity.X, oPaddle.Velocity.Y, oPaddle.Position.z - oPaddle.LastPosition.z)
|
||||
oPaddle.LastVelocityTick = timeGetTime
|
||||
End If
|
||||
|
||||
MakeSurePaddleIsOnBoard oPaddle
|
||||
Exit Sub
|
||||
|
||||
INPUTLOST:
|
||||
If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = DIERR_NOTACQUIRED) Then
|
||||
'We no longer have the joystick..
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub GetAndHandleInput(oPaddle As cPaddle, oPuck As cPuck)
|
||||
|
||||
Dim vOldPaddle As D3DVECTOR
|
||||
|
||||
oPaddle.Velocity = vec3(0, 0, 0)
|
||||
vOldPaddle = oPaddle.Position
|
||||
If UseMouse Then
|
||||
'First let's handle the mouse
|
||||
ProcessMouseData oPaddle, oPuck
|
||||
End If
|
||||
|
||||
If UseKeyboard Then
|
||||
'Now we can worry about keyboard
|
||||
ProcessKeyBoardData oPaddle, oPuck
|
||||
End If
|
||||
|
||||
If UseJoystick Then
|
||||
'If we have a joystick selected check that too
|
||||
ProcessJoystickData oPaddle, oPuck
|
||||
End If
|
||||
oPaddle.EnsureReality vOldPaddle, oPuck
|
||||
End Sub
|
||||
|
||||
'Helper function to determine if a key is pressed
|
||||
Private Function KeyPressed(diKeys As DIKEYBOARDSTATE, Key As Byte)
|
||||
KeyPressed = (diKeys.Key(Key) And &H80 = &H80)
|
||||
End Function
|
||||
|
||||
Private Function MakeSurePaddleIsOnBoard(oPaddle As cPaddle)
|
||||
Dim lTempZ As Single, lTempX As Single
|
||||
lTempX = oPaddle.Position.X
|
||||
lTempZ = oPaddle.Position.z
|
||||
|
||||
'Don't let the paddle leave the left or right sides of the table
|
||||
If lTempX > (gnSideLeftWallEdge - (gnPaddleRadius)) Then
|
||||
lTempX = (gnSideLeftWallEdge - (gnPaddleRadius))
|
||||
ElseIf lTempX < (gnSideRightWallEdge + (gnPaddleRadius)) Then
|
||||
lTempX = (gnSideRightWallEdge + (gnPaddleRadius))
|
||||
End If
|
||||
'Depending on which end of the table we are *supposed* to be on,
|
||||
'restrict our movement.
|
||||
If oPaddle.PaddleID = 0 Then
|
||||
If lTempZ > -(gnPaddleRadius * 1.5) Then
|
||||
lTempZ = -(gnPaddleRadius * 1.5)
|
||||
ElseIf lTempZ < (gnFarWallEdge + (gnPaddleRadius)) Then
|
||||
lTempZ = (gnFarWallEdge + (gnPaddleRadius))
|
||||
End If
|
||||
Else
|
||||
If lTempZ > (gnNearWallEdge - (gnPaddleRadius)) Then
|
||||
lTempZ = (gnNearWallEdge - (gnPaddleRadius))
|
||||
ElseIf lTempZ < (gnPaddleRadius * 1.5) Then
|
||||
lTempZ = (gnPaddleRadius * 1.5)
|
||||
End If
|
||||
End If
|
||||
|
||||
oPaddle.Position = vec3(lTempX, oPaddle.Position.Y, lTempZ)
|
||||
End Function
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
Set diMouse = Nothing
|
||||
Set diKeyboard = Nothing
|
||||
Set diJoystick = Nothing
|
||||
Set di = Nothing
|
||||
Set di = dx.DirectInputCreate
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Terminate()
|
||||
On Error Resume Next 'Ignore any errors, we're cleaning everything up
|
||||
'Unacquire the mouse
|
||||
If Not (diMouse Is Nothing) Then diMouse.Unacquire
|
||||
If Not (diKeyboard Is Nothing) Then diKeyboard.Unacquire
|
||||
If Not (diJoystick Is Nothing) Then diJoystick.Unacquire
|
||||
'Destroy our objects
|
||||
Set diMouse = Nothing
|
||||
Set diKeyboard = Nothing
|
||||
Set diJoystick = Nothing
|
||||
Set di = Nothing
|
||||
End Sub
|
||||
@@ -0,0 +1,268 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "cPaddle"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'Here we will encapsulate all of the code needed for the Paddle
|
||||
'Local variables for the properties of the Paddle
|
||||
Private moPosition As D3DVECTOR 'Current position of the Paddle
|
||||
Private moVelocity As D3DVECTOR 'Current velocity of the Paddle
|
||||
Private moLastPosition As D3DVECTOR 'Last position of the Paddle
|
||||
Private moPaddle As CD3DFrame 'D3D Mesh for the Paddle
|
||||
Private mlPaddleTime As Long 'Last time the Paddle was updated
|
||||
Private mlTransparantPaddle As Boolean
|
||||
Public LastVelocityTick As Long 'Last time the paddle's velocity changed
|
||||
Public PaddleID As Long
|
||||
|
||||
'Position property
|
||||
Public Property Let Position(oPos As D3DVECTOR)
|
||||
moPosition = oPos
|
||||
End Property
|
||||
|
||||
Public Property Get Position() As D3DVECTOR
|
||||
Position = moPosition
|
||||
End Property
|
||||
|
||||
'Velocity property
|
||||
Public Property Let Velocity(oVel As D3DVECTOR)
|
||||
moVelocity = oVel
|
||||
End Property
|
||||
|
||||
Public Property Get Velocity() As D3DVECTOR
|
||||
Velocity = moVelocity
|
||||
End Property
|
||||
|
||||
'LastPosition prop
|
||||
Public Property Let LastPosition(oLastPos As D3DVECTOR)
|
||||
moLastPosition = oLastPos
|
||||
End Property
|
||||
|
||||
Public Property Get LastPosition() As D3DVECTOR
|
||||
LastPosition = moLastPosition
|
||||
End Property
|
||||
|
||||
'Transparent property
|
||||
Public Property Let Transparent(ByVal fTrans As Boolean)
|
||||
Dim oMesh As CD3DMesh, oMaterial As D3DMATERIAL8
|
||||
Dim lNumMaterial As Long, lCount As Long
|
||||
|
||||
mlTransparantPaddle = fTrans
|
||||
'now set the property
|
||||
Set oMesh = moPaddle.FindChildObject("paddle", 0)
|
||||
lNumMaterial = oMesh.GetMaterialCount
|
||||
For lCount = 0 To lNumMaterial - 1
|
||||
oMaterial = oMesh.GetMaterial(lCount)
|
||||
If fTrans Then
|
||||
oMaterial.diffuse.a = 0.5
|
||||
Else
|
||||
oMaterial.diffuse.a = 1
|
||||
End If
|
||||
oMesh.SetMaterial lCount, oMaterial
|
||||
Next
|
||||
End Property
|
||||
|
||||
Public Property Get Transparent() As Boolean
|
||||
Transparent = mlTransparantPaddle
|
||||
End Property
|
||||
|
||||
'Methods
|
||||
Public Sub Init(ByVal sMedia As String, sFile As String)
|
||||
Set moPaddle = D3DUtil_LoadFromFile(AddDirSep(sMedia) & sFile, Nothing, Nothing)
|
||||
End Sub
|
||||
|
||||
Public Sub UpdateTime()
|
||||
mlPaddleTime = timeGetTime
|
||||
End Sub
|
||||
|
||||
Public Sub UpdatePosition()
|
||||
Dim RealVelocity As D3DVECTOR
|
||||
|
||||
'Here we will update the position of the paddle
|
||||
'and move it based on the velocity assigned.
|
||||
If mlPaddleTime = 0 Then mlPaddleTime = timeGetTime
|
||||
'First calculate the 'real' velocity (based on the time)
|
||||
RealVelocity.X = ((timeGetTime - mlPaddleTime) / 100) * moVelocity.X
|
||||
RealVelocity.Y = ((timeGetTime - mlPaddleTime) / 100) * moVelocity.Y
|
||||
RealVelocity.z = ((timeGetTime - mlPaddleTime) / 100) * moVelocity.z
|
||||
'Let's save our current position
|
||||
moLastPosition = moPosition
|
||||
|
||||
moPosition.X = moPosition.X + RealVelocity.X
|
||||
moPosition.Y = moPosition.Y + RealVelocity.Y
|
||||
moPosition.z = moPosition.z + RealVelocity.z
|
||||
|
||||
mlPaddleTime = timeGetTime
|
||||
End Sub
|
||||
|
||||
Public Sub Render(dev As Direct3DDevice8)
|
||||
Dim matPaddle As D3DMATRIX
|
||||
|
||||
D3DXMatrixIdentity matPaddle
|
||||
D3DXMatrixTranslation matPaddle, moPosition.X, moPosition.Y, moPosition.z
|
||||
moPaddle.SetMatrix matPaddle
|
||||
moPaddle.Render dev
|
||||
End Sub
|
||||
|
||||
Public Sub CleanupFrame()
|
||||
Set moPaddle = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub EnsureReality(oldPos As D3DVECTOR, oPuck As cPuck)
|
||||
Dim vecDif As D3DVECTOR, nDistance As Single
|
||||
Dim vNewVel As D3DVECTOR, nVel As Single
|
||||
Dim fMovePaddle As Boolean
|
||||
|
||||
'We do *not* want to go 'inside' the puck, don't let it happen
|
||||
D3DXVec3Subtract vecDif, oPuck.Position, moPosition
|
||||
nDistance = D3DXVec3Length(vecDif)
|
||||
If nDistance < (gnPuckRadius + gnPaddleRadius) Then
|
||||
'Ok, we are within the puck, now who should move? The puck or the paddle?
|
||||
With moPosition
|
||||
fMovePaddle = False
|
||||
If .z < (gnFarWallEdge + (gnPaddleRadius + gnPuckRadius)) Then
|
||||
fMovePaddle = True
|
||||
End If
|
||||
If .z > (gnNearWallEdge - (gnPaddleRadius + gnPuckRadius)) Then
|
||||
fMovePaddle = True
|
||||
End If
|
||||
If .X < (gnSideRightWallEdge + (gnPaddleRadius + gnPuckRadius)) Then
|
||||
fMovePaddle = True
|
||||
End If
|
||||
If .X > (gnSideLeftWallEdge - (gnPaddleRadius + gnPuckRadius)) Then
|
||||
fMovePaddle = True
|
||||
End If
|
||||
End With
|
||||
|
||||
If fMovePaddle Then
|
||||
'Move the paddle back out so it's not hitting the puck
|
||||
Dim vDir As D3DVECTOR, vScale As D3DVECTOR, vPaddleVel As D3DVECTOR
|
||||
Dim vPaddleDif As D3DVECTOR
|
||||
|
||||
D3DXVec3Subtract vPaddleDif, oPuck.Position, moPosition
|
||||
D3DXVec3Subtract vPaddleVel, oldPos, moPosition
|
||||
'Get the direction vector by normalizing the pucks velocity
|
||||
D3DXVec3Normalize vDir, vPaddleVel
|
||||
'Scale the length of the two vectors, plus a little more.
|
||||
D3DXVec3Scale vScale, vDir, D3DXVec3Length(vPaddleDif) '(gnPaddleRadius / 4)
|
||||
'Move the paddle to it's new location
|
||||
D3DXVec3Add moPosition, oldPos, vScale
|
||||
'Else We can ignore the case of the puck needing to move because that will
|
||||
'happen in checkcollisions call for the puck
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub DoComputerAI(oPuck As cPuck)
|
||||
|
||||
Dim vOldPos As D3DVECTOR
|
||||
Dim nTempX As Single, nTempZ As Single
|
||||
|
||||
'We'll create a simplistic AI opponent
|
||||
vOldPos = moPosition
|
||||
'Let's just set the velocity of the paddle
|
||||
moLastPosition = moPosition
|
||||
With moPosition
|
||||
If Abs(oPuck.Position.X > .X) Then
|
||||
nTempX = Min(oPuck.Velocity.X, gnComputerMaximumVelocity)
|
||||
Else
|
||||
nTempX = Min(oPuck.Velocity.X, -gnComputerMaximumVelocity)
|
||||
End If
|
||||
If Abs(oPuck.Position.z - .z) > Abs(oPuck.LastPosition.z - .z) Then
|
||||
nTempZ = gnComputerMaximumVelocity
|
||||
Else
|
||||
nTempZ = -gnComputerMaximumVelocity
|
||||
End If
|
||||
End With
|
||||
moVelocity = vec3(nTempX, 0, nTempZ)
|
||||
'If the puck is in *front* of the paddle, just move the paddle directly backwards
|
||||
If moPosition.z < oPuck.Position.z Then
|
||||
moVelocity = vec3(0, 0, gnComputerMaximumVelocity)
|
||||
End If
|
||||
UpdatePosition
|
||||
EnsureReality vOldPos, oPuck
|
||||
|
||||
With moPosition
|
||||
nTempX = .X
|
||||
nTempZ = .z
|
||||
If PaddleID = 0 Then
|
||||
If nTempZ > -(gnPaddleRadius * 1.5) Then
|
||||
nTempZ = -(gnPaddleRadius * 1.5)
|
||||
ElseIf nTempZ < (gnFarWallEdge + (gnPaddleRadius)) Then
|
||||
nTempZ = (gnFarWallEdge + (gnPaddleRadius))
|
||||
End If
|
||||
Else
|
||||
If nTempZ > (gnNearWallEdge - (gnPaddleRadius)) Then
|
||||
nTempZ = (gnNearWallEdge - (gnPaddleRadius))
|
||||
ElseIf nTempZ < (gnPaddleRadius * 1.5) Then
|
||||
nTempZ = (gnPaddleRadius * 1.5)
|
||||
End If
|
||||
End If
|
||||
If nTempX < (gnSideRightWallEdge + (gnPaddleRadius)) Then
|
||||
nTempX = (gnSideRightWallEdge + (gnPaddleRadius))
|
||||
End If
|
||||
If nTempX > (gnSideLeftWallEdge - (gnPaddleRadius)) Then
|
||||
nTempX = (gnSideLeftWallEdge - (gnPaddleRadius))
|
||||
End If
|
||||
moPosition = vec3(nTempX, moPosition.Y, nTempZ)
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Public Function FadeMesh(FadeInterval As Single) As Boolean
|
||||
Dim lNumMaterial As Long
|
||||
Dim lCount As Long
|
||||
Dim oMaterial As D3DMATERIAL8
|
||||
Dim fDoneFading As Boolean
|
||||
Dim oMesh As CD3DMesh
|
||||
Dim nInternalInterval As Single
|
||||
Static lFadeTime As Long
|
||||
|
||||
nInternalInterval = FadeInterval
|
||||
If lFadeTime = 0 Then
|
||||
lFadeTime = timeGetTime
|
||||
Exit Function 'We'll do the fade next render pass
|
||||
End If
|
||||
nInternalInterval = (((timeGetTime - lFadeTime) / 1000000) * nInternalInterval)
|
||||
|
||||
Set oMesh = moPaddle.FindChildObject("paddle", 0)
|
||||
fDoneFading = True
|
||||
lNumMaterial = oMesh.GetMaterialCount
|
||||
For lCount = 0 To lNumMaterial - 1
|
||||
oMaterial = oMesh.GetMaterial(lCount)
|
||||
If nInternalInterval > 0 And oMaterial.diffuse.a <= 1 Then
|
||||
oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
|
||||
fDoneFading = False
|
||||
ElseIf nInternalInterval < 0 And oMaterial.diffuse.a >= -1 Then
|
||||
oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
|
||||
fDoneFading = False
|
||||
End If
|
||||
oMesh.SetMaterial lCount, oMaterial
|
||||
Next
|
||||
FadeMesh = fDoneFading
|
||||
End Function
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
Set moPaddle = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Terminate()
|
||||
Set moPaddle = Nothing
|
||||
End Sub
|
||||
|
||||
Private Function Min(ByVal nVal As Single, nVal2 As Single) As Single
|
||||
If Abs(nVal) < Abs(nVal2) Then
|
||||
Min = nVal
|
||||
Else
|
||||
Min = nVal2
|
||||
End If
|
||||
End Function
|
||||
|
||||
@@ -0,0 +1,454 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "cPuck"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Const mnMaxSpinSpeed As Single = 0.9
|
||||
'Here we will encapsulate all of the code needed for the puck
|
||||
'Local variables for the properties of the puck
|
||||
Private moPosition As D3DVECTOR 'Current position of the puck
|
||||
Private moVelocity As D3DVECTOR 'Current velocity of the puck
|
||||
Private moLastPosition As D3DVECTOR 'Last position of the puck
|
||||
|
||||
Public Spinning As Boolean 'Is the puck currently spinning?
|
||||
Public MaximumPuckVelocity As Single
|
||||
|
||||
Private mnSpinDir As Single 'Direction of the pucks spinning
|
||||
Private mlPuckTime As Long 'Last time the puck was updated
|
||||
Private mnPuckSpin As Single
|
||||
|
||||
Private moPuck As CD3DFrame 'D3D Mesh for the puck
|
||||
'Default spin speed
|
||||
Private mnDefaultSpin As Single
|
||||
|
||||
'Position property
|
||||
Public Property Let Position(oPos As D3DVECTOR)
|
||||
moPosition = oPos
|
||||
End Property
|
||||
|
||||
Public Property Get Position() As D3DVECTOR
|
||||
Position = moPosition
|
||||
End Property
|
||||
|
||||
'Velocity property
|
||||
Public Property Let Velocity(oVel As D3DVECTOR)
|
||||
moVelocity = oVel
|
||||
'Update the velocity, but make sure it isn't too high
|
||||
EnsurePuckVelocityIsBelowMax
|
||||
End Property
|
||||
|
||||
Public Property Get Velocity() As D3DVECTOR
|
||||
Velocity = moVelocity
|
||||
End Property
|
||||
|
||||
'LastPosition prop
|
||||
Public Property Let LastPosition(oLastPos As D3DVECTOR)
|
||||
moLastPosition = oLastPos
|
||||
End Property
|
||||
|
||||
Public Property Get LastPosition() As D3DVECTOR
|
||||
LastPosition = moLastPosition
|
||||
End Property
|
||||
|
||||
'Different methods from the puck.
|
||||
Public Sub Init(ByVal sMedia As String, sFile As String)
|
||||
Set moPuck = D3DUtil_LoadFromFile(AddDirSep(sMedia) & sFile, Nothing, Nothing)
|
||||
End Sub
|
||||
|
||||
Public Sub UpdatePosition()
|
||||
Dim RealVelocity As D3DVECTOR
|
||||
|
||||
'Here we will update the position of the puck
|
||||
'and move it based on the velocity assigned.
|
||||
If mlPuckTime = 0 Then mlPuckTime = timeGetTime
|
||||
'First calculate the 'real' velocity (based on the time)
|
||||
RealVelocity.X = ((timeGetTime - mlPuckTime) / 100) * moVelocity.X
|
||||
RealVelocity.Y = ((timeGetTime - mlPuckTime) / 100) * moVelocity.Y
|
||||
RealVelocity.z = ((timeGetTime - mlPuckTime) / 100) * moVelocity.z
|
||||
'Let's save our current position
|
||||
moLastPosition = moPosition
|
||||
|
||||
moPosition.X = moPosition.X + RealVelocity.X
|
||||
moPosition.Y = moPosition.Y + RealVelocity.Y
|
||||
moPosition.z = moPosition.z + RealVelocity.z
|
||||
|
||||
If Spinning Then
|
||||
'Update Puck Spin
|
||||
mnPuckSpin = mnPuckSpin + ((((timeGetTime - mlPuckTime) / 100) * mnDefaultSpin) * mnSpinDir)
|
||||
If mnPuckSpin > 2 * g_pi Then mnPuckSpin = 0
|
||||
End If
|
||||
|
||||
mlPuckTime = timeGetTime
|
||||
End Sub
|
||||
|
||||
Public Sub Render(dev As Direct3DDevice8)
|
||||
Dim matRot As D3DMATRIX, matTrans As D3DMATRIX
|
||||
Dim matPuck As D3DMATRIX
|
||||
|
||||
D3DXMatrixRotationAxis matRot, vec3(0, 1, 0), mnPuckSpin
|
||||
D3DXMatrixTranslation matTrans, moPosition.X, moPosition.Y, moPosition.z
|
||||
D3DXMatrixMultiply matPuck, matRot, matTrans
|
||||
|
||||
moPuck.SetMatrix matPuck
|
||||
moPuck.Render dev
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub LaunchPuck()
|
||||
Randomize
|
||||
DefaultStartPosition
|
||||
Do While (D3DXVec3Length(moVelocity) < (MaximumPuckVelocity / 4)) And (Abs(moVelocity.z) < 0.2) 'Make sure there is *some* z movement
|
||||
moVelocity.z = Rnd * (MaximumPuckVelocity / 3)
|
||||
moVelocity.X = Rnd * (MaximumPuckVelocity / 3)
|
||||
If Rnd > 0.5 Then moVelocity.X = moVelocity.X * -1
|
||||
If Rnd < 0.5 Then moVelocity.z = moVelocity.z * -1
|
||||
Loop
|
||||
End Sub
|
||||
|
||||
Public Sub DefaultStartPosition()
|
||||
moPosition = vec3(0, 2.5, 0)
|
||||
moVelocity = vec3(0, 0, 0)
|
||||
moLastPosition = vec3(0, 0, 0)
|
||||
End Sub
|
||||
|
||||
Public Sub ChangePuckVelocity(oPaddle As cPaddle, oAudio As cAudio, Optional ByVal fIgnoreMax As Boolean = False)
|
||||
|
||||
Dim vDir As D3DVECTOR
|
||||
Dim a As Single, b As Single, c As Single
|
||||
Dim t0 As Single, t1 As Single
|
||||
Dim vIntersect As D3DVECTOR, vIntersectHigh As D3DVECTOR
|
||||
Dim oPlane As D3DPLANE, matReflect As D3DMATRIX
|
||||
Dim oPoint As D3DVECTOR, vNewVelDir As D3DVECTOR
|
||||
Dim vPuck As D3DVECTOR, tSmall As Single
|
||||
Dim nVelocity As Single, nVelocityPaddle As Single
|
||||
Dim vNewVelPad As D3DVECTOR
|
||||
|
||||
'We hit with the paddle, randomly change the spin direction
|
||||
UpdatePuckSpin
|
||||
glPaddleCollideTime = timeGetTime
|
||||
'gfRecentlyHitPaddle = True
|
||||
'Notify the user that the puck hit the paddle by playing a sound
|
||||
If Not (oAudio Is Nothing) Then oAudio.PlayHitSound
|
||||
'Let's store the original velocity
|
||||
nVelocity = D3DXVec3Length(moVelocity)
|
||||
nVelocityPaddle = D3DXVec3Length(oPaddle.Velocity) * gnPaddleMass
|
||||
'First we need to find the intersection point
|
||||
'To do that we first need to solve for t:
|
||||
'x = Dxt + x0
|
||||
'z = Dzt + z0
|
||||
D3DXVec3Subtract vPuck, moPosition, oPaddle.Position
|
||||
D3DXVec3Normalize vDir, moVelocity
|
||||
a = 1 ' (vDir.x ^ 2) + (vDir.z ^ 2) will always be one since the vector is normalized
|
||||
b = (2 * vPuck.X * vDir.X) + (2 * vPuck.z * vDir.z)
|
||||
c = ((vPuck.X ^ 2) + (vPuck.z ^ 2) - ((gnPaddleRadius + gnPuckRadius) ^ 2))
|
||||
't = (-b <20> SQR(b<>-4ac))/2a
|
||||
If (b ^ 2) - (4 * a * c) > 0 Then
|
||||
t0 = (-b + Sqr((b ^ 2) - (4 * a * c))) / (2 * a)
|
||||
t1 = (-b - Sqr((b ^ 2) - (4 * a * c))) / (2 * a)
|
||||
Else 'We shouldn't hit this case, but just in case.
|
||||
t0 = 0
|
||||
t1 = 0
|
||||
End If
|
||||
|
||||
Dim vInt1 As D3DVECTOR, vInt2 As D3DVECTOR
|
||||
Dim vDifInt1 As D3DVECTOR, vDifInt2 As D3DVECTOR
|
||||
'Find both possible intersection points
|
||||
vInt1.X = (vDir.X * t0) + vPuck.X: vInt1.z = (vDir.z * t0) + vPuck.z
|
||||
vInt2.X = (vDir.X * t1) + vPuck.X: vInt2.z = (vDir.z * t1) + vPuck.z
|
||||
'Find the difference from the starting location
|
||||
D3DXVec3Subtract vDifInt1, oPaddle.Position, vInt1
|
||||
D3DXVec3Subtract vDifInt2, oPaddle.Position, vInt2
|
||||
|
||||
'Find the smallest t
|
||||
'If t0 > t1 Then
|
||||
If D3DXVec3Length(vDifInt1) < D3DXVec3Length(vDifInt2) Then
|
||||
tSmall = t1
|
||||
Else
|
||||
tSmall = t0
|
||||
End If
|
||||
'Let's get the intersected point
|
||||
vIntersect.X = (vDir.X * tSmall) + vPuck.X
|
||||
vIntersect.z = (vDir.z * tSmall) + vPuck.z
|
||||
|
||||
'Create a new vector with an enormously high Y field to create our reflection plane
|
||||
vIntersectHigh = vIntersect
|
||||
vIntersectHigh.Y = 500
|
||||
'Let's create a plane from this point
|
||||
D3DXPlaneFromPoints oPlane, vec3(0, 0, 0), vIntersect, vIntersectHigh
|
||||
|
||||
'Now we can create a reflection matrix based on this plane
|
||||
D3DXMatrixReflect matReflect, oPlane
|
||||
'Create a new point that is reflected
|
||||
D3DXVec3TransformCoord oPoint, vPuck, matReflect
|
||||
D3DXVec3Subtract vNewVelDir, oPoint, vIntersect
|
||||
'Normalize the vector
|
||||
D3DXVec3Normalize vNewVelDir, vNewVelDir
|
||||
vNewVelDir.X = -vNewVelDir.X
|
||||
vNewVelDir.z = -vNewVelDir.z
|
||||
D3DXVec3Scale moVelocity, vNewVelDir, nVelocity
|
||||
If nVelocityPaddle > 0 Then 'The paddle is moving, add it's velocity
|
||||
'Now let's add the velocity of the paddle to our resulting velocity
|
||||
D3DXVec3Normalize vNewVelPad, oPaddle.Velocity
|
||||
D3DXVec3Scale vNewVelPad, vNewVelPad, nVelocityPaddle
|
||||
D3DXVec3Add moVelocity, moVelocity, vNewVelPad
|
||||
End If
|
||||
Debug.Print "Old Velocity:"; nVelocity; " - New Velocity:"; D3DXVec3Length(moVelocity)
|
||||
'If we are limiting the velocity to it's maximum (most times), do so
|
||||
If Not fIgnoreMax Then EnsurePuckVelocityIsBelowMax
|
||||
End Sub
|
||||
|
||||
Public Sub CheckCollisions(oPaddle() As cPaddle, Optional oAudio As cAudio = Nothing)
|
||||
'First we should check to see if we are scoring in this frame.
|
||||
Dim nDistance As Single
|
||||
Dim lCount As Long, fCollided As Boolean
|
||||
Dim lCollided As Long, nCollideDist As Single
|
||||
|
||||
If gfScored Then Exit Sub
|
||||
'Check to see if the puck has collided with any of the walls
|
||||
'We could do an exhaustive check to see if any of the polygons collide, but since the table
|
||||
'is static, in the name of faster calculations, we will use a group of constants defining the
|
||||
'edges of the walls. We will check those instead.
|
||||
|
||||
'If the puck does hit one of the walls, we can easily calculate it's new direction by simply reversing
|
||||
'it's velocity (of that vector). If we want to be even more accurate we can lower the velocity by a small amount as well
|
||||
|
||||
'The left and right walls are bound to the X axis
|
||||
If moPosition.X > (gnSideLeftWallEdge - (gnPuckRadius)) Then
|
||||
'We hit the wall
|
||||
'Reverse the velocity of the X axis
|
||||
moVelocity = vec3((moVelocity.X * -1) * gnVelocityDamp, 0, moVelocity.z)
|
||||
moPosition = vec3((gnSideLeftWallEdge - (gnPuckRadius)), moPosition.Y, moPosition.z)
|
||||
If Not (oAudio Is Nothing) Then oAudio.PlayBankSound
|
||||
gfRecentlyHitPaddle = False
|
||||
ElseIf moPosition.X < (gnSideRightWallEdge + (gnPuckRadius)) Then
|
||||
'We hit the wall
|
||||
moVelocity = vec3((moVelocity.X * -1) * gnVelocityDamp, 0, moVelocity.z)
|
||||
moPosition = vec3((gnSideRightWallEdge + (gnPuckRadius)), moPosition.Y, moPosition.z)
|
||||
If Not (oAudio Is Nothing) Then oAudio.PlayBankSound
|
||||
gfRecentlyHitPaddle = False
|
||||
End If
|
||||
|
||||
'The front and rear walls are count to the Z axis
|
||||
If moPosition.z > (gnNearWallEdge - (gnPuckRadius)) Then
|
||||
'Only reverse the velocity if we hit the sides of the 'scoring area'
|
||||
If (moPosition.X > (gnScoringEdgeLeft - (gnPuckRadius))) Or (moPosition.X < (gnScoringEdgeRight + (gnPuckRadius))) Then
|
||||
'We hit the wall
|
||||
'Reverse the velocity of the Z axis
|
||||
moVelocity = vec3(moVelocity.X, 0, (moVelocity.z * -1) * gnVelocityDamp)
|
||||
moPosition = vec3(moPosition.X, moPosition.Y, gnNearWallEdge - (gnPuckRadius))
|
||||
If Not (oAudio Is Nothing) Then oAudio.PlayBankSound
|
||||
gfRecentlyHitPaddle = False
|
||||
End If
|
||||
ElseIf moPosition.z < (gnFarWallEdge + (gnPuckRadius)) Then
|
||||
If (moPosition.X > (gnScoringEdgeLeft - (gnPuckRadius))) Or (moPosition.X < (gnScoringEdgeRight - (gnPuckRadius))) Then
|
||||
'We hit the wall
|
||||
moVelocity = vec3(moVelocity.X, 0, (moVelocity.z * -1) * gnVelocityDamp)
|
||||
moPosition = vec3(moPosition.X, moPosition.Y, gnFarWallEdge + (gnPuckRadius))
|
||||
If Not (oAudio Is Nothing) Then oAudio.PlayBankSound
|
||||
gfRecentlyHitPaddle = False
|
||||
End If
|
||||
End If
|
||||
|
||||
'Next we should check to see if the puck has collided with either of the paddles
|
||||
'We will use a simple formula to determine if the puck has collided with one of the
|
||||
'paddles. Simply put if the distance between the center of the puck, and the center
|
||||
'of the paddle in question is greater than the radius of the puck + the radius of the
|
||||
'paddle, they haven't collided
|
||||
Dim vecDif As D3DVECTOR
|
||||
|
||||
If ((timeGetTime - glPaddleCollideTime) > glMinDelayPaddleHit) Or (Not gfRecentlyHitPaddle) Then
|
||||
gfRecentlyHitPaddle = False
|
||||
For lCount = 0 To 1 'Both paddles
|
||||
'We only check the X/Z coords because in this demo the puck will never leave the table
|
||||
'so it will maintain a constant Y coord.
|
||||
D3DXVec3Subtract vecDif, moPosition, oPaddle(lCount).Position
|
||||
nDistance = D3DXVec3Length(vecDif)
|
||||
If nDistance < (gnPaddleRadius + gnPuckRadius) Then 'They have collided
|
||||
nCollideDist = nDistance
|
||||
lCollided = lCount
|
||||
fCollided = True
|
||||
If gfMultiplayer Then
|
||||
'Let each client handle it's own collision detection
|
||||
'in a multiplayer game. This balances the load between
|
||||
'the host machine, and the client machine and gives the
|
||||
'most realistic playing feel.
|
||||
If glMyPaddleID = lCount Then 'We collided with our paddle
|
||||
ChangePuckVelocity oPaddle(lCount), oAudio
|
||||
SendPuck
|
||||
SendCollidePaddle
|
||||
End If
|
||||
Else
|
||||
ChangePuckVelocity oPaddle(lCount), oAudio
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
' Make sure we aren't colliding anymore
|
||||
If fCollided Then EnsurePuckIsNotInPaddle nCollideDist, oPaddle(lCollided)
|
||||
'Lastly we should check if we have scored (on either side)
|
||||
If gfMultiplayer And (Not gfHost) Then Exit Sub 'Only the host should check for scoring
|
||||
If moPosition.z > (gnNearWallEdge) Then
|
||||
'We scored!
|
||||
goPuck.DropPuckIntoScoringPosition goAudio
|
||||
ElseIf moPosition.z < (gnFarWallEdge) Then
|
||||
'We scored!
|
||||
goPuck.DropPuckIntoScoringPosition goAudio
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub EnsurePuckIsNotInPaddle(ByVal nDistance As Single, oPaddle As cPaddle, Optional ByVal fSentPaddle As Boolean = False)
|
||||
'Move the paddle back out so it's not hitting the puck
|
||||
Dim vDir As D3DVECTOR, vScale As D3DVECTOR, vPaddleVel As D3DVECTOR
|
||||
|
||||
If fSentPaddle Then
|
||||
D3DXVec3Subtract vPaddleVel, oPaddle.LastPosition, oPaddle.Position
|
||||
'Get the direction vector by normalizing the paddle's velocity
|
||||
D3DXVec3Normalize vDir, vPaddleVel
|
||||
Else
|
||||
'Get the direction vector by normalizing the pucks velocity
|
||||
D3DXVec3Normalize vDir, moVelocity
|
||||
End If
|
||||
'Scale the vector, just enough to get it out of the paddle
|
||||
D3DXVec3Scale vScale, vDir, (gnPuckRadius + gnPaddleRadius) - nDistance
|
||||
'Move the puck to it's new location
|
||||
D3DXVec3Add moPosition, moPosition, vScale
|
||||
'Now, let's increase the pucks velocity that much as well..
|
||||
If fSentPaddle Then D3DXVec3Add moVelocity, moVelocity, vScale
|
||||
End Sub
|
||||
|
||||
Private Sub UpdatePuckSpin()
|
||||
Randomize
|
||||
If Rnd > 0.5 Then
|
||||
mnSpinDir = mnSpinDir * -1
|
||||
'Update the spin, change speed from 75%-125% of current speed..
|
||||
mnDefaultSpin = (Rnd * (mnSpinDir * 0.75)) + (mnSpinDir * 0.5)
|
||||
If Abs(mnDefaultSpin) > mnMaxSpinSpeed Then
|
||||
mnDefaultSpin = mnMaxSpinSpeed * (Abs(mnDefaultSpin) \ mnDefaultSpin)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub CleanupFrame()
|
||||
moPuck.Destroy
|
||||
Set moPuck = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub DropPuckIntoScoringPosition(oAudio As cAudio, Optional ByVal fFromReceive As Boolean = False)
|
||||
|
||||
gfScored = True
|
||||
glTimeCompPaddle = 0
|
||||
If Not gfMultiplayer Then
|
||||
With goPaddle(1).Velocity
|
||||
.X = 0: .z = 0
|
||||
End With
|
||||
End If
|
||||
glTimePuckScored = timeGetTime
|
||||
oAudio.PlayScoreSound
|
||||
If gfMultiplayer Then
|
||||
If Not gfHost And Not fFromReceive Then Exit Sub
|
||||
End If
|
||||
'First stop the velocity
|
||||
moVelocity = vec3(0, 0, 0)
|
||||
|
||||
With moPosition
|
||||
'Now position the puck
|
||||
If .z < 0 Then
|
||||
gPlayer(1).Score = gPlayer(1).Score + 1
|
||||
.z = gnFarWallEdge - 1.2
|
||||
ElseIf .z > 0 Then
|
||||
.z = gnNearWallEdge + 1.2
|
||||
gPlayer(0).Score = gPlayer(0).Score + 1
|
||||
End If
|
||||
If Abs(.X) > gnScoringEdgeLeft / 3 Then
|
||||
If Abs(.X) <> .X Then
|
||||
.X = gnScoringEdgeRight / 3
|
||||
Else
|
||||
.X = gnScoringEdgeLeft / 3
|
||||
End If
|
||||
End If
|
||||
.Y = gnPuckScored
|
||||
End With
|
||||
|
||||
Spinning = False
|
||||
'If we are the host, notify everyone that we've scored
|
||||
If gfMultiplayer Then NotifyPlayersWeScored
|
||||
|
||||
End Sub
|
||||
|
||||
Public Function FadeMesh(FadeInterval As Single) As Boolean
|
||||
Dim lNumMaterial As Long
|
||||
Dim lCount As Long
|
||||
Dim oMaterial As D3DMATERIAL8
|
||||
Dim fDoneFading As Boolean
|
||||
Dim oMesh As CD3DMesh
|
||||
Dim nInternalInterval As Single
|
||||
Static lFadeTime As Long
|
||||
|
||||
nInternalInterval = FadeInterval
|
||||
If lFadeTime = 0 Then
|
||||
lFadeTime = timeGetTime
|
||||
Exit Function 'We'll do the fade next render pass
|
||||
End If
|
||||
nInternalInterval = (((timeGetTime - lFadeTime) / 1000000) * nInternalInterval)
|
||||
|
||||
Set oMesh = moPuck.FindChildObject("puck", 0)
|
||||
fDoneFading = True
|
||||
lNumMaterial = oMesh.GetMaterialCount
|
||||
For lCount = 0 To lNumMaterial - 1
|
||||
oMaterial = oMesh.GetMaterial(lCount)
|
||||
If nInternalInterval > 0 And oMaterial.diffuse.a <= 1 Then
|
||||
oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
|
||||
fDoneFading = False
|
||||
ElseIf nInternalInterval < 0 And oMaterial.diffuse.a >= -1 Then
|
||||
oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
|
||||
fDoneFading = False
|
||||
End If
|
||||
oMesh.SetMaterial lCount, oMaterial
|
||||
Next
|
||||
FadeMesh = fDoneFading
|
||||
End Function
|
||||
|
||||
Public Sub PauseSystem(ByVal fPause As Boolean)
|
||||
If Not fPause Then
|
||||
mlPuckTime = timeGetTime
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'************
|
||||
'Private functions that the public subs here will call, but the main application doesn't need to know about
|
||||
|
||||
Private Sub EnsurePuckVelocityIsBelowMax()
|
||||
Dim VelVec As D3DVECTOR
|
||||
'Let's make sure the puck's velocity isn't above the max,
|
||||
'and if it is, lower it to the max velocity
|
||||
If D3DXVec3Length(moVelocity) > MaximumPuckVelocity Then
|
||||
'Yup, lower the velocity to the max
|
||||
Dim vNrm As D3DVECTOR
|
||||
|
||||
D3DXVec3Normalize vNrm, moVelocity
|
||||
D3DXVec3Scale VelVec, vNrm, MaximumPuckVelocity
|
||||
moVelocity = VelVec
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
mnSpinDir = 1
|
||||
mnDefaultSpin = 0.15
|
||||
Set moPuck = Nothing
|
||||
DefaultStartPosition
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Terminate()
|
||||
If Not moPuck Is Nothing Then moPuck.Destroy
|
||||
Set moPuck = Nothing
|
||||
End Sub
|
||||
@@ -0,0 +1,121 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "cRoom"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
Private Const mnRoomX As Single = 0
|
||||
Private Const mnRoomY As Single = 2
|
||||
Private Const mnRoomZ As Single = 0
|
||||
|
||||
Private Const mnBarRoomX As Single = 0
|
||||
Private Const mnBarRoomY As Single = -5
|
||||
Private Const mnBarRoomZ As Single = 0
|
||||
|
||||
Private Const mnLobbyScaleX As Single = 8
|
||||
Private Const mnLobbyScaleY As Single = 5
|
||||
Private Const mnLobbyScaleZ As Single = 9
|
||||
|
||||
Private moRoom As CD3DFrame ' Our Room frame
|
||||
Private moOfficeRoom As CD3DFrame ' Our Room frame
|
||||
|
||||
Public DrawRoom As Boolean 'Should we draw the room at all
|
||||
Public BarRoom As Boolean 'Should we draw the bar or the MS lobby
|
||||
|
||||
'Methods
|
||||
Public Sub Init(ByVal sMedia As String, sRoom As String, sLobby As String)
|
||||
Set moRoom = D3DUtil_LoadFromFile(AddDirSep(sMedia) & sRoom, Nothing, Nothing)
|
||||
Set moOfficeRoom = D3DUtil_LoadFromFile(AddDirSep(sMedia) & sLobby, Nothing, Nothing)
|
||||
End Sub
|
||||
|
||||
Public Sub CleanupFrame()
|
||||
If Not (moRoom Is Nothing) Then moRoom.Destroy
|
||||
If Not (moOfficeRoom Is Nothing) Then moOfficeRoom.Destroy
|
||||
Set moRoom = Nothing
|
||||
Set moOfficeRoom = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub Render(dev As Direct3DDevice8)
|
||||
Dim matRoom As D3DMATRIX
|
||||
Dim matScale As D3DMATRIX
|
||||
|
||||
If DrawRoom Then
|
||||
If BarRoom Then
|
||||
'First the room
|
||||
D3DXMatrixIdentity matRoom
|
||||
D3DXMatrixTranslation matRoom, mnBarRoomX, mnBarRoomY, mnBarRoomZ
|
||||
moRoom.SetMatrix matRoom
|
||||
moRoom.Render g_dev
|
||||
Else
|
||||
'First the room
|
||||
D3DXMatrixIdentity matRoom
|
||||
D3DXMatrixTranslation matRoom, mnRoomX, mnRoomY, mnRoomZ
|
||||
D3DXMatrixScaling matScale, mnLobbyScaleX, mnLobbyScaleY, mnLobbyScaleZ
|
||||
D3DXMatrixMultiply matRoom, matRoom, matScale
|
||||
moOfficeRoom.SetMatrix matRoom
|
||||
moOfficeRoom.Render g_dev
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Function FadeMesh(FadeInterval As Single) As Boolean
|
||||
Dim lNumMaterial As Long
|
||||
Dim lCount As Long
|
||||
Dim oMaterial As D3DMATERIAL8
|
||||
Dim fDoneFading As Boolean
|
||||
Dim oMesh As CD3DMesh
|
||||
Dim nInternalInterval As Single
|
||||
Static lFadeTime As Long
|
||||
|
||||
FadeMesh = True
|
||||
nInternalInterval = FadeInterval
|
||||
If lFadeTime = 0 Then
|
||||
lFadeTime = timeGetTime
|
||||
Exit Function 'We'll do the fade next render pass
|
||||
End If
|
||||
nInternalInterval = (((timeGetTime - lFadeTime) / 1000000) * nInternalInterval)
|
||||
|
||||
If Not DrawRoom Then Exit Function
|
||||
fDoneFading = True
|
||||
If BarRoom Then
|
||||
Set oMesh = moRoom.FindChildObject("room", 0)
|
||||
Else
|
||||
Set oMesh = moOfficeRoom.FindChildObject("Unnamed_0", 0)
|
||||
End If
|
||||
lNumMaterial = oMesh.GetMaterialCount
|
||||
For lCount = 0 To lNumMaterial - 1
|
||||
oMaterial = oMesh.GetMaterial(lCount)
|
||||
If nInternalInterval > 0 And oMaterial.diffuse.a <= 1 Then
|
||||
oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
|
||||
fDoneFading = False
|
||||
ElseIf nInternalInterval < 0 And oMaterial.diffuse.a >= -1 Then
|
||||
oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
|
||||
fDoneFading = False
|
||||
End If
|
||||
oMesh.SetMaterial lCount, oMaterial
|
||||
Next
|
||||
FadeMesh = fDoneFading
|
||||
End Function
|
||||
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
DrawRoom = True
|
||||
Set moRoom = Nothing
|
||||
Set moOfficeRoom = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Terminate()
|
||||
If Not (moRoom Is Nothing) Then moRoom.Destroy
|
||||
If Not (moOfficeRoom Is Nothing) Then moOfficeRoom.Destroy
|
||||
|
||||
Set moRoom = Nothing
|
||||
Set moOfficeRoom = Nothing
|
||||
End Sub
|
||||
@@ -0,0 +1,120 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "cTable"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'Here we will encapsulate all of the code needed for the table
|
||||
'Local variables for the properties of the table
|
||||
Private moPosition As D3DVECTOR 'Current position of the table
|
||||
Private moTable As CD3DFrame 'D3D Mesh for the table
|
||||
Private mlTransparantPaddle As Boolean
|
||||
Public DrawTable As Boolean ' You can also turn off the table (dunno why, but let'em)
|
||||
|
||||
'Position property
|
||||
Public Property Let Position(oPos As D3DVECTOR)
|
||||
moPosition = oPos
|
||||
End Property
|
||||
|
||||
Public Property Get Position() As D3DVECTOR
|
||||
Position = moPosition
|
||||
End Property
|
||||
|
||||
'Transparent property
|
||||
Public Property Let Transparent(ByVal fTrans As Boolean)
|
||||
Dim oMesh As CD3DMesh, oMaterial As D3DMATERIAL8
|
||||
Dim lNumMaterial As Long, lCount As Long
|
||||
|
||||
mlTransparantPaddle = fTrans
|
||||
'now set the property
|
||||
Set oMesh = moTable.FindChildObject("table", 0)
|
||||
lNumMaterial = oMesh.GetMaterialCount
|
||||
For lCount = 0 To lNumMaterial - 1
|
||||
oMaterial = oMesh.GetMaterial(lCount)
|
||||
If fTrans Then
|
||||
oMaterial.diffuse.a = 0.5
|
||||
Else
|
||||
oMaterial.diffuse.a = 1
|
||||
End If
|
||||
oMesh.SetMaterial lCount, oMaterial
|
||||
Next
|
||||
End Property
|
||||
|
||||
Public Property Get Transparent() As Boolean
|
||||
Transparent = mlTransparantPaddle
|
||||
End Property
|
||||
|
||||
'Methods
|
||||
Public Sub Init(ByVal sMedia As String, sFile As String)
|
||||
Set moTable = D3DUtil_LoadFromFile(AddDirSep(sMedia) & sFile, Nothing, Nothing)
|
||||
End Sub
|
||||
|
||||
Public Sub Render(dev As Direct3DDevice8)
|
||||
Dim matTable As D3DMATRIX
|
||||
If DrawTable Then
|
||||
'Now the table
|
||||
D3DXMatrixIdentity matTable
|
||||
D3DXMatrixTranslation matTable, moPosition.X, moPosition.Y, moPosition.z
|
||||
moTable.SetMatrix matTable
|
||||
moTable.Render g_dev
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub CleanupFrame()
|
||||
moTable.Destroy
|
||||
Set moTable = Nothing
|
||||
End Sub
|
||||
|
||||
Public Function FadeMesh(FadeInterval As Single) As Boolean
|
||||
Dim lNumMaterial As Long
|
||||
Dim lCount As Long
|
||||
Dim oMaterial As D3DMATERIAL8
|
||||
Dim fDoneFading As Boolean
|
||||
Dim oMesh As CD3DMesh
|
||||
Dim nInternalInterval As Single
|
||||
Static lFadeTime As Long
|
||||
|
||||
FadeMesh = True
|
||||
nInternalInterval = FadeInterval
|
||||
If lFadeTime = 0 Then
|
||||
lFadeTime = timeGetTime
|
||||
Exit Function 'We'll do the fade next render pass
|
||||
End If
|
||||
nInternalInterval = (((timeGetTime - lFadeTime) / 1000000) * nInternalInterval)
|
||||
|
||||
fDoneFading = True
|
||||
If Not DrawTable Then Exit Function
|
||||
Set oMesh = moTable.FindChildObject("table", 0)
|
||||
lNumMaterial = oMesh.GetMaterialCount
|
||||
For lCount = 0 To lNumMaterial - 1
|
||||
oMaterial = oMesh.GetMaterial(lCount)
|
||||
If nInternalInterval > 0 And oMaterial.diffuse.a <= 1 Then
|
||||
oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
|
||||
fDoneFading = False
|
||||
ElseIf nInternalInterval < 0 And oMaterial.diffuse.a >= -1 Then
|
||||
oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
|
||||
fDoneFading = False
|
||||
End If
|
||||
oMesh.SetMaterial lCount, oMaterial
|
||||
Next
|
||||
FadeMesh = fDoneFading
|
||||
End Function
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
DrawTable = True
|
||||
Set moTable = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Terminate()
|
||||
If Not moTable Is Nothing Then moTable.Destroy
|
||||
Set moTable = Nothing
|
||||
End Sub
|
||||
@@ -0,0 +1,56 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "cText"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'Helper class to encapsulate text drawing
|
||||
|
||||
'Here we will keep the font information and the calls to draw the text
|
||||
Private moD3DXFont As D3DXFont
|
||||
|
||||
Public Sub InitText(d3dx As D3DX8, dev As Direct3DDevice8, ByVal sFontName As String, lSize As Long, fBold As Boolean)
|
||||
Dim oMyFont As IFont
|
||||
|
||||
Set oMyFont = New StdFont
|
||||
oMyFont.Name = "Times New Roman"
|
||||
oMyFont.size = 8
|
||||
oMyFont.Bold = True
|
||||
|
||||
Set moD3DXFont = d3dx.CreateFont(dev, oMyFont.hFont)
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub BeginText()
|
||||
moD3DXFont.Begin
|
||||
End Sub
|
||||
|
||||
Public Sub EndText()
|
||||
moD3DXFont.End
|
||||
End Sub
|
||||
|
||||
Public Sub DrawText(ByVal sText As String, X As Long, Y As Long, lColor As Long)
|
||||
Dim rcText As RECT
|
||||
|
||||
'X and Y are in screen coords
|
||||
rcText.Left = X
|
||||
rcText.Top = Y
|
||||
'actually draw the text now, telling d3dx to build the rectangle based on the text and the x,y coord
|
||||
moD3DXFont.DrawTextW sText, -1, rcText, 0, lColor
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
Set moD3DXFont = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Terminate()
|
||||
Set moD3DXFont = Nothing
|
||||
End Sub
|
||||
@@ -0,0 +1,572 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "CD3DAnimation"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: D3DAnimation.cls
|
||||
' Content: D3D Visual Basic Framework Animation Class
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
|
||||
Public ObjectName As String
|
||||
|
||||
Private Type KEYHEADER
|
||||
keytype As Long
|
||||
keycount As Long
|
||||
End Type
|
||||
|
||||
Private Type RMROTATEKEY
|
||||
time As Long
|
||||
nFloats As Long
|
||||
w As Single
|
||||
x As Single
|
||||
y As Single
|
||||
z As Single
|
||||
End Type
|
||||
|
||||
Private Type D3DMATRIXKEY
|
||||
time As Long
|
||||
nFloats As Long
|
||||
matrix As D3DMATRIX
|
||||
End Type
|
||||
|
||||
|
||||
Const kAnimGrowSize = 10
|
||||
|
||||
Dim m_RotateKeys() As D3DROTATEKEY
|
||||
Dim m_ScaleKeys() As D3DVECTORKEY
|
||||
Dim m_PositionKeys() As D3DVECTORKEY
|
||||
Dim m_RMRotateKeys() As RMROTATEKEY
|
||||
Dim m_MatrixKeys() As D3DMATRIXKEY
|
||||
|
||||
Dim m_NumRotateKeys As Long
|
||||
Dim m_NumScaleKeys As Long
|
||||
Dim m_NumPositionKeys As Long
|
||||
Dim m_NumMatrixKeys As Long
|
||||
Dim m_strFrameName As String
|
||||
Dim m_frame As CD3DFrame
|
||||
Dim m_iMatrixKey As Long
|
||||
|
||||
|
||||
Dim m_Children() As CD3DAnimation
|
||||
Dim m_NumChildren As Long
|
||||
Dim m_MaxChildren As Long
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ParseAnimSet
|
||||
' Desc: called from D3DUtil_LoadFromFile
|
||||
'-----------------------------------------------------------------------------
|
||||
Friend Sub ParseAnimSet(FileData As DirectXFileData, parentFrame As CD3DFrame)
|
||||
On Local Error Resume Next
|
||||
ObjectName = FileData.GetName()
|
||||
|
||||
Dim ChildData As DirectXFileData
|
||||
Dim NewAnim As CD3DAnimation
|
||||
Dim ChildObj As DirectXFileObject
|
||||
Dim ChildRef As DirectXFileReference
|
||||
|
||||
Set ChildObj = FileData.GetNextObject()
|
||||
|
||||
Do While Not ChildObj Is Nothing
|
||||
|
||||
Set ChildData = ChildObj
|
||||
If Err.Number = 0 Then
|
||||
|
||||
If ChildData.GetType = "TID_D3DRMAnimation" Then
|
||||
Set NewAnim = New CD3DAnimation
|
||||
AddChild NewAnim
|
||||
NewAnim.ParseAnim ChildData, Me, parentFrame
|
||||
End If
|
||||
End If
|
||||
|
||||
Err.Clear
|
||||
Set ChildRef = ChildObj
|
||||
|
||||
If Err.Number = 0 Then
|
||||
Set ChildData = ChildRef.Resolve
|
||||
|
||||
Set NewAnim = New CD3DAnimation
|
||||
AddChild NewAnim
|
||||
NewAnim.ParseAnim ChildData, Me, parentFrame
|
||||
End If
|
||||
|
||||
Err.Clear
|
||||
|
||||
Set ChildObj = FileData.GetNextObject()
|
||||
Loop
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetChild
|
||||
' Desc: return child Animation
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Public Function GetChild(i As Long) As CD3DAnimation
|
||||
Set GetChild = m_Children(i)
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetChildCount
|
||||
' Desc: return number of child animations
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Public Function GetChildCount() As Long
|
||||
GetChildCount = m_NumChildren
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: AddChild
|
||||
' Desc: Add child animation
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Public Sub AddChild(child As CD3DAnimation)
|
||||
If child Is Nothing Then Exit Sub
|
||||
|
||||
If m_MaxChildren = 0 Then
|
||||
m_MaxChildren = kAnimGrowSize
|
||||
ReDim m_Children(m_MaxChildren)
|
||||
ElseIf m_NumChildren >= m_MaxChildren Then
|
||||
m_MaxChildren = m_MaxChildren + kAnimGrowSize
|
||||
ReDim Preserve m_Children(m_MaxChildren)
|
||||
End If
|
||||
|
||||
Set m_Children(m_NumChildren) = child
|
||||
m_NumChildren = m_NumChildren + 1
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetFrame
|
||||
' Desc: set Frame to be animated
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub SetFrame(frame As CD3DFrame)
|
||||
Set m_frame = frame
|
||||
m_strFrameName = frame.ObjectName
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetFrame
|
||||
' Desc: return frame being animated
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function GetFrame() As CD3DFrame
|
||||
Set GetFrame = m_frame
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ParseAnim
|
||||
' Desc: Called by ParseAnimSet
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Friend Sub ParseAnim(FileData As DirectXFileData, parentAnimation As CD3DAnimation, parentFrame As CD3DFrame)
|
||||
On Local Error Resume Next
|
||||
ObjectName = FileData.GetName()
|
||||
|
||||
Dim dataSize As Long
|
||||
Dim KeyHead As KEYHEADER
|
||||
Dim size As Long
|
||||
Dim newFrame As CD3DFrame
|
||||
Dim ChildObj As DirectXFileObject
|
||||
Dim ChildData As DirectXFileData
|
||||
Dim ChildReference As DirectXFileReference
|
||||
Dim strChunkType As String
|
||||
Dim i As Long
|
||||
|
||||
Set ChildObj = FileData.GetNextObject()
|
||||
|
||||
Do While Not ChildObj Is Nothing
|
||||
|
||||
Set ChildReference = ChildObj
|
||||
If Err.Number = 0 Then
|
||||
|
||||
Set ChildData = ChildReference.Resolve()
|
||||
|
||||
|
||||
If ChildData.GetType = "TID_D3DRMFrame" Then
|
||||
m_strFrameName = ChildData.GetName()
|
||||
Set m_frame = parentFrame.FindChildObject(m_strFrameName, 0)
|
||||
End If
|
||||
|
||||
Set ChildReference = Nothing
|
||||
End If
|
||||
Err.Clear
|
||||
|
||||
Set ChildData = ChildObj
|
||||
If Err.Number = 0 Then
|
||||
|
||||
strChunkType = ChildData.GetType
|
||||
Select Case strChunkType
|
||||
Case "TID_D3DRMFrame"
|
||||
Set newFrame = New CD3DFrame
|
||||
newFrame.InitFromXOF g_dev, ChildData, parentFrame
|
||||
Set newFrame = Nothing
|
||||
|
||||
Case "TID_D3DRMAnimationOptions"
|
||||
|
||||
Case "TID_D3DRMAnimationKey"
|
||||
dataSize = ChildData.GetDataSize("")
|
||||
ChildData.GetDataFromOffset "", 0, 8, KeyHead
|
||||
|
||||
Select Case KeyHead.keytype
|
||||
Case 0 'ROTATEKEY
|
||||
ReDim m_RMRotateKeys(KeyHead.keycount)
|
||||
ReDim m_RotateKeys(KeyHead.keycount)
|
||||
size = Len(m_RMRotateKeys(0)) * KeyHead.keycount
|
||||
ChildData.GetDataFromOffset "", 8, size, m_RMRotateKeys(0)
|
||||
m_NumRotateKeys = KeyHead.keycount
|
||||
|
||||
'NOTE x files are w x y z and QUATERNIONS are x y z w
|
||||
'so we loop through on load and copy the values
|
||||
For i = 0 To m_NumRotateKeys - 1
|
||||
With m_RotateKeys(i)
|
||||
.time = m_RMRotateKeys(i).time
|
||||
If g_InvertRotateKey Then
|
||||
.quat.w = -m_RMRotateKeys(i).w
|
||||
Else
|
||||
.quat.w = m_RMRotateKeys(i).w
|
||||
End If
|
||||
.quat.x = m_RMRotateKeys(i).x
|
||||
.quat.y = m_RMRotateKeys(i).y
|
||||
.quat.z = m_RMRotateKeys(i).z
|
||||
End With
|
||||
Next
|
||||
ReDim m_RMRotateKeys(0)
|
||||
|
||||
Case 1 'SCALE KEY
|
||||
ReDim m_ScaleKeys(KeyHead.keycount)
|
||||
size = Len(m_ScaleKeys(0)) * KeyHead.keycount
|
||||
ChildData.GetDataFromOffset "", 8, size, m_ScaleKeys(0)
|
||||
m_NumScaleKeys = KeyHead.keycount
|
||||
|
||||
Case 2 'POSITION KEY
|
||||
ReDim m_PositionKeys(KeyHead.keycount)
|
||||
size = Len(m_PositionKeys(0)) * KeyHead.keycount
|
||||
ChildData.GetDataFromOffset "", 8, size, m_PositionKeys(0)
|
||||
m_NumPositionKeys = KeyHead.keycount
|
||||
|
||||
Case 4 'MATRIX KEY
|
||||
ReDim m_MatrixKeys(KeyHead.keycount)
|
||||
size = Len(m_MatrixKeys(0)) * KeyHead.keycount
|
||||
ChildData.GetDataFromOffset "", 8, size, m_MatrixKeys(0)
|
||||
m_NumMatrixKeys = KeyHead.keycount
|
||||
|
||||
End Select
|
||||
|
||||
|
||||
End Select
|
||||
End If
|
||||
|
||||
Set ChildData = Nothing
|
||||
Set ChildReference = Nothing
|
||||
|
||||
Set ChildObj = FileData.GetNextObject()
|
||||
Loop
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ComputeP1234
|
||||
' Desc: Aux function to compute 4 nearest keys
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub ComputeP1234(j As Long, maxNum As Long, ByRef p1 As Long, ByRef p2 As Long, ByRef p3 As Long, ByRef p4 As Long)
|
||||
|
||||
p1 = j: p2 = j: p3 = j: p4 = j
|
||||
|
||||
If j > 0 Then
|
||||
p1 = j - 2: p2 = j - 1
|
||||
End If
|
||||
If j = 1 Then
|
||||
p1 = j - 1: p2 = j - 1
|
||||
End If
|
||||
If j < (maxNum) - 1 Then p4 = j + 1
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetTime
|
||||
' Desc: Sets the matrix of the frame being animated
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub SetTime(t As Single)
|
||||
Dim t2 As Single
|
||||
Dim i As Long, j As Long
|
||||
Dim p1 As Long, p2 As Long, p3 As Long, p4 As Long
|
||||
Dim f1 As Single, f2 As Single, f3 As Single, f4 As Single
|
||||
Dim rM As D3DMATRIX, rQuat As D3DQUATERNION, rPos As D3DVECTOR, rScale As D3DVECTOR
|
||||
|
||||
Dim a As D3DVECTOR, b As D3DVECTOR
|
||||
Dim q1 As D3DQUATERNION, q2 As D3DQUATERNION
|
||||
Dim s As Single
|
||||
|
||||
Dim child As CD3DAnimation
|
||||
Dim LastT As Single
|
||||
|
||||
'Check children
|
||||
For i = 1 To m_NumChildren
|
||||
Set child = m_Children(i - 1)
|
||||
If Not child Is Nothing Then
|
||||
child.SetTime t
|
||||
End If
|
||||
Set child = Nothing
|
||||
Next
|
||||
|
||||
If m_frame Is Nothing Then Exit Sub
|
||||
|
||||
'set components to identity incase we dont have any keys.
|
||||
D3DXMatrixIdentity rM
|
||||
rScale = vec3(1, 1, 1)
|
||||
|
||||
D3DXQuaternionIdentity rQuat
|
||||
|
||||
|
||||
t2 = t
|
||||
|
||||
'loop matrix keys
|
||||
If m_NumMatrixKeys > 0 Then
|
||||
t2 = t
|
||||
LastT = m_MatrixKeys(m_NumMatrixKeys - 1).time
|
||||
If t > LastT Then
|
||||
i = t \ LastT
|
||||
t2 = t - i * LastT
|
||||
Else
|
||||
|
||||
End If
|
||||
|
||||
|
||||
'optimizations
|
||||
Dim tAt As Single, tNext1 As Single, tNext2 As Single
|
||||
|
||||
If m_iMatrixKey < m_NumMatrixKeys - 2 Then
|
||||
tAt = m_MatrixKeys(m_iMatrixKey).time
|
||||
tNext1 = m_MatrixKeys(m_iMatrixKey + 1).time
|
||||
tNext2 = m_MatrixKeys(m_iMatrixKey + 2).time
|
||||
If tAt < t2 And t2 <= tNext1 Then Exit Sub
|
||||
|
||||
If tNext1 < t2 And t2 <= tNext2 Then
|
||||
m_iMatrixKey = m_iMatrixKey + 1
|
||||
If m_iMatrixKey > m_NumMatrixKeys Then m_iMatrixKey = 0
|
||||
m_frame.SetMatrix m_MatrixKeys(m_iMatrixKey).matrix
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
'linear search
|
||||
For i = 1 To m_NumMatrixKeys
|
||||
If m_MatrixKeys(i - 1).time > t2 Then
|
||||
m_frame.SetMatrix m_MatrixKeys(i - 1).matrix
|
||||
m_iMatrixKey = i - 1
|
||||
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
|
||||
End If
|
||||
|
||||
'.................
|
||||
|
||||
|
||||
'loop position keys
|
||||
If m_NumPositionKeys > 0 Then
|
||||
t2 = t
|
||||
LastT = m_PositionKeys(m_NumPositionKeys - 1).time
|
||||
If t > LastT Then
|
||||
i = t \ LastT
|
||||
t2 = t - i * LastT
|
||||
End If
|
||||
End If
|
||||
|
||||
'Check Position Keys
|
||||
For i = 1 To m_NumPositionKeys
|
||||
j = i - 1
|
||||
|
||||
If m_PositionKeys(j).time > t2 Then
|
||||
|
||||
ComputeP1234 j, m_NumPositionKeys, p1, p2, p3, p4
|
||||
f1 = m_PositionKeys(p1).time
|
||||
f2 = m_PositionKeys(p2).time
|
||||
f3 = m_PositionKeys(p3).time
|
||||
f4 = m_PositionKeys(p4).time
|
||||
|
||||
|
||||
If ((f3 - f2) = 0) Then
|
||||
s = 1
|
||||
Else
|
||||
s = (t2 - f2) / (f3 - f2)
|
||||
End If
|
||||
|
||||
a = m_PositionKeys(p2).vec
|
||||
b = m_PositionKeys(p3).vec
|
||||
|
||||
|
||||
D3DXVec3Lerp rPos, a, b, s
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
|
||||
|
||||
'loop scale keys
|
||||
If m_NumScaleKeys > 0 Then
|
||||
t2 = t
|
||||
LastT = m_ScaleKeys(m_NumScaleKeys - 1).time
|
||||
If t > LastT Then
|
||||
i = t \ LastT
|
||||
t2 = t - i * LastT
|
||||
End If
|
||||
End If
|
||||
|
||||
|
||||
'Check Scale Keys
|
||||
For i = 1 To m_NumScaleKeys
|
||||
j = i - 1
|
||||
If m_ScaleKeys(j).time > t2 Then
|
||||
|
||||
ComputeP1234 j, m_NumScaleKeys, p1, p2, p3, p4
|
||||
f1 = m_ScaleKeys(p1).time
|
||||
f2 = m_ScaleKeys(p2).time
|
||||
f3 = m_ScaleKeys(p3).time
|
||||
f4 = m_ScaleKeys(p4).time
|
||||
|
||||
If ((f3 - f2) = 0) Then
|
||||
s = 1
|
||||
Else
|
||||
s = (t2 - f2) / (f3 - f2)
|
||||
End If
|
||||
|
||||
a = m_ScaleKeys(p2).vec
|
||||
b = m_ScaleKeys(p3).vec
|
||||
|
||||
|
||||
D3DXVec3Lerp rScale, a, b, s
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
|
||||
'loop rotate keys
|
||||
If m_NumRotateKeys > 0 Then
|
||||
t2 = t
|
||||
LastT = m_RotateKeys(m_NumRotateKeys - 1).time
|
||||
If t > LastT Then
|
||||
i = t \ LastT
|
||||
t2 = t - i * LastT
|
||||
End If
|
||||
End If
|
||||
|
||||
'Check Rotate Keys
|
||||
For i = 1 To m_NumRotateKeys
|
||||
j = i - 1
|
||||
|
||||
If m_RotateKeys(j).time > t2 Then
|
||||
|
||||
|
||||
|
||||
ComputeP1234 j, m_NumRotateKeys, p1, p2, p3, p4
|
||||
f1 = m_RotateKeys(p1).time
|
||||
f2 = m_RotateKeys(p2).time
|
||||
f3 = m_RotateKeys(p3).time
|
||||
f4 = m_RotateKeys(p4).time
|
||||
|
||||
If ((f3 - f2) = 0) Then
|
||||
s = 1
|
||||
Else
|
||||
s = (t2 - f2) / (f3 - f2)
|
||||
End If
|
||||
|
||||
q1 = m_RotateKeys(p2).quat
|
||||
q2 = m_RotateKeys(p3).quat
|
||||
|
||||
D3DXQuaternionSlerp rQuat, q1, q2, s
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
Dim temp1 As D3DMATRIX
|
||||
Dim temp2 As D3DMATRIX
|
||||
Dim temp3 As D3DMATRIX
|
||||
|
||||
D3DXMatrixScaling temp1, rScale.x, rScale.y, rScale.z
|
||||
D3DXMatrixRotationQuaternion temp2, rQuat
|
||||
D3DXMatrixTranslation temp3, rPos.x, rPos.y, rPos.z
|
||||
D3DXMatrixMultiply rM, temp1, temp2
|
||||
D3DXMatrixMultiply rM, rM, temp3
|
||||
|
||||
m_frame.SetMatrix rM
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: AddRotateKey
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Sub AddRotateKey(t As Long, quat As D3DQUATERNION)
|
||||
|
||||
ReDim Preserve m_RotateKeys(m_NumRotateKeys)
|
||||
|
||||
With m_RotateKeys(m_NumRotateKeys)
|
||||
.time = t
|
||||
.quat = quat
|
||||
End With
|
||||
m_NumRotateKeys = m_NumRotateKeys + 1
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: AddScaleKey
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Sub AddScaleKey(t As Long, scalevec As D3DVECTOR)
|
||||
|
||||
ReDim Preserve m_ScaleKeys(m_NumScaleKeys)
|
||||
|
||||
|
||||
|
||||
With m_ScaleKeys(m_NumScaleKeys)
|
||||
.time = t
|
||||
.vec = scalevec
|
||||
End With
|
||||
|
||||
m_NumScaleKeys = m_NumScaleKeys + 1
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: AddPositionKey
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub AddPositionKey(t As Long, posvec As D3DVECTOR)
|
||||
|
||||
ReDim Preserve m_PositionKeys(m_NumPositionKeys)
|
||||
|
||||
|
||||
|
||||
With m_PositionKeys(m_NumPositionKeys)
|
||||
.time = t
|
||||
.vec = posvec
|
||||
End With
|
||||
m_NumPositionKeys = m_NumPositionKeys + 1
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,745 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "CD3DMesh"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: D3DMesh.cls
|
||||
' Content: D3D VB Framework Mesh
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
|
||||
Option Explicit
|
||||
|
||||
Private Type BoneComboIdList
|
||||
List(4) As Long
|
||||
End Type
|
||||
|
||||
|
||||
' Base Objects
|
||||
Public mesh As D3DXMesh 'if not skinned, regular mesh object
|
||||
Public skinmesh As D3DXSkinMesh 'if skinned - skinned mesh object
|
||||
Public bUseMaterials As Boolean 'Use materials in object
|
||||
Public bUseMaterialOverride As Boolean 'Use only override material
|
||||
Public ObjectName As String 'Name of object
|
||||
Public bSkinned As Boolean 'Inidicates if the object is a skin
|
||||
|
||||
' Culling objects
|
||||
Dim m_SphereCenter As D3DVECTOR 'center of bounding sphere
|
||||
Public SphereRadius As Single 'radius of bounding sphere
|
||||
Public bHasSphere As Boolean 'Inidcatges if bounding sphere is calculated
|
||||
|
||||
' Material and Adjacency information
|
||||
Dim m_MaterialOverride As D3DMATERIAL8 'Override material to use if bUseMaterialOverride set
|
||||
Dim m_NumMaterials As Long 'Number of materials in object
|
||||
Dim m_Materials() As D3DMATERIAL8 'Material List
|
||||
Dim m_Textures() As Direct3DTexture8 'Texture List
|
||||
Dim m_TextureNames() As String 'Texture List Names
|
||||
Dim m_AdjBuffer As D3DXBuffer 'Adjacency buffer for the mesh
|
||||
|
||||
|
||||
' Bone and skinning informatin
|
||||
Dim m_BoneNames As D3DXBuffer 'Names of Frame objects that are bones
|
||||
Dim m_BoneMatrices As D3DXBuffer 'Matrix object per bone
|
||||
Dim m_BoneComboTable As D3DXBuffer 'Groupings of bone material and triangles
|
||||
Dim m_BoneFrames() As CD3DFrame 'Frame objects that are bones
|
||||
Dim m_maxFaceInfl As Long 'Number of matrices that will influence a vertex
|
||||
Dim m_worldMatHandles(4) As Long 'handle to multiple world matrices
|
||||
Dim m_BoneOffsetMat() As D3DMATRIX 'Bone offset matrices from D3DXBuffers
|
||||
Dim m_NumBoneCombos As Long 'Size of bonecombo table
|
||||
Dim m_BoneCombos() As D3DXBONECOMBINATION 'Combo table as returned from D3DX
|
||||
Dim m_BoneComboIds() As BoneComboIdList 'BoneId portion of combotable
|
||||
Dim m_BoneCount As Long 'Number of bones
|
||||
Dim m_bonesAttached As Boolean 'Indicates if bones have been attached to the mesh
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Init
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Init()
|
||||
bUseMaterials = True
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' SphereCenter()
|
||||
' returns Sphere Center since D3DVECTOR can not be public variable return value
|
||||
'-----------------------------------------------------------------------------
|
||||
Property Get SphereCenter() As D3DVECTOR
|
||||
SphereCenter = m_SphereCenter
|
||||
End Property
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitFromFile
|
||||
' Desc: Tries first to load mesh in current directory or using explicit path
|
||||
' If that fails loads mesh from SDK media path
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Public Function InitFromFile(dev As Direct3DDevice8, Name As String) As Boolean
|
||||
Dim mtrlBuffer As D3DXBuffer
|
||||
Dim strPath As String
|
||||
Destroy
|
||||
|
||||
' On Local Error Resume Next
|
||||
Set m_AdjBuffer = Nothing
|
||||
bSkinned = False
|
||||
|
||||
Set mesh = g_d3dx.LoadMeshFromX(Name, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials)
|
||||
If Err.Number <> 0 Then
|
||||
Err.Clear
|
||||
On Local Error GoTo ErrOut
|
||||
strPath = g_mediaPath + Name
|
||||
Set mesh = g_d3dx.LoadMeshFromX(strPath, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials)
|
||||
|
||||
End If
|
||||
|
||||
Call InitMaterials(g_dev, mtrlBuffer)
|
||||
|
||||
InitFromFile = True
|
||||
Exit Function
|
||||
|
||||
ErrOut:
|
||||
InitFromFile = False
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitFromXOF
|
||||
' Desc: Load mesh from data provided by XOF api
|
||||
' Called from D3DUtil_LoadFromFile
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Public Function InitFromXOF(dev As Direct3DDevice8, meshdata As DirectXFileData) As Boolean
|
||||
Dim mtrlBuffer As D3DXBuffer
|
||||
Dim bonename As String
|
||||
Dim i As Long
|
||||
Dim q As Long
|
||||
|
||||
|
||||
Destroy
|
||||
|
||||
|
||||
Set m_AdjBuffer = Nothing
|
||||
Set m_BoneMatrices = Nothing
|
||||
Set m_BoneNames = Nothing
|
||||
Set mesh = Nothing
|
||||
Set skinmesh = Nothing
|
||||
Set m_BoneMatrices = Nothing
|
||||
Set m_BoneComboTable = Nothing
|
||||
|
||||
ObjectName = meshdata.GetName()
|
||||
|
||||
' On Local Error GoTo errOut
|
||||
bSkinned = False
|
||||
|
||||
'Users can set this variable to TRUE try the skinned load path
|
||||
If g_bLoadSkins = True Then
|
||||
Set skinmesh = g_d3dx.LoadSkinMeshFromXof(meshdata, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials, m_BoneNames, m_BoneMatrices)
|
||||
|
||||
|
||||
Dim pAdj As Long, AdjOut As D3DXBuffer
|
||||
pAdj = m_AdjBuffer.GetBufferPointer
|
||||
|
||||
m_BoneCount = skinmesh.GetNumBones()
|
||||
|
||||
If m_BoneCount = 0 Then
|
||||
|
||||
''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
' a skinned mesh with no bones is just a regular mesh
|
||||
''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
bSkinned = False
|
||||
Set mesh = skinmesh.GetOriginalMesh()
|
||||
'Set skinmesh = Nothing
|
||||
|
||||
Else
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''
|
||||
' code specific to x files with skinning data in them
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
bSkinned = True
|
||||
|
||||
Set mesh = skinmesh.ConvertToBlendedMesh(D3DXMESH_MANAGED, ByVal pAdj, ByVal 0, m_NumBoneCombos, m_BoneComboTable, ByVal 0&, Nothing)
|
||||
Set m_AdjBuffer = Nothing
|
||||
Set m_AdjBuffer = AdjOut
|
||||
Set AdjOut = Nothing
|
||||
|
||||
'retrieve number of influence (matrices) that a vertices could have
|
||||
'we support up to 4 corresponding to the 4 world matrices that can be set
|
||||
m_maxFaceInfl = skinmesh.GetMaxFaceInfluences()
|
||||
|
||||
m_worldMatHandles(0) = D3DTS_WORLD
|
||||
m_worldMatHandles(1) = D3DTS_WORLD1
|
||||
m_worldMatHandles(2) = D3DTS_WORLD2
|
||||
m_worldMatHandles(3) = D3DTS_WORLD3
|
||||
|
||||
ReDim m_BoneCombos(m_NumBoneCombos)
|
||||
ReDim m_BoneComboIds(m_NumBoneCombos)
|
||||
|
||||
' fill in our private table for bone combo data
|
||||
' this inidicates which bones (matrices) need to be blended
|
||||
' for a given subset in the mesh
|
||||
For q = 0 To m_NumBoneCombos - 1
|
||||
g_d3dx.BufferGetBoneCombo m_BoneComboTable, q, m_BoneCombos(q)
|
||||
g_d3dx.BufferGetBoneComboBoneIds m_BoneComboTable, q, m_maxFaceInfl, m_BoneComboIds(q).List(0)
|
||||
Next
|
||||
Set m_BoneComboTable = Nothing
|
||||
|
||||
' fill in our private table for bone offset matrices
|
||||
' these are the matrices that give the intitial displacement of mesh subsets
|
||||
' release the d3dx buffer to save memory
|
||||
ReDim m_BoneOffsetMat(m_BoneCount)
|
||||
g_d3dx.BufferGetData m_BoneMatrices, 0, Len(m_BoneOffsetMat(0)), m_BoneCount, m_BoneOffsetMat(0)
|
||||
Set m_BoneMatrices = Nothing
|
||||
|
||||
|
||||
End If
|
||||
Else
|
||||
|
||||
Set mesh = g_d3dx.LoadMeshFromXof(meshdata, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials)
|
||||
|
||||
End If
|
||||
|
||||
|
||||
Call InitMaterials(g_dev, mtrlBuffer)
|
||||
|
||||
InitFromXOF = True
|
||||
Exit Function
|
||||
|
||||
ErrOut:
|
||||
InitFromXOF = False
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: AttatchBonesToMesh
|
||||
' Desc: Called to attach bones to a skin.
|
||||
' The BoneNames table is used to search out bone frames
|
||||
' in the children of the given parent frame
|
||||
'
|
||||
' This must be done for any skinning animation to work
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Friend Sub AttatchBonesToMesh(parent As CD3DFrame)
|
||||
' get links to all the frames (bones)
|
||||
Dim i As Long
|
||||
Dim bonename As String
|
||||
ReDim m_BoneFrames(m_BoneCount)
|
||||
For i = 0 To m_BoneCount - 1
|
||||
bonename = g_d3dx.BufferGetBoneName(m_BoneNames, i)
|
||||
Set m_BoneFrames(i) = parent.FindChildObject(bonename, 0)
|
||||
If m_BoneFrames(i) Is Nothing Then
|
||||
'Debug.Print "unable to find " + bonename
|
||||
Stop
|
||||
End If
|
||||
Next
|
||||
m_bonesAttached = True
|
||||
Set m_BoneNames = Nothing
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Optimize
|
||||
' Desc: Re-organize the mesh for better performance
|
||||
'
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Sub Optimize()
|
||||
Dim s As Long
|
||||
Dim adjBuf1() As Long
|
||||
Dim adjBuf2() As Long
|
||||
Dim facemap() As Long
|
||||
Dim newmesh As D3DXMesh
|
||||
Dim vertexMap As D3DXBuffer
|
||||
|
||||
s = m_AdjBuffer.GetBufferSize
|
||||
ReDim adjBuf1(s / 4)
|
||||
ReDim adjBuf2(s / 4)
|
||||
|
||||
s = mesh.GetNumFaces
|
||||
ReDim facemap(s)
|
||||
|
||||
g_d3dx.BufferGetData m_AdjBuffer, 0, 4, s * 3, adjBuf1(0)
|
||||
|
||||
Set newmesh = mesh.Optimize(D3DXMESHOPT_ATTRSORT Or D3DXMESHOPT_VERTEXCACHE, adjBuf1(0), adjBuf2(0), facemap(0), vertexMap)
|
||||
|
||||
If Not newmesh Is Nothing Then
|
||||
Set mesh = Nothing
|
||||
Set mesh = newmesh
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitMaterials
|
||||
' Desc: Helper function for creating mesh materials
|
||||
' called after initialization
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub InitMaterials(d3ddevice As Direct3DDevice8, mtrlBuffer As D3DXBuffer)
|
||||
Dim i As Long
|
||||
|
||||
If m_NumMaterials <= 0 Then Exit Sub
|
||||
|
||||
ReDim m_Materials(m_NumMaterials)
|
||||
ReDim m_Textures(m_NumMaterials)
|
||||
ReDim m_TextureNames(m_NumMaterials)
|
||||
|
||||
For i = 0 To m_NumMaterials - 1
|
||||
'copy material out of material buffer into our own structure
|
||||
g_d3dx.BufferGetMaterial mtrlBuffer, i, m_Materials(i)
|
||||
|
||||
If g_bLoadNoAlpha Then m_Materials(i).diffuse.a = 1
|
||||
|
||||
m_Materials(i).Ambient = m_Materials(i).diffuse
|
||||
|
||||
m_TextureNames(i) = g_d3dx.BufferGetTextureName(mtrlBuffer, i)
|
||||
|
||||
If g_bUseTextureLoadCallback Then
|
||||
Set m_Textures(i) = g_TextureLoadCallback.TextureLoadCallback(m_TextureNames(i))
|
||||
Else
|
||||
Set m_Textures(i) = D3DUtil_CreateTextureInPool(g_dev, m_TextureNames(i), D3DFMT_UNKNOWN)
|
||||
End If
|
||||
Next
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetFVF
|
||||
' Desc: Change the FVF of the current mesh
|
||||
'----------------------------------------------------------------------------
|
||||
Public Sub SetFVF(dev As Direct3DDevice8, fvf As Long)
|
||||
|
||||
Dim tempMesh As D3DXMesh
|
||||
Dim verts() As D3DVERTEX
|
||||
|
||||
If mesh Is Nothing Then Exit Sub
|
||||
|
||||
Set tempMesh = mesh.CloneMeshFVF(D3DXMESH_MANAGED, fvf, dev)
|
||||
|
||||
|
||||
Set mesh = tempMesh
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GenerateNormals
|
||||
' Desc: if the current mesh Flexible Vertex Format (FVF) has normals in it
|
||||
' that are not initialized. This function will fill them.
|
||||
' if no normals are present in the FVF this function will fire an
|
||||
' exception
|
||||
'----------------------------------------------------------------------------
|
||||
Public Sub ComputeNormals()
|
||||
Dim bm As D3DXBaseMesh
|
||||
Set bm = mesh
|
||||
g_d3dx.ComputeNormals bm
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FlipNormals
|
||||
' Desc: Convenience function that flips normals for a D3DVERTEX mesh (default)
|
||||
'----------------------------------------------------------------------------
|
||||
Public Sub FlipNormals()
|
||||
Dim count As Long
|
||||
Dim size As Long
|
||||
Dim i As Long
|
||||
|
||||
Dim verts() As D3DVERTEX
|
||||
|
||||
Dim vb As Direct3DVertexBuffer8
|
||||
Set vb = mesh.GetVertexBuffer()
|
||||
|
||||
|
||||
|
||||
|
||||
size = g_d3dx.GetFVFVertexSize(mesh.GetFVF())
|
||||
count = mesh.GetNumVertices()
|
||||
|
||||
|
||||
|
||||
If mesh.GetFVF() = D3DFVF_VERTEX Then
|
||||
ReDim verts(count)
|
||||
|
||||
D3DVertexBuffer8GetData vb, 0, size * count, 0, verts(0)
|
||||
|
||||
For i = 0 To count - 1
|
||||
verts(i).nx = -verts(i).nx
|
||||
verts(i).ny = -verts(i).ny
|
||||
verts(i).nz = -verts(i).nz
|
||||
Next
|
||||
|
||||
D3DVertexBuffer8SetData vb, 0, size * count, 0, verts(0)
|
||||
Else
|
||||
Stop
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Translate
|
||||
' Desc: all vertices are moved by x,y,z
|
||||
' note that object will still rotate about 0,0,0
|
||||
'
|
||||
'----------------------------------------------------------------------------
|
||||
Public Sub Translate(X As Single, Y As Single, z As Single)
|
||||
Dim count As Long
|
||||
Dim size As Long
|
||||
Dim i As Long
|
||||
|
||||
Dim verts() As D3DVERTEX
|
||||
|
||||
Dim vb As Direct3DVertexBuffer8
|
||||
Set vb = mesh.GetVertexBuffer()
|
||||
|
||||
|
||||
|
||||
size = g_d3dx.GetFVFVertexSize(mesh.GetFVF())
|
||||
count = mesh.GetNumVertices()
|
||||
|
||||
|
||||
If mesh.GetFVF() = D3DFVF_VERTEX Then
|
||||
ReDim verts(count)
|
||||
|
||||
D3DVertexBuffer8GetData vb, 0, size * count, 0, verts(0)
|
||||
|
||||
For i = 0 To count - 1
|
||||
verts(i).X = verts(i).X + X
|
||||
verts(i).Y = verts(i).Y + Y
|
||||
verts(i).z = verts(i).z + z
|
||||
Next
|
||||
|
||||
D3DVertexBuffer8SetData vb, 0, size * count, 0, verts(0)
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetLocalBox
|
||||
' Desc: Returns the extent of the mesh in the local coordinate system
|
||||
'----------------------------------------------------------------------------
|
||||
Public Sub GetLocalBox(MinExt As D3DVECTOR, MaxExt As D3DVECTOR)
|
||||
g_d3dx.ComputeBoundingBoxFromMesh mesh, MinExt, MaxExt
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Destroy
|
||||
' Desc: release any reference to frame and texture objects
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Destroy()
|
||||
|
||||
'Releases all objects (does leave 1 element in the array)
|
||||
ReDim m_Textures(0)
|
||||
ReDim m_Materials(0)
|
||||
ReDim m_TextureNames(0)
|
||||
ReDim m_BoneFrames(0)
|
||||
ReDim m_BoneOffsetMat(0)
|
||||
ReDim m_BoneCombos(0)
|
||||
m_NumMaterials = 0
|
||||
bUseMaterials = True
|
||||
Set mesh = Nothing
|
||||
Set skinmesh = Nothing
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ComputeBoundingVolumes
|
||||
' Desc: Makes BoundingSphere valid
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub ComputeBoundingVolumes()
|
||||
g_d3dx.ComputeBoundingSphereFromMesh mesh, m_SphereCenter, SphereRadius
|
||||
bHasSphere = True
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RenderEx
|
||||
' Desc: Render Mesh
|
||||
' Params:
|
||||
' dev the device to draw to
|
||||
' bDrawOpaqueSubsets draws all triangles that do not have alpha
|
||||
' bDrawOpaqueSubsets draws all triangles that have alpha
|
||||
' (note Blending renderstates are modified)
|
||||
'
|
||||
' Note: do not use for skinned meshes
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub RenderEx(dev As Direct3DDevice8, bDrawOpaqueSubsets As Boolean, bDrawAlphaSubsets As Boolean)
|
||||
If mesh Is Nothing Then Exit Sub
|
||||
Dim i As Long
|
||||
|
||||
'If bSkinned = True Then Exit Sub
|
||||
|
||||
' Frist, draw the subsets without alpha
|
||||
If (bDrawOpaqueSubsets) Then
|
||||
For i = 0 To m_NumMaterials - 1
|
||||
|
||||
|
||||
|
||||
If (bUseMaterials) Then
|
||||
If m_Materials(i).diffuse.a = 1# Then
|
||||
g_dev.SetMaterial m_Materials(i)
|
||||
|
||||
If g_bDontDrawTextures Then
|
||||
g_dev.SetTexture 0, Nothing
|
||||
Else
|
||||
g_dev.SetTexture 0, m_Textures(i)
|
||||
End If
|
||||
|
||||
mesh.DrawSubset i
|
||||
End If
|
||||
ElseIf (bUseMaterialOverride) Then
|
||||
If m_MaterialOverride.diffuse.a = 1# Then
|
||||
If g_bDontDrawTextures Then
|
||||
g_dev.SetTexture 0, Nothing
|
||||
Else
|
||||
g_dev.SetTexture 0, m_Textures(i)
|
||||
End If
|
||||
g_dev.SetMaterial m_MaterialOverride
|
||||
mesh.DrawSubset i
|
||||
End If
|
||||
Else
|
||||
mesh.DrawSubset i
|
||||
End If
|
||||
|
||||
Next
|
||||
End If
|
||||
|
||||
|
||||
' Then, draw the subsets with alpha
|
||||
If (bDrawAlphaSubsets And (bUseMaterialOverride Or bUseMaterials)) Then
|
||||
For i = 0 To m_NumMaterials - 1
|
||||
|
||||
If (bUseMaterials) Then
|
||||
If (m_Materials(i).diffuse.a < 1#) Then
|
||||
g_dev.SetMaterial m_Materials(i)
|
||||
g_dev.SetTexture 0, m_Textures(i)
|
||||
mesh.DrawSubset i
|
||||
End If
|
||||
ElseIf (bUseMaterialOverride) Then
|
||||
If (m_MaterialOverride.diffuse.a < 1#) Then
|
||||
g_dev.SetMaterial m_MaterialOverride
|
||||
g_dev.SetTexture 0, m_Textures(i)
|
||||
mesh.DrawSubset i
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Render
|
||||
' Desc: Render the mesh to the given device
|
||||
'
|
||||
' Note: Do not use for skinned meshes
|
||||
'
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Render(dev As Direct3DDevice8)
|
||||
Dim i As Long
|
||||
|
||||
If mesh Is Nothing Then Exit Sub
|
||||
|
||||
If bSkinned = True Then Exit Sub
|
||||
|
||||
If (bUseMaterials) Then
|
||||
For i = 0 To m_NumMaterials - 1
|
||||
g_dev.SetMaterial m_Materials(i)
|
||||
g_dev.SetTexture 0, m_Textures(i)
|
||||
mesh.DrawSubset i
|
||||
Next
|
||||
Else
|
||||
For i = 0 To m_NumMaterials - 1
|
||||
mesh.DrawSubset i
|
||||
Next
|
||||
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RenderSkin
|
||||
' Desc: Render the Mesh as skin
|
||||
' Note: The mesh must have been loaded as a skin and bones must have been attached
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub RenderSkin()
|
||||
|
||||
If Not bSkinned Then Exit Sub
|
||||
|
||||
Dim ipAttr As Long 'bonecombo attribute
|
||||
Dim matId As Long 'matrix id
|
||||
|
||||
Dim i As Long
|
||||
Dim mat2 As D3DMATRIX
|
||||
Dim mat1 As D3DMATRIX
|
||||
Dim mat0 As D3DMATRIX
|
||||
|
||||
|
||||
g_dev.SetRenderState D3DRS_VERTEXBLEND, m_maxFaceInfl - 1
|
||||
|
||||
For ipAttr = 0 To m_NumBoneCombos - 1
|
||||
For i = 0 To m_maxFaceInfl - 1
|
||||
matId = m_BoneComboIds(ipAttr).List(i)
|
||||
|
||||
'If we get a MatId of -1 then all the vertex weights are 0
|
||||
'and we dont need to set the transform for this bone
|
||||
If matId <> -1 Then
|
||||
mat0 = m_BoneFrames(matId).GetUpdatedMatrix()
|
||||
mat1 = m_BoneOffsetMat(matId)
|
||||
D3DXMatrixMultiply mat2, mat1, mat0
|
||||
g_dev.SetTransform m_worldMatHandles(i), mat2
|
||||
End If
|
||||
Next
|
||||
g_dev.SetTexture 0, m_Textures(m_BoneCombos(ipAttr).AttribId)
|
||||
g_dev.SetMaterial m_Materials(m_BoneCombos(ipAttr).AttribId)
|
||||
|
||||
mesh.DrawSubset ipAttr
|
||||
|
||||
Next
|
||||
|
||||
g_dev.SetRenderState D3DRS_VERTEXBLEND, 0
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetMaterialCount
|
||||
'
|
||||
'---------------------------------------------------------------------------
|
||||
Public Function GetMaterialCount() As Long
|
||||
GetMaterialCount = m_NumMaterials
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetMaterialOverride
|
||||
' Desc: Sets the materail to be used in place of the ones loaded from file
|
||||
' Note: to disable set bUseMaterialOverride to false
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub SetMaterialOverride(m As D3DMATERIAL8)
|
||||
m_MaterialOverride = m
|
||||
bUseMaterialOverride = True
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetMaterialOverride
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub GetMaterialOverride(m As D3DMATERIAL8)
|
||||
m = m_MaterialOverride
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ClassName
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function ClassName() As String
|
||||
ClassName = "CD3DMesh"
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InvalidateDeviceObjects
|
||||
' Desc: Release reference to device dependent objects
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub InvalidateDeviceObjects()
|
||||
'all framework objects are managed so nothing to do here
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RestoreDeviceObjects
|
||||
' Desc: If we had any video memory objects they would need
|
||||
' to be reloaded here
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub RestoreDeviceObjects(dev As Direct3DDevice8)
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitFromD3DXMesh
|
||||
' Desc: Allow mesh objects to be created from external D3DXMesh objects
|
||||
'
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub InitFromD3DXMesh(d3dxmeshIn As D3DXMesh)
|
||||
bUseMaterials = False
|
||||
ReDim m_Materials(1)
|
||||
ReDim m_Textures(1)
|
||||
m_NumMaterials = 1
|
||||
Set mesh = d3dxmeshIn
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetMaterialCount
|
||||
' Desc: If a mesh was initialized with InitFromD3DXMesh
|
||||
' This function can allocate space for Materials and Textures
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub SetMaterialCount(n As Long)
|
||||
m_NumMaterials = n
|
||||
ReDim Preserve m_Materials(n)
|
||||
ReDim Preserve m_Textures(n)
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetMaterialTexture
|
||||
' Desc: Sets the texture for a given material subset
|
||||
' Note: use nothing to remove a texture
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub SetMaterialTexture(n As Long, tex As Direct3DTexture8)
|
||||
Set m_Textures(n) = tex
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetMaterialTexture
|
||||
' Desc: returns a given texture for a material subset
|
||||
'-----------------------------------------------------------------------------
|
||||
Function GetMaterialTexture(n As Long) As Direct3DTexture8
|
||||
Set GetMaterialTexture = m_Textures(n)
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: SetMaterial
|
||||
' Desc: Sets the material properties for a given material subset
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub SetMaterial(n As Long, material As D3DMATERIAL8)
|
||||
m_Materials(n) = material
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetMaterial
|
||||
' Desc: returns material properties for a material subset
|
||||
'-----------------------------------------------------------------------------
|
||||
Function GetMaterial(n As Long) As D3DMATERIAL8
|
||||
GetMaterial = m_Materials(n)
|
||||
End Function
|
||||
|
||||
|
||||
@@ -0,0 +1,334 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "CD3DPick"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: D3DPick.cls
|
||||
' Content: D3D Visual Basic Framework Pick object
|
||||
' See raypack and viewport pick entrypoints
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
|
||||
Dim m_item() As D3D_PICK_RECORD
|
||||
Dim m_frame() As CD3DFrame
|
||||
Dim m_mesh() As CD3DMesh
|
||||
Dim m_count As Long
|
||||
Dim m_maxsize As Long
|
||||
Const kGrowSize = 10
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetCount
|
||||
' Dest: returns number of items picked
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function GetCount() As Long
|
||||
GetCount = m_count
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetRecord
|
||||
' Desc: returns the properties of a given pick item
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub GetRecord(i As Long, ByRef a As Single, ByRef b As Single, ByRef dist As Single, ByRef triFaceid As Long)
|
||||
a = m_item(i).a
|
||||
b = m_item(i).b
|
||||
dist = m_item(i).dist
|
||||
triFaceid = m_item(i).triFaceid
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetFrame
|
||||
' Desc: returns the frame of a given pick item
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function GetFrame(i As Long) As CD3DFrame
|
||||
Set GetFrame = m_frame(i)
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: GetMesh
|
||||
' Desc: returns the mesh of a given pick item
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function GetMesh(i As Long) As CD3DMesh
|
||||
Set GetMesh = m_mesh(i)
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FindNearest
|
||||
' Desc: returns the index of the pick with the smallest distance (closest to viewer)
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function FindNearest() As Long
|
||||
Dim q As Long, mindist As Single, i As Long
|
||||
q = -1
|
||||
mindist = 1E+38
|
||||
For i = 0 To m_count - 1
|
||||
If m_item(i).dist < mindist Then
|
||||
q = i
|
||||
mindist = m_item(i).dist
|
||||
End If
|
||||
Next
|
||||
FindNearest = q
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FindFurthest
|
||||
' Desc: returns the index of the pick with the largest distance
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function FindFurthest() As Long
|
||||
Dim q As Long, maxdist As Single, i As Long
|
||||
q = -1
|
||||
maxdist = -1E+38
|
||||
For i = 0 To m_count - 1
|
||||
If m_item(i).dist < maxdist Then
|
||||
q = i
|
||||
maxdist = m_item(i).dist
|
||||
End If
|
||||
Next
|
||||
FindFurthest = q
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Destroy
|
||||
' Desc: Release all references
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function Destroy()
|
||||
ReDim m_mesh(0)
|
||||
ReDim m_frame(0)
|
||||
m_count = 0
|
||||
m_maxsize = 0
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ViewportPick
|
||||
' Params:
|
||||
' frame parent of frame heirarchy to pick from
|
||||
' x x screen coordinate in pixels
|
||||
' y y screen coordinate in pixels
|
||||
'
|
||||
' Note: After call GetCount to see if any objets where hit
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function ViewportPick(frame As CD3DFrame, X As Single, Y As Single)
|
||||
Destroy
|
||||
|
||||
Dim viewport As D3DVIEWPORT8
|
||||
Dim world As D3DMATRIX
|
||||
Dim proj As D3DMATRIX
|
||||
Dim view As D3DMATRIX
|
||||
|
||||
'NOTE the following functions will fail on PURE HAL devices
|
||||
'use ViewportPickEx if working with pureHal devices
|
||||
|
||||
g_dev.GetViewport viewport
|
||||
world = g_identityMatrix
|
||||
g_dev.GetTransform D3DTS_VIEW, view
|
||||
g_dev.GetTransform D3DTS_PROJECTION, proj
|
||||
|
||||
ViewportPick = ViewportPickEx(frame, viewport, proj, view, world, X, Y)
|
||||
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ViewportPickEx
|
||||
' Desc: Aux function for ViewportPick
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function ViewportPickEx(frame As CD3DFrame, viewport As D3DVIEWPORT8, proj As D3DMATRIX, view As D3DMATRIX, world As D3DMATRIX, X As Single, Y As Single) As Boolean
|
||||
|
||||
If frame.Enabled = False Then Exit Function
|
||||
|
||||
Dim vIn As D3DVECTOR, vNear As D3DVECTOR, vFar As D3DVECTOR, vDir As D3DVECTOR
|
||||
Dim bHit As Boolean, i As Long
|
||||
|
||||
If frame Is Nothing Then Exit Function
|
||||
|
||||
|
||||
Dim currentMatrix As D3DMATRIX
|
||||
Dim NewWorldMatrix As D3DMATRIX
|
||||
|
||||
currentMatrix = frame.GetMatrix
|
||||
|
||||
'Setup our basis matrix for this frame
|
||||
D3DXMatrixMultiply NewWorldMatrix, currentMatrix, world
|
||||
|
||||
vIn.X = X: vIn.Y = Y
|
||||
|
||||
'Compute point on Near Clip plane at cursor
|
||||
vIn.z = 0
|
||||
D3DXVec3Unproject vNear, vIn, viewport, proj, view, NewWorldMatrix
|
||||
|
||||
'compute point on far clip plane at cursor
|
||||
vIn.z = 1
|
||||
D3DXVec3Unproject vFar, vIn, viewport, proj, view, NewWorldMatrix
|
||||
|
||||
'Comput direction vector
|
||||
D3DXVec3Subtract vDir, vFar, vNear
|
||||
|
||||
|
||||
|
||||
Dim item As D3D_PICK_RECORD
|
||||
|
||||
|
||||
'Check all child meshes
|
||||
'Even if we got a hit we continue as the next mesh may be closer
|
||||
Dim childMesh As CD3DMesh
|
||||
For i = 0 To frame.GetChildMeshCount() - 1
|
||||
|
||||
Set childMesh = frame.GetChildMesh(i)
|
||||
|
||||
If Not childMesh Is Nothing Then
|
||||
g_d3dx.Intersect childMesh.mesh, vNear, vDir, item.hit, item.triFaceid, item.a, item.b, item.dist, 0
|
||||
End If
|
||||
|
||||
If item.hit <> 0 Then
|
||||
InternalAddItem frame, childMesh, item
|
||||
item.hit = 0
|
||||
End If
|
||||
bHit = True
|
||||
Next
|
||||
|
||||
'check pick for all child frame
|
||||
Dim childFrame As CD3DFrame
|
||||
For i = 0 To frame.GetChildFrameCount() - 1
|
||||
Set childFrame = frame.GetChildFrame(i)
|
||||
bHit = bHit Or _
|
||||
ViewportPickEx(childFrame, viewport, proj, view, NewWorldMatrix, X, Y)
|
||||
Next
|
||||
|
||||
ViewportPickEx = bHit
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RayPick
|
||||
' Desc: given a ray cast it into a scene graph
|
||||
' Params:
|
||||
' frame parent of frame heirarchy to pick from
|
||||
' vOrig origen of the ray to cast
|
||||
' vDir direction of the ray
|
||||
'
|
||||
' Note: the following functions will fail on PURE HAL devices
|
||||
' use RayPickEx if working with pureHal devices
|
||||
' Call getCount to see if the ray hit any objects
|
||||
'
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function RayPick(frame As CD3DFrame, vOrig As D3DVECTOR, vDir As D3DVECTOR)
|
||||
Destroy
|
||||
|
||||
Dim world As D3DMATRIX
|
||||
|
||||
|
||||
g_dev.GetTransform D3DTS_WORLD, world
|
||||
|
||||
RayPick = RayPickEx(frame, world, vOrig, vDir)
|
||||
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RayPickEx
|
||||
' Desc: Aux function for RayPickEx
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function RayPickEx(frame As CD3DFrame, worldmatrix As D3DMATRIX, vOrig As D3DVECTOR, vDir As D3DVECTOR) As Boolean
|
||||
|
||||
Dim NewWorldMatrix As D3DMATRIX 'world matrix for this stack frame
|
||||
Dim InvWorldMatrix As D3DMATRIX 'world matrix for this stack frame
|
||||
Dim currentMatrix As D3DMATRIX
|
||||
Dim i As Long, det As Single, bHit As Boolean
|
||||
Dim vNewDir As D3DVECTOR, vNewOrig As D3DVECTOR
|
||||
|
||||
If frame Is Nothing Then Exit Function
|
||||
|
||||
currentMatrix = frame.GetMatrix
|
||||
|
||||
'Setup our basis matrix for this frame
|
||||
D3DXMatrixMultiply NewWorldMatrix, currentMatrix, worldmatrix
|
||||
D3DXMatrixInverse InvWorldMatrix, det, NewWorldMatrix
|
||||
|
||||
|
||||
' we want to compute vdir and vOrig in model space
|
||||
' note we use TransformNormal so we dont translate vDir
|
||||
' just rotate it into a new dir
|
||||
Call D3DXVec3TransformNormal(vNewDir, vDir, InvWorldMatrix)
|
||||
Call D3DXVec3TransformCoord(vNewOrig, vOrig, InvWorldMatrix)
|
||||
|
||||
|
||||
Dim item As D3D_PICK_RECORD
|
||||
|
||||
|
||||
'Check all child meshes
|
||||
'Even if we got a hit we continue as the next mesh may be closer
|
||||
Dim childMesh As CD3DMesh
|
||||
For i = 0 To frame.GetChildMeshCount() - 1
|
||||
|
||||
Set childMesh = frame.GetChildMesh(i)
|
||||
|
||||
If Not childMesh Is Nothing Then
|
||||
Call D3DXVec3Scale(vDir, vDir, 1000) 'Workaround for d3dx Intersect bug
|
||||
g_d3dx.Intersect childMesh.mesh, vNewOrig, vDir, item.hit, item.triFaceid, item.a, item.b, item.dist, 0
|
||||
End If
|
||||
|
||||
If item.hit <> 0 Then
|
||||
InternalAddItem frame, childMesh, item
|
||||
item.hit = 0
|
||||
End If
|
||||
bHit = True
|
||||
Next
|
||||
|
||||
'check pick for all child frame
|
||||
Dim childFrame As CD3DFrame
|
||||
For i = 0 To frame.GetChildFrameCount() - 1
|
||||
Set childFrame = frame.GetChildFrame(i)
|
||||
bHit = bHit Or _
|
||||
RayPickEx(childFrame, NewWorldMatrix, vOrig, vDir)
|
||||
Next
|
||||
|
||||
RayPickEx = bHit
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' InternalAddItem
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub InternalAddItem(parentFrame As CD3DFrame, mesh As CD3DMesh, item As D3D_PICK_RECORD)
|
||||
Dim maxsize As Long
|
||||
If m_maxsize = 0 Then
|
||||
ReDim m_item(kGrowSize)
|
||||
ReDim m_mesh(kGrowSize)
|
||||
ReDim m_frame(kGrowSize)
|
||||
m_maxsize = kGrowSize
|
||||
ElseIf m_count >= m_maxsize Then
|
||||
ReDim Preserve m_item(m_maxsize + kGrowSize)
|
||||
ReDim Preserve m_frame(m_maxsize + kGrowSize)
|
||||
ReDim Preserve m_mesh(m_maxsize + kGrowSize)
|
||||
m_maxsize = m_maxsize + kGrowSize
|
||||
End If
|
||||
|
||||
Set m_mesh(m_count) = mesh
|
||||
Set m_frame(m_count) = parentFrame
|
||||
m_item(m_count) = item
|
||||
|
||||
m_count = m_count + 1
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,528 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmAir
|
||||
BackColor = &H00000000&
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Caption = "Air Hockey"
|
||||
ClientHeight = 4500
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 6000
|
||||
BeginProperty Font
|
||||
Name = "Comic Sans MS"
|
||||
Size = 9.75
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Icon = "frmAir.frx":0000
|
||||
KeyPreview = -1 'True
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 300
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 400
|
||||
StartUpPosition = 2 'CenterScreen
|
||||
Begin MSComctlLib.ProgressBar barProg
|
||||
Height = 540
|
||||
Left = 225
|
||||
TabIndex = 0
|
||||
Top = 3390
|
||||
Visible = 0 'False
|
||||
Width = 5490
|
||||
_ExtentX = 9684
|
||||
_ExtentY = 953
|
||||
_Version = 393216
|
||||
Appearance = 1
|
||||
Scrolling = 1
|
||||
End
|
||||
Begin VB.Label lblSplash
|
||||
Alignment = 2 'Center
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Visual Basic Air Hockey, loading...."
|
||||
ForeColor = &H00FFFFFF&
|
||||
Height = 360
|
||||
Left = 1095
|
||||
TabIndex = 1
|
||||
Top = 390
|
||||
Visible = 0 'False
|
||||
Width = 4110
|
||||
End
|
||||
Begin VB.Image imgSplash
|
||||
Height = 4395
|
||||
Left = 30
|
||||
Picture = "frmAir.frx":030A
|
||||
Stretch = -1 'True
|
||||
Top = 60
|
||||
Visible = 0 'False
|
||||
Width = 5925
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmAir"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'Sleep declare
|
||||
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
|
||||
Private Enum SplashScreenMode
|
||||
SplashShow
|
||||
SplashHide
|
||||
SplashResize
|
||||
End Enum
|
||||
|
||||
'We need to implement our event interfaces
|
||||
Implements DirectPlay8Event
|
||||
Private mlSendTime As Long
|
||||
Private mlNumSend As Long
|
||||
Private mfGotGameSettings As Boolean
|
||||
Private mfGameStarted As Boolean
|
||||
|
||||
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
|
||||
'We need to be able to handle F2 keys for resolution changes
|
||||
Select Case KeyCode
|
||||
Case vbKeyF2
|
||||
PauseSystem True
|
||||
goDev.SelectDevice Me
|
||||
Case vbKeyF1
|
||||
'Toggle the ability to draw the room
|
||||
goRoom.DrawRoom = Not goRoom.DrawRoom
|
||||
Case vbKeyF4
|
||||
'Toggle the transparency of the paddles
|
||||
goTable.Transparent = Not goTable.Transparent
|
||||
Case vbKeyF5
|
||||
'Toggle the ability to draw the room
|
||||
goTable.DrawTable = Not goTable.DrawTable
|
||||
Case vbKeyF6
|
||||
'Toggle the transparency of the paddles
|
||||
goPaddle(0).Transparent = Not goPaddle(0).Transparent
|
||||
goPaddle(1).Transparent = Not goPaddle(1).Transparent
|
||||
Case vbKeyF3
|
||||
'Restart the game if it's available
|
||||
If gfGameOver Then
|
||||
gPlayer(0).Score = 0: gPlayer(1).Score = 0
|
||||
goPuck.DefaultStartPosition
|
||||
gfGameOver = False
|
||||
NotifyGameRestart
|
||||
End If
|
||||
Case vbKeyReturn
|
||||
|
||||
' Check for Alt-Enter if not pressed exit
|
||||
If Shift <> 4 Then Exit Sub
|
||||
PauseSystem True
|
||||
' If we are windowed go fullscreen
|
||||
' If we are fullscreen returned to windowed
|
||||
SaveOrRestoreObjectSettings True
|
||||
InvalidateDeviceObjects
|
||||
Cleanup True, True
|
||||
If g_d3dpp.Windowed Then
|
||||
D3DUtil_ResetFullscreen
|
||||
Else
|
||||
D3DUtil_ResetWindowed
|
||||
End If
|
||||
|
||||
' Call Restore after ever mode change
|
||||
' because calling reset looses state that needs to
|
||||
' be reinitialized
|
||||
Me.RestoreDeviceObjects False
|
||||
SaveOrRestoreObjectSettings False
|
||||
PauseSystem False
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
Private Sub Form_KeyPress(KeyAscii As Integer)
|
||||
Dim nVel As Single
|
||||
Dim vNewVel As D3DVECTOR
|
||||
|
||||
If KeyAscii = vbKeyEscape Then
|
||||
Unload Me
|
||||
ElseIf LCase(Chr$(KeyAscii)) = "v" Then
|
||||
'Scroll through the different 'default' views. If there is currently a custom view on
|
||||
'turn on the default view.
|
||||
goCamera.NextCameraPosition glMyPaddleID
|
||||
ElseIf KeyAscii = vbKeySpace Then
|
||||
'We want to launch the puck. We should only be able to do this if
|
||||
'we have recently scored, or if we haven't started the game yet.
|
||||
If gfGameCanBeStarted And gfScored And (Not gfGameOver) Then
|
||||
goPuck.LaunchPuck
|
||||
If gfMultiplayer Then
|
||||
SendPuck
|
||||
End If
|
||||
'Start the puck spinning
|
||||
goPuck.Spinning = True
|
||||
gfScored = False
|
||||
glTimeCompPaddle = 0
|
||||
End If
|
||||
ElseIf LCase(Chr$(KeyAscii)) = "w" Then
|
||||
gfWireFrame = Not gfWireFrame
|
||||
'These two cases should be removed in the final version
|
||||
ElseIf LCase(Chr$(KeyAscii)) = "+" Then
|
||||
If Not gfScored Then
|
||||
nVel = D3DXVec3Length(goPuck.Velocity) * 1.2
|
||||
D3DXVec3Normalize vNewVel, goPuck.Velocity
|
||||
D3DXVec3Scale vNewVel, vNewVel, nVel
|
||||
goPuck.Velocity = vNewVel
|
||||
SendPuck
|
||||
End If
|
||||
ElseIf LCase(Chr$(KeyAscii)) = "-" Then
|
||||
If Not gfScored Then
|
||||
nVel = D3DXVec3Length(goPuck.Velocity) * 0.8
|
||||
D3DXVec3Normalize vNewVel, goPuck.Velocity
|
||||
D3DXVec3Scale vNewVel, vNewVel, nVel
|
||||
goPuck.Velocity = vNewVel
|
||||
SendPuck
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
|
||||
glMyPaddleID = 0
|
||||
mfGotGameSettings = False
|
||||
'We've got here now. Go ahead and init our 3D device
|
||||
If gfMultiplayer Then
|
||||
'Oh good, we want to play a multiplayer game.
|
||||
'First lets get the dplay connection started
|
||||
|
||||
'Here we will init our DPlay objects
|
||||
InitDPlay
|
||||
'Now we can create a new Connection Form (which will also be our message pump)
|
||||
Set DPlayEventsForm = New DPlayConnect
|
||||
'Start the connection form (it will either create or join a session)
|
||||
If Not DPlayEventsForm.StartConnectWizard(dx, dpp, AppGuid, 2, Me, False) Then
|
||||
CleanupDPlay
|
||||
End
|
||||
Else 'We did choose to play a game
|
||||
gsUserName = DPlayEventsForm.UserName
|
||||
If DPlayEventsForm.IsHost Then
|
||||
Me.Caption = Me.Caption & " (HOST)"
|
||||
mfGotGameSettings = True
|
||||
End If
|
||||
gfHost = DPlayEventsForm.IsHost
|
||||
End If
|
||||
End If
|
||||
|
||||
'Do a quick switch to windowed mode just to initialize all the vars
|
||||
If Not D3DUtil_Init(frmAir.hwnd, True, 0, 0, D3DDEVTYPE_HAL, Me) Then
|
||||
MsgBox "Could not initialize Direct3D. This sample will now exit", vbOKOnly Or vbInformation, "Exiting..."
|
||||
Unload Me
|
||||
Exit Sub
|
||||
End If
|
||||
'Now update to the 'correct' resolution (or windowed)
|
||||
goDev.UpdateNow Me
|
||||
glScreenHeight = Me.ScaleHeight: glScreenWidth = Me.ScaleWidth
|
||||
If g_d3dpp.Windowed = 0 Then
|
||||
Me.Move 0, 0, g_d3dpp.BackBufferWidth * Screen.TwipsPerPixelX, g_d3dpp.BackBufferHeight * Screen.TwipsPerPixelY
|
||||
End If
|
||||
Me.Show
|
||||
SplashScreenMode SplashShow
|
||||
DoEvents
|
||||
barProg.Min = 0: barProg.Max = 9
|
||||
InitDeviceObjects
|
||||
IncreaseProgressBar
|
||||
RestoreDeviceObjects
|
||||
IncreaseProgressBar
|
||||
'Start up our Input devices
|
||||
If Not goInput.InitDirectInput(Me) Then
|
||||
Cleanup 'This should restore our state so we can complain that we couldn't Init Dinput
|
||||
MsgBox "Unable to Initialize DirectInput, this sample will now exit.", vbOKOnly Or vbInformation, "No DirectInput"
|
||||
Unload Me
|
||||
Exit Sub
|
||||
End If
|
||||
IncreaseProgressBar
|
||||
'Start up our sounds
|
||||
If Not goAudio.InitAudio Then
|
||||
MsgBox "Unable to Initialize Audio, this sample will not have audio capablities.", vbOKOnly Or vbInformation, "No Audio"
|
||||
goAudio.PlayMusic = False
|
||||
goAudio.PlaySounds = False
|
||||
End If
|
||||
IncreaseProgressBar
|
||||
'Here we will load the initial positions for our objects
|
||||
LoadDefaultStartPositions
|
||||
'Get rid of the splash screen
|
||||
Unload frmSplash
|
||||
glTimePuckScored = timeGetTime
|
||||
SplashScreenMode SplashHide
|
||||
'Wait a brief period of time
|
||||
Sleep 100
|
||||
'Do the intro
|
||||
ShowStartup
|
||||
goAudio.StartBackgroundMusic
|
||||
glTimePuckScored = timeGetTime
|
||||
|
||||
Me.Show
|
||||
|
||||
'Start the puck spinning
|
||||
goPuck.Spinning = True
|
||||
'Now, if we're in a multiplayer game, and we're the client
|
||||
'let the host know that we are ready to play the game, and he can launch the puck at any time.
|
||||
If gfMultiplayer Then
|
||||
Do While Not mfGotGameSettings
|
||||
DPlayEventsForm.DoSleep 10 'Wait until we receive the game settings
|
||||
Loop
|
||||
NotifyClientReady
|
||||
End If
|
||||
glTimePuckScored = timeGetTime
|
||||
MainGameLoop
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Resize()
|
||||
|
||||
If Me.WindowState = vbMinimized Then
|
||||
PauseSystem True
|
||||
Else
|
||||
PauseSystem False
|
||||
glScreenHeight = Me.ScaleHeight: glScreenWidth = Me.ScaleWidth
|
||||
SplashScreenMode SplashResize
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
goFade.Fade -5
|
||||
Do While goFade.AmFading
|
||||
Render
|
||||
goFade.UpdateFade goPuck, goPaddle, goTable, goRoom
|
||||
DoEvents
|
||||
Loop
|
||||
SaveDrawingSettings
|
||||
CleanupDPlay
|
||||
Cleanup True
|
||||
End
|
||||
End Sub
|
||||
|
||||
Private Sub SaveDrawingSettings()
|
||||
SaveSetting gsKeyName, gsSubKey, "DrawRoom", goRoom.DrawRoom
|
||||
SaveSetting gsKeyName, gsSubKey, "DrawTable", goTable.DrawTable
|
||||
End Sub
|
||||
|
||||
Public Function VerifyDevice(flags As Long, format As CONST_D3DFORMAT) As Boolean
|
||||
'All the checks we care about are already done, always return true
|
||||
VerifyDevice = True
|
||||
End Function
|
||||
|
||||
Public Sub InvalidateDeviceObjects()
|
||||
InitDeviceObjects False
|
||||
End Sub
|
||||
|
||||
Public Sub RestoreDeviceObjects(Optional ByVal fSplash As Boolean = True)
|
||||
modAirHockey.RestoreDeviceObjects
|
||||
InitDeviceObjects (Not fSplash)
|
||||
glScreenHeight = Me.ScaleHeight: glScreenWidth = Me.ScaleWidth
|
||||
If fSplash Then SplashScreenMode SplashResize
|
||||
End Sub
|
||||
|
||||
Public Sub DeleteDeviceObjects()
|
||||
Cleanup
|
||||
End Sub
|
||||
|
||||
Public Sub InitDeviceObjects(Optional fLoadGeometry As Boolean = True)
|
||||
'Check caps for lights
|
||||
Dim d3dcaps As D3DCAPS8
|
||||
|
||||
g_dev.GetDeviceCaps d3dcaps
|
||||
If (d3dcaps.VertexProcessingCaps And D3DVTXPCAPS_DIRECTIONALLIGHTS) <> 0 Then 'We can use directional lights
|
||||
InitDefaultLights d3dcaps.MaxActiveLights 'Set up the lights for the room
|
||||
Else
|
||||
'We could render the whole scene just using ambient light
|
||||
'(which we'll have too since we can't position our direction
|
||||
'lights), but the user will miss out on the shading of the table
|
||||
InitDefaultLights 0 'Set up a default ambiant only light
|
||||
End If
|
||||
'Make sure the device supports alpha blending
|
||||
If (d3dcaps.TextureCaps And D3DPTEXTURECAPS_ALPHA) Then
|
||||
If Not (goFade Is Nothing) Then goFade.CanFade = True
|
||||
g_dev.SetRenderState D3DRS_ALPHABLENDENABLE, 1
|
||||
Else
|
||||
If Not (goFade Is Nothing) Then goFade.CanFade = False
|
||||
End If
|
||||
|
||||
'Load our objects now
|
||||
If fLoadGeometry Then InitGeometry 'Set up the room geometry
|
||||
End Sub
|
||||
|
||||
Public Sub IncreaseProgressBar()
|
||||
On Error Resume Next
|
||||
barProg.Value = barProg.Value + 1
|
||||
DoEvents
|
||||
End Sub
|
||||
|
||||
Private Sub SplashScreenMode(ByVal Mode As SplashScreenMode)
|
||||
Select Case Mode
|
||||
Case SplashHide
|
||||
imgSplash.Visible = False
|
||||
barProg.Visible = False
|
||||
lblSplash.Visible = False
|
||||
Case SplashResize
|
||||
'Move the splash screen to cover the entire client area
|
||||
imgSplash.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
|
||||
'Move the progress bar
|
||||
barProg.Move 15, Me.ScaleHeight - ((Me.ScaleHeight / 10) + 20), Me.ScaleWidth - 30, Me.ScaleHeight / 10
|
||||
lblSplash.Move 15, ((Me.ScaleHeight / 10) + 20), Me.ScaleWidth - 30, Me.ScaleHeight / 10
|
||||
Case SplashShow
|
||||
imgSplash.Visible = True
|
||||
barProg.Visible = True
|
||||
lblSplash.Visible = True
|
||||
lblSplash.ZOrder
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
|
||||
'VB requires that we implement *all* members of an interface
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
|
||||
'VB requires that we implement *all* members of an interface
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
|
||||
'VB requires that we implement *all* members of an interface
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
|
||||
If dpnotify.hResultCode <> 0 Then 'There was a problem
|
||||
MsgBox "Failed to connect to host." & vbCrLf & "Error:" & CStr(dpnotify.hResultCode), vbOKOnly Or vbInformation, "Exiting..."
|
||||
Unload Me
|
||||
Exit Sub
|
||||
End If
|
||||
'If we are receiving this event we must know that we are the client, since the server never receives this message.
|
||||
'Make sure we are assigned paddle ID #1
|
||||
glMyPaddleID = 1 'We are the second paddle
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean)
|
||||
'VB requires that we implement *all* members of an interface
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean)
|
||||
'We've got the create player message, so someone has just joined. Send them the
|
||||
'Setup message (if it's not us)
|
||||
Dim dpPlayer As DPN_PLAYER_INFO
|
||||
|
||||
dpPlayer = dpp.GetPeerInfo(lPlayerID)
|
||||
If (dpPlayer.lPlayerFlags And DPNPLAYER_HOST) = 0 Then 'This isn't the host, let them know
|
||||
SendGameSettings
|
||||
End If
|
||||
If (dpPlayer.lPlayerFlags And DPNPLAYER_LOCAL) = 0 Then 'This isn't the local player, save this id
|
||||
glOtherPlayerID = lPlayerID
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
|
||||
'VB requires that we implement *all* members of an interface
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
|
||||
'If we receive a DestroyPlayer msg, then the other player must have quit.
|
||||
'We have been disconnected, stop sending data
|
||||
gfNoSendData = True
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean)
|
||||
'If the game has started don't even bother answering the enum query.
|
||||
If mfGameStarted Then fRejectMsg = True
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
|
||||
'VB requires that we implement *all* members of an interface
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean)
|
||||
'VB requires that we implement *all* members of an interface
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean)
|
||||
If Not mfGameStarted Then
|
||||
'We haven't started the game yet, go ahead and allow this
|
||||
mfGameStarted = True
|
||||
Else
|
||||
fRejectMsg = True
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean)
|
||||
'Uh oh, the person who indicated connect has now aborted, reset our flag
|
||||
fRejectMsg = False
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean)
|
||||
'VB requires that we implement *all* members of an interface
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
|
||||
'process what msgs we receive.
|
||||
Dim lMsg As Byte, lOffset As Long
|
||||
Dim lPaddleID As Byte
|
||||
Dim vTemp As D3DVECTOR
|
||||
|
||||
With dpnotify
|
||||
GetDataFromBuffer .ReceivedData, lMsg, LenB(lMsg), lOffset
|
||||
Select Case lMsg
|
||||
Case MsgPaddleLocation
|
||||
GetDataFromBuffer .ReceivedData, lPaddleID, LenB(lPaddleID), lOffset
|
||||
GetDataFromBuffer .ReceivedData, vTemp, LenB(vTemp), lOffset
|
||||
goPaddle(lPaddleID).Position = vTemp
|
||||
Case MsgPuckLocation
|
||||
GetDataFromBuffer .ReceivedData, vTemp, LenB(vTemp), lOffset
|
||||
goPuck.Position = vTemp
|
||||
GetDataFromBuffer .ReceivedData, vTemp, LenB(vTemp), lOffset
|
||||
goPuck.Velocity = vTemp
|
||||
'Start the puck spinning
|
||||
goPuck.Spinning = True
|
||||
gfScored = False
|
||||
Case MsgClientConnectedAndReadyToPlay
|
||||
gfGameCanBeStarted = True
|
||||
Case MsgPlayerScored
|
||||
goPuck.DropPuckIntoScoringPosition goAudio, True
|
||||
Case MsgRestartGame
|
||||
If gfGameOver Then
|
||||
gPlayer(0).Score = 0: gPlayer(1).Score = 0
|
||||
goPuck.DefaultStartPosition
|
||||
gfGameOver = False
|
||||
End If
|
||||
Case MsgSendGameSettings
|
||||
'Get the data that holds the game settings
|
||||
GetDataFromBuffer .ReceivedData, gnVelocityDamp, LenB(gnVelocityDamp), lOffset
|
||||
goPuck.MaximumPuckVelocity = gnVelocityDamp * 6.23
|
||||
GetDataFromBuffer .ReceivedData, glUserWinningScore, LenB(glUserWinningScore), lOffset
|
||||
GetDataFromBuffer .ReceivedData, gnPaddleMass, LenB(gnPaddleMass), lOffset
|
||||
mfGotGameSettings = True
|
||||
Case MsgCollidePaddle
|
||||
'Notify the user that the puck hit the paddle by playing a sound
|
||||
goAudio.PlayHitSound
|
||||
End Select
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean)
|
||||
|
||||
'Here we can update our send frequency based on how quickly the messages are arriving
|
||||
mlSendTime = mlSendTime + dpnotify.lSendTime
|
||||
mlNumSend = mlNumSend + 1
|
||||
If dpnotify.hResultCode = DPNERR_TIMEDOUT Then
|
||||
'Add a little more delay, packets are timing out
|
||||
mlSendTime = mlSendTime + dpnotify.lSendTime + (glMinimumSendFrequency \ 2)
|
||||
End If
|
||||
'Send them as fast as they can receive them, but not overly fast (20 times/second max)
|
||||
'We will calculate this based on the average amount of time it takes to send the data
|
||||
glSendFrequency = ((mlSendTime \ mlNumSend) + glSendFrequency) \ 2
|
||||
|
||||
Debug.Print "Send Freq:"; glSendFrequency; mlSendTime; mlNumSend
|
||||
glOneWaySendLatency = (mlSendTime \ mlNumSend) \ 2
|
||||
If glSendFrequency < glMinimumSendFrequency Then glSendFrequency = glMinimumSendFrequency
|
||||
'Check for the max value for long (just in case)
|
||||
If (mlNumSend > 2147483647) Or (mlSendTime > 2147483647) Then 'You would have to run the app for like 3 years to reach this level, but just in case...
|
||||
'If it does though, reset the average
|
||||
mlNumSend = 0
|
||||
mlSendTime = 0
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean)
|
||||
'We have been disconnected, stop sending data
|
||||
gfNoSendData = True
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,171 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmAudio
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "Audio Options"
|
||||
ClientHeight = 3360
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 6405
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 3360
|
||||
ScaleWidth = 6405
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.CommandButton cmdOk
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 375
|
||||
Left = 5340
|
||||
TabIndex = 0
|
||||
Top = 2880
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Cancel = -1 'True
|
||||
Caption = "Cancel"
|
||||
Height = 375
|
||||
Left = 4260
|
||||
TabIndex = 5
|
||||
Top = 2880
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Frame Frame1
|
||||
Caption = "Audio details"
|
||||
Height = 2655
|
||||
Left = 60
|
||||
TabIndex = 6
|
||||
Top = 120
|
||||
Width = 6255
|
||||
Begin MSComctlLib.Slider sldVolume
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 2
|
||||
Top = 1140
|
||||
Width = 6075
|
||||
_ExtentX = 10716
|
||||
_ExtentY = 450
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
SmallChange = 5
|
||||
Min = -100
|
||||
Max = 0
|
||||
TickFrequency = 10
|
||||
End
|
||||
Begin VB.CheckBox chkMusic
|
||||
Caption = "Play Background Music"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 3
|
||||
Top = 1500
|
||||
Width = 5955
|
||||
End
|
||||
Begin VB.CheckBox chkPlaySounds
|
||||
Caption = "Play Sounds"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 1
|
||||
Top = 540
|
||||
Width = 5955
|
||||
End
|
||||
Begin MSComctlLib.Slider sldMusic
|
||||
Height = 255
|
||||
Left = 60
|
||||
TabIndex = 4
|
||||
Top = 2100
|
||||
Width = 6075
|
||||
_ExtentX = 10716
|
||||
_ExtentY = 450
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
SmallChange = 5
|
||||
Min = -100
|
||||
Max = 0
|
||||
TickFrequency = 10
|
||||
End
|
||||
Begin VB.Label lblMusic
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Volume of background music"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 9
|
||||
Top = 1800
|
||||
Width = 3855
|
||||
End
|
||||
Begin VB.Label lblSound
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Volume of ambient sounds (puck, scoring, etc)"
|
||||
Height = 255
|
||||
Left = 180
|
||||
TabIndex = 8
|
||||
Top = 840
|
||||
Width = 3855
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Here you can control the few audio settings."
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 7
|
||||
Top = 240
|
||||
Width = 6015
|
||||
End
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmAudio"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Sub chkMusic_Click()
|
||||
sldMusic.Enabled = (chkMusic.Value = vbChecked)
|
||||
lblMusic.Enabled = (chkMusic.Value = vbChecked)
|
||||
End Sub
|
||||
|
||||
Private Sub chkPlaySounds_Click()
|
||||
sldVolume.Enabled = (chkPlaySounds.Value = vbChecked)
|
||||
lblSound.Enabled = (chkPlaySounds.Value = vbChecked)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdCancel_Click()
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOk_Click()
|
||||
SaveAudioSettings
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
'Now update the display
|
||||
chkMusic.Value = Abs(goAudio.PlayMusic)
|
||||
chkPlaySounds.Value = Abs(goAudio.PlaySounds)
|
||||
sldVolume.Value = goAudio.SoundVolume / 25
|
||||
sldMusic.Value = goAudio.MusicVolume / 25
|
||||
|
||||
'Update the UI
|
||||
sldMusic.Enabled = (chkMusic.Value = vbChecked)
|
||||
lblMusic.Enabled = (chkMusic.Value = vbChecked)
|
||||
sldVolume.Enabled = (chkPlaySounds.Value = vbChecked)
|
||||
lblSound.Enabled = (chkPlaySounds.Value = vbChecked)
|
||||
End Sub
|
||||
|
||||
Private Sub SaveAudioSettings()
|
||||
goAudio.PlayMusic = (chkMusic.Value = vbChecked)
|
||||
goAudio.PlaySounds = (chkPlaySounds.Value = vbChecked)
|
||||
goAudio.MusicVolume = sldMusic.Value * 25
|
||||
goAudio.SoundVolume = sldVolume.Value * 25
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
'We're leaving the form, save the settings
|
||||
SaveSetting gsKeyName, gsSubKeyAudio, "UseBackgroundMusic", goAudio.PlayMusic
|
||||
SaveSetting gsKeyName, gsSubKeyAudio, "UseSound", goAudio.PlaySounds
|
||||
SaveSetting gsKeyName, gsSubKeyAudio, "MusicVolume", goAudio.MusicVolume
|
||||
SaveSetting gsKeyName, gsSubKeyAudio, "SoundVolume", goAudio.SoundVolume
|
||||
End Sub
|
||||
@@ -0,0 +1,177 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmGraphics
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "Graphic Options"
|
||||
ClientHeight = 3360
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 6405
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 3360
|
||||
ScaleWidth = 6405
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.CommandButton cmdOk
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 375
|
||||
Left = 5340
|
||||
TabIndex = 0
|
||||
Top = 2880
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Cancel = -1 'True
|
||||
Caption = "Cancel"
|
||||
Height = 375
|
||||
Left = 4260
|
||||
TabIndex = 5
|
||||
Top = 2880
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Frame Frame1
|
||||
Caption = "Options"
|
||||
Height = 2655
|
||||
Left = 60
|
||||
TabIndex = 6
|
||||
Top = 120
|
||||
Width = 6255
|
||||
Begin VB.CommandButton cmdChgMode
|
||||
Caption = "Change..."
|
||||
Height = 315
|
||||
Left = 180
|
||||
TabIndex = 1
|
||||
Top = 900
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.OptionButton optOffice
|
||||
Caption = "Office Lobby (Less detailed, higher performance)"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 4
|
||||
Top = 2280
|
||||
Width = 4935
|
||||
End
|
||||
Begin VB.OptionButton optGame
|
||||
Caption = "Game Room (More detailed, lower performance)"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 3
|
||||
Top = 1980
|
||||
Value = -1 'True
|
||||
Width = 4935
|
||||
End
|
||||
Begin VB.CheckBox chkDrawRoom
|
||||
Caption = "Display the room where the game is taking place."
|
||||
Height = 315
|
||||
Left = 120
|
||||
TabIndex = 2
|
||||
Top = 1260
|
||||
Width = 4095
|
||||
End
|
||||
Begin VB.Label lblMode
|
||||
BackStyle = 0 'Transparent
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Caption = "Label1"
|
||||
Height = 255
|
||||
Left = 1245
|
||||
TabIndex = 10
|
||||
Top = 570
|
||||
Width = 4815
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Display Mode"
|
||||
Height = 255
|
||||
Index = 2
|
||||
Left = 180
|
||||
TabIndex = 9
|
||||
Top = 600
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblRoom
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "If the room is displayed, what type of room should be displayed?"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 8
|
||||
Top = 1680
|
||||
Width = 4635
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "You can control different options here to improve graphic quality, or performance"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 7
|
||||
Top = 240
|
||||
Width = 6015
|
||||
End
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmGraphics"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Sub chkDrawRoom_Click()
|
||||
EnableRoomInfo (chkDrawRoom.Value = vbChecked)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdCancel_Click()
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdChgMode_Click()
|
||||
goDev.Show vbModal
|
||||
'Now that we've potentially changed modes, update them
|
||||
If goDev.Windowed Then
|
||||
lblMode.Caption = "Windowed mode"
|
||||
Else
|
||||
lblMode.Caption = goDev.ModeString
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOk_Click()
|
||||
SaveAudioSettings
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
'Now update the display
|
||||
chkDrawRoom.Value = Abs(goRoom.DrawRoom)
|
||||
optGame.Value = goRoom.BarRoom
|
||||
optOffice.Value = Not goRoom.BarRoom
|
||||
If goDev.Windowed Then
|
||||
lblMode.Caption = "Windowed mode"
|
||||
Else
|
||||
lblMode.Caption = goDev.ModeString
|
||||
End If
|
||||
EnableRoomInfo (chkDrawRoom.Value = vbChecked)
|
||||
End Sub
|
||||
|
||||
Private Sub SaveAudioSettings()
|
||||
goRoom.DrawRoom = (chkDrawRoom.Value = vbChecked)
|
||||
goRoom.BarRoom = optGame.Value
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
'We're leaving the form, save the settings
|
||||
SaveSetting gsKeyName, gsSubKey, "DrawRoom", goRoom.DrawRoom
|
||||
SaveSetting gsKeyName, gsSubKey, "RoomIsBarRoom", goRoom.BarRoom
|
||||
SaveSetting gsKeyName, gsSubKeyGraphics, "Windowed", goDev.Windowed
|
||||
SaveSetting gsKeyName, gsSubKeyGraphics, "AdapterID", goDev.Adapter
|
||||
SaveSetting gsKeyName, gsSubKeyGraphics, "Mode", goDev.Mode
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub EnableRoomInfo(ByVal fEnable As Boolean)
|
||||
lblRoom.Enabled = fEnable
|
||||
optGame.Enabled = fEnable
|
||||
optOffice.Enabled = fEnable
|
||||
End Sub
|
||||
@@ -0,0 +1,268 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmInput
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "Input Options"
|
||||
ClientHeight = 3360
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 6405
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 3360
|
||||
ScaleWidth = 6405
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.Frame Frame1
|
||||
Caption = "Controllers"
|
||||
Height = 2715
|
||||
Left = 60
|
||||
TabIndex = 8
|
||||
Top = 120
|
||||
Width = 6255
|
||||
Begin MSComctlLib.Slider sldSens
|
||||
Height = 195
|
||||
Left = 1080
|
||||
TabIndex = 5
|
||||
Top = 2400
|
||||
Width = 4995
|
||||
_ExtentX = 8811
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
Min = 1
|
||||
Max = 50
|
||||
SelStart = 1
|
||||
TickFrequency = 5
|
||||
Value = 1
|
||||
End
|
||||
Begin VB.ComboBox cboJoy
|
||||
Height = 315
|
||||
Left = 300
|
||||
Style = 2 'Dropdown List
|
||||
TabIndex = 4
|
||||
Top = 1980
|
||||
Width = 5775
|
||||
End
|
||||
Begin VB.CheckBox chkJoy
|
||||
Caption = "Joystick"
|
||||
Height = 315
|
||||
Left = 60
|
||||
TabIndex = 3
|
||||
Top = 1665
|
||||
Width = 5655
|
||||
End
|
||||
Begin VB.CheckBox chkKeyboard
|
||||
Caption = "Keyboard"
|
||||
Height = 315
|
||||
Left = 60
|
||||
TabIndex = 2
|
||||
Top = 1080
|
||||
Width = 5655
|
||||
End
|
||||
Begin VB.CheckBox chkMouse
|
||||
Caption = "Mouse"
|
||||
Height = 315
|
||||
Left = 120
|
||||
TabIndex = 0
|
||||
Top = 420
|
||||
Width = 5655
|
||||
End
|
||||
Begin MSComctlLib.Slider sldMouseSens
|
||||
Height = 195
|
||||
Left = 1140
|
||||
TabIndex = 1
|
||||
Top = 780
|
||||
Width = 4935
|
||||
_ExtentX = 8705
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
Min = 1
|
||||
Max = 50
|
||||
SelStart = 1
|
||||
TickFrequency = 5
|
||||
Value = 1
|
||||
End
|
||||
Begin MSComctlLib.Slider sldKeyboard
|
||||
Height = 195
|
||||
Left = 1125
|
||||
TabIndex = 12
|
||||
Top = 1410
|
||||
Width = 4935
|
||||
_ExtentX = 8705
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
Min = 1
|
||||
Max = 100
|
||||
SelStart = 1
|
||||
TickFrequency = 5
|
||||
Value = 1
|
||||
End
|
||||
Begin VB.Label lblKeySens
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Sensitivity"
|
||||
Height = 255
|
||||
Left = 345
|
||||
TabIndex = 13
|
||||
Top = 1410
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lblMouseSens
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Sensitivity"
|
||||
Height = 255
|
||||
Left = 360
|
||||
TabIndex = 11
|
||||
Top = 780
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lblSens
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Sensitivity"
|
||||
Height = 255
|
||||
Left = 300
|
||||
TabIndex = 10
|
||||
Top = 2400
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Here you will select the controllers you wish to use during gameplay."
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 9
|
||||
Top = 180
|
||||
Width = 4875
|
||||
End
|
||||
End
|
||||
Begin VB.CommandButton cmdOk
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 375
|
||||
Left = 5340
|
||||
TabIndex = 7
|
||||
Top = 2940
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Cancel = -1 'True
|
||||
Caption = "Cancel"
|
||||
Height = 375
|
||||
Left = 4260
|
||||
TabIndex = 6
|
||||
Top = 2940
|
||||
Width = 975
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmInput"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
Private diDevEnum As DirectInputEnumDevices8
|
||||
|
||||
Private Sub chkJoy_Click()
|
||||
cboJoy.Enabled = (chkJoy.Value = vbChecked)
|
||||
lblSens.Enabled = (chkJoy.Value = vbChecked)
|
||||
sldSens.Enabled = (chkJoy.Value = vbChecked)
|
||||
End Sub
|
||||
|
||||
Private Sub chkKeyboard_Click()
|
||||
If chkMouse.Value = vbUnchecked And chkKeyboard.Value = vbUnchecked Then
|
||||
MsgBox "You must leave at least the keyboard or the mouse enabled.", vbOKOnly Or vbInformation, "No basic input"
|
||||
chkKeyboard.Value = vbChecked
|
||||
End If
|
||||
lblKeySens.Enabled = (chkKeyboard.Value = vbChecked)
|
||||
sldKeyboard.Enabled = (chkKeyboard.Value = vbChecked)
|
||||
End Sub
|
||||
|
||||
Private Sub chkMouse_Click()
|
||||
If chkMouse.Value = vbUnchecked And chkKeyboard.Value = vbUnchecked Then
|
||||
MsgBox "You must leave at least the keyboard or the mouse enabled.", vbOKOnly Or vbInformation, "No basic input"
|
||||
chkMouse.Value = vbChecked
|
||||
End If
|
||||
lblMouseSens.Enabled = (chkMouse.Value = vbChecked)
|
||||
sldMouseSens.Enabled = (chkMouse.Value = vbChecked)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdCancel_Click()
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOk_Click()
|
||||
SaveAudioSettings
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim lIndex As Long
|
||||
|
||||
'Now update the display
|
||||
chkMouse.Value = Abs(goInput.UseMouse)
|
||||
chkKeyboard.Value = Abs(goInput.UseKeyboard)
|
||||
chkJoy.Value = Abs(goInput.UseJoystick)
|
||||
sldSens.Value = (goInput.JoystickSensitivity * 100000)
|
||||
sldMouseSens.Value = (goInput.MouseSensitivity * 1000)
|
||||
sldKeyboard.Value = (goInput.KeyboardSensitivity * 1000)
|
||||
|
||||
cboJoy.Enabled = (chkJoy.Value = vbChecked)
|
||||
lblSens.Enabled = (chkJoy.Value = vbChecked)
|
||||
sldSens.Enabled = (chkJoy.Value = vbChecked)
|
||||
lblMouseSens.Enabled = (chkMouse.Value = vbChecked)
|
||||
sldMouseSens.Enabled = (chkMouse.Value = vbChecked)
|
||||
lblKeySens.Enabled = (chkKeyboard.Value = vbChecked)
|
||||
sldKeyboard.Enabled = (chkKeyboard.Value = vbChecked)
|
||||
|
||||
'Now, let's fill up the ui for the joysticks
|
||||
Set diDevEnum = goInput.InputObject.GetDIDevices(DI8DEVCLASS_GAMECTRL, DIEDFL_ATTACHEDONLY)
|
||||
If diDevEnum.GetCount = 0 Then
|
||||
chkJoy.Enabled = False
|
||||
cboJoy.Enabled = False
|
||||
Else
|
||||
'Ok, there *are* joysticks. Load them into the combo box
|
||||
Dim lCount As Long
|
||||
lIndex = 0
|
||||
For lCount = 1 To diDevEnum.GetCount
|
||||
cboJoy.AddItem diDevEnum.GetItem(lCount).GetInstanceName
|
||||
If diDevEnum.GetItem(lCount).GetGuidInstance = goInput.JoystickGuid Then lIndex = lCount - 1
|
||||
Next
|
||||
cboJoy.ListIndex = lIndex
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub SaveAudioSettings()
|
||||
goInput.UseMouse = (chkMouse.Value = vbChecked)
|
||||
If goInput.UseMouse Then
|
||||
goInput.MouseSensitivity = sldMouseSens.Value / 1000
|
||||
End If
|
||||
goInput.UseKeyboard = (chkKeyboard.Value = vbChecked)
|
||||
If goInput.UseKeyboard Then
|
||||
goInput.KeyboardSensitivity = sldKeyboard.Value / 1000
|
||||
End If
|
||||
goInput.UseJoystick = (chkJoy.Value = vbChecked)
|
||||
If goInput.UseJoystick Then
|
||||
goInput.JoystickGuid = diDevEnum.GetItem(cboJoy.ListIndex + 1).GetGuidInstance
|
||||
goInput.JoystickSensitivity = sldSens.Value / 100000
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
'We're leaving the form, save the settings
|
||||
SaveSetting gsKeyName, gsSubKeyInput, "UseMouse", goInput.UseMouse
|
||||
SaveSetting gsKeyName, gsSubKeyInput, "UseKeyboard", goInput.UseKeyboard
|
||||
SaveSetting gsKeyName, gsSubKeyInput, "UseJoystick", goInput.UseJoystick
|
||||
If goInput.UseJoystick Then
|
||||
SaveSetting gsKeyName, gsSubKeyInput, "JoystickGuid", goInput.JoystickGuid
|
||||
SaveSetting gsKeyName, gsSubKeyInput, "JoystickSensitivity", goInput.JoystickSensitivity
|
||||
End If
|
||||
If goInput.UseMouse Then
|
||||
SaveSetting gsKeyName, gsSubKeyInput, "MouseSensitivity", goInput.MouseSensitivity
|
||||
End If
|
||||
If goInput.UseKeyboard Then
|
||||
SaveSetting gsKeyName, gsSubKeyInput, "KeyboardSensitivity", goInput.KeyboardSensitivity
|
||||
End If
|
||||
End Sub
|
||||
|
||||
@@ -0,0 +1,290 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmSplash
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "vb Air Hockey"
|
||||
ClientHeight = 5400
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 7200
|
||||
Icon = "frmSplash.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 5400
|
||||
ScaleWidth = 7200
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.Frame Frame1
|
||||
Caption = "Options"
|
||||
Height = 2115
|
||||
Left = 60
|
||||
TabIndex = 5
|
||||
Top = 720
|
||||
Width = 7095
|
||||
Begin VB.CommandButton cmdAudio
|
||||
Caption = "&Audio Options..."
|
||||
Height = 375
|
||||
Left = 5040
|
||||
TabIndex = 15
|
||||
Top = 1560
|
||||
Width = 1815
|
||||
End
|
||||
Begin VB.CommandButton cmdInput
|
||||
Caption = "&Input Options..."
|
||||
Height = 375
|
||||
Left = 5040
|
||||
TabIndex = 14
|
||||
Top = 1080
|
||||
Width = 1815
|
||||
End
|
||||
Begin VB.CommandButton cmdGraphicsOptions
|
||||
Caption = "&Graphics Options..."
|
||||
Height = 375
|
||||
Left = 5040
|
||||
TabIndex = 13
|
||||
Top = 600
|
||||
Width = 1815
|
||||
End
|
||||
Begin MSComctlLib.Slider sldSpeed
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 7
|
||||
Top = 870
|
||||
Width = 2055
|
||||
_ExtentX = 3625
|
||||
_ExtentY = 450
|
||||
_Version = 393216
|
||||
LargeChange = 50
|
||||
SmallChange = 5
|
||||
Min = 10
|
||||
Max = 1000
|
||||
SelStart = 10
|
||||
TickFrequency = 100
|
||||
Value = 10
|
||||
End
|
||||
Begin MSComctlLib.Slider sldScore
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 8
|
||||
Top = 1470
|
||||
Width = 2055
|
||||
_ExtentX = 3625
|
||||
_ExtentY = 450
|
||||
_Version = 393216
|
||||
LargeChange = 3
|
||||
Min = 2
|
||||
Max = 20
|
||||
SelStart = 10
|
||||
TickFrequency = 2
|
||||
Value = 10
|
||||
End
|
||||
Begin MSComctlLib.Slider sldPaddleMass
|
||||
Height = 255
|
||||
Left = 2310
|
||||
TabIndex = 10
|
||||
Top = 870
|
||||
Width = 2055
|
||||
_ExtentX = 3625
|
||||
_ExtentY = 450
|
||||
_Version = 393216
|
||||
LargeChange = 50
|
||||
SmallChange = 5
|
||||
Min = 50
|
||||
Max = 300
|
||||
SelStart = 50
|
||||
TickFrequency = 20
|
||||
Value = 50
|
||||
End
|
||||
Begin VB.Label Label3
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = $"frmSplash.frx":000C
|
||||
Height = 435
|
||||
Left = 60
|
||||
TabIndex = 12
|
||||
Top = 180
|
||||
Width = 6930
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Paddle Mass"
|
||||
Height = 255
|
||||
Index = 2
|
||||
Left = 2430
|
||||
TabIndex = 11
|
||||
Top = 630
|
||||
Width = 3615
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Winning Score"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 270
|
||||
TabIndex = 9
|
||||
Top = 1230
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Game Speed"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 270
|
||||
TabIndex = 6
|
||||
Top = 630
|
||||
Width = 1215
|
||||
End
|
||||
End
|
||||
Begin VB.CommandButton cmdExit
|
||||
Cancel = -1 'True
|
||||
Caption = "Exit Game"
|
||||
Height = 375
|
||||
Left = 5220
|
||||
TabIndex = 2
|
||||
Top = 4860
|
||||
Width = 1815
|
||||
End
|
||||
Begin VB.CommandButton cmdSingle
|
||||
Caption = "&Single Player Game..."
|
||||
Height = 375
|
||||
Left = 5220
|
||||
TabIndex = 0
|
||||
Top = 4020
|
||||
Width = 1815
|
||||
End
|
||||
Begin VB.CommandButton cmdMulti
|
||||
Caption = "&Multiplayer Game..."
|
||||
Height = 375
|
||||
Left = 5220
|
||||
TabIndex = 1
|
||||
Top = 4440
|
||||
Width = 1815
|
||||
End
|
||||
Begin VB.Label lblText
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Label2"
|
||||
ForeColor = &H80000008&
|
||||
Height = 2340
|
||||
Left = 180
|
||||
TabIndex = 4
|
||||
Top = 2895
|
||||
Width = 4920
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Alignment = 2 'Center
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Visual Basic Air Hockey"
|
||||
BeginProperty Font
|
||||
Name = "Comic Sans MS"
|
||||
Size = 21.75
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
ForeColor = &H000000FF&
|
||||
Height = 675
|
||||
Left = 120
|
||||
TabIndex = 3
|
||||
Top = 0
|
||||
Width = 6915
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmSplash"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
Dim fStartingGame As Boolean
|
||||
|
||||
Private Sub cmdAudio_Click()
|
||||
'Here we will allow the changing of the audio options.
|
||||
'Load the options screen
|
||||
frmAudio.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdExit_Click()
|
||||
'Quit the game
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdGraphicsOptions_Click()
|
||||
'Here we will allow the changing of the graphics options.
|
||||
'Load the options screen
|
||||
frmGraphics.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdInput_Click()
|
||||
'Here we will allow the changing of the input options.
|
||||
'Load the options screen
|
||||
frmInput.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdMulti_Click()
|
||||
fStartingGame = True
|
||||
SaveAll
|
||||
gfMultiplayer = True
|
||||
gfGameCanBeStarted = False
|
||||
'Go ahead and load the game
|
||||
frmAir.Show vbModeless
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSingle_Click()
|
||||
fStartingGame = True
|
||||
SaveAll
|
||||
gfMultiplayer = False
|
||||
gfGameCanBeStarted = True
|
||||
'Go ahead and load the game
|
||||
frmAir.Show vbModeless
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
gfScored = True
|
||||
|
||||
sldSpeed.Value = CLng(GetSetting(gsKeyName, gsSubKey, "Speed", 780))
|
||||
sldScore.Value = CLng(GetSetting(gsKeyName, gsSubKey, "WinningScore", glDefaultWinningScore))
|
||||
sldPaddleMass.Value = CLng(GetSetting(gsKeyName, gsSubKey, "PaddleMass", 100))
|
||||
|
||||
lblText.Caption = "Options during gameplay:" & vbCrLf & vbCrLf & _
|
||||
"<Space> Start game (launch puck from center)" & vbCrLf & _
|
||||
"<F1> Toggle showing the game room" & vbCrLf & _
|
||||
"<F3> Restart the game after someone has won" & vbCrLf & _
|
||||
"<F4> Toggle the game tables transparency" & vbCrLf & _
|
||||
"<F5> Toggle showing the game table" & vbCrLf & _
|
||||
"<F6> Toggle the paddles transparency" & vbCrLf & _
|
||||
"<V> Scroll through default views" & vbCrLf & _
|
||||
"<W> Toggle wireframe mode" & vbCrLf & vbCrLf & _
|
||||
"Use the right mouse button to get a different view."
|
||||
|
||||
'Init objects and load values
|
||||
LoadObjects
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
If Not fStartingGame Then 'We're not starting, cleanup
|
||||
Set goPuck = Nothing
|
||||
Set goPaddle(0) = Nothing
|
||||
Set goPaddle(1) = Nothing
|
||||
Set goCamera = Nothing
|
||||
Set goTable = Nothing
|
||||
Set goRoom = Nothing
|
||||
Set goInput = Nothing
|
||||
Set goAudio = New cAudio
|
||||
Set goDev = Nothing
|
||||
End
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub SaveAll()
|
||||
gnVelocityDamp = sldSpeed.Value / 1000
|
||||
glUserWinningScore = sldScore.Value
|
||||
gnPaddleMass = sldPaddleMass.Value / 100
|
||||
goPuck.MaximumPuckVelocity = gnVelocityDamp * glMaxPuckSpeedConstant
|
||||
|
||||
SaveSetting gsKeyName, gsSubKey, "Speed", CStr(sldSpeed.Value)
|
||||
SaveSetting gsKeyName, gsSubKey, "WinningScore", CStr(sldScore.Value)
|
||||
SaveSetting gsKeyName, gsSubKey, "PaddleMass", CStr(sldPaddleMass.Value)
|
||||
End Sub
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,118 @@
|
||||
Attribute VB_Name = "modAudio"
|
||||
Option Explicit
|
||||
|
||||
'We will keep our Audio vars here
|
||||
Dim dmPerf As DirectMusicPerformance8
|
||||
Dim dmLoad As DirectMusicLoader8
|
||||
Dim dmSegBank() As DirectMusicSegment8
|
||||
Dim dmSegHit() As DirectMusicSegment8
|
||||
Dim dmScore As DirectMusicSegment8
|
||||
|
||||
Public glNumBankSounds As Long
|
||||
Public glNumHitSounds As Long
|
||||
|
||||
Public Sub SetNumberSounds()
|
||||
Dim sFile As String
|
||||
Dim lCount As Long
|
||||
|
||||
lCount = 1
|
||||
sFile = Dir$(App.path & "\sounds\bank" & format$(CStr(lCount), "00") & ".wav")
|
||||
Do While sFile <> vbNullString
|
||||
lCount = lCount + 1
|
||||
sFile = Dir$(App.path & "\sounds\bank" & format$(CStr(lCount), "00") & ".wav")
|
||||
Loop
|
||||
glNumBankSounds = lCount - 1
|
||||
lCount = 1
|
||||
sFile = Dir$(App.path & "\sounds\hit" & format$(CStr(lCount), "00") & ".wav")
|
||||
Do While sFile <> vbNullString
|
||||
lCount = lCount + 1
|
||||
sFile = Dir$(App.path & "\sounds\hit" & format$(CStr(lCount), "00") & ".wav")
|
||||
Loop
|
||||
glNumHitSounds = lCount - 1
|
||||
End Sub
|
||||
|
||||
Public Function InitAudio() As Boolean
|
||||
|
||||
Dim lCount As Long, dma As DMUS_AUDIOPARAMS
|
||||
|
||||
On Error GoTo FailedInit
|
||||
InitAudio = True
|
||||
'Create our objects
|
||||
Set dmPerf = dx.DirectMusicPerformanceCreate
|
||||
Set dmLoad = dx.DirectMusicLoaderCreate
|
||||
'Get the total number of sounds we have for each type of sound
|
||||
SetNumberSounds
|
||||
|
||||
'Using that information create an array of segments
|
||||
ReDim dmSegBank(1 To glNumBankSounds)
|
||||
ReDim dmSegHit(1 To glNumHitSounds)
|
||||
|
||||
'Create a default audio path
|
||||
dmPerf.InitAudio frmAir.hwnd, DMUS_AUDIOF_ALL, dma, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
|
||||
'Load each of the sounds
|
||||
For lCount = 1 To glNumBankSounds
|
||||
Set dmSegBank(lCount) = dmLoad.LoadSegment(App.path & "\sounds\bank" & format$(CStr(lCount), "00") & ".wav")
|
||||
dmSegBank(lCount).Download dmPerf.GetDefaultAudioPath
|
||||
Next
|
||||
For lCount = 1 To glNumHitSounds
|
||||
Set dmSegHit(lCount) = dmLoad.LoadSegment(App.path & "\sounds\hit" & format$(CStr(lCount), "00") & ".wav")
|
||||
dmSegHit(lCount).Download dmPerf.GetDefaultAudioPath
|
||||
Next
|
||||
Set dmScore = dmLoad.LoadSegment(App.path & "\sounds\score.wav")
|
||||
dmScore.Download dmPerf.GetDefaultAudioPath
|
||||
Exit Function
|
||||
|
||||
FailedInit:
|
||||
InitAudio = False
|
||||
End Function
|
||||
|
||||
Public Sub PlayRandomBankSound()
|
||||
Dim lRnd As Long
|
||||
|
||||
'Pick a valid 'Bank' sound randomly and play it
|
||||
Randomize
|
||||
lRnd = CLng(Rnd * glNumBankSounds) + 1
|
||||
Do While lRnd < 1 Or lRnd > glNumBankSounds
|
||||
lRnd = CLng(Rnd * glNumBankSounds) + 1
|
||||
Loop
|
||||
dmPerf.PlaySegmentEx dmSegBank(lRnd), DMUS_SEGF_SECONDARY, 0
|
||||
End Sub
|
||||
|
||||
Public Sub PlayRandomHitSound()
|
||||
Dim lRnd As Long
|
||||
|
||||
'Pick a valid 'Hit' sound randomly and play it
|
||||
Randomize
|
||||
lRnd = CLng(Rnd * glNumHitSounds) + 1
|
||||
Do While lRnd < 1 Or lRnd > glNumHitSounds
|
||||
lRnd = CLng(Rnd * glNumHitSounds) + 1
|
||||
Loop
|
||||
dmPerf.PlaySegmentEx dmSegHit(lRnd), DMUS_SEGF_SECONDARY, 0
|
||||
End Sub
|
||||
|
||||
Public Sub PlayScoreSound()
|
||||
'Play the sound that happens when we score
|
||||
dmPerf.PlaySegmentEx dmScore, DMUS_SEGF_SECONDARY, 0
|
||||
End Sub
|
||||
|
||||
Public Sub CleanupAudio()
|
||||
|
||||
On Error Resume Next
|
||||
Dim lCount As Long
|
||||
|
||||
'Unload all of our sounds off of the audio path and destroy them
|
||||
For lCount = 1 To glNumBankSounds
|
||||
dmSegBank(lCount).Unload dmPerf.GetDefaultAudioPath
|
||||
Set dmSegBank(lCount) = Nothing
|
||||
Next
|
||||
For lCount = 1 To glNumHitSounds
|
||||
dmSegHit(lCount).Unload dmPerf.GetDefaultAudioPath
|
||||
Set dmSegHit(lCount) = Nothing
|
||||
Next
|
||||
If Not (dmScore Is Nothing) Then dmScore.Unload dmPerf.GetDefaultAudioPath
|
||||
Set dmScore = Nothing
|
||||
|
||||
'Destroy the rest of the objects
|
||||
Set dmPerf = Nothing
|
||||
Set dmLoad = Nothing
|
||||
End Sub
|
||||
@@ -0,0 +1,264 @@
|
||||
Attribute VB_Name = "modD3D"
|
||||
Option Explicit
|
||||
|
||||
Public dx As New DirectX8
|
||||
|
||||
Public gfDrawRoomText As Boolean
|
||||
Public glScreenWidth As Long
|
||||
Public glScreenHeight As Long
|
||||
|
||||
'Extra misc vars
|
||||
Public gfWireFrame As Boolean
|
||||
|
||||
Public Sub Render()
|
||||
|
||||
Dim lCount As Long
|
||||
|
||||
On Error Resume Next
|
||||
If g_dev Is Nothing Then Exit Sub
|
||||
|
||||
' Clear the backbuffer to a black color
|
||||
g_dev.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, &H0&, 1#, 0
|
||||
|
||||
' Setup the world, view, and projection matrices
|
||||
SetupMatrices
|
||||
|
||||
' Begin the scene
|
||||
g_dev.BeginScene
|
||||
|
||||
'Draw everything in either a solid fillmode, or wireframe
|
||||
If gfWireFrame Then
|
||||
g_dev.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME
|
||||
Else
|
||||
g_dev.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID
|
||||
End If
|
||||
|
||||
'Render the room
|
||||
goRoom.Render g_dev
|
||||
|
||||
'Render the table
|
||||
goTable.Render g_dev
|
||||
|
||||
'Now Paddle (0)
|
||||
goPaddle(0).Render g_dev
|
||||
|
||||
'Now Paddle (1)
|
||||
goPaddle(1).Render g_dev
|
||||
|
||||
'And finally the puck
|
||||
goPuck.Render g_dev
|
||||
'Now lets draw whatever text we need
|
||||
|
||||
'We can draw text (don't draw text if we're currently fading)
|
||||
If Not goFade.AmFading Then
|
||||
goTextLittle.BeginText
|
||||
If gfGameCanBeStarted Then
|
||||
'If the game can be started, then draw the scores at the top of the screen
|
||||
If gfMultiplayer Then
|
||||
If glMyPaddleID = 0 Then
|
||||
goTextLittle.DrawText gsUserName & ":" & glPlayerScore(0), 10, 5, &HFFFFFF00
|
||||
Else
|
||||
goTextLittle.DrawText "Opponent:" & glPlayerScore(0), 10, 5, &HFFFFFFFF
|
||||
End If
|
||||
If glMyPaddleID = 1 Then
|
||||
goTextLittle.DrawText gsUserName & ":" & glPlayerScore(1), glScreenWidth - 75, 5, &HFFFFFF00
|
||||
Else
|
||||
goTextLittle.DrawText "Opponent:" & glPlayerScore(1), glScreenWidth - 75, 5, &HFFFFFFFF
|
||||
End If
|
||||
Else
|
||||
goTextLittle.DrawText "Player:" & glPlayerScore(0), 10, 5, &HFFFFFF00
|
||||
goTextLittle.DrawText "Computer:" & glPlayerScore(1), glScreenWidth - 75, 5, &HFFFFFFFF
|
||||
End If
|
||||
Else
|
||||
'The game can't be started yet (only in multiplayer) Let the host know
|
||||
goTextLittle.DrawText "Waiting for the game to be started...", (glScreenWidth / 2) - 50, 5, &HFFFFFFFF
|
||||
End If
|
||||
'Here is a little helper text letting the user know to press Space
|
||||
'to launch the puck (will show up after 3 seconds, and stay on for 10 seconds)
|
||||
If (timeGetTime - glTimePuckScored > glDefaultDelayTime) And gfScored And Not gfGameOver And ((timeGetTime - glTimePuckScored < glDefaultDelayTimeGone + glDefaultDelayTime)) Then
|
||||
goPuck.DefaultStartPosition
|
||||
goPuck.Spinning = True
|
||||
goTextLittle.DrawText "Press <Space> to launch puck...", (glScreenWidth / 2) - 50, 25, &HFF0000FF
|
||||
End If
|
||||
|
||||
'Here is a little helper text letting the user know to press F1
|
||||
'to turn of the room (will show up after 3 seconds, and stay on for 10 seconds)
|
||||
If (gfDrawRoomText And goRoom.DrawRoom) And (timeGetTime - glTimeNoRoom < glDefaultDelayTimeGone) Then
|
||||
goPuck.DefaultStartPosition
|
||||
goPuck.Spinning = True
|
||||
goTextLittle.DrawText "You can press F1 to turn off the drawing " & vbCrLf & " of the room, which will increase performance.", -15, glScreenHeight - 50, &HFFFF00FF
|
||||
End If
|
||||
If gfGameOver And ((timeGetTime - glTimeGameOver) > glDefaultDelayTime) And ((timeGetTime - glTimeGameOver < glDefaultDelayTimeGone + glDefaultDelayTime)) Then
|
||||
goTextLittle.DrawText "Press F3 to restart...", (glScreenWidth / 2) - 50, 25, &HFF0000FF
|
||||
End If
|
||||
goTextLittle.EndText
|
||||
goTextBig.BeginText
|
||||
If gfGameOver Then
|
||||
If gfMultiplayer Then
|
||||
If glPlayerScore(glMyPaddleID) > glPlayerScore(Abs(glMyPaddleID - 1)) Then
|
||||
goTextBig.DrawText "Game over!!" & vbCrLf & "You win!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
|
||||
Else
|
||||
goTextBig.DrawText "Game over!!" & vbCrLf & "You lose!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
|
||||
End If
|
||||
Else
|
||||
If glPlayerScore(0) > glPlayerScore(1) Then
|
||||
goTextBig.DrawText "Game over!!" & vbCrLf & "You win!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
|
||||
Else
|
||||
goTextBig.DrawText "Game over!!" & vbCrLf & "You lose!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
If gfMultiplayer And gfNoSendData Then 'We've been disconnected sometime, notify the user
|
||||
goTextBig.DrawText "The connection with the other" & vbCrLf & "system was lost.", 5, (glScreenHeight / 2) - (glScreenHeight / 4), &HFFFFFF00
|
||||
End If
|
||||
goTextBig.EndText
|
||||
End If
|
||||
' End the scene
|
||||
g_dev.EndScene
|
||||
' Present the backbuffer contents to the front buffer (screen)
|
||||
D3DUtil_PresentAll 0
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub SetupMatrices()
|
||||
|
||||
Dim matView As D3DMATRIX
|
||||
|
||||
D3DXMatrixLookAtLH matView, goCamera.Position, vec3(0#, 0#, 0#), vec3(0#, 1#, 0#)
|
||||
g_dev.SetTransform D3DTS_VIEW, matView
|
||||
|
||||
Dim matProj As D3DMATRIX
|
||||
D3DXMatrixPerspectiveFovLH matProj, g_pi / 4, 1, 1, 110
|
||||
g_dev.SetTransform D3DTS_PROJECTION, matProj
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub RestoreDeviceObjects()
|
||||
|
||||
' Set miscellaneous render states
|
||||
With g_dev
|
||||
' Set world transform
|
||||
Dim matWorld As D3DMATRIX
|
||||
D3DXMatrixIdentity matWorld
|
||||
.SetTransform D3DTS_WORLD, matWorld
|
||||
' Set the projection matrix
|
||||
Dim matProj As D3DMATRIX
|
||||
Dim fAspect As Single
|
||||
fAspect = 1
|
||||
D3DXMatrixPerspectiveFovLH matProj, g_pi / 3, fAspect, 1, 1000
|
||||
.SetTransform D3DTS_PROJECTION, matProj
|
||||
|
||||
.SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
|
||||
.SetTextureStageState 0, D3DTSS_COLORARG2, D3DTA_DIFFUSE
|
||||
.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_MODULATE
|
||||
.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
|
||||
.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
|
||||
.SetTextureStageState 1, D3DTSS_MINFILTER, D3DTEXF_LINEAR
|
||||
.SetTextureStageState 1, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
|
||||
|
||||
' Set default render states
|
||||
.SetRenderState D3DRS_DITHERENABLE, 1 'True
|
||||
.SetRenderState D3DRS_SPECULARENABLE, 0 'False
|
||||
.SetRenderState D3DRS_ZENABLE, 1 'True
|
||||
.SetRenderState D3DRS_NORMALIZENORMALS, 1 'True
|
||||
|
||||
End With
|
||||
|
||||
Set goTextBig = Nothing
|
||||
Set goTextLittle = Nothing
|
||||
|
||||
'Now create a new text object
|
||||
Set goTextLittle = New cText
|
||||
goTextLittle.InitText g_d3dx, g_dev, "Times New Roman", 8, True
|
||||
Set goTextBig = New cText
|
||||
goTextBig.InitText g_d3dx, g_dev, "Times New Roman", 18, True
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub InitDefaultLights(Optional ByVal lNumLights As Long = 2, Optional ByVal fFullAmbiantOnly As Boolean = False)
|
||||
With g_dev
|
||||
' Set ambient light
|
||||
.SetRenderState D3DRS_AMBIENT, &HFFFFFFFF
|
||||
goFade.AmbientColor = &HFFFFFFFF
|
||||
goFade.MaxAmbientColor = goFade.AmbientColor
|
||||
If fFullAmbiantOnly Then Exit Sub
|
||||
If lNumLights < 1 Then Exit Sub 'Nothing to do
|
||||
|
||||
' Set ambient light
|
||||
'We will slowly lower the ambient light as each new light gets added
|
||||
.SetRenderState D3DRS_AMBIENT, &HFFBBBBBB
|
||||
goFade.AmbientColor = &HFFBBBBBB
|
||||
' Turn on lighting
|
||||
.SetRenderState D3DRS_LIGHTING, 1
|
||||
|
||||
'Turn on two lights one on each end of the table
|
||||
Dim light As D3DLIGHT8
|
||||
|
||||
If lNumLights > 0 Then
|
||||
With light
|
||||
.Type = D3DLIGHT_DIRECTIONAL
|
||||
.diffuse.r = 0
|
||||
.diffuse.g = 0
|
||||
.diffuse.b = 0
|
||||
.Direction.x = 0
|
||||
.Direction.y = -10
|
||||
.Direction.z = 0
|
||||
.Range = 100000#
|
||||
.Position.x = 0
|
||||
.Position.y = 3
|
||||
.Position.z = 0
|
||||
End With
|
||||
goFade.LightColor(0) = light
|
||||
|
||||
.SetLight 0, light 'let d3d know about the light
|
||||
.LightEnable 0, 1 'turn it on
|
||||
goFade.NumLight = 0
|
||||
End If
|
||||
|
||||
|
||||
If lNumLights > 1 Then
|
||||
.SetRenderState D3DRS_AMBIENT, &HFFAAAAAA
|
||||
goFade.AmbientColor = &HFFAAAAAA
|
||||
'Now turn on the second light if we can
|
||||
With light
|
||||
.Type = D3DLIGHT_DIRECTIONAL
|
||||
.Direction.x = 15
|
||||
.Direction.y = -10
|
||||
.Direction.z = -15
|
||||
.Range = 1000#
|
||||
.Position.x = -15
|
||||
.Position.y = 10
|
||||
.Position.z = 15
|
||||
End With
|
||||
goFade.LightColor(1) = light
|
||||
|
||||
.SetLight 1, light 'let d3d know about the light
|
||||
.LightEnable 1, 1 'turn it on
|
||||
goFade.NumLight = 1
|
||||
End If
|
||||
|
||||
|
||||
If lNumLights > 3 Then
|
||||
.SetRenderState D3DRS_AMBIENT, 0
|
||||
goFade.AmbientColor = 0
|
||||
'Now turn on the third light if we can
|
||||
With light
|
||||
.Type = D3DLIGHT_DIRECTIONAL
|
||||
.Direction.x = -15
|
||||
.Direction.y = 10
|
||||
.Direction.z = 15
|
||||
.Range = 1000#
|
||||
.Position.x = 15
|
||||
.Position.y = -10
|
||||
.Position.z = -15
|
||||
End With
|
||||
goFade.LightColor(2) = light
|
||||
|
||||
.SetLight 2, light 'let d3d know about the light
|
||||
.LightEnable 2, 1 'turn it on
|
||||
goFade.NumLight = 2
|
||||
End If
|
||||
End With
|
||||
goFade.MaxAmbientColor = goFade.AmbientColor
|
||||
|
||||
End Sub
|
||||
@@ -0,0 +1,158 @@
|
||||
Attribute VB_Name = "modDInput"
|
||||
Option Explicit
|
||||
|
||||
Private Enum DefaultCameraViews
|
||||
DefaultView
|
||||
OverHeadView
|
||||
SideOverheadView1
|
||||
SideOverheadView2
|
||||
OpponentView
|
||||
CustomView
|
||||
End Enum
|
||||
|
||||
Private Const mnMouseSensitivity As Single = 0.02
|
||||
Private Const mnMaxZThresh As Single = 35
|
||||
Private Const mnMaxYThresh As Single = 50
|
||||
Private Const mnMaxXThresh As Single = 35
|
||||
Private mnLastX As Single
|
||||
Private mnLastY As Single
|
||||
|
||||
'DirectInput variables, etc
|
||||
Public Const glBufferSize As Long = 10
|
||||
Public Const gnVelocityBoost As Single = 1.1
|
||||
|
||||
Public DI As DirectInput8
|
||||
Public DIMouse As DirectInputDevice8
|
||||
Public gfMovingCamera As Boolean
|
||||
|
||||
Public Function InitDInput(oForm As Form) As Boolean
|
||||
|
||||
Dim diProp As DIPROPLONG
|
||||
|
||||
On Error GoTo FailedInput
|
||||
|
||||
InitDInput = True
|
||||
Set DI = dx.DirectInputCreate
|
||||
Set DIMouse = DI.CreateDevice("guid_SysMouse")
|
||||
Call DIMouse.SetCommonDataFormat(DIFORMAT_MOUSE)
|
||||
Call DIMouse.SetCooperativeLevel(oForm.hwnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)
|
||||
|
||||
' Set the buffer size
|
||||
diProp.lHow = DIPH_DEVICE
|
||||
diProp.lObj = 0
|
||||
diProp.lData = glBufferSize
|
||||
Call DIMouse.SetProperty("DIPROP_BUFFERSIZE", diProp)
|
||||
|
||||
'Acquire the mouse
|
||||
DIMouse.Acquire
|
||||
Exit Function
|
||||
|
||||
FailedInput:
|
||||
InitDInput = False
|
||||
|
||||
End Function
|
||||
|
||||
Public Sub CleanupDInput()
|
||||
On Error Resume Next
|
||||
'Unacquire the mouse
|
||||
If Not (DIMouse Is Nothing) Then DIMouse.Unacquire
|
||||
'Destroy our objects
|
||||
Set DIMouse = Nothing
|
||||
Set DI = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub ProcessMouseData()
|
||||
'This is where we respond to any change in mouse state. Usually this will be an axis movement
|
||||
'or button press or release, but it could also mean we've lost acquisition.
|
||||
|
||||
Dim diDeviceData(1 To glBufferSize) As DIDEVICEOBJECTDATA
|
||||
Dim lNumItems As Long
|
||||
Dim lCount As Integer
|
||||
Dim vOldPaddle As D3DVECTOR
|
||||
Static OldSequence As Long
|
||||
|
||||
On Error GoTo INPUTLOST 'In case we lost the mouse
|
||||
DIMouse.Acquire 'Just in case
|
||||
lNumItems = DIMouse.GetDeviceData(diDeviceData, 0)
|
||||
On Error GoTo 0 'Reset our error
|
||||
|
||||
vOldPaddle = goPaddle(glMyPaddleID).Position
|
||||
' Process data
|
||||
For lCount = 1 To lNumItems
|
||||
Select Case diDeviceData(lCount).lOfs
|
||||
Case DIMOFS_X 'We moved the X axis
|
||||
If gfMovingCamera Then
|
||||
With goCamera.Position
|
||||
.x = .x + (diDeviceData(lCount).lData * mnMouseSensitivity)
|
||||
goCamera.SetCameraPosition CustomView, glMyPaddleID
|
||||
If Abs(.x) > mnMaxXThresh Then
|
||||
'Whoops too much
|
||||
.x = mnMaxXThresh * (.x / Abs(.x))
|
||||
End If
|
||||
End With
|
||||
Else
|
||||
goPaddle(glMyPaddleID).LastPosition = goPaddle(glMyPaddleID).Position
|
||||
With goPaddle(glMyPaddleID).Position
|
||||
.x = .x + (diDeviceData(lCount).lData * mnMouseSensitivity)
|
||||
If .x > (gnSideLeftWallEdge - (gnPaddleRadius)) Then
|
||||
.x = (gnSideLeftWallEdge - (gnPaddleRadius))
|
||||
ElseIf .x < (gnSideRightWallEdge + (gnPaddleRadius)) Then
|
||||
.x = (gnSideRightWallEdge + (gnPaddleRadius))
|
||||
End If
|
||||
End With
|
||||
goPaddle(glMyPaddleID).Velocity.x = goPaddle(glMyPaddleID).Position.x - goPaddle(glMyPaddleID).LastPosition.x
|
||||
goPaddle(glMyPaddleID).LastVelocityTick = timeGetTime
|
||||
End If
|
||||
Case DIMOFS_Y 'We moved the Y axis
|
||||
If gfMovingCamera Then
|
||||
With goCamera.Position
|
||||
.z = .z - (diDeviceData(lCount).lData * mnMouseSensitivity)
|
||||
goCamera.SetCameraPosition CustomView, glMyPaddleID
|
||||
If Abs(.z) > mnMaxZThresh Then
|
||||
'Whoops too much
|
||||
.z = mnMaxZThresh * (.z / Abs(.z))
|
||||
End If
|
||||
End With
|
||||
Else
|
||||
goPaddle(glMyPaddleID).LastPosition = goPaddle(glMyPaddleID).Position
|
||||
With goPaddle(glMyPaddleID).Position
|
||||
.z = .z - (diDeviceData(lCount).lData * mnMouseSensitivity)
|
||||
'The front and rear walls are count to the Z axis
|
||||
If glMyPaddleID = 0 Then
|
||||
If .z > -2 Then
|
||||
.z = -2
|
||||
ElseIf .z < (gnFarWallEdge + (gnPaddleRadius)) Then
|
||||
.z = (gnFarWallEdge + (gnPaddleRadius))
|
||||
End If
|
||||
Else
|
||||
If .z > (gnNearWallEdge - (gnPaddleRadius)) Then
|
||||
.z = (gnNearWallEdge - (gnPaddleRadius))
|
||||
ElseIf .z < 2 Then
|
||||
.z = 2
|
||||
End If
|
||||
End If
|
||||
End With
|
||||
goPaddle(glMyPaddleID).Velocity.z = goPaddle(glMyPaddleID).Position.z - goPaddle(glMyPaddleID).LastPosition.z
|
||||
goPaddle(glMyPaddleID).LastVelocityTick = timeGetTime
|
||||
End If
|
||||
|
||||
Case DIMOFS_BUTTON1
|
||||
gfMovingCamera = (diDeviceData(lCount).lData And &H80 = &H80)
|
||||
|
||||
End Select
|
||||
EnsurePaddleReality vOldPaddle, goPaddle(glMyPaddleID)
|
||||
Next lCount
|
||||
Exit Sub
|
||||
|
||||
INPUTLOST:
|
||||
If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = DIERR_NOTACQUIRED) Then
|
||||
'We no longer have the mouse..
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub GetAndHandleDinput()
|
||||
'First let's handle the mouse
|
||||
ProcessMouseData
|
||||
'Now we can worry about keyboard
|
||||
'If we have a joystick selected check that too
|
||||
End Sub
|
||||
@@ -0,0 +1,193 @@
|
||||
Attribute VB_Name = "modDplay"
|
||||
Option Explicit
|
||||
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
|
||||
|
||||
'We want to keep the amount of data we send down to a bare minimum. Use the lowest
|
||||
'data type we can. For example, even though Enums are by default Long's
|
||||
'We will never have more than 255 messages for this application so we will convert
|
||||
'them all to bytes when we send them
|
||||
Public Enum vbDplayHockeyMsgType
|
||||
MsgSendGameSettings 'The settings for the application to run under
|
||||
MsgPaddleLocation 'The location of a particular paddle
|
||||
MsgPuckLocation 'The location of the puck
|
||||
MsgPlayerScored 'Someone just scored
|
||||
MsgClientConnectedAndReadyToPlay 'The client is connected, has received the game settings and is ready to play
|
||||
MsgRestartGame 'Time to restart the game
|
||||
MsgCollidePaddle 'Used only for sound effects...
|
||||
End Enum
|
||||
|
||||
'Constants
|
||||
Public Const AppGuid = "{AC35AAB4-32D3-465d-96C3-4F4137FBF9A1}"
|
||||
'Minimum frequency to allow sending data (in ms)
|
||||
'Regardless of network latency, we never want to send more than 20 msgs/second
|
||||
'which equates to a minimum send frequency of 50
|
||||
Public Const glMinimumSendFrequency As Long = 1000 \ 20
|
||||
'Main Peer object
|
||||
Public dpp As DirectPlay8Peer
|
||||
'PlayerID of the user who is connected
|
||||
Public glOtherPlayerID As Long
|
||||
|
||||
'App specific variables
|
||||
Public gsUserName As String
|
||||
'Our connection form and message pump
|
||||
Public DPlayEventsForm As DPlayConnect
|
||||
'How often we should send our paddles information
|
||||
Public glSendFrequency As Long
|
||||
'The amount of latency between two systems
|
||||
'(calculated as Avg(RoundTripLatency)/2)
|
||||
Public glOneWaySendLatency As Long
|
||||
'We have disconnected from the session. Stop sending data
|
||||
Public gfNoSendData As Boolean
|
||||
|
||||
Public Sub InitDPlay()
|
||||
'Create our DX/DirectPlay objects
|
||||
If dx Is Nothing Then Set dx = New DirectX8
|
||||
Set dpp = dx.DirectPlayPeerCreate
|
||||
glSendFrequency = glMinimumSendFrequency
|
||||
End Sub
|
||||
|
||||
Public Sub CleanupDPlay()
|
||||
On Error Resume Next
|
||||
If Not (DPlayEventsForm Is Nothing) Then
|
||||
If Not (dpp Is Nothing) Then dpp.UnRegisterMessageHandler
|
||||
DPlayEventsForm.DoSleep 50
|
||||
'Get rid of our message pump
|
||||
DPlayEventsForm.GoUnload
|
||||
'Close down our session
|
||||
If Not (dpp Is Nothing) Then dpp.Close
|
||||
'Lose references to peer and dx objects
|
||||
Set dpp = Nothing
|
||||
Set dx = Nothing
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub UpdateNetworkSettings()
|
||||
|
||||
Dim lMsg As Long, lNumMsg As Long, lNumByte As Long
|
||||
Dim lOffset As Long, oBuf() As Byte
|
||||
Static lLastSendTime As Long
|
||||
Static lLastSendCount As Long
|
||||
|
||||
On Error Resume Next 'in case we are already in this sub when we receive our connection terminated message
|
||||
If gfGameOver Then Exit Sub
|
||||
If gfNoSendData Then Exit Sub
|
||||
If Not gfGameCanBeStarted Then Exit Sub
|
||||
'First lets check the current send queue information. IF the queue is building up,
|
||||
'then we need to bump up the frequency so we don't oversaturate our line.
|
||||
dpp.GetSendQueueInfo glOtherPlayerID, lNumMsg, lNumByte
|
||||
If lNumMsg > 3 Or lNumByte > 256 Then
|
||||
'We are sending data to fast, slow down
|
||||
glSendFrequency = glSendFrequency + glMinimumSendFrequency
|
||||
End If
|
||||
'Here we will send the current game state (puck, and paddle information), and we will send this information
|
||||
'not faster than the glSendFrequency (which will be throttled according to latency)
|
||||
If timeGetTime - lLastSendTime > glSendFrequency Then
|
||||
If gfHost Then
|
||||
lLastSendCount = lLastSendCount + 1
|
||||
'We will not send the puck every time
|
||||
If lLastSendCount > 3 Then
|
||||
'Update puck
|
||||
'SendPuck 0
|
||||
lLastSendCount = 0
|
||||
End If
|
||||
End If
|
||||
|
||||
'Now send our paddle
|
||||
lMsg = MsgPaddleLocation
|
||||
AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset 'Msg
|
||||
AddDataToBuffer oBuf, CByte(glMyPaddleID), SIZE_BYTE, lOffset 'Paddle ID
|
||||
AddDataToBuffer oBuf, goPaddle(glMyPaddleID).Position, LenB(goPaddle(glMyPaddleID).Position), lOffset 'Paddle information
|
||||
'We will send this information to the other player only
|
||||
dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, 0
|
||||
lLastSendTime = timeGetTime
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub NotifyClientReady()
|
||||
Dim lMsg As Long
|
||||
Dim lOffset As Long, oBuf() As Byte
|
||||
|
||||
If gfNoSendData Then Exit Sub
|
||||
If Not gfMultiplayer Then Exit Sub
|
||||
If gfHost Then Exit Sub 'Only the client needs to tell the host
|
||||
'Here we will tell the host we are ready to play
|
||||
lMsg = MsgClientConnectedAndReadyToPlay
|
||||
AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
|
||||
'We will send this information to the other player only
|
||||
dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
|
||||
gfGameCanBeStarted = True
|
||||
End Sub
|
||||
|
||||
Public Sub NotifyPlayersWeScored()
|
||||
Dim lMsg As Long
|
||||
Dim lOffset As Long, oBuf() As Byte
|
||||
|
||||
If gfNoSendData Then Exit Sub
|
||||
If Not gfMultiplayer Then Exit Sub
|
||||
If Not gfHost Then Exit Sub
|
||||
'Here we will tell the host we are ready to play
|
||||
lMsg = MsgPlayerScored
|
||||
AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
|
||||
'We will send this information to the other player only
|
||||
dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
|
||||
End Sub
|
||||
|
||||
Public Sub NotifyGameRestart()
|
||||
Dim lMsg As Long
|
||||
Dim lOffset As Long, oBuf() As Byte
|
||||
|
||||
If gfNoSendData Then Exit Sub
|
||||
If Not gfMultiplayer Then Exit Sub
|
||||
'Here we will tell the host we are ready to play
|
||||
lMsg = MsgRestartGame
|
||||
AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
|
||||
'We will send this information to the other player only
|
||||
dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
|
||||
End Sub
|
||||
|
||||
Public Sub SendGameSettings()
|
||||
Dim lMsg As Long
|
||||
Dim lOffset As Long, oBuf() As Byte
|
||||
|
||||
If gfNoSendData Then Exit Sub
|
||||
If Not gfMultiplayer Then Exit Sub
|
||||
If Not gfHost Then Exit Sub
|
||||
'Here we will tell the host we are ready to play
|
||||
lMsg = MsgSendGameSettings
|
||||
AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
|
||||
AddDataToBuffer oBuf, gnVelocityDamp, LenB(gnVelocityDamp), lOffset
|
||||
AddDataToBuffer oBuf, glUserWinningScore, LenB(glUserWinningScore), lOffset
|
||||
AddDataToBuffer oBuf, gnPaddleMass, LenB(gnPaddleMass), lOffset
|
||||
'We will send this information to the other player only
|
||||
dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
|
||||
End Sub
|
||||
|
||||
Public Sub SendPuck(Optional ByVal lFlags As Long = (DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH))
|
||||
Dim lMsg As Long
|
||||
Dim lOffset As Long, oBuf() As Byte
|
||||
|
||||
If gfNoSendData Then Exit Sub
|
||||
If Not gfMultiplayer Then Exit Sub
|
||||
'Here we will tell the host we are ready to play
|
||||
lMsg = MsgPuckLocation
|
||||
AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
|
||||
AddDataToBuffer oBuf, goPuck.Position, LenB(goPuck.Position), lOffset
|
||||
AddDataToBuffer oBuf, goPuck.Velocity, LenB(goPuck.Velocity), lOffset
|
||||
'We will send this information to the other player only
|
||||
dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, lFlags
|
||||
End Sub
|
||||
|
||||
Public Sub SendCollidePaddle()
|
||||
Dim lMsg As Long
|
||||
Dim lOffset As Long, oBuf() As Byte
|
||||
|
||||
If gfNoSendData Then Exit Sub
|
||||
If Not gfMultiplayer Then Exit Sub
|
||||
'Here we will tell the host we are ready to play
|
||||
lMsg = MsgCollidePaddle
|
||||
AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
|
||||
'We will send this information to the other player only
|
||||
dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
|
||||
End Sub
|
||||
|
||||
@@ -0,0 +1,639 @@
|
||||
Attribute VB_Name = "modAirHockey"
|
||||
Option Explicit
|
||||
|
||||
Public dx As New DirectX8
|
||||
|
||||
Public Type HockeyPlayerInfo
|
||||
Score As Long 'Current score of this player
|
||||
PlayerName As String ' The name of the player
|
||||
Latency As Long 'Average latency (ping time) of this player
|
||||
End Type
|
||||
|
||||
'Declare for timeGetTime
|
||||
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
|
||||
|
||||
'Registry constants (for saving and retreiving information)
|
||||
Public Const gsKeyName As String = "vbAirHockey"
|
||||
Public Const gsSubKey As String = "Defaults"
|
||||
Public Const gsSubKeyAudio As String = "Audio"
|
||||
Public Const gsSubKeyInput As String = "Input"
|
||||
Public Const gsSubKeyGraphics As String = "Graphics"
|
||||
|
||||
Public Const glMaxPuckSpeedConstant As Long = 10.23
|
||||
|
||||
'The wall locations, use these for easier collision detection
|
||||
Public Const gnSideRightWallEdge As Single = -5
|
||||
Public Const gnSideLeftWallEdge As Single = 5
|
||||
Public Const gnNearWallEdge As Single = 9.92
|
||||
Public Const gnFarWallEdge As Single = -9.92
|
||||
'We also need the dimensions for the 'scoring area' so we can tell when we score
|
||||
Public Const gnScoringEdgeLeft As Single = 1.35
|
||||
Public Const gnScoringEdgeRight As Single = -1.35
|
||||
|
||||
Public Const gnPuckScored As Single = 1.15
|
||||
'Radius constants for the puck and paddle
|
||||
Public Const gnPuckRadius As Single = 0.46046
|
||||
Public Const gnPaddleRadius As Single = 0.6
|
||||
'ComputerAI Maximum velocity
|
||||
Public Const gnComputerMaximumVelocity As Single = 0.43
|
||||
'Winning score
|
||||
Public Const glDefaultWinningScore As Long = 7
|
||||
|
||||
'We will ensure that we have at least a particular number of physics calculations per second
|
||||
'We will lower frame rate to ensure we can calculate these physic calculations if necessary
|
||||
'Number of physics calculations per second
|
||||
Public Const glNumPhysicCalcPerSec As Long = 100
|
||||
'Ticks between physic calcs
|
||||
Public Const glNumTickForPhysicCalcs As Long = 1000 \ glNumPhysicCalcPerSec
|
||||
|
||||
'Minimum delay before allowing another paddle hit
|
||||
Public Const glMinDelayPaddleHit = 100
|
||||
'Delay time (ms) before 'helper' text appears
|
||||
Public Const glDefaultDelayTime As Long = 3000
|
||||
'Delay time (ms) before 'helper' text disappears
|
||||
Public Const glDefaultDelayTimeGone As Long = 10000
|
||||
Public Const gnVelocityBoost As Single = 1.1
|
||||
|
||||
'The objects that can appear in the scene
|
||||
Public goCamera As cCamera 'Doesn't really appear in the scene, but it does control what we see in the scene
|
||||
Public goPuck As cPuck 'The puck. Pretty important
|
||||
Public goPaddle(1) As cPaddle 'There are two paddles
|
||||
Public goTable As cTable 'The table will never have a destination or a velocity, but we may need to move it's position
|
||||
Public goRoom As cRoom 'The room information
|
||||
Public goAudio As cAudio 'All of the audio information will be stored here
|
||||
Public goInput As cInput 'All of the input (mouse,keyboard, joystick,etc) will be stored here
|
||||
Public goFade As cFade 'The 'Fading' class
|
||||
'Text variables
|
||||
Public goTextLittle As cText
|
||||
Public goTextBig As cText
|
||||
'Main 'Select device' form
|
||||
Public goDev As frmSelectDevice
|
||||
|
||||
'Which paddle am I controlling (Used mainly for multiplayer mode)
|
||||
Public glMyPaddleID As Long
|
||||
Public gfScored As Boolean 'Is the puck in the scored state
|
||||
Public gfMultiplayer As Boolean 'Is this a multiplayer game
|
||||
Public gfHost As Boolean 'Am I the host of this game?
|
||||
Public gfGameCanBeStarted As Boolean 'Can the game be started
|
||||
Public gPlayer(1) As HockeyPlayerInfo 'Current information of all the players
|
||||
Public gfRecentlyHitPaddle As Boolean 'Have we recently hit a paddle?
|
||||
'Current time for all objects
|
||||
Public glTimeCompPaddle As Long
|
||||
'Is the game over (ie, has someone won the game)
|
||||
Public gfGameOver As Boolean
|
||||
'The user defined winning score
|
||||
Public glUserWinningScore As Long
|
||||
Public glPaddleCollideTime As Long
|
||||
'We'll maintain a slight dampening factor for realism as the puck bounces off
|
||||
'the wall
|
||||
Public gnVelocityDamp As Single
|
||||
'Paddle mass
|
||||
Public gnPaddleMass As Single
|
||||
'Time the puck was last scored
|
||||
Public glTimePuckScored As Long
|
||||
'Time the game was over
|
||||
Public glTimeGameOver As Long
|
||||
'Time the F1 help was displayed
|
||||
Public glTimeNoRoom As Long
|
||||
'Is the system paused
|
||||
Public gfSystemPause As Boolean
|
||||
|
||||
Public gfDrawRoomText As Boolean
|
||||
Public glScreenWidth As Long
|
||||
Public glScreenHeight As Long
|
||||
|
||||
Public gfObjectsLoaded As Boolean
|
||||
|
||||
'Extra misc vars
|
||||
Public gfWireFrame As Boolean
|
||||
|
||||
Public Sub MainGameLoop()
|
||||
Dim lTime As Long
|
||||
Dim lLastPhysicsTime As Long
|
||||
|
||||
'Start the render loop
|
||||
lTime = timeGetTime
|
||||
Do While True
|
||||
Do While Not gfSystemPause
|
||||
'In each frame we need to do a few things
|
||||
If (timeGetTime - lTime > 100) And (Not gfDrawRoomText) And (goRoom.DrawRoom) Then
|
||||
'We want to maintain a reasonable frame rate (10fps is on
|
||||
'the low end), so if we start taking too long between updates,
|
||||
'tell them they can get rid of the room
|
||||
gfDrawRoomText = True
|
||||
glTimeNoRoom = timeGetTime
|
||||
End If
|
||||
lTime = timeGetTime
|
||||
'Check to see if the game is over
|
||||
CheckGameOver
|
||||
'We need to update any objects that are in the scene
|
||||
UpdateObjects
|
||||
'Get and handle any input
|
||||
goInput.GetAndHandleInput goPaddle(glMyPaddleID), goPuck
|
||||
If (Not gfScored) And (Not gfGameOver) Then
|
||||
'Next we need to check for any collisions that may have happened
|
||||
goPuck.CheckCollisions goPaddle, goAudio
|
||||
If Not gfMultiplayer Then 'Only on single player mode
|
||||
'Let the Computer AI do it's thing
|
||||
goPaddle(Abs(glMyPaddleID - 1)).DoComputerAI goPuck
|
||||
End If
|
||||
End If
|
||||
'We need to update the game state on the other machine
|
||||
If gfMultiplayer Then
|
||||
UpdateNetworkSettings
|
||||
Else
|
||||
If gfScored Then goPaddle(Abs(glMyPaddleID - 1)).UpdateTime
|
||||
End If
|
||||
'Only redraw the world if we're keeping up with our physic calculations
|
||||
If timeGetTime - lLastPhysicsTime < glNumTickForPhysicCalcs Then
|
||||
'We should fade if necessary
|
||||
If goFade.AmFading Then goFade.UpdateFade goPuck, goPaddle, goTable, goRoom
|
||||
'Now we need to render the frame
|
||||
Render
|
||||
End If
|
||||
lLastPhysicsTime = timeGetTime
|
||||
DoEvents
|
||||
Loop
|
||||
'Now give the CPU a chance
|
||||
DoEvents
|
||||
Loop
|
||||
End Sub
|
||||
|
||||
Public Sub LoadDefaultStartPositions()
|
||||
'Our camera will start away from the table, and zoom in on it
|
||||
With goCamera
|
||||
.Position = vec3(0, 35, -40)
|
||||
.LastPosition = .Position
|
||||
End With
|
||||
goCamera.SetCameraPosition 0, glMyPaddleID
|
||||
'The puck's initial position should be on top of the table
|
||||
With goPaddle(0)
|
||||
.Position = vec3(0, 2.5, -6.8)
|
||||
.LastPosition = .Position
|
||||
End With
|
||||
With goPaddle(1)
|
||||
.Position = vec3(0, 2.5, 6.8)
|
||||
.LastPosition = .Position
|
||||
End With
|
||||
With goTable
|
||||
.Position = vec3(0, -5, 0)
|
||||
End With
|
||||
goPuck.DefaultStartPosition
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub UpdateObjects()
|
||||
'We need a timer for each of the objects we're updating
|
||||
Dim lCount As Long
|
||||
|
||||
If gfMultiplayer And gfNoSendData Then 'Uh oh! We've been disconnected sometime, no need to process anything
|
||||
Exit Sub
|
||||
End If
|
||||
'Update the camera's position based on it's velocity
|
||||
goCamera.UpdatePosition
|
||||
'Update the puck's position
|
||||
goPuck.UpdatePosition
|
||||
End Sub
|
||||
|
||||
Public Sub CheckGameOver()
|
||||
Dim lCount As Long
|
||||
|
||||
If gfGameOver Then Exit Sub
|
||||
For lCount = 0 To 1
|
||||
If gPlayer(lCount).Score >= glUserWinningScore Then
|
||||
'Make sure we're leading the other player by 2 or more
|
||||
If gPlayer(lCount).Score > gPlayer(Abs(lCount - 1)).Score + 1 Then
|
||||
gfGameOver = True
|
||||
glTimeGameOver = timeGetTime
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End Sub
|
||||
|
||||
Public Sub ShowStartup()
|
||||
|
||||
'Now 'zoom' in with our camera
|
||||
Do While ((goCamera.Dest.Y <> goCamera.Position.Y) Or (goCamera.Dest.z <> goCamera.Position.z))
|
||||
goCamera.UpdatePosition
|
||||
Render
|
||||
DoEvents
|
||||
Loop
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub LoadObjects()
|
||||
|
||||
If gfObjectsLoaded Then Exit Sub
|
||||
'Initialize the objects
|
||||
Set goPuck = New cPuck
|
||||
Set goPaddle(0) = New cPaddle
|
||||
goPaddle(0).PaddleID = 0
|
||||
Set goPaddle(1) = New cPaddle
|
||||
goPaddle(1).PaddleID = 1
|
||||
If goCamera Is Nothing Then Set goCamera = New cCamera
|
||||
Set goTable = New cTable
|
||||
Set goRoom = New cRoom
|
||||
|
||||
If goInput Is Nothing Then Set goInput = New cInput
|
||||
If goAudio Is Nothing Then Set goAudio = New cAudio
|
||||
If goFade Is Nothing Then Set goFade = New cFade
|
||||
If goDev Is Nothing Then Set goDev = New frmSelectDevice
|
||||
|
||||
D3DEnum_BuildAdapterList frmAir
|
||||
|
||||
'Get any defaults from the registry we might need
|
||||
goTable.DrawTable = GetSetting(gsKeyName, gsSubKey, "DrawTable", True)
|
||||
goRoom.DrawRoom = GetSetting(gsKeyName, gsSubKey, "DrawRoom", True)
|
||||
goRoom.barRoom = GetSetting(gsKeyName, gsSubKey, "RoomIsBarRoom", True)
|
||||
|
||||
'Audio options
|
||||
goAudio.PlayMusic = GetSetting(gsKeyName, gsSubKeyAudio, "UseBackgroundMusic", False)
|
||||
goAudio.PlaySounds = GetSetting(gsKeyName, gsSubKeyAudio, "UseSound", True)
|
||||
goAudio.MusicVolume = GetSetting(gsKeyName, gsSubKeyAudio, "MusicVolume", 0)
|
||||
goAudio.SoundVolume = GetSetting(gsKeyName, gsSubKeyAudio, "SoundVolume", 0)
|
||||
'Input options
|
||||
goInput.UseMouse = GetSetting(gsKeyName, gsSubKeyInput, "UseMouse", True)
|
||||
goInput.UseKeyboard = GetSetting(gsKeyName, gsSubKeyInput, "UseKeyboard", True)
|
||||
goInput.UseJoystick = GetSetting(gsKeyName, gsSubKeyInput, "UseJoystick", False)
|
||||
goInput.JoystickGuid = GetSetting(gsKeyName, gsSubKeyInput, "JoystickGuid", vbNullString)
|
||||
goInput.JoystickSensitivity = GetSetting(gsKeyName, gsSubKeyInput, "JoystickSensitivity", 0.00025)
|
||||
goInput.MouseSensitivity = GetSetting(gsKeyName, gsSubKeyInput, "MouseSensitivity", 0.02)
|
||||
goInput.KeyboardSensitivity = GetSetting(gsKeyName, gsSubKeyInput, "KeyboardSensitivity", 0.002)
|
||||
'D3D options
|
||||
goDev.Windowed = GetSetting(gsKeyName, gsSubKeyGraphics, "Windowed", True)
|
||||
goDev.Adapter = GetSetting(gsKeyName, gsSubKeyGraphics, "AdapterID", 0)
|
||||
goDev.Mode = GetSetting(gsKeyName, gsSubKeyGraphics, "Mode", 0)
|
||||
|
||||
gfObjectsLoaded = True
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub PauseSystem(ByVal fPause As Boolean)
|
||||
gfSystemPause = fPause
|
||||
If Not fPause Then
|
||||
glTimeCompPaddle = timeGetTime
|
||||
End If
|
||||
If Not (goPuck Is Nothing) Then
|
||||
goPuck.PauseSystem fPause
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub Cleanup(Optional fFinalCleanup As Boolean = False, Optional fOnlyD3D As Boolean = False)
|
||||
|
||||
'Getting rid of the objects will clean up the internal objects
|
||||
If fFinalCleanup Then
|
||||
Set goPuck = Nothing
|
||||
Set goPaddle(0) = Nothing
|
||||
Set goPaddle(1) = Nothing
|
||||
Set goTable = Nothing
|
||||
Set goRoom = Nothing
|
||||
Set goTextBig = Nothing
|
||||
Set goTextLittle = Nothing
|
||||
If Not fOnlyD3D Then
|
||||
Set goInput = Nothing
|
||||
Set goAudio = Nothing
|
||||
Set goFade = Nothing
|
||||
Set goDev = Nothing
|
||||
End If
|
||||
gfObjectsLoaded = False
|
||||
Else
|
||||
goPuck.CleanupFrame
|
||||
goPaddle(0).CleanupFrame
|
||||
goPaddle(1).CleanupFrame
|
||||
goTable.CleanupFrame
|
||||
goRoom.CleanupFrame
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub InitGeometry()
|
||||
|
||||
LoadObjects
|
||||
'First set up the media
|
||||
D3DUtil_SetMediaPath AddDirSep(App.path) & "models\"
|
||||
goRoom.Init g_mediaPath, "room.x", "lobby_skybox.x"
|
||||
frmAir.IncreaseProgressBar
|
||||
goPaddle(1).Init g_mediaPath, "paddle.x"
|
||||
frmAir.IncreaseProgressBar
|
||||
goPaddle(0).Init g_mediaPath, "paddle.x"
|
||||
frmAir.IncreaseProgressBar
|
||||
goPuck.Init g_mediaPath, "puck.x"
|
||||
frmAir.IncreaseProgressBar
|
||||
goTable.Init g_mediaPath, "table.x"
|
||||
frmAir.IncreaseProgressBar
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub Render()
|
||||
|
||||
Dim lCount As Long
|
||||
|
||||
On Error Resume Next
|
||||
If gfSystemPause Then Exit Sub
|
||||
If g_dev Is Nothing Then Exit Sub
|
||||
|
||||
' Clear the backbuffer to a black color
|
||||
If gfMultiplayer And gfNoSendData Then 'Uh oh! We've been disconnected sometime, notify the user
|
||||
D3DUtil_ClearAll &HFF0000FF 'Clear with a blue background
|
||||
Else
|
||||
D3DUtil_ClearAll 0
|
||||
|
||||
' Setup the view and projection matrices
|
||||
SetupMatrices
|
||||
|
||||
' Begin the scene
|
||||
g_dev.BeginScene
|
||||
|
||||
'Draw everything in either a solid fillmode, or wireframe
|
||||
If gfWireFrame Then
|
||||
g_dev.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME
|
||||
Else
|
||||
g_dev.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID
|
||||
End If
|
||||
|
||||
If goFade.AmFading Then
|
||||
g_dev.SetRenderState D3DRS_ALPHABLENDENABLE, 1 'TRUE
|
||||
g_dev.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
|
||||
g_dev.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
|
||||
End If
|
||||
|
||||
'Render the room
|
||||
goRoom.Render g_dev
|
||||
|
||||
'Render the table
|
||||
goTable.Render g_dev
|
||||
|
||||
'Now Paddle (0)
|
||||
goPaddle(0).Render g_dev
|
||||
|
||||
'Now Paddle (1)
|
||||
goPaddle(1).Render g_dev
|
||||
|
||||
'And finally the puck
|
||||
goPuck.Render g_dev
|
||||
'Now lets draw whatever text we need
|
||||
End If
|
||||
|
||||
'We can draw text (don't draw text if we're currently fading)
|
||||
If Not goFade.AmFading Then
|
||||
goTextLittle.BeginText
|
||||
If gfGameCanBeStarted Then
|
||||
'If the game can be started, then draw the scores at the top of the screen
|
||||
If gfMultiplayer Then
|
||||
If glMyPaddleID = 0 Then
|
||||
goTextLittle.DrawText gsUserName & ":" & gPlayer(0).Score, 10, 5, &HFFFFFF00
|
||||
Else
|
||||
goTextLittle.DrawText "Opponent:" & gPlayer(0).Score, 10, 5, &HFFFFFFFF
|
||||
End If
|
||||
If glMyPaddleID = 1 Then
|
||||
goTextLittle.DrawText gsUserName & ":" & gPlayer(1).Score, glScreenWidth - 75, 5, &HFFFFFF00
|
||||
Else
|
||||
goTextLittle.DrawText "Opponent:" & gPlayer(1).Score, glScreenWidth - 75, 5, &HFFFFFFFF
|
||||
End If
|
||||
Else
|
||||
goTextLittle.DrawText "Player:" & gPlayer(0).Score, 10, 5, &HFFFFFF00
|
||||
goTextLittle.DrawText "Computer:" & gPlayer(1).Score, glScreenWidth - 75, 5, &HFFFFFFFF
|
||||
End If
|
||||
Else
|
||||
'The game can't be started yet (only in multiplayer) Let the host know
|
||||
goTextLittle.DrawText "Waiting for the game to be started...", (glScreenWidth / 2) - 50, 5, &HFFFFFFFF
|
||||
End If
|
||||
'Here is a little helper text letting the user know to press Space
|
||||
'to launch the puck (will show up after 3 seconds, and stay on for 10 seconds)
|
||||
If (timeGetTime - glTimePuckScored > glDefaultDelayTime) And gfScored And Not gfGameOver And ((timeGetTime - glTimePuckScored < glDefaultDelayTimeGone + glDefaultDelayTime)) Then
|
||||
goPuck.DefaultStartPosition
|
||||
goPuck.Spinning = True
|
||||
goTextLittle.DrawText "Press <Space> to launch puck...", (glScreenWidth / 2) - 50, 25, &HFF0000FF
|
||||
End If
|
||||
|
||||
'Here is a little helper text letting the user know to press F1
|
||||
'to turn of the room (will show up after 3 seconds, and stay on for 10 seconds)
|
||||
If (gfDrawRoomText And goRoom.DrawRoom) And (timeGetTime - glTimeNoRoom < glDefaultDelayTimeGone) Then
|
||||
goTextLittle.DrawText "You can press F1 to turn off the drawing " & vbCrLf & " of the room, which will increase performance.", -15, glScreenHeight - 50, &HFFFF00FF
|
||||
End If
|
||||
If gfGameOver And ((timeGetTime - glTimeGameOver) > glDefaultDelayTime) And ((timeGetTime - glTimeGameOver < glDefaultDelayTimeGone + glDefaultDelayTime)) Then
|
||||
goTextLittle.DrawText "Press F3 to restart...", (glScreenWidth / 2) - 50, 25, &HFF0000FF
|
||||
End If
|
||||
goTextLittle.EndText
|
||||
goTextBig.BeginText
|
||||
If gfGameOver Then
|
||||
If gfMultiplayer Then
|
||||
If gPlayer(glMyPaddleID).Score > gPlayer(Abs(glMyPaddleID - 1)).Score Then
|
||||
goTextBig.DrawText "Game over!!" & vbCrLf & "You win!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
|
||||
Else
|
||||
goTextBig.DrawText "Game over!!" & vbCrLf & "You lose!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
|
||||
End If
|
||||
Else
|
||||
If gPlayer(0).Score > gPlayer(1).Score Then
|
||||
goTextBig.DrawText "Game over!!" & vbCrLf & "You win!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
|
||||
Else
|
||||
goTextBig.DrawText "Game over!!" & vbCrLf & "You lose!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
If gfMultiplayer And gfNoSendData Then 'Uh oh! We've been disconnected sometime, notify the user
|
||||
goTextBig.DrawText "The connection with the other" & vbCrLf & "system was lost.", 5, (glScreenHeight / 2) - (glScreenHeight / 4), &HFFFFFF00
|
||||
'This message isn't on a timer to go away
|
||||
End If
|
||||
goTextBig.EndText
|
||||
End If
|
||||
' End the scene
|
||||
g_dev.EndScene
|
||||
' Present the backbuffer contents to the front buffer (screen)
|
||||
D3DUtil_PresentAll 0
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub SetupMatrices()
|
||||
|
||||
Dim matView As D3DMATRIX
|
||||
Dim matProj As D3DMATRIX
|
||||
|
||||
D3DXMatrixLookAtLH matView, goCamera.Position, vec3(0#, 0#, 0#), vec3(0#, 1#, 0#)
|
||||
g_dev.SetTransform D3DTS_VIEW, matView
|
||||
|
||||
D3DXMatrixPerspectiveFovLH matProj, g_pi / 4, 1, 1, 110
|
||||
g_dev.SetTransform D3DTS_PROJECTION, matProj
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub RestoreDeviceObjects()
|
||||
|
||||
' Set miscellaneous render states
|
||||
With g_dev
|
||||
' Set world transform
|
||||
Dim matWorld As D3DMATRIX
|
||||
D3DXMatrixIdentity matWorld
|
||||
.SetTransform D3DTS_WORLD, matWorld
|
||||
|
||||
.SetTextureStageState 0, D3DTSS_COLORARG2, D3DTA_DIFFUSE
|
||||
.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG1
|
||||
.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_DIFFUSE
|
||||
.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
|
||||
.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
|
||||
|
||||
' Set default render states
|
||||
.SetRenderState D3DRS_ZENABLE, 1 'True
|
||||
|
||||
End With
|
||||
|
||||
Set goTextBig = Nothing
|
||||
Set goTextLittle = Nothing
|
||||
|
||||
'Now create a new text object
|
||||
Set goTextLittle = New cText
|
||||
goTextLittle.InitText g_d3dx, g_dev, "Times New Roman", 8, True
|
||||
Set goTextBig = New cText
|
||||
goTextBig.InitText g_d3dx, g_dev, "Times New Roman", 18, True
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub InitDefaultLights(ByVal lNumLights As Long)
|
||||
With g_dev
|
||||
' Set ambient light
|
||||
.SetRenderState D3DRS_AMBIENT, &HFFFFFFFF
|
||||
If lNumLights < 3 Then Exit Sub 'Nothing to do
|
||||
|
||||
' Set ambient light
|
||||
'We will slowly lower the ambient light as each new light gets added
|
||||
.SetRenderState D3DRS_AMBIENT, &HFFBBBBBB
|
||||
' Turn on lighting
|
||||
.SetRenderState D3DRS_LIGHTING, 1
|
||||
|
||||
'Turn on two lights one on each end of the table
|
||||
Dim light As D3DLIGHT8
|
||||
|
||||
If lNumLights > 0 Then
|
||||
With light
|
||||
.Type = D3DLIGHT_DIRECTIONAL
|
||||
.diffuse.r = 1
|
||||
.diffuse.g = 1
|
||||
.diffuse.b = 1
|
||||
.Direction.X = 0
|
||||
.Direction.Y = -10
|
||||
.Direction.z = 0
|
||||
.Range = 1.84467435229094E+19 'User defined.
|
||||
.Position.X = 0
|
||||
.Position.Y = 3
|
||||
.Position.z = 0
|
||||
End With
|
||||
|
||||
.SetLight 0, light 'let d3d know about the light
|
||||
.LightEnable 0, 1 'turn it on
|
||||
End If
|
||||
|
||||
|
||||
If lNumLights > 1 Then
|
||||
.SetRenderState D3DRS_AMBIENT, &HFFAAAAAA
|
||||
'Now turn on the second light if we can
|
||||
With light
|
||||
.Type = D3DLIGHT_DIRECTIONAL
|
||||
.Direction.X = 5
|
||||
.Direction.Y = -3
|
||||
.Direction.z = -5
|
||||
.Position.X = -5
|
||||
.Position.Y = 3
|
||||
.Position.z = 5
|
||||
End With
|
||||
|
||||
.SetLight 1, light 'let d3d know about the light
|
||||
.LightEnable 1, 1 'turn it on
|
||||
End If
|
||||
|
||||
|
||||
If lNumLights > 3 Then
|
||||
.SetRenderState D3DRS_AMBIENT, 0
|
||||
'Now turn on the third light if we can
|
||||
With light
|
||||
.Type = D3DLIGHT_DIRECTIONAL
|
||||
.Direction.X = -5
|
||||
.Direction.Y = 3
|
||||
.Direction.z = 5
|
||||
.Position.X = 5
|
||||
.Position.Y = -3
|
||||
.Position.z = -5
|
||||
End With
|
||||
|
||||
.SetLight 2, light 'let d3d know about the light
|
||||
.LightEnable 2, 1 'turn it on
|
||||
End If
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Public Sub SaveOrRestoreObjectSettings(ByVal fSave As Boolean)
|
||||
'Puck
|
||||
Static LastPuckPosition As D3DVECTOR
|
||||
Static PuckPosition As D3DVECTOR
|
||||
Static MaxPuckVel As Single
|
||||
Static PuckSpinning As Boolean
|
||||
Static PuckVelocity As D3DVECTOR
|
||||
|
||||
If fSave Then
|
||||
LastPuckPosition = goPuck.LastPosition
|
||||
MaxPuckVel = goPuck.MaximumPuckVelocity
|
||||
PuckPosition = goPuck.Position
|
||||
PuckSpinning = goPuck.Spinning
|
||||
PuckVelocity = goPuck.Velocity
|
||||
Else
|
||||
goPuck.LastPosition = LastPuckPosition
|
||||
goPuck.MaximumPuckVelocity = MaxPuckVel
|
||||
goPuck.Position = PuckPosition
|
||||
goPuck.Spinning = PuckSpinning
|
||||
goPuck.Velocity = PuckVelocity
|
||||
End If
|
||||
|
||||
'paddles
|
||||
Static LastPaddlePosition(1) As D3DVECTOR
|
||||
Static LastPaddleVelTick(1) As Long
|
||||
Static PaddleID(1) As Long
|
||||
Static PaddlePosition(1) As D3DVECTOR
|
||||
Static PaddleTrans(1) As Boolean
|
||||
Static PaddleVelocity(1) As D3DVECTOR
|
||||
|
||||
Dim i As Integer
|
||||
If fSave Then
|
||||
For i = 0 To 1
|
||||
LastPaddlePosition(i) = goPaddle(i).LastPosition
|
||||
LastPaddleVelTick(i) = goPaddle(i).LastVelocityTick
|
||||
PaddleID(i) = goPaddle(i).PaddleID
|
||||
PaddlePosition(i) = goPaddle(i).Position
|
||||
PaddleTrans(i) = goPaddle(i).Transparent
|
||||
PaddleVelocity(i) = goPaddle(i).Velocity
|
||||
Next
|
||||
Else
|
||||
For i = 0 To 1
|
||||
goPaddle(i).LastPosition = LastPaddlePosition(i)
|
||||
goPaddle(i).LastVelocityTick = LastPaddleVelTick(i)
|
||||
goPaddle(i).PaddleID = PaddleID(i)
|
||||
goPaddle(i).Position = PaddlePosition(i)
|
||||
goPaddle(i).Transparent = PaddleTrans(i)
|
||||
goPaddle(i).Velocity = PaddleVelocity(i)
|
||||
Next
|
||||
End If
|
||||
|
||||
'Room
|
||||
Static barRoom As Boolean
|
||||
Static DrawRoom As Boolean
|
||||
If fSave Then
|
||||
barRoom = goRoom.barRoom
|
||||
DrawRoom = goRoom.DrawRoom
|
||||
Else
|
||||
goRoom.barRoom = barRoom
|
||||
goRoom.DrawRoom = DrawRoom
|
||||
End If
|
||||
|
||||
'Table
|
||||
Static DrawTable As Boolean
|
||||
Static TablePosition As D3DVECTOR
|
||||
Static TableTrans As Boolean
|
||||
|
||||
If fSave Then
|
||||
DrawTable = goTable.DrawTable
|
||||
TablePosition = goTable.Position
|
||||
TableTrans = goTable.Transparent
|
||||
Else
|
||||
goTable.DrawTable = DrawTable
|
||||
goTable.Position = TablePosition
|
||||
goTable.Transparent = TableTrans
|
||||
End If
|
||||
|
||||
End Sub
|
||||
@@ -0,0 +1,15 @@
|
||||
Attribute VB_Name = "modMisc"
|
||||
Option Explicit
|
||||
|
||||
Public Function aCos(dCos As Double) As Double
|
||||
On Error Resume Next 'Assume any errors mean the aCos = 0
|
||||
'Here we will figure out the arccosine..
|
||||
aCos = Atn(Sqr(1 - (dCos * dCos)) / dCos)
|
||||
End Function
|
||||
|
||||
Public Sub PrintVector(vec As D3DVECTOR, Optional ByVal s As String = vbNullString)
|
||||
With vec
|
||||
Debug.Print s; " X="; .x; " Y="; .y; " Z="; .z
|
||||
End With
|
||||
End Sub
|
||||
|
||||
@@ -0,0 +1,41 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: Air Hockey Demo
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
This application demonstrates a simple peer-peer (or single player) Air Hockey
|
||||
Game.
|
||||
|
||||
In Single player mode, a crude computer AI will be your opponent. You can
|
||||
dictate numerous settings in the game, including overall 'speed' of the game as
|
||||
well as score to win (although the computer always enforces the rule that you
|
||||
must win by 2).
|
||||
|
||||
The multiplayer mode is similar to the single player mode, with the exception of
|
||||
no computer AI.
|
||||
|
||||
Please note, if you try to run this sample from the source tree it will most likely
|
||||
fail due to lack of media. The 'models' and 'sounds' folders must be in the same folder
|
||||
as where you run the sample from (by default these folders are in the 'bin' folder).
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\Demos\AirHockey
|
||||
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\Demos\bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
Press Space to launch the puck. Use the mouse (or arrow keys on your keyboard, or joystick)
|
||||
to control your paddle.
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
This sample shows many of the directX components working together.
|
||||
@@ -0,0 +1,394 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmSelectDevice
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "Select Device"
|
||||
ClientHeight = 2805
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 6045
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 2805
|
||||
ScaleWidth = 6045
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.Frame optRenderingModeoptRenderingMode
|
||||
Caption = "Rendering Mode"
|
||||
Height = 1335
|
||||
Left = 120
|
||||
TabIndex = 7
|
||||
Top = 1320
|
||||
Width = 4575
|
||||
Begin VB.ComboBox cboFullScreenMode
|
||||
Enabled = 0 'False
|
||||
Height = 315
|
||||
Left = 2040
|
||||
Style = 2 'Dropdown List
|
||||
TabIndex = 10
|
||||
Top = 720
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.OptionButton optRenderingMode
|
||||
Caption = "&Fullscreen mode"
|
||||
Height = 375
|
||||
Index = 1
|
||||
Left = 240
|
||||
TabIndex = 9
|
||||
Top = 690
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.OptionButton optRenderingMode
|
||||
Caption = "Use desktop &window"
|
||||
Height = 375
|
||||
Index = 0
|
||||
Left = 240
|
||||
TabIndex = 8
|
||||
Top = 240
|
||||
Value = -1 'True
|
||||
Width = 1815
|
||||
End
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Cancel = -1 'True
|
||||
Caption = "Cancel"
|
||||
Height = 375
|
||||
Left = 4800
|
||||
TabIndex = 4
|
||||
Top = 720
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdOk
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 375
|
||||
Left = 4800
|
||||
TabIndex = 3
|
||||
Top = 240
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Frame Frame1
|
||||
Caption = "Rendering device"
|
||||
Height = 1095
|
||||
Left = 120
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 4575
|
||||
Begin VB.ComboBox cboDevice
|
||||
Height = 315
|
||||
Left = 1440
|
||||
Style = 2 'Dropdown List
|
||||
TabIndex = 6
|
||||
Top = 600
|
||||
Width = 2775
|
||||
End
|
||||
Begin VB.ComboBox cboAdapter
|
||||
Height = 315
|
||||
Left = 1440
|
||||
Style = 2 'Dropdown List
|
||||
TabIndex = 2
|
||||
Top = 240
|
||||
Width = 2775
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
AutoSize = -1 'True
|
||||
Caption = "D3D &device:"
|
||||
Height = 195
|
||||
Left = 360
|
||||
TabIndex = 5
|
||||
Top = 660
|
||||
Width = 900
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
AutoSize = -1 'True
|
||||
Caption = "&Adapter:"
|
||||
Height = 195
|
||||
Left = 360
|
||||
TabIndex = 1
|
||||
Top = 300
|
||||
Width = 600
|
||||
End
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmSelectDevice"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
|
||||
Dim m_callback As Object
|
||||
|
||||
Public Sub SelectDevice(callback As Object)
|
||||
|
||||
If callback Is Nothing Then Exit Sub
|
||||
Set m_callback = callback
|
||||
|
||||
Dim dm As D3DDISPLAYMODE
|
||||
|
||||
If g_d3dpp.Windowed = 0 Then
|
||||
|
||||
m_callback.InvalidateDeviceObjects
|
||||
|
||||
D3DUtil_ResetWindowed
|
||||
|
||||
m_callback.RestoreDeviceObjects
|
||||
|
||||
End If
|
||||
|
||||
Me.Show 1
|
||||
|
||||
Set m_callback = Nothing
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub cboAdapter_Click()
|
||||
|
||||
Dim devtype As CONST_D3DDEVTYPE
|
||||
|
||||
If (cboDevice.ListIndex = 1) Then
|
||||
devtype = D3DDEVTYPE_REF
|
||||
Else
|
||||
devtype = D3DDEVTYPE_HAL
|
||||
End If
|
||||
|
||||
Call UpdateModes(cboAdapter.ListIndex, devtype)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub cboDevice_Change()
|
||||
|
||||
Dim devtype As CONST_D3DDEVTYPE
|
||||
|
||||
If (cboDevice.ListIndex = 1) Then
|
||||
devtype = D3DDEVTYPE_REF
|
||||
Else
|
||||
devtype = D3DDEVTYPE_HAL
|
||||
End If
|
||||
|
||||
Call UpdateModes(cboAdapter.ListIndex, devtype)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub cmdCancel_Click()
|
||||
|
||||
Set m_callback = Nothing
|
||||
Me.Hide
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub UpdateNow(callback As Object)
|
||||
|
||||
On Local Error Resume Next
|
||||
|
||||
Dim bAdapterChanged As Boolean
|
||||
Dim bRasterizerChanged As Boolean
|
||||
Dim bRef As Boolean
|
||||
Dim lWindowed As Long
|
||||
Dim AdapterID As Long
|
||||
Dim ModeID As Long
|
||||
Dim devtype As CONST_D3DDEVTYPE
|
||||
|
||||
If callback Is Nothing Then Exit Sub
|
||||
Set m_callback = callback
|
||||
|
||||
AdapterID = cboAdapter.ListIndex
|
||||
ModeID = cboFullScreenMode.ListIndex
|
||||
|
||||
' see if user changed adapters
|
||||
If g_lCurrentAdapter <> AdapterID Then bAdapterChanged = True
|
||||
|
||||
bRef = g_Adapters(g_lCurrentAdapter).bReference
|
||||
|
||||
If (cboDevice.ListIndex = 1) Then
|
||||
devtype = D3DDEVTYPE_REF
|
||||
Else
|
||||
devtype = D3DDEVTYPE_HAL
|
||||
End If
|
||||
|
||||
' see if user changed rasterizers
|
||||
If (devtype = D3DDEVTYPE_REF And bRef = False) Then bRasterizerChanged = True
|
||||
If (devtype = D3DDEVTYPE_HAL And bRef = True) Then bRasterizerChanged = True
|
||||
|
||||
|
||||
If optRenderingMode(1).Value = True Then
|
||||
lWindowed = 0
|
||||
Else
|
||||
lWindowed = 1
|
||||
End If
|
||||
|
||||
' if they didnt change adapters or switch to refrast, then we can just use reset
|
||||
If bAdapterChanged = False And bRasterizerChanged = False Then
|
||||
|
||||
'If trying to go Fullscreen
|
||||
If lWindowed = 0 Then
|
||||
|
||||
'call g_dev.reset
|
||||
Call D3DUtil_ResizeFullscreen(g_focushwnd, cboFullScreenMode.ListIndex)
|
||||
|
||||
Else
|
||||
|
||||
Call D3DUtil_ResizeWindowed(g_focushwnd)
|
||||
|
||||
End If
|
||||
|
||||
'tell user needs to restore device objects
|
||||
m_callback.RestoreDeviceObjects
|
||||
|
||||
'exit modal dialog
|
||||
Unload Me
|
||||
Exit Sub
|
||||
|
||||
End If
|
||||
|
||||
Set g_dev = Nothing
|
||||
|
||||
D3DUtil_ReleaseAllTexturesFromPool
|
||||
|
||||
'tell user to lose reference counts in its objects device objects
|
||||
m_callback.InvalidateDeviceObjects
|
||||
m_callback.DeleteDeviceObjects
|
||||
|
||||
'Reinitialize D3D
|
||||
If lWindowed = 0 Then
|
||||
D3DUtil_InitFullscreen g_focushwnd, AdapterID, ModeID, devtype, True
|
||||
Else
|
||||
D3DUtil_InitWindowed g_focushwnd, AdapterID, devtype, True
|
||||
End If
|
||||
|
||||
|
||||
'tell user to re-create device objects
|
||||
m_callback.InitDeviceObjects
|
||||
|
||||
'tell user to restore device objects
|
||||
m_callback.RestoreDeviceObjects
|
||||
|
||||
'exit modal dialog
|
||||
Unload Me
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOk_Click()
|
||||
Set m_callback = Nothing
|
||||
Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
|
||||
Call UpdateAdapters
|
||||
Call UpdateDevices(g_lCurrentAdapter)
|
||||
Call UpdateModes(g_lCurrentAdapter, g_Adapters(g_lCurrentAdapter).DeviceType)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub UpdateAdapters()
|
||||
|
||||
Dim i As Long
|
||||
Dim sDescription As String
|
||||
|
||||
cboAdapter.Clear
|
||||
|
||||
For i = 0 To g_lNumAdapters - 1
|
||||
sDescription = vbNullString
|
||||
sDescription = StrConv(g_Adapters(i).d3dai.Description, vbUnicode)
|
||||
cboAdapter.AddItem sDescription
|
||||
Next
|
||||
|
||||
cboAdapter.ListIndex = g_lCurrentAdapter
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub UpdateDevices(Adapter As Long)
|
||||
|
||||
Dim i As Long
|
||||
|
||||
cboDevice.Clear
|
||||
|
||||
cboDevice.AddItem "HAL"
|
||||
cboDevice.AddItem "REF"
|
||||
|
||||
'If g_Adapters(g_lCurrentAdapter).bReference Then
|
||||
If g_Adapters(Adapter).bReference Then
|
||||
cboDevice.ListIndex = 1
|
||||
Else
|
||||
cboDevice.ListIndex = 0
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub UpdateModes(Adapter As Long, devtype As CONST_D3DDEVTYPE)
|
||||
|
||||
Dim i As Long
|
||||
Dim pAdapter As D3DUTIL_ADAPTERINFO
|
||||
Dim sModeString As String
|
||||
|
||||
cboFullScreenMode.Clear
|
||||
|
||||
With g_Adapters(Adapter).DevTypeInfo(devtype)
|
||||
For i = 0 To .lNumModes - 1
|
||||
sModeString = .Modes(i).lWidth & " x "
|
||||
sModeString = sModeString & .Modes(i).lHeight & " x "
|
||||
If .Modes(i).format = D3DFMT_X8R8G8B8 Or _
|
||||
.Modes(i).format = D3DFMT_A8R8G8B8 Or _
|
||||
.Modes(i).format = D3DFMT_R8G8B8 Then
|
||||
sModeString = sModeString & "32"
|
||||
Else
|
||||
sModeString = sModeString & "16"
|
||||
End If
|
||||
|
||||
cboFullScreenMode.AddItem sModeString
|
||||
Next
|
||||
If cboFullScreenMode.ListCount > 0 Then cboFullScreenMode.ListIndex = .lCurrentMode
|
||||
End With
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub optRenderingMode_Click(Index As Integer)
|
||||
|
||||
If Index = 1 Then
|
||||
cboFullScreenMode.Enabled = True
|
||||
Else
|
||||
cboFullScreenMode.Enabled = False
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Public Property Get Windowed() As Boolean
|
||||
Windowed = optRenderingMode(0).Value
|
||||
End Property
|
||||
|
||||
Public Property Get AdapterString() As String
|
||||
AdapterString = cboAdapter.List(cboAdapter.ListIndex)
|
||||
End Property
|
||||
|
||||
Public Property Get Adapter() As Long
|
||||
Adapter = cboAdapter.ListIndex
|
||||
End Property
|
||||
|
||||
Public Property Get ModeString() As String
|
||||
ModeString = cboFullScreenMode.List(cboFullScreenMode.ListIndex)
|
||||
End Property
|
||||
|
||||
Public Property Get Mode() As Long
|
||||
Mode = cboFullScreenMode.ListIndex
|
||||
End Property
|
||||
|
||||
Public Property Let Mode(ByVal lMode As Long)
|
||||
On Error Resume Next 'Just in case
|
||||
cboFullScreenMode.ListIndex = lMode
|
||||
End Property
|
||||
|
||||
Public Property Let Adapter(ByVal lAdapter As Long)
|
||||
cboAdapter.ListIndex = lAdapter
|
||||
End Property
|
||||
|
||||
Public Property Let Windowed(ByVal fWindow As Boolean)
|
||||
If fWindow Then
|
||||
optRenderingMode(0).Value = True
|
||||
Else
|
||||
optRenderingMode(1).Value = True
|
||||
End If
|
||||
End Property
|
||||
|
||||
@@ -0,0 +1,60 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=frmAir.frm
|
||||
Module=modAirHockey; modHelper.bas
|
||||
Class=CD3DFrame; d3dFrame.cls
|
||||
Class=CD3DMesh; d3dMesh.cls
|
||||
Class=CD3DPick; d3dPick.cls
|
||||
Module=D3DUtil; d3dutil.bas
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
Module=D3DInit; d3dinit.bas
|
||||
Form=selectDevice.frm
|
||||
Module=modDplay; modDplay.bas
|
||||
Form=frmSplash.frm
|
||||
Form=..\..\common\DplayCon.frm
|
||||
Class=CD3DAnimation; d3dAnimation.cls
|
||||
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
|
||||
Class=cPuck; cPuck.cls
|
||||
Class=cPaddle; cPaddle.cls
|
||||
Class=cCamera; cCamera.cls
|
||||
Class=cAudio; cAudio.cls
|
||||
Class=cAudioFile; cAudioFile.cls
|
||||
Class=cTable; cTable.cls
|
||||
Class=cText; cText.cls
|
||||
Class=cRoom; cRoom.cls
|
||||
Class=cInput; cInput.cls
|
||||
Form=frmGraphics.frm
|
||||
Form=frmInput.frm
|
||||
Form=frmAudio.frm
|
||||
Class=cFade; cFade.cls
|
||||
IconForm="frmAir"
|
||||
Startup="frmSplash"
|
||||
HelpFile=""
|
||||
Title="vbair"
|
||||
ExeName32="vb_airhockey.exe"
|
||||
Command32=""
|
||||
Name="vbAir"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,526 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmMain
|
||||
BackColor = &H00000000&
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "Club Metamorphous"
|
||||
ClientHeight = 7140
|
||||
ClientLeft = 3510
|
||||
ClientTop = 1890
|
||||
ClientWidth = 8310
|
||||
ForeColor = &H0000C000&
|
||||
Icon = "ClubMet.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 476
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 554
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.CommandButton cmdExit
|
||||
BackColor = &H0080FF80&
|
||||
Cancel = -1 'True
|
||||
Caption = "Exit"
|
||||
Height = 495
|
||||
Left = 240
|
||||
TabIndex = 12
|
||||
Top = 6600
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdAdmission
|
||||
BackColor = &H00FFC0FF&
|
||||
Caption = "Admission"
|
||||
BeginProperty Font
|
||||
Name = "Times New Roman"
|
||||
Size = 9.75
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 495
|
||||
Left = 240
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 10
|
||||
Top = 6000
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdSpecials
|
||||
BackColor = &H008080FF&
|
||||
Caption = "Dinner Specials"
|
||||
BeginProperty Font
|
||||
Name = "Times New Roman"
|
||||
Size = 9.75
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 495
|
||||
Left = 240
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 9
|
||||
Top = 5400
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdDirections
|
||||
BackColor = &H0080C0FF&
|
||||
Caption = "Directions"
|
||||
BeginProperty Font
|
||||
Name = "Times New Roman"
|
||||
Size = 9.75
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 495
|
||||
Left = 240
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 8
|
||||
Top = 4800
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.PictureBox mnCan
|
||||
BackColor = &H80000007&
|
||||
BorderStyle = 0 'None
|
||||
Height = 3795
|
||||
Left = 2400
|
||||
ScaleHeight = 253
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 385
|
||||
TabIndex = 7
|
||||
Top = 1680
|
||||
Width = 5775
|
||||
End
|
||||
Begin VB.Label lblStuff
|
||||
BackColor = &H80000007&
|
||||
Caption = "Label2"
|
||||
ForeColor = &H8000000E&
|
||||
Height = 1455
|
||||
Left = 2340
|
||||
TabIndex = 11
|
||||
Top = 5580
|
||||
Width = 5835
|
||||
End
|
||||
Begin VB.Label lblSunday
|
||||
AutoSize = -1 'True
|
||||
BackColor = &H00000000&
|
||||
Caption = "Sunday"
|
||||
BeginProperty Font
|
||||
Name = "Times New Roman"
|
||||
Size = 20.25
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
ForeColor = &H0000C000&
|
||||
Height = 465
|
||||
Left = 240
|
||||
TabIndex = 6
|
||||
Top = 4200
|
||||
Width = 1305
|
||||
End
|
||||
Begin VB.Label lblSaturday
|
||||
AutoSize = -1 'True
|
||||
BackColor = &H00000000&
|
||||
Caption = "Saturday"
|
||||
BeginProperty Font
|
||||
Name = "Times New Roman"
|
||||
Size = 20.25
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
ForeColor = &H0000C000&
|
||||
Height = 465
|
||||
Left = 240
|
||||
TabIndex = 5
|
||||
Top = 3600
|
||||
Width = 1605
|
||||
End
|
||||
Begin VB.Label lblFriday
|
||||
AutoSize = -1 'True
|
||||
BackColor = &H00000000&
|
||||
Caption = "Friday"
|
||||
BeginProperty Font
|
||||
Name = "Times New Roman"
|
||||
Size = 20.25
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
ForeColor = &H0000C000&
|
||||
Height = 465
|
||||
Left = 240
|
||||
TabIndex = 4
|
||||
Top = 3000
|
||||
Width = 1185
|
||||
End
|
||||
Begin VB.Label lblThursday
|
||||
AutoSize = -1 'True
|
||||
BackColor = &H00000000&
|
||||
Caption = "Thursday"
|
||||
BeginProperty Font
|
||||
Name = "Times New Roman"
|
||||
Size = 20.25
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
ForeColor = &H0000C000&
|
||||
Height = 465
|
||||
Left = 240
|
||||
TabIndex = 3
|
||||
Top = 2400
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.Label lblWednesday
|
||||
AutoSize = -1 'True
|
||||
BackColor = &H00000000&
|
||||
Caption = "Wednesday"
|
||||
BeginProperty Font
|
||||
Name = "Times New Roman"
|
||||
Size = 20.25
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
ForeColor = &H0000FF00&
|
||||
Height = 465
|
||||
Left = 240
|
||||
TabIndex = 2
|
||||
Top = 1800
|
||||
Width = 2025
|
||||
End
|
||||
Begin VB.Label lblName
|
||||
Alignment = 2 'Center
|
||||
BackColor = &H00000000&
|
||||
Caption = "Club Metamorphous"
|
||||
BeginProperty Font
|
||||
Name = "Times New Roman"
|
||||
Size = 36
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
ForeColor = &H000080FF&
|
||||
Height = 915
|
||||
Left = 480
|
||||
TabIndex = 1
|
||||
Top = 0
|
||||
Width = 7455
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackColor = &H00000000&
|
||||
Caption = """The only thing that stays the same is a good time!"""
|
||||
BeginProperty Font
|
||||
Name = "Times New Roman"
|
||||
Size = 15.75
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = -1 'True
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
ForeColor = &H000080FF&
|
||||
Height = 495
|
||||
Left = 840
|
||||
TabIndex = 0
|
||||
Top = 1020
|
||||
Width = 6855
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmMain"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: ClubMet.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
'This application uses conditional compilation. To run this sample in the IDE, you
|
||||
'must first go to Project Properties (Project Menu-> Properties). Then on the Make tab
|
||||
'change the RunInIDE=0 to RunInIDE=1.
|
||||
|
||||
'This sample also shows developers how to combine the DX7 and DX8 DLL's to create
|
||||
'an app with the latest DMusic and still use older functionality like DDraw
|
||||
|
||||
Private dx As New DXVBLibA.DirectX8
|
||||
Dim day As Integer
|
||||
Dim sJazz As DXVBLibA.DirectMusicStyle8
|
||||
Dim sDance As DXVBLibA.DirectMusicStyle8
|
||||
Dim sBigBand As DXVBLibA.DirectMusicStyle8
|
||||
Dim sDisco As DXVBLibA.DirectMusicStyle8
|
||||
Dim sClassical As DXVBLibA.DirectMusicStyle8
|
||||
Dim sHeartland As DXVBLibA.DirectMusicStyle8
|
||||
Dim cmp As DXVBLibA.DirectMusicChordMap8
|
||||
Dim com As DXVBLibA.DirectMusicComposer8
|
||||
Dim perf As DXVBLibA.DirectMusicPerformance8
|
||||
Dim seg As DXVBLibA.DirectMusicSegment8
|
||||
Dim loader As DXVBLibA.DirectMusicLoader8
|
||||
Dim currentstyle As DXVBLibA.DirectMusicStyle8
|
||||
Dim LabelNumber As Integer
|
||||
Dim runit As Boolean
|
||||
|
||||
Private Sub cmdAdmission_Click()
|
||||
Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(2)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
|
||||
lblStuff.Caption = ChangeStuffLabel(6)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdDirections_Click()
|
||||
|
||||
Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(0)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
|
||||
lblStuff.Caption = ChangeStuffLabel(0)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdExit_Click()
|
||||
runit = False
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSpecials_Click()
|
||||
Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(1)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
|
||||
lblStuff.Caption = ChangeStuffLabel(LabelNumber)
|
||||
End Sub
|
||||
|
||||
|
||||
Private Function ChangeStuffLabel(Index As Integer) As String
|
||||
Dim tString(9) As String
|
||||
|
||||
Call ClearlblStuff
|
||||
|
||||
'directions
|
||||
tString(0) = "Corner of 4th and Stewart, next to the new stadium!"
|
||||
|
||||
'dinners
|
||||
tString(1) = "London Broil with Hollandaise sauce, baby red potatoes, green vegetables, and Lobster Bisque soup."
|
||||
tString(2) = "Grilled Mahi-Mahi on a bed of rice pilaf, green vegetables, and Ceasar salad"
|
||||
tString(3) = "Chicken Cordon Bleu, steamed vegetables, wild lemon rice, and clam chowder"
|
||||
tString(4) = "Bacon CheeseBurger, onion rings, and a vanilla shake"
|
||||
tString(5) = "Salmon in parchment, rice pilaf, green vegetables, and lentil soup."
|
||||
|
||||
'Admission
|
||||
tString(6) = "Age 14 - 18, $4.50, age 19 and up, $7.00"
|
||||
|
||||
ChangeStuffLabel = tString(Index)
|
||||
|
||||
End Function
|
||||
|
||||
Private Sub ClearlblStuff()
|
||||
lblStuff.Caption = ""
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
On Error GoTo err_out
|
||||
Show
|
||||
|
||||
ClearlblStuff
|
||||
|
||||
InitDD hwnd, mnCan
|
||||
DoEvents
|
||||
initDMusic
|
||||
DoEvents
|
||||
|
||||
|
||||
runit = True
|
||||
|
||||
Do
|
||||
MoveFrame day
|
||||
DoEvents
|
||||
Loop
|
||||
|
||||
End
|
||||
err_out:
|
||||
MsgBox "Could not start application!", vbApplicationModal
|
||||
End
|
||||
|
||||
End Sub
|
||||
Private Sub initDMusic()
|
||||
Dim dma As DMUS_AUDIOPARAMS
|
||||
|
||||
On Error GoTo FailedInit
|
||||
Set perf = dx.DirectMusicPerformanceCreate
|
||||
Set com = dx.DirectMusicComposerCreate
|
||||
Set loader = dx.DirectMusicLoaderCreate
|
||||
|
||||
perf.InitAudio Me.hwnd, DMUS_AUDIOF_ALL, dma, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
|
||||
perf.SetMasterAutoDownload True
|
||||
|
||||
'Load the objects
|
||||
#If RunInIDE = 1 Then
|
||||
Dim sMedia As String
|
||||
|
||||
sMedia = FindMediaDir("bigband.sty")
|
||||
If sMedia <> vbNullString Then 'Media is not in current folder
|
||||
If (Left$(sMedia, 2) <> Left$(CurDir, 2)) And (InStr(Left$(sMedia, 2), ":") > 0) Then ChDrive Left$(sMedia, 2)
|
||||
ChDir sMedia
|
||||
End If
|
||||
|
||||
Set sBigBand = loader.LoadStyle("BIGBAND.STY")
|
||||
Set sJazz = loader.LoadStyle("JAZZ.STY")
|
||||
Set sDisco = loader.LoadStyle("DISCO.STY")
|
||||
Set sClassical = loader.LoadStyle("CLASSICAL.STY")
|
||||
Set sDance = loader.LoadStyle("DANCEMIX.STY")
|
||||
Set sHeartland = loader.LoadStyle("HEARTLAND.STY")
|
||||
|
||||
Set currentstyle = sHeartland
|
||||
Set cmp = loader.LoadChordMap("CHORDMAP.CDM")
|
||||
#Else
|
||||
Set sBigBand = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "BIGBAND")
|
||||
Set sJazz = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "JAZZ")
|
||||
Set sDisco = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "DISCO")
|
||||
Set sClassical = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "CLASSICAL")
|
||||
Set sDance = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "DANCEMIX")
|
||||
Set sHeartland = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "HEARTLAND")
|
||||
|
||||
Set currentstyle = sHeartland
|
||||
Set cmp = loader.LoadChordMapFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "CHORDMAP")
|
||||
#End If
|
||||
Set seg = com.ComposeSegmentFromShape(sHeartland, 64, 0, 1, True, False, cmp)
|
||||
Call perf.PlaySegmentEx(seg, 0, 0)
|
||||
Exit Sub
|
||||
|
||||
FailedInit:
|
||||
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
|
||||
Unload Me
|
||||
|
||||
End Sub
|
||||
Private Sub ChangeMusic()
|
||||
Set seg = com.ComposeSegmentFromShape(currentstyle, 64, 0, 2, False, False, cmp)
|
||||
Call com.AutoTransition(perf, seg, DMUS_COMMANDT_FILL, DMUS_COMPOSEF_MEASURE, cmp)
|
||||
End Sub
|
||||
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
runit = False
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
If Not (perf Is Nothing) Then perf.CloseDown
|
||||
End
|
||||
End Sub
|
||||
|
||||
Private Sub lblFriday_Click()
|
||||
ClearlblStuff
|
||||
Set currentstyle = sDisco
|
||||
ChangeMusic
|
||||
day = 2: LabelNumber = 3
|
||||
lblStuff.Caption = LoadMSg(2)
|
||||
End Sub
|
||||
|
||||
Private Sub lblFriday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
|
||||
lblName.Font = "Courier New"
|
||||
lblName.ForeColor = &H8080FF
|
||||
|
||||
lblFriday.ForeColor = &HFF&
|
||||
|
||||
lblWednesday.ForeColor = &HC000&
|
||||
lblThursday.ForeColor = &HC000&
|
||||
lblSaturday.ForeColor = &HC000&
|
||||
lblSunday.ForeColor = &HC000&
|
||||
End Sub
|
||||
|
||||
Private Sub lblSaturday_Click()
|
||||
ClearlblStuff
|
||||
Set currentstyle = sDance
|
||||
ChangeMusic
|
||||
day = 6: LabelNumber = 4
|
||||
lblStuff.Caption = LoadMSg(3)
|
||||
End Sub
|
||||
|
||||
Private Sub lblSaturday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
|
||||
lblName.Font = "Tahoma"
|
||||
lblName.ForeColor = &HC00000
|
||||
|
||||
lblSaturday.ForeColor = &HFF&
|
||||
|
||||
lblWednesday.ForeColor = &HC000&
|
||||
lblThursday.ForeColor = &HC000&
|
||||
lblFriday.ForeColor = &HC000&
|
||||
lblSunday.ForeColor = &HC000&
|
||||
End Sub
|
||||
|
||||
Private Sub lblSunday_Click()
|
||||
ClearlblStuff
|
||||
Set currentstyle = sClassical
|
||||
ChangeMusic
|
||||
day = 5: LabelNumber = 5
|
||||
lblStuff.Caption = LoadMSg(4)
|
||||
End Sub
|
||||
|
||||
Private Sub lblSunday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
lblName.Font = "Garamond"
|
||||
lblName.ForeColor = &HFFC0C0
|
||||
|
||||
lblSunday.ForeColor = &HFF&
|
||||
|
||||
lblWednesday.ForeColor = &HC000&
|
||||
lblThursday.ForeColor = &HC000&
|
||||
lblFriday.ForeColor = &HC000&
|
||||
lblSaturday.ForeColor = &HC000&
|
||||
End Sub
|
||||
|
||||
Private Sub lblThursday_Click()
|
||||
ClearlblStuff
|
||||
Set currentstyle = sJazz
|
||||
ChangeMusic
|
||||
day = 3: LabelNumber = 2
|
||||
lblStuff.Caption = LoadMSg(1)
|
||||
End Sub
|
||||
|
||||
Private Sub lblThursday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
lblName.Font = "Comic Sans MS"
|
||||
lblName.ForeColor = &H80FF80
|
||||
|
||||
lblThursday.ForeColor = &HFF&
|
||||
|
||||
lblWednesday.ForeColor = &HC000&
|
||||
lblFriday.ForeColor = &HC000&
|
||||
lblSaturday.ForeColor = &HC000&
|
||||
lblSunday.ForeColor = &HC000&
|
||||
End Sub
|
||||
|
||||
Private Sub lblWednesday_Click()
|
||||
ClearlblStuff
|
||||
Set currentstyle = sBigBand
|
||||
ChangeMusic
|
||||
day = 1: LabelNumber = 1
|
||||
lblStuff.Caption = LoadMSg(0)
|
||||
End Sub
|
||||
|
||||
Private Sub lblWednesday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
lblName.Font = "Times New Roman"
|
||||
lblName.ForeColor = &HFFFF&
|
||||
|
||||
|
||||
lblWednesday.ForeColor = &HFF&
|
||||
|
||||
lblThursday.ForeColor = &HC000&
|
||||
lblFriday.ForeColor = &HC000&
|
||||
lblSaturday.ForeColor = &HC000&
|
||||
lblSunday.ForeColor = &HC000&
|
||||
End Sub
|
||||
|
||||
@@ -0,0 +1,587 @@
|
||||
Attribute VB_Name = "basDD"
|
||||
Option Explicit
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: basDD.bas
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As DxVBLib.RECT) As Long
|
||||
|
||||
'******
|
||||
'This application uses conditional compilation. To run this sample in the IDE, you
|
||||
'must first go to Project Properties (Project Menu-> Properties). Then on the Make tab
|
||||
'change the RunInIDE=0 to RunInIDE=1.
|
||||
|
||||
'This sample also shows developers how to combine the DX7 and DX8 DLL's to create
|
||||
'an app with the latest DMusic and still use older functionality like DDraw
|
||||
|
||||
Private dx As New DxVBLib.DirectX7
|
||||
Private DD As DxVBLib.DirectDraw7
|
||||
Private DDS As DxVBLib.DirectDrawSurface7
|
||||
Private dC As DxVBLib.DirectDrawClipper
|
||||
Private DDSD As DxVBLib.DDSURFACEDESC2
|
||||
Private DR As DxVBLib.RECT
|
||||
|
||||
Private bB As DxVBLib.DirectDrawSurface7
|
||||
Private BD As DxVBLib.DDSURFACEDESC2
|
||||
Private BBR As DxVBLib.RECT
|
||||
|
||||
Private ar() As Byte
|
||||
Private AlphaRect As DxVBLib.RECT
|
||||
|
||||
Private lPixelDepth As Byte
|
||||
Private clr As Long
|
||||
Private cols As Long
|
||||
Private rows As Long
|
||||
Private col As Long
|
||||
Private row As Long
|
||||
|
||||
Private Sprites(9) As DxVBLib.DirectDrawSurface7
|
||||
Private SpriteD(9) As DxVBLib.DDSURFACEDESC2
|
||||
Private SpriteR(9) As DxVBLib.RECT
|
||||
Private key(9) As DDCOLORKEY
|
||||
|
||||
Private spriteWidth As Integer
|
||||
Private spriteHeight As Integer
|
||||
Private currentframe As Integer
|
||||
Private slide(39) As DxVBLib.RECT
|
||||
Private Pal(255) As DxVBLib.PALETTEENTRY
|
||||
Private Palette As DxVBLib.DirectDrawPalette
|
||||
|
||||
Private Fish(2) As DxVBLib.DirectDrawSurface7
|
||||
Private fishD(2) As DxVBLib.DDSURFACEDESC2
|
||||
Private fishR(2) As DxVBLib.RECT
|
||||
Private fishkey(2) As DxVBLib.DDCOLORKEY
|
||||
|
||||
Private sMSG As String
|
||||
|
||||
Private x%, y%
|
||||
Private tmpR As DxVBLib.RECT
|
||||
|
||||
Private Type fis
|
||||
sR As DxVBLib.RECT
|
||||
x As Long
|
||||
y As Single
|
||||
End Type
|
||||
|
||||
Private fi(2) As fis
|
||||
|
||||
'Registry constants
|
||||
Private Const KEY_READ = 131097
|
||||
Private Const REG_SZ = 1
|
||||
Private Const HKEY_LOCAL_MACHINE = &H80000002
|
||||
'Registry API's
|
||||
Private Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long
|
||||
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
|
||||
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
|
||||
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
|
||||
'Sleep
|
||||
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
|
||||
|
||||
Public Sub InitDD(hwnd As Long, ClipperHwnd As PictureBox)
|
||||
Dim oPixelFormat As DDPIXELFORMAT
|
||||
On Local Error GoTo err_
|
||||
|
||||
Set DD = dx.DirectDrawCreate(vbNullString)
|
||||
DD.SetCooperativeLevel hwnd, DDSCL_NORMAL
|
||||
|
||||
DDSD.lFlags = DDSD_CAPS
|
||||
DDSD.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
|
||||
Set DDS = DD.CreateSurface(DDSD)
|
||||
|
||||
Set dC = DD.CreateClipper(0)
|
||||
dC.SetHWnd ClipperHwnd.hwnd
|
||||
|
||||
DDS.SetClipper dC
|
||||
|
||||
DDS.GetPixelFormat oPixelFormat
|
||||
|
||||
If oPixelFormat.lRGBBitCount < 8 Then
|
||||
If Not (DD Is Nothing) Then
|
||||
DD.SetCooperativeLevel frmMain.hwnd, DDSCL_NORMAL
|
||||
DoEvents
|
||||
End If
|
||||
|
||||
MsgBox "Must run at 16bit color or higher.", vbApplicationModal
|
||||
End
|
||||
Else
|
||||
lPixelDepth = oPixelFormat.lRGBBitCount
|
||||
End If
|
||||
|
||||
BD.lFlags = DDSD_HEIGHT Or DDSD_WIDTH Or DDSD_CAPS
|
||||
BD.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
BD.lWidth = ClipperHwnd.ScaleWidth
|
||||
BD.lHeight = ClipperHwnd.ScaleHeight
|
||||
|
||||
Set bB = DD.CreateSurface(BD)
|
||||
|
||||
BBR.bottom = ClipperHwnd.Height
|
||||
BBR.Right = ClipperHwnd.Width
|
||||
|
||||
loadSprites
|
||||
|
||||
AlphaRect.Right = BD.lWidth - 1
|
||||
AlphaRect.bottom = BD.lHeight - 1
|
||||
Exit Sub
|
||||
|
||||
err_:
|
||||
|
||||
If Not (DD Is Nothing) Then
|
||||
DD.SetCooperativeLevel frmMain.hwnd, DDSCL_NORMAL
|
||||
DoEvents
|
||||
End If
|
||||
|
||||
MsgBox "Unable to initalize DirectDraw.", vbApplicationModal
|
||||
End
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub loadSprites()
|
||||
'0
|
||||
SpriteD(0).lFlags = DDSD_CAPS
|
||||
SpriteD(0).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
|
||||
#If RunInIDE = 1 Then
|
||||
'ide
|
||||
Dim sMedia As String
|
||||
|
||||
sMedia = FindMediaDir("base.bmp")
|
||||
If sMedia <> vbNullString Then 'Media is not in current folder
|
||||
If (Left$(sMedia, 2) <> Left$(CurDir, 2)) And (InStr(Left$(sMedia, 2), ":") > 0) Then ChDrive Left$(sMedia, 2)
|
||||
ChDir sMedia
|
||||
End If
|
||||
|
||||
Set Sprites(0) = DD.CreateSurfaceFromFile("base.bmp", SpriteD(0))
|
||||
#Else
|
||||
'exe
|
||||
Set Sprites(0) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "BASE", SpriteD(0))
|
||||
#End If
|
||||
|
||||
SpriteR(0).Right = SpriteD(0).lWidth
|
||||
SpriteR(0).bottom = SpriteD(0).lHeight
|
||||
|
||||
|
||||
'1
|
||||
SpriteD(1).lFlags = DDSD_CAPS
|
||||
SpriteD(1).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
|
||||
#If RunInIDE = 1 Then
|
||||
'ide
|
||||
Set Sprites(1) = DD.CreateSurfaceFromFile("sax.bmp", SpriteD(1))
|
||||
#Else
|
||||
'exe
|
||||
Set Sprites(1) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "sax", SpriteD(1))
|
||||
#End If
|
||||
|
||||
SpriteR(1).Right = SpriteD(1).lWidth
|
||||
SpriteR(1).bottom = SpriteD(1).lHeight
|
||||
|
||||
'notes
|
||||
SpriteD(6).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
|
||||
SpriteD(6).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
SpriteD(6).lWidth = 64: SpriteD(6).lHeight = 64
|
||||
|
||||
#If RunInIDE = 1 Then
|
||||
'ide
|
||||
Set Sprites(6) = DD.CreateSurfaceFromFile("notes.bmp", SpriteD(6))
|
||||
#Else
|
||||
'exe
|
||||
Set Sprites(6) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "NOTES", SpriteD(6))
|
||||
#End If
|
||||
|
||||
SpriteR(6).Right = SpriteD(6).lWidth
|
||||
SpriteR(6).bottom = SpriteD(6).lHeight
|
||||
|
||||
|
||||
key(6).low = 0
|
||||
key(6).high = 0
|
||||
Sprites(6).SetColorKey DDCKEY_SRCBLT, key(6)
|
||||
|
||||
|
||||
|
||||
'2
|
||||
SpriteD(2).lFlags = DDSD_CAPS
|
||||
SpriteD(2).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
|
||||
#If RunInIDE = 1 Then
|
||||
'ide
|
||||
Set Sprites(2) = DD.CreateSurfaceFromFile("keys.bmp", SpriteD(2))
|
||||
#Else
|
||||
Set Sprites(2) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "KEYS", SpriteD(2))
|
||||
#End If
|
||||
|
||||
SpriteR(2).Right = SpriteD(2).lWidth
|
||||
SpriteR(2).bottom = SpriteD(2).lHeight
|
||||
|
||||
|
||||
''''''''''''''''''''''''''''''''''''''''''
|
||||
'loadFish
|
||||
''''''''''''''''''''''''''''''''''''''''''
|
||||
fishD(0).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
|
||||
fishD(0).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
fishD(0).lWidth = 64: fishD(0).lHeight = 64
|
||||
|
||||
fishD(1).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
|
||||
fishD(1).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
fishD(1).lWidth = 64: fishD(1).lHeight = 64
|
||||
|
||||
fishD(2).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
|
||||
fishD(2).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
fishD(2).lWidth = 64: fishD(2).lHeight = 64
|
||||
|
||||
#If RunInIDE = 1 Then
|
||||
'ide
|
||||
Set Fish(0) = DD.CreateSurfaceFromFile("f1.bmp", fishD(0))
|
||||
Set Fish(1) = DD.CreateSurfaceFromFile("f2.bmp", fishD(1))
|
||||
Set Fish(2) = DD.CreateSurfaceFromFile("f3.bmp", fishD(2))
|
||||
#Else
|
||||
'exe
|
||||
Set Fish(0) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "F1", fishD(0))
|
||||
Set Fish(1) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "F2", fishD(1))
|
||||
Set Fish(2) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "F3", fishD(2))
|
||||
#End If
|
||||
|
||||
|
||||
|
||||
Dim i As Integer
|
||||
|
||||
For i = 0 To UBound(Fish)
|
||||
fishR(i).Right = fishD(i).lWidth
|
||||
fishR(i).bottom = fishD(i).lHeight
|
||||
fishkey(i).low = 0
|
||||
fishkey(i).high = 0
|
||||
Fish(i).SetColorKey DDCKEY_SRCBLT, fishkey(i)
|
||||
Next i
|
||||
|
||||
|
||||
'sprite(5) animated hand
|
||||
|
||||
SpriteD(5).lFlags = DDSD_CAPS
|
||||
SpriteD(5).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
|
||||
#If RunInIDE = 1 Then
|
||||
'ide
|
||||
Set Sprites(5) = DD.CreateSurfaceFromFile("handani.bmp", SpriteD(5))
|
||||
#Else
|
||||
'exe
|
||||
Set Sprites(5) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "handani", SpriteD(5))
|
||||
#End If
|
||||
|
||||
|
||||
SpriteR(5).Right = SpriteD(5).lWidth
|
||||
SpriteR(5).bottom = SpriteD(5).lHeight
|
||||
spriteWidth = 272
|
||||
spriteHeight = 177
|
||||
cols = SpriteD(5).lWidth / spriteWidth
|
||||
rows = SpriteD(5).lHeight / spriteHeight
|
||||
|
||||
key(5).low = 0
|
||||
key(5).high = 0
|
||||
Sprites(5).SetColorKey DDCKEY_SRCBLT, key(5)
|
||||
|
||||
|
||||
'9
|
||||
SpriteD(9).lFlags = DDSD_CAPS
|
||||
SpriteD(9).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
|
||||
#If RunInIDE = 1 Then
|
||||
'ide
|
||||
Set Sprites(9) = DD.CreateSurfaceFromFile("bknote.bmp", SpriteD(9))
|
||||
#Else
|
||||
'exe
|
||||
Set Sprites(9) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "bknote", SpriteD(9))
|
||||
#End If
|
||||
|
||||
|
||||
SpriteR(9).Right = SpriteD(9).lWidth
|
||||
SpriteR(9).bottom = SpriteD(9).lHeight
|
||||
|
||||
|
||||
StripVert slide(), SpriteR(9).Right, SpriteR(9).bottom
|
||||
|
||||
'8
|
||||
SpriteD(8).lFlags = DDSD_CAPS
|
||||
SpriteD(8).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
|
||||
#If RunInIDE = 1 Then
|
||||
'ide
|
||||
Set Sprites(8) = DD.CreateSurfaceFromFile("dance.bmp", SpriteD(8))
|
||||
#Else
|
||||
'exe
|
||||
Set Sprites(8) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "dance", SpriteD(8))
|
||||
#End If
|
||||
|
||||
SpriteR(8).Right = SpriteD(8).lWidth
|
||||
SpriteR(8).bottom = SpriteD(8).lHeight
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub MoveFrame(Index As Integer)
|
||||
|
||||
On Local Error GoTo err_
|
||||
|
||||
Select Case Index
|
||||
Case 0
|
||||
bB.Blt BBR, Sprites(Index), SpriteR(Index), DDBLT_WAIT
|
||||
|
||||
|
||||
bB.Lock AlphaRect, BD, DDLOCK_WAIT, 0
|
||||
bB.GetLockedArray ar()
|
||||
DoEvents
|
||||
|
||||
clr = Rnd * 255
|
||||
|
||||
For y = 0 To (AlphaRect.bottom - 1)
|
||||
For x = 0 To (AlphaRect.Right - 1) * 2
|
||||
|
||||
If ar(x, y) <> 0 And ar(x, y) <> 64 And ar(x, y) <> 255 And ar(x, y) <> 127 Then
|
||||
If ar(x, y) = 224 Then
|
||||
ar(x, y) = clr
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
DoEvents
|
||||
Next
|
||||
DoEvents
|
||||
bB.Unlock AlphaRect
|
||||
|
||||
|
||||
GetWindowRect frmMain.mnCan.hwnd, DR
|
||||
DDS.Blt DR, bB, BBR, DDBLT_WAIT
|
||||
|
||||
Case 1
|
||||
tmpR.Top = Rnd * 200
|
||||
tmpR.Left = Rnd * 50
|
||||
|
||||
bB.Blt BBR, Sprites(Index), SpriteR(Index), DDBLT_WAIT
|
||||
bB.BltFast tmpR.Left, tmpR.Top, Sprites(6), SpriteR(6), DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
|
||||
|
||||
|
||||
|
||||
GetWindowRect frmMain.mnCan.hwnd, DR
|
||||
DDS.Blt DR, bB, BBR, DDBLT_WAIT
|
||||
Sleep 50
|
||||
|
||||
|
||||
Case 2
|
||||
On Error Resume Next
|
||||
Dim nColor As Integer, tmp As Integer
|
||||
bB.Blt BBR, Sprites(Index), SpriteR(Index), DDBLT_WAIT
|
||||
GetWindowRect frmMain.mnCan.hwnd, DR
|
||||
bB.Lock AlphaRect, BD, DDLOCK_WAIT, 0
|
||||
bB.GetLockedArray ar()
|
||||
DoEvents
|
||||
nColor = Rnd * 256
|
||||
If nColor = 0 Then nColor = 1
|
||||
|
||||
For y = 0 To (AlphaRect.bottom - 1)
|
||||
For x = 0 To (AlphaRect.Right - 1) * (lPixelDepth \ 8)
|
||||
If ar(x, y) <> 0 And ar(x, y) <> 124 Then
|
||||
ar(x, y) = nColor
|
||||
End If
|
||||
Next
|
||||
DoEvents
|
||||
|
||||
Next
|
||||
DoEvents
|
||||
bB.Unlock AlphaRect
|
||||
DDS.Blt DR, bB, BBR, DDBLT_WAIT
|
||||
On Error GoTo 0
|
||||
Case 3
|
||||
|
||||
|
||||
With fi(0)
|
||||
.x = .x + 1: If .x > frmMain.mnCan.ScaleWidth Then .x = 0
|
||||
.y = Sin(.x / 5) * 5 + (frmMain.mnCan.ScaleHeight \ 2)
|
||||
End With
|
||||
|
||||
|
||||
With fi(1)
|
||||
.x = .x + 2: If .x > frmMain.mnCan.ScaleWidth Then .x = 0
|
||||
.y = Sin(.x / 20) * 20 + (frmMain.mnCan.ScaleHeight \ 4)
|
||||
End With
|
||||
|
||||
With fi(2)
|
||||
.x = .x - 2: If .x < frmMain.mnCan.ScaleLeft Then .x = frmMain.mnCan.ScaleWidth
|
||||
.y = Sin(.x / 40) * 40 + (frmMain.mnCan.ScaleHeight \ 3)
|
||||
End With
|
||||
|
||||
Dim i As Integer
|
||||
|
||||
bB.BltColorFill BBR, &H0
|
||||
|
||||
For i = 0 To UBound(fi)
|
||||
bB.BltFast fi(i).x, fi(i).y, Fish(i), fishR(i), DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
|
||||
Next i
|
||||
|
||||
GetWindowRect frmMain.mnCan.hwnd, DR
|
||||
DDS.Blt DR, bB, BBR, DDBLT_WAIT
|
||||
|
||||
Sleep 50
|
||||
Case 5
|
||||
|
||||
Dim rSprite As DxVBLib.RECT
|
||||
|
||||
currentframe = currentframe + 1
|
||||
If currentframe > rows * cols - 1 Then currentframe = 0
|
||||
|
||||
col = currentframe Mod cols
|
||||
row = Int(currentframe / cols)
|
||||
rSprite.Left = col * spriteWidth
|
||||
rSprite.Top = row * spriteHeight
|
||||
rSprite.Right = rSprite.Left + spriteWidth
|
||||
rSprite.bottom = rSprite.Top + spriteHeight
|
||||
|
||||
|
||||
|
||||
bB.BltColorFill BBR, &H0
|
||||
Set bB = MoveBackRight(bB, Sprites(9), slide)
|
||||
|
||||
DoEvents
|
||||
|
||||
bB.BltFast 0, frmMain.mnCan.ScaleHeight \ 3, Sprites(Index), rSprite, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT
|
||||
|
||||
|
||||
GetWindowRect frmMain.mnCan.hwnd, DR
|
||||
DDS.Blt DR, bB, BBR, DDBLT_WAIT
|
||||
|
||||
|
||||
Sleep 80
|
||||
Case 6
|
||||
|
||||
|
||||
bB.Blt BBR, Sprites(8), SpriteR(8), DDBLT_WAIT
|
||||
|
||||
|
||||
bB.Lock AlphaRect, BD, DDLOCK_WAIT, 0
|
||||
bB.GetLockedArray ar()
|
||||
DoEvents
|
||||
|
||||
|
||||
For y = 0 To (AlphaRect.bottom - 1)
|
||||
For x = 0 To (AlphaRect.Right - 1) * 2
|
||||
|
||||
If ar(x, y) <> 0 And ar(x, y) <> 255 Then
|
||||
ar(x, y) = Rnd * 255
|
||||
End If
|
||||
Next
|
||||
DoEvents
|
||||
|
||||
Next
|
||||
DoEvents
|
||||
bB.Unlock AlphaRect
|
||||
DDS.Blt DR, bB, BBR, DDBLT_WAIT
|
||||
|
||||
|
||||
|
||||
GetWindowRect frmMain.mnCan.hwnd, DR
|
||||
DDS.Blt DR, bB, BBR, DDBLT_WAIT
|
||||
|
||||
' Sleep 20
|
||||
|
||||
End Select
|
||||
|
||||
Exit Sub
|
||||
err_:
|
||||
|
||||
If Not (DD Is Nothing) Then
|
||||
DD.SetCooperativeLevel frmMain.hwnd, DDSCL_NORMAL
|
||||
DoEvents
|
||||
End If
|
||||
MsgBox "There was an issue with playing the current frame." & vbCrLf & _
|
||||
Err.Number & vbCrLf & _
|
||||
Err.Description, vbApplicationModal
|
||||
End
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Public Sub StripVert(cChop() As DxVBLib.RECT, wD As Long, hD As Long)
|
||||
Dim cntr As Integer
|
||||
Dim nN As Long
|
||||
Dim sZ As Long
|
||||
|
||||
For cntr = 0 To UBound(cChop)
|
||||
sZ = wD / UBound(cChop)
|
||||
nN = nN + sZ
|
||||
|
||||
cChop(cntr).Left = (nN - sZ)
|
||||
cChop(cntr).Right = nN
|
||||
cChop(cntr).bottom = hD
|
||||
Next
|
||||
|
||||
'StripVert = cChop
|
||||
|
||||
End Sub
|
||||
|
||||
Public Function MoveBackRight(ByVal bB As DirectDrawSurface7, ByVal backgrounds As DirectDrawSurface7, recArray() As DxVBLib.RECT) As DirectDrawSurface7
|
||||
Dim tmpC As Integer
|
||||
Dim stp As Integer
|
||||
Static cntrFR As Integer
|
||||
|
||||
For tmpC = 0 To UBound(recArray)
|
||||
If cntrFR >= (UBound(recArray) - 1) Then
|
||||
cntrFR = 0
|
||||
End If
|
||||
bB.BltFast recArray(cntrFR).Left, (frmMain.mnCan.ScaleHeight \ 3), backgrounds, recArray(tmpC), DDBLTFAST_WAIT
|
||||
cntrFR = cntrFR + 1
|
||||
DoEvents
|
||||
Next
|
||||
|
||||
Set MoveBackRight = bB
|
||||
DoEvents
|
||||
End Function
|
||||
|
||||
Public Function LoadMSg(Index As Integer) As String
|
||||
|
||||
Dim tempMSG(7) As String
|
||||
|
||||
'wed
|
||||
tempMSG(0) = "Big Band!" & vbCrLf & _
|
||||
"Join us for a blast from the past! Enjoy cutting the rug " & vbCrLf & _
|
||||
"with the finest big band musicians from the area. Whether " & vbCrLf & _
|
||||
"you want to swing dance the night away, or just listen to " & vbCrLf & _
|
||||
"the big sound from the stage, you're sure to have a great time." & vbCrLf & _
|
||||
"Just don't forget the zoot suit at home!"
|
||||
'thur
|
||||
tempMSG(1) = "Jazz Night!" & vbCrLf & _
|
||||
"Thursdays are a big night at Club Met, because our jazz music" & vbCrLf & _
|
||||
"is always cool and fresh. The musicians that join us are always" & vbCrLf & _
|
||||
"Grade A, including local band Benny HaHa and the Blue Wave." & vbCrLf & _
|
||||
"Jazz has never been better!"
|
||||
'fri
|
||||
tempMSG(2) = "Disco!" & vbCrLf & _
|
||||
"If the 70's are making a comeback, you'll find Friday Night at Club Met" & vbCrLf & _
|
||||
"to be the headquarters. Always a blast, we bring in some of the original" & vbCrLf & _
|
||||
"disco artists to play their most popular numbers. It's even more fun to" & vbCrLf & _
|
||||
"come dressed to the part. Come once and it's sure to be your Friday Night" & vbCrLf & _
|
||||
"hang out!"
|
||||
'sat
|
||||
tempMSG(3) = "Dance Night!" & vbCrLf & _
|
||||
"A definite favorite of Generation X (and Y) is Dance night at Club Met." & vbCrLf & _
|
||||
"Our own DJ, Flavor Mike, spins the latest dance hits all night long." & vbCrLf & _
|
||||
"Once you start dancing, you can't slow down. Plenty of new people to " & vbCrLf & _
|
||||
"meet, and always a good time."
|
||||
|
||||
'sun
|
||||
tempMSG(4) = "Classical!" & vbCrLf & _
|
||||
"If your tastes are more refined, we encourage you to join us on Sunday" & vbCrLf & _
|
||||
"night at Club Met. You'll enjoy intellectual conversation and delightful" & vbCrLf & _
|
||||
"music from the Baroque, Classical, and Romantic eras, played by renowned" & vbCrLf & _
|
||||
"local artists. A great way to energize yourself for the week ahead."
|
||||
|
||||
|
||||
LoadMSg = tempMSG(Index)
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -0,0 +1,38 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C602}#1.0#0#dx7vb.dll#DirectX 7 for Visual Basic Type Library
|
||||
Form=ClubMet.frm
|
||||
Module=basDD; basDD.bas
|
||||
ResFile32="ClubMet.RES"
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
IconForm="frmMain"
|
||||
Startup="frmMain"
|
||||
HelpFile=""
|
||||
Title="ClubMet"
|
||||
Command32=""
|
||||
Name="vbClubMet"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="MS"
|
||||
CondComp="RunInIDE = 0"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,262 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form Form3
|
||||
Caption = "Animate Key Frames"
|
||||
ClientHeight = 6015
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 7530
|
||||
Icon = "AnimKeys.frx":0000
|
||||
LinkTopic = "Form3"
|
||||
ScaleHeight = 401
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 502
|
||||
StartUpPosition = 3 'Windows Default
|
||||
End
|
||||
Attribute VB_Name = "Form3"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: AnimKeys.frm
|
||||
' Content: Playback of animated geometry
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
|
||||
Dim Character As CD3DFrame
|
||||
Dim Animation As CD3DAnimation
|
||||
|
||||
Dim MediaDir As String
|
||||
Dim m_bInit As Boolean
|
||||
Dim m_bMinimized As Boolean
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Load()
|
||||
' Desc: Main entry point for the sample
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Load()
|
||||
Dim hr As Long
|
||||
|
||||
' Show the form
|
||||
Me.Show
|
||||
DoEvents
|
||||
|
||||
' Initialize D3D
|
||||
' Note: D3DUtil_Init will attempt to use D3D Hardware acceleartion.
|
||||
' If it is not available it attempt to use the Software Reference Rasterizer.
|
||||
' If all fail it will display a message box indicating so.
|
||||
'
|
||||
m_bInit = D3DUtil_Init(Me.hwnd, True, 0, 0, D3DDEVTYPE_HAL, Nothing)
|
||||
If Not (m_bInit) Then End
|
||||
|
||||
|
||||
|
||||
' Find a path to our media
|
||||
MediaDir = FindMediaDir("skmech.x")
|
||||
D3DUtil_SetMediaPath MediaDir
|
||||
|
||||
' Load Character and Animation Data
|
||||
InitDeviceObjects
|
||||
|
||||
' Position camera and Lights
|
||||
RestoreDeviceObjects
|
||||
|
||||
' Start our timer
|
||||
DXUtil_Timer TIMER_start
|
||||
|
||||
' Loop forever rendering our animation
|
||||
Do While True
|
||||
|
||||
'Have our animation pose our character
|
||||
Animation.SetTime DXUtil_Timer(TIMER_GETAPPTIME) * 30
|
||||
|
||||
'See what state the device is in.
|
||||
hr = g_dev.TestCooperativeLevel
|
||||
If hr = D3DERR_DEVICENOTRESET Then
|
||||
g_dev.Reset g_d3dpp
|
||||
RestoreDeviceObjects
|
||||
End If
|
||||
|
||||
'dont bother rendering if we are not ready yet
|
||||
If hr = 0 Then
|
||||
|
||||
|
||||
'Clear the background to ARGB grey
|
||||
D3DUtil_ClearAll &HFF909090
|
||||
|
||||
'Start the Scene
|
||||
g_dev.BeginScene
|
||||
|
||||
'Render the character (g_dev defined in D3DUtil)
|
||||
Character.Render g_dev
|
||||
|
||||
'End the scene
|
||||
g_dev.EndScene
|
||||
|
||||
'Update the Scene to our window
|
||||
D3DUtil_PresentAll Me.hwnd
|
||||
|
||||
End If
|
||||
|
||||
|
||||
'Allow VB events to process
|
||||
DoEvents
|
||||
|
||||
Loop
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitDeviceObjects()
|
||||
' Desc: Load Character and Animation Data
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub InitDeviceObjects()
|
||||
|
||||
'Create an Animation object to hold any animations
|
||||
Set Animation = New CD3DAnimation
|
||||
|
||||
'Create a Frame object from a file
|
||||
'the Animation object will parent any animations in the file
|
||||
Set Character = D3DUtil_LoadFromFile(MediaDir + "skmech.x", Nothing, Animation)
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InvalidateDeviceObjects()
|
||||
' Desc: place code to release references to non-managed objects here
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub InvalidateDeviceObjects()
|
||||
'all objects are managed in this sample
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RestoreDeviceObjects()
|
||||
' Desc: setup device state such as camera and light placement
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub RestoreDeviceObjects()
|
||||
|
||||
' Set up some lights and camera
|
||||
g_lWindowWidth = Me.ScaleWidth
|
||||
g_lWindowHeight = Me.ScaleHeight
|
||||
D3DUtil_SetupDefaultScene
|
||||
|
||||
' position the camera
|
||||
D3DUtil_SetupCamera vec3(0, 0, 300), vec3(0, 0, 0), vec3(0, 1, 0)
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: DeleteDeviceObjects()
|
||||
' Desc: Called when the app is exitting, or the device is being changed,
|
||||
' this function deletes any device dependant objects.
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub DeleteDeviceObjects()
|
||||
Set Character = Nothing
|
||||
Set Animation = Nothing
|
||||
m_bInit = False
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_KeyDown()
|
||||
' Desc: Process key messages for exit and change device
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
|
||||
Select Case KeyCode
|
||||
|
||||
Case vbKeyEscape
|
||||
Unload Me
|
||||
|
||||
Case vbKeyF2
|
||||
|
||||
' Pause the timer
|
||||
DXUtil_Timer TIMER_STOP
|
||||
|
||||
' Bring up the device selection dialog
|
||||
' we pass in the form so the selection process
|
||||
' can make calls into InitDeviceObjects
|
||||
' and RestoreDeviceObjects
|
||||
frmSelectDevice.SelectDevice Me
|
||||
|
||||
' Restart the timer
|
||||
DXUtil_Timer TIMER_start
|
||||
|
||||
Case vbKeyReturn
|
||||
|
||||
' Check for Alt-Enter if not pressed exit
|
||||
If Shift <> 4 Then Exit Sub
|
||||
|
||||
' If we are windowed go fullscreen
|
||||
' If we are fullscreen returned to windowed
|
||||
If g_d3dpp.Windowed Then
|
||||
D3DUtil_ResetFullscreen
|
||||
Else
|
||||
D3DUtil_ResetWindowed
|
||||
End If
|
||||
|
||||
' Call Restore after ever mode change
|
||||
' because calling reset looses state that needs to
|
||||
' be reinitialized
|
||||
RestoreDeviceObjects
|
||||
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Resize()
|
||||
' Desc: hadle resizing of the D3D backbuffer
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Resize()
|
||||
|
||||
' If D3D is not initialized then exit
|
||||
If Not m_bInit Then Exit Sub
|
||||
|
||||
' If we are in a minimized state stop the timer and exit
|
||||
If Me.WindowState = vbMinimized Then
|
||||
DXUtil_Timer TIMER_STOP
|
||||
m_bMinimized = True
|
||||
Exit Sub
|
||||
|
||||
' If we just went from a minimized state to maximized
|
||||
' restart the timer
|
||||
Else
|
||||
If m_bMinimized = True Then
|
||||
DXUtil_Timer TIMER_start
|
||||
m_bMinimized = False
|
||||
End If
|
||||
End If
|
||||
|
||||
' Dont let the window get too small
|
||||
If Me.ScaleWidth < 10 Then
|
||||
Me.width = Screen.TwipsPerPixelX * 10
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Me.ScaleHeight < 10 Then
|
||||
Me.height = Screen.TwipsPerPixelY * 10
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'reset and resize our D3D backbuffer to the size of the window
|
||||
D3DUtil_ResizeWindowed Me.hwnd
|
||||
|
||||
'All state get losts after a reset so we need to reinitialze it here
|
||||
RestoreDeviceObjects
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Unload()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
DeleteDeviceObjects
|
||||
End
|
||||
End Sub
|
||||
|
||||
@@ -0,0 +1,45 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Module=D3DInit; ..\..\common\D3DInit.bas
|
||||
Module=D3DUtil; ..\..\common\D3DUtil.bas
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
Class=CD3DPick; ..\..\common\D3DPick.cls
|
||||
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
|
||||
Class=CD3DFrame; ..\..\common\D3DFrame.cls
|
||||
Class=CD3DMesh; ..\..\common\D3DMesh.cls
|
||||
Form=AnimKeys.frm
|
||||
Form=..\..\common\SelectDevice.frm
|
||||
IconForm="Form3"
|
||||
Startup="Form3"
|
||||
HelpFile=""
|
||||
Title="AnimKeys"
|
||||
ExeName32="vb_AnimKeys.exe"
|
||||
Command32=""
|
||||
Name="AnimKeys"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
Binary file not shown.
@@ -0,0 +1,45 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: AnimKeys Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The AnimKeys sample illustrates how to use the d3d framework to load an x-file with
|
||||
key framed animation and playback the animation.nt
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\AnimKeys
|
||||
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
The following keys are implemented. The dropdown menus can be used for the
|
||||
same controls.
|
||||
|
||||
<F2> Prompts user to select a new rendering device or display mode
|
||||
<Alt+Enter> Toggles between fullscreen and windowed modes
|
||||
<Esc> Exits the app.
|
||||
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
Note that the last argument passed to D3DUtil_LoadFromFile is a CD3DAnimation
|
||||
class that is the parent to any animations that are found in the xfile.
|
||||
Subsequently Animation.SetTime can be used to pose the model.
|
||||
|
||||
|
||||
This sample makes use of common DirectX code (consisting of helper functions,
|
||||
etc.) that is shared with other samples on the DirectX SDK. All common
|
||||
classes and modules can be found in the following directory:
|
||||
DXSDK\Samples\Multimedia\VBSamples\Common
|
||||
|
||||
@@ -0,0 +1,876 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form Form1
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "Auto Collision Parts Database"
|
||||
ClientHeight = 8520
|
||||
ClientLeft = 480
|
||||
ClientTop = 615
|
||||
ClientWidth = 10875
|
||||
Icon = "auto.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 568
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 725
|
||||
Begin MSComctlLib.TreeView TreeView1
|
||||
Height = 3495
|
||||
Left = 120
|
||||
TabIndex = 27
|
||||
Top = 480
|
||||
Width = 3975
|
||||
_ExtentX = 7011
|
||||
_ExtentY = 6165
|
||||
_Version = 393217
|
||||
HideSelection = 0 'False
|
||||
Style = 7
|
||||
Appearance = 1
|
||||
End
|
||||
Begin VB.TextBox Text8
|
||||
Enabled = 0 'False
|
||||
Height = 375
|
||||
Left = 9000
|
||||
TabIndex = 25
|
||||
Top = 7380
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.PictureBox Picture2
|
||||
Height = 735
|
||||
Left = 120
|
||||
ScaleHeight = 675
|
||||
ScaleWidth = 10515
|
||||
TabIndex = 19
|
||||
Top = 4080
|
||||
Width = 10575
|
||||
Begin VB.Label Label9
|
||||
Caption = $"auto.frx":0442
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 20
|
||||
Top = 120
|
||||
Width = 9495
|
||||
End
|
||||
End
|
||||
Begin VB.CommandButton Command1
|
||||
Caption = "Add To Invoice"
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 16
|
||||
Top = 7920
|
||||
Width = 3975
|
||||
End
|
||||
Begin MSComctlLib.ListView ListView1
|
||||
Height = 2355
|
||||
Left = 4320
|
||||
TabIndex = 15
|
||||
Top = 4920
|
||||
Width = 6375
|
||||
_ExtentX = 11245
|
||||
_ExtentY = 4154
|
||||
View = 3
|
||||
LabelWrap = -1 'True
|
||||
HideSelection = 0 'False
|
||||
_Version = 393217
|
||||
ForeColor = -2147483640
|
||||
BackColor = -2147483643
|
||||
BorderStyle = 1
|
||||
Appearance = 1
|
||||
NumItems = 5
|
||||
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
|
||||
Key = "price"
|
||||
Text = "DESCRIPTION"
|
||||
Object.Width = 5821
|
||||
EndProperty
|
||||
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
|
||||
SubItemIndex = 1
|
||||
Key = "part"
|
||||
Text = "PRICE"
|
||||
Object.Width = 2117
|
||||
EndProperty
|
||||
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
|
||||
SubItemIndex = 2
|
||||
Key = "id"
|
||||
Text = "ID"
|
||||
Object.Width = 2117
|
||||
EndProperty
|
||||
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
|
||||
SubItemIndex = 3
|
||||
Key = "modid"
|
||||
Text = "MODID"
|
||||
Object.Width = 0
|
||||
EndProperty
|
||||
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
|
||||
SubItemIndex = 4
|
||||
Object.Width = 38100
|
||||
EndProperty
|
||||
End
|
||||
Begin VB.CommandButton Command3
|
||||
Caption = "Process Order"
|
||||
Height = 495
|
||||
Left = 7680
|
||||
TabIndex = 3
|
||||
Top = 7920
|
||||
Width = 3015
|
||||
End
|
||||
Begin VB.CommandButton Command2
|
||||
Caption = "Remove From Invoice"
|
||||
Height = 495
|
||||
Left = 4320
|
||||
TabIndex = 2
|
||||
Top = 7920
|
||||
Width = 3135
|
||||
End
|
||||
Begin VB.PictureBox largepict
|
||||
Height = 3495
|
||||
Left = 4320
|
||||
ScaleHeight = 229
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 421
|
||||
TabIndex = 1
|
||||
Top = 480
|
||||
Width = 6375
|
||||
End
|
||||
Begin VB.PictureBox Picture1
|
||||
Height = 2835
|
||||
Left = 120
|
||||
ScaleHeight = 2775
|
||||
ScaleWidth = 3915
|
||||
TabIndex = 0
|
||||
Top = 4920
|
||||
Width = 3975
|
||||
Begin VB.TextBox Text7
|
||||
Enabled = 0 'False
|
||||
Height = 285
|
||||
Left = 1440
|
||||
TabIndex = 26
|
||||
Top = 2400
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.TextBox Text6
|
||||
Enabled = 0 'False
|
||||
Height = 285
|
||||
Left = 1440
|
||||
TabIndex = 24
|
||||
Top = 2040
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.TextBox Text5
|
||||
Enabled = 0 'False
|
||||
Height = 285
|
||||
Left = 1440
|
||||
TabIndex = 13
|
||||
Top = 1680
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.TextBox Text4
|
||||
Enabled = 0 'False
|
||||
Height = 285
|
||||
Left = 1440
|
||||
TabIndex = 11
|
||||
Top = 1320
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.TextBox Text3
|
||||
Enabled = 0 'False
|
||||
Height = 285
|
||||
Left = 1440
|
||||
TabIndex = 9
|
||||
Top = 960
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.TextBox Text2
|
||||
Enabled = 0 'False
|
||||
Height = 285
|
||||
Left = 1440
|
||||
TabIndex = 7
|
||||
Top = 600
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.TextBox Text1
|
||||
Enabled = 0 'False
|
||||
Height = 285
|
||||
Left = 1440
|
||||
TabIndex = 4
|
||||
Top = 240
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.Label Label12
|
||||
Caption = "MAKE"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 23
|
||||
Top = 2400
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label Label11
|
||||
Caption = "Label11"
|
||||
Height = 15
|
||||
Left = 240
|
||||
TabIndex = 22
|
||||
Top = 2640
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label Label10
|
||||
Caption = "STOCK"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 21
|
||||
Top = 2040
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label Label5
|
||||
Caption = "ASSEMBLY"
|
||||
Height = 375
|
||||
Left = 120
|
||||
TabIndex = 12
|
||||
Top = 1680
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label Label4
|
||||
Caption = "COMPAT PARTS"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 10
|
||||
Top = 1320
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label Label3
|
||||
Caption = "PRICE"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 8
|
||||
Top = 960
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
Caption = "DESCRIPTION"
|
||||
Height = 375
|
||||
Left = 120
|
||||
TabIndex = 6
|
||||
Top = 600
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Caption = "PARTID"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 5
|
||||
Top = 240
|
||||
Width = 735
|
||||
End
|
||||
End
|
||||
Begin VB.Label Label8
|
||||
Caption = "Select Assembly"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 18
|
||||
Top = 120
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.Label Label7
|
||||
Caption = "Click On a Part From Assembly - Use the mouse to Rotate the Assembly"
|
||||
Height = 255
|
||||
Left = 4320
|
||||
TabIndex = 17
|
||||
Top = 120
|
||||
Width = 5895
|
||||
End
|
||||
Begin VB.Label Label6
|
||||
Caption = "TOTAL"
|
||||
Height = 255
|
||||
Left = 4440
|
||||
TabIndex = 14
|
||||
Top = 7380
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.Menu MENU_FILE
|
||||
Caption = "&File"
|
||||
Begin VB.Menu MENU_EXIT
|
||||
Caption = "E&xit"
|
||||
End
|
||||
End
|
||||
Begin VB.Menu MENU_HELP
|
||||
Caption = "&Help"
|
||||
Begin VB.Menu MENU_ABOUT
|
||||
Caption = "&About..."
|
||||
End
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "Form1"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'The model used by this sample, engine1.x, is provided courtesy of Viewpoint
|
||||
'Digital, Inc. (www.viewpoint.com). It is provided for use with this sample
|
||||
'only and cannot be distributed with any application without prior written
|
||||
'consent. V6 Engine Model copyright 1999 Viewpoint Digital, Inc..
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: auto.frm
|
||||
' Content: Example of display and picking geometry
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Dim m_assemblies(100) As CD3DFrame
|
||||
Dim m_assemblyName(100) As String
|
||||
Dim m_nAssembly As Long
|
||||
|
||||
Dim m_scene As CD3DFrame
|
||||
Dim m_root As CD3DFrame
|
||||
Dim m_bMouseDown As Boolean
|
||||
Dim m_lastX As Integer
|
||||
Dim m_lastY As Integer
|
||||
Dim m_current As CD3DFrame
|
||||
|
||||
Dim m_bInLoad As Boolean
|
||||
Dim m_binit As Boolean
|
||||
Dim m_data As New Data
|
||||
Dim fLoading As Boolean
|
||||
Dim m_backcolor As Long
|
||||
Dim m_mediadir As String
|
||||
|
||||
Implements DirectXEvent8
|
||||
|
||||
|
||||
|
||||
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
|
||||
Dim b As Boolean
|
||||
|
||||
End Sub
|
||||
|
||||
'- Form_Load
|
||||
'
|
||||
' Initialize the D3DUtil Framework
|
||||
' Initialize the parts info text database
|
||||
' Initialize the treeview control
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim b As Boolean
|
||||
|
||||
Me.Show
|
||||
DoEvents
|
||||
|
||||
' Initialize D3D Window
|
||||
b = D3DUtil_DefaultInitWindowed(0, largepict.hwnd)
|
||||
If b = False Then
|
||||
MsgBox "Exiting, Unable to initialize 3D device"
|
||||
End
|
||||
End If
|
||||
|
||||
'Add some default light and turn on lighting
|
||||
g_lWindowWidth = largepict.ScaleWidth
|
||||
g_lWindowHeight = largepict.ScaleHeight
|
||||
D3DUtil.D3DUtil_SetupDefaultScene
|
||||
|
||||
'Find Media Directory
|
||||
m_mediadir = FindMediaDir("partstable.txt", False)
|
||||
|
||||
'Open Text Database
|
||||
m_data.InitData m_mediadir + "partstable.txt"
|
||||
|
||||
'Save our initial background color
|
||||
m_backcolor = &HFF90D090
|
||||
|
||||
'Fill the Tree view with its root node
|
||||
FillTreeViewControl
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'- SelectPart
|
||||
'
|
||||
' fill in the text boxes given a certain identifier
|
||||
' from a model. We query the database for the identifier
|
||||
' and from there we get the rest of the info
|
||||
Sub SelectPart(strName As String, strObject As String)
|
||||
|
||||
If m_data.MoveToModelPartRecord(strName) = False Then Exit Sub
|
||||
|
||||
Text1.Text = m_data.PartID
|
||||
Text2.Text = m_data.Description
|
||||
Text3.Text = format$(m_data.Price, "#0.00")
|
||||
Text4.Text = m_data.CompatibleParts
|
||||
Text5.Text = "Engine"
|
||||
Text6.Text = m_data.Stock
|
||||
Text7.Text = m_data.PartMake
|
||||
|
||||
If Not m_root Is Nothing Then
|
||||
|
||||
'Turn the selected object red
|
||||
If Not m_current Is Nothing Then
|
||||
With m_current.GetChildMesh(0)
|
||||
.bUseMaterials = True
|
||||
.bUseMaterialOverride = False
|
||||
End With
|
||||
End If
|
||||
|
||||
Set m_current = m_scene.FindChildObject(strObject, 0)
|
||||
|
||||
If Not (m_current Is Nothing) Then
|
||||
Dim mat As D3DMATERIAL8
|
||||
With m_current.GetChildMesh(0)
|
||||
.bUseMaterials = False
|
||||
.bUseMaterialOverride = True
|
||||
mat.emissive.r = 0.5
|
||||
mat.emissive.a = 1
|
||||
mat.diffuse.r = 0.3
|
||||
mat.diffuse.a = 1
|
||||
.SetMaterialOverride mat
|
||||
End With
|
||||
End If
|
||||
End If
|
||||
|
||||
|
||||
errOut:
|
||||
End Sub
|
||||
|
||||
|
||||
'- Rotate Track ball
|
||||
' given a point on the screen the mouse was moved to
|
||||
' simulate a track ball
|
||||
Private Sub RotateTrackBall(x As Integer, y As Integer)
|
||||
|
||||
|
||||
Dim delta_x As Single, delta_y As Single
|
||||
Dim delta_r As Single, radius As Single, denom As Single, angle As Single
|
||||
|
||||
' rotation axis in camcoords, worldcoords, sframecoords
|
||||
Dim axisC As D3DVECTOR
|
||||
Dim wc As D3DVECTOR
|
||||
Dim axisS As D3DVECTOR
|
||||
Dim base As D3DVECTOR
|
||||
Dim origin As D3DVECTOR
|
||||
|
||||
delta_x = x - m_lastX
|
||||
delta_y = y - m_lastY
|
||||
m_lastX = x
|
||||
m_lastY = y
|
||||
|
||||
|
||||
delta_r = Sqr(delta_x * delta_x + delta_y * delta_y)
|
||||
radius = 50
|
||||
denom = Sqr(radius * radius + delta_r * delta_r)
|
||||
|
||||
If (delta_r = 0 Or denom = 0) Then Exit Sub
|
||||
angle = (delta_r / denom)
|
||||
|
||||
axisC.x = (-delta_y / delta_r)
|
||||
axisC.y = (-delta_x / delta_r)
|
||||
axisC.z = 0
|
||||
|
||||
|
||||
'transform camera space vector to world space
|
||||
'm_largewindow.m_cameraFrame.Transform wc, axisC
|
||||
g_dev.GetTransform D3DTS_VIEW, g_viewMatrix
|
||||
D3DXVec3TransformCoord wc, axisC, g_viewMatrix
|
||||
|
||||
|
||||
'transform world space vector into Model space
|
||||
m_scene.UpdateFrames
|
||||
axisS = m_root.InverseTransformCoord(wc)
|
||||
|
||||
'transform origen camera space to world coordinates
|
||||
'm_largewindow.m_cameraFrame.Transform wc, origin
|
||||
D3DXVec3TransformCoord wc, origin, g_viewMatrix
|
||||
|
||||
'transfer cam space origen to model space
|
||||
base = m_root.InverseTransformCoord(wc)
|
||||
|
||||
axisS.x = axisS.x - base.x
|
||||
axisS.y = axisS.y - base.y
|
||||
axisS.z = axisS.z - base.z
|
||||
|
||||
m_root.AddRotation COMBINE_BEFORE, axisS.x, axisS.y, axisS.z, angle
|
||||
|
||||
End Sub
|
||||
|
||||
'- LoadAssembly
|
||||
'
|
||||
' See if we have the assembly loaded
|
||||
' if not figure out which model to use from a db
|
||||
' and load it
|
||||
' by default it will attach it to the scene
|
||||
Function LoadAssembly(sname As String) As Long
|
||||
|
||||
|
||||
Dim i As Long
|
||||
Dim strCap As String
|
||||
Dim strModel As String
|
||||
|
||||
Static b As Boolean
|
||||
|
||||
If b = True Then Exit Function
|
||||
b = True
|
||||
|
||||
'make sure we dont habe it already
|
||||
For i = 1 To m_nAssembly
|
||||
If sname = m_assemblyName(i) Then
|
||||
LoadAssembly = i
|
||||
b = False
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
|
||||
|
||||
m_nAssembly = m_nAssembly + 1
|
||||
m_assemblyName(m_nAssembly) = sname
|
||||
|
||||
|
||||
'look up the model we need to load
|
||||
'for this example we only show 1 model
|
||||
'but one could query for the files from a database
|
||||
strModel = "engine1.x"
|
||||
strCap = Me.Caption
|
||||
Me.Caption = "Loading- please wait"
|
||||
DoEvents
|
||||
Err.Number = 0
|
||||
|
||||
Form2.Top = Me.Top + Me.height / 4
|
||||
Form2.Left = Me.Left + Me.width / 8
|
||||
Form2.Show
|
||||
DoEvents
|
||||
|
||||
Set m_assemblies(m_nAssembly) = New CD3DFrame
|
||||
b = m_assemblies(m_nAssembly).InitFromFile(g_dev, m_mediadir + strModel, Nothing, Nothing)
|
||||
|
||||
|
||||
If b = False Then
|
||||
Set m_assemblies(m_nAssembly) = Nothing
|
||||
m_assemblyName(m_nAssembly) = ""
|
||||
m_nAssembly = m_nAssembly - 1
|
||||
Unload Form2
|
||||
Me.Caption = strCap
|
||||
GoTo errOut
|
||||
End If
|
||||
Me.Caption = strCap
|
||||
|
||||
m_assemblies(m_nAssembly).SetFVF g_dev, D3DFVF_VERTEX
|
||||
m_assemblies(m_nAssembly).ComputeNormals
|
||||
|
||||
g_dev.SetRenderState D3DRS_AMBIENT, &H90909090
|
||||
|
||||
|
||||
'Release the previous scene
|
||||
Set m_scene = Nothing
|
||||
Set m_root = Nothing
|
||||
Set m_current = Nothing
|
||||
|
||||
'Create a root object for the scene
|
||||
Set m_scene = New CD3DFrame
|
||||
|
||||
'Create a new root object to use for rotation matrix
|
||||
Set m_root = D3DUtil_CreateFrame(m_scene)
|
||||
|
||||
|
||||
|
||||
'Add our assembly to the tree
|
||||
m_root.AddChild m_assemblies(m_nAssembly)
|
||||
|
||||
|
||||
'Position our assembly
|
||||
m_assemblies(m_nAssembly).AddTranslation COMBINE_replace, 0, 0, 5
|
||||
|
||||
|
||||
|
||||
'Recolor m_assemblies(m_nAssembly)
|
||||
|
||||
LoadAssembly = m_nAssembly
|
||||
|
||||
|
||||
Unload Form2
|
||||
DoEvents
|
||||
If fLoading Then End
|
||||
|
||||
RenderScene
|
||||
|
||||
DoEvents
|
||||
|
||||
Set m_root = m_assemblies(m_nAssembly)
|
||||
|
||||
|
||||
m_binit = True
|
||||
|
||||
errOut:
|
||||
|
||||
|
||||
b = False
|
||||
|
||||
|
||||
TreeView1.Enabled = True
|
||||
largepict.SetFocus
|
||||
DoEvents
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
' Command1_Click
|
||||
' Add To Invoice
|
||||
'
|
||||
Private Sub Command1_Click()
|
||||
|
||||
Dim itm As ListItem
|
||||
If Text1.Text = "" Then Exit Sub
|
||||
|
||||
Set itm = ListView1.ListItems.Add(, , Text2.Text)
|
||||
itm.SubItems(1) = Text3.Text
|
||||
itm.SubItems(2) = Text1.Text
|
||||
Set ListView1.SelectedItem = itm
|
||||
itm.EnsureVisible
|
||||
Text8.Text = format(val(Text8.Text) + val(Text3.Text), "#0.00")
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
' Command1_Click
|
||||
' Delete from Invoice
|
||||
'
|
||||
Private Sub Command2_Click()
|
||||
If ListView1.SelectedItem Is Nothing Then Exit Sub
|
||||
|
||||
Text8 = format(val(Text8.Text) - val(ListView1.SelectedItem.SubItems(1)), "#0.00")
|
||||
ListView1.ListItems.Remove ListView1.SelectedItem.index
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' Form_QueryUnload
|
||||
'
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
fLoading = True
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'- MouseDown
|
||||
'
|
||||
Private Sub largepict_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
|
||||
If m_binit = False Then Exit Sub
|
||||
|
||||
Dim b As Boolean
|
||||
Dim mb As CD3DMesh
|
||||
Dim r As Integer, c As Integer
|
||||
Dim f As CD3DFrame
|
||||
Dim p As CD3DFrame
|
||||
Dim strName As String
|
||||
Dim pick As CD3DPick
|
||||
Dim n As Long
|
||||
|
||||
'- save our current position
|
||||
m_bMouseDown = True
|
||||
m_lastX = x
|
||||
m_lastY = y
|
||||
|
||||
|
||||
If Button = 1 Then
|
||||
|
||||
'Get the frame under the the mouse
|
||||
Set pick = New CD3DPick
|
||||
If Not pick.ViewportPick(m_scene, x, y) Then Exit Sub
|
||||
|
||||
|
||||
n = pick.FindNearest()
|
||||
If n < 0 Then Exit Sub
|
||||
Set f = pick.GetFrame(n)
|
||||
|
||||
|
||||
'Get its id and call SelectPart
|
||||
'to fill in our text boxes
|
||||
strName = f.ObjectName
|
||||
strName = Right$(strName, Len(strName) - 1)
|
||||
'The words V6 and Chevy are part of the manifold cover.
|
||||
If strName = "words" Or strName = "v6" Then strName = "manifoldt"
|
||||
|
||||
SelectPart strName, f.ObjectName
|
||||
SelectTreeview strName
|
||||
DoEvents
|
||||
|
||||
End If
|
||||
|
||||
RenderScene
|
||||
|
||||
End Sub
|
||||
|
||||
'- MOUSE MOVE
|
||||
'
|
||||
Private Sub largepict_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
|
||||
'- dont do anything unless the mouse is down
|
||||
If m_bMouseDown = False Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'- Rotate the object
|
||||
RotateTrackBall CInt(x), CInt(y)
|
||||
|
||||
'- Rerender
|
||||
RenderScene
|
||||
|
||||
End Sub
|
||||
|
||||
'- MOUSE UP
|
||||
' reset the mouse state
|
||||
'
|
||||
Private Sub largepict_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
m_bMouseDown = False
|
||||
End Sub
|
||||
|
||||
'- largepict_Paint UP
|
||||
'
|
||||
Private Sub largepict_Paint()
|
||||
If Not m_binit Then Exit Sub
|
||||
RenderScene
|
||||
End Sub
|
||||
|
||||
|
||||
'- MENU_ABOUT_Click
|
||||
'
|
||||
Private Sub MENU_ABOUT_Click()
|
||||
MsgBox "The model used by this sample, engine1.x, is provided courtesy of Viewpoint" + Chr(10) + Chr(13) + _
|
||||
"Digital, Inc. (www.viewpoint.com). It is provided for use with this sample" + Chr(10) + Chr(13) + _
|
||||
"only and cannot be distributed with any application without prior written" + Chr(10) + Chr(13) + _
|
||||
"consent. V6 Engine Model copyright 1999 Viewpoint Digital, Inc.."
|
||||
End Sub
|
||||
|
||||
' MENU_EXIT_Click
|
||||
'
|
||||
Private Sub MENU_EXIT_Click()
|
||||
End
|
||||
End Sub
|
||||
|
||||
|
||||
' TreeView1_Expand
|
||||
'
|
||||
Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)
|
||||
Dim i As Long
|
||||
|
||||
Static b As Boolean
|
||||
|
||||
If b Then Exit Sub
|
||||
b = True
|
||||
|
||||
'See if they are asking for a new assembly alltogether
|
||||
If Mid$(Node.Tag, 1, 8) = "ASSMBLY:" Then
|
||||
m_bInLoad = True
|
||||
i = LoadAssembly(Node.Tag)
|
||||
If i = 0 Then
|
||||
MsgBox "Assembly not available at this time- try a different Engine"
|
||||
b = False
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
b = False
|
||||
|
||||
End Sub
|
||||
|
||||
'- TreeView1_NodeClick
|
||||
'
|
||||
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
|
||||
|
||||
Static b As Boolean
|
||||
If b Then Exit Sub
|
||||
b = True
|
||||
|
||||
Dim o As CD3DFrame
|
||||
Dim i As Long
|
||||
|
||||
If Node.Tag = "" Then
|
||||
b = False
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Fill in the text boxes
|
||||
SelectPart Node.Tag, "_" & Node.Tag
|
||||
DoEvents
|
||||
|
||||
'Render
|
||||
RenderScene
|
||||
DoEvents
|
||||
|
||||
b = False
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'- FillTreeViewControl
|
||||
Sub FillTreeViewControl()
|
||||
TreeView1.Nodes.Clear
|
||||
|
||||
Dim sPartID As String
|
||||
Dim sDesc As String
|
||||
|
||||
|
||||
'A non-demo application would build the tree view
|
||||
'from the database and dynamically load in new
|
||||
'information into the treeview
|
||||
|
||||
Dim n As Node
|
||||
Call TreeView1.Nodes.Add(, , "ASSEMBLIES", "Assemblies - [click here to start]")
|
||||
|
||||
Set n = TreeView1.Nodes.Add("ASSEMBLIES", tvwChild, "ENG V6 1996", "V6 4 Liter 1996 - [click here]")
|
||||
n.Tag = "ASSMBLY:ENG V6 1996"
|
||||
n.Selected = True
|
||||
|
||||
TreeView1.Nodes.Add("ASSEMBLIES", tvwChild, "ENG V8 1998", "V8 6 Liter 1998 - [not available]").Tag = ""
|
||||
TreeView1.Nodes.Add("ASSEMBLIES", tvwChild, "OTHERENG", "Other Assemblies not available").Tag = ""
|
||||
|
||||
m_data.MoveTop
|
||||
Do While m_data.IsEOF() = False
|
||||
sPartID = m_data.ModelPart
|
||||
sDesc = m_data.Description
|
||||
TreeView1.Nodes.Add("ENG V6 1996", tvwChild, sPartID, sDesc).Tag = sPartID
|
||||
m_data.MoveNext
|
||||
Loop
|
||||
|
||||
End Sub
|
||||
|
||||
Sub SelectTreeview(sname As String)
|
||||
On Local Error Resume Next
|
||||
TreeView1.Nodes(sname).Selected = True
|
||||
DoEvents
|
||||
End Sub
|
||||
|
||||
|
||||
'- RenderScene
|
||||
'
|
||||
Sub RenderScene()
|
||||
Dim hr As Long
|
||||
|
||||
If m_scene Is Nothing Then Exit Sub
|
||||
|
||||
|
||||
|
||||
'See what state the device is in.
|
||||
hr = g_dev.TestCooperativeLevel
|
||||
If hr = D3DERR_DEVICENOTRESET Then
|
||||
g_dev.Reset g_d3dpp
|
||||
|
||||
'reset our state
|
||||
g_lWindowWidth = largepict.ScaleWidth
|
||||
g_lWindowHeight = largepict.ScaleHeight
|
||||
D3DUtil.D3DUtil_SetupDefaultScene
|
||||
DoEvents
|
||||
ElseIf hr <> 0 Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
D3DXMatrixLookAtLH g_viewMatrix, vec3(0, 0, -1), vec3(0, 0, 0), vec3(0, 1, 0)
|
||||
g_dev.SetTransform D3DTS_VIEW, g_viewMatrix
|
||||
|
||||
D3DUtil_ClearAll m_backcolor
|
||||
g_dev.BeginScene
|
||||
m_scene.Render g_dev
|
||||
g_dev.EndScene
|
||||
D3DUtil_PresentAll 0
|
||||
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,56 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form Form2
|
||||
BorderStyle = 0 'None
|
||||
Caption = "Form2"
|
||||
ClientHeight = 1080
|
||||
ClientLeft = 0
|
||||
ClientTop = 0
|
||||
ClientWidth = 7575
|
||||
LinkTopic = "Form2"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 1080
|
||||
ScaleWidth = 7575
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.PictureBox Picture1
|
||||
Height = 855
|
||||
Left = 120
|
||||
ScaleHeight = 795
|
||||
ScaleWidth = 7275
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 7335
|
||||
Begin VB.Label Label1
|
||||
Caption = "Loading Assembly Please Wait"
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 24
|
||||
Charset = 0
|
||||
Weight = 400
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 555
|
||||
Left = 240
|
||||
TabIndex = 1
|
||||
Top = 120
|
||||
Width = 6615
|
||||
End
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "Form2"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: AutoLoad.frm
|
||||
' Content: Autoparts loading dialog
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
@@ -0,0 +1,45 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Object={86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCT2.OCX
|
||||
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
|
||||
Form=auto.frm
|
||||
Form=autoload.frm
|
||||
Class=Data; data.cls
|
||||
Class=CD3DFrame; ..\..\common\D3DFrame.cls
|
||||
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
|
||||
Class=CD3DMesh; ..\..\common\D3DMesh.cls
|
||||
Class=CD3DPick; ..\..\common\D3DPick.cls
|
||||
Module=D3DUtil; ..\..\common\D3DUtil.bas
|
||||
Module=D3DInit; ..\..\common\D3DInit.bas
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
Startup="Form1"
|
||||
ExeName32="vb_autoparts.exe"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft Corp"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
@@ -0,0 +1,176 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "Data"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: data.cls
|
||||
' Content: DATA MIDDLEWARE
|
||||
' replace with your favorite
|
||||
' database code
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
|
||||
Private Type rec
|
||||
AssemblyId As Long
|
||||
ModelPart As String
|
||||
PartID As String
|
||||
Description As String
|
||||
Price As Currency
|
||||
CompatibleParts As String
|
||||
Stock As String
|
||||
PartMake As String
|
||||
End Type
|
||||
|
||||
Dim rs() As rec
|
||||
Dim index As Integer
|
||||
Dim lastindex As Integer
|
||||
Dim maxsize As Integer
|
||||
|
||||
Public Function MoveTop()
|
||||
index = 0
|
||||
MoveTop = True
|
||||
End Function
|
||||
|
||||
Public Function IsEOF()
|
||||
If index = -1 Then IsEOF = True
|
||||
End Function
|
||||
Public Function MoveNext()
|
||||
If index = lastindex Then
|
||||
index = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
index = index + 1
|
||||
MoveNext = True
|
||||
End Function
|
||||
|
||||
Public Property Get ModelPart() As String
|
||||
ModelPart = rs(index).ModelPart
|
||||
End Property
|
||||
|
||||
Public Property Get PartID() As String
|
||||
PartID = rs(index).PartID
|
||||
End Property
|
||||
|
||||
Public Property Get Description() As String
|
||||
Description = rs(index).Description
|
||||
End Property
|
||||
|
||||
Public Property Get Price() As Currency
|
||||
Price = rs(index).Price
|
||||
End Property
|
||||
|
||||
Public Property Get CompatibleParts() As String
|
||||
CompatibleParts = rs(index).CompatibleParts
|
||||
End Property
|
||||
|
||||
Public Property Get Stock() As String
|
||||
Stock = rs(index).Stock
|
||||
End Property
|
||||
|
||||
Public Property Get PartMake() As String
|
||||
PartMake = rs(index).PartMake
|
||||
End Property
|
||||
|
||||
Public Function MoveToModelPartRecord(sname As String) As Boolean
|
||||
|
||||
For index = 0 To lastindex
|
||||
If (UCase(rs(index).ModelPart) = UCase(sname)) Then
|
||||
MoveToModelPartRecord = True
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
MoveToModelPartRecord = False
|
||||
End Function
|
||||
|
||||
Function InitData(sFile As String) As Boolean
|
||||
Dim strData As String
|
||||
On Local Error GoTo errOut
|
||||
|
||||
ReDim rs(100)
|
||||
maxsize = 100
|
||||
|
||||
Dim fl As Long
|
||||
fl = FreeFile
|
||||
index = 0
|
||||
Open sFile For Input As #fl
|
||||
Line Input #fl, strData
|
||||
Do While Not EOF(fl)
|
||||
Line Input #fl, strData
|
||||
|
||||
|
||||
Dim j As Long, q As Long
|
||||
Dim r As rec
|
||||
|
||||
'Assembly ID - what assembly does this belong to
|
||||
j = 1
|
||||
q = InStr(j, strData, Chr(9))
|
||||
r.AssemblyId = Mid$(strData, 1, q - 1)
|
||||
|
||||
'Unique ID for all parts
|
||||
j = q + 1
|
||||
q = InStr(j, strData, Chr(9))
|
||||
r.PartID = Mid$(strData, j, q - j)
|
||||
|
||||
'Model Part .. whats the name of the part in the xfile
|
||||
j = q + 1
|
||||
q = InStr(j, strData, Chr(9))
|
||||
r.ModelPart = Mid$(strData, j + 1, q - 2 - j)
|
||||
|
||||
'Part Price
|
||||
j = q + 1
|
||||
q = InStr(j, strData, Chr(9))
|
||||
r.Price =val(Mid$(strData, j + 1, q - 1 - j))
|
||||
|
||||
'Description
|
||||
j = q + 1
|
||||
q = InStr(j, strData, Chr(9))
|
||||
r.Description = Mid$(strData, j + 1, q - 2 - j)
|
||||
|
||||
'Stock
|
||||
j = q + 1
|
||||
q = InStr(j, strData, Chr(9))
|
||||
r.Stock = Mid$(strData, j, q - j)
|
||||
|
||||
'PartMake
|
||||
j = q + 1
|
||||
q = InStr(j, strData, Chr(9))
|
||||
r.PartMake = Mid$(strData, j + 1, q - j - 2)
|
||||
|
||||
'CompatibleParts
|
||||
j = q + 1
|
||||
r.CompatibleParts = Mid$(strData, j + 1)
|
||||
q = Len(r.CompatibleParts) - 1
|
||||
r.CompatibleParts = Mid$(r.CompatibleParts, 1, q)
|
||||
|
||||
If index > maxsize Then
|
||||
maxsize = maxsize + 100
|
||||
ReDim Preserve rs(maxsize)
|
||||
End If
|
||||
|
||||
rs(index) = r
|
||||
lastindex = index
|
||||
index = index + 1
|
||||
|
||||
Loop
|
||||
InitData = True
|
||||
Exit Function
|
||||
errOut:
|
||||
InitData = False
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,43 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: AutoParts Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The AutoParts sample illustrates the use of Picking against a 3D database.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDF\Samples\Multimedia\VBSamples\Direct3D\AutoParts
|
||||
|
||||
Executable: DXSDF\Samples\Multimedia\VBSamples\Direct3D\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
click where it says "click here" in the Tree view to the left to load the engine model.
|
||||
The model can be rotated by holding the left mouse button down and dragging.
|
||||
When a part has been clicked on, it is described in the lower left hand corner.
|
||||
The Add and Remove from Invoice button manage the Invoice list but the Order button has
|
||||
no function.
|
||||
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
Each object in the Engine model is named. These names are unique and can be used to cross
|
||||
reference a database (a custom text database in this example for the sake of not requiring
|
||||
the installation of MDAC). From that database more detailed information is gahtered on the
|
||||
part such as price and part number.
|
||||
|
||||
This sample makes use of common DirectX code (consisting of helper functions,
|
||||
etc.) that is shared with other samples on the DirectX SDK. All common
|
||||
classes and modules can be found in the following directory:
|
||||
DXSDF\Samples\Multimedia\VBSamples\Common
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,46 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=BarGraph.frm
|
||||
Class=DataEntry; DataEntry.cls
|
||||
Class=CD3DFrame; ..\..\common\D3DFrame.cls
|
||||
Class=CD3DMesh; ..\..\common\D3DMesh.cls
|
||||
Class=CD3DPick; ..\..\common\D3DPick.cls
|
||||
Module=D3DUtil; ..\..\common\d3dutil.bas
|
||||
Module=D3DInit; ..\..\common\d3dinit.bas
|
||||
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
Startup="GraphForm"
|
||||
HelpFile=""
|
||||
NoControlUpgrade=1
|
||||
ExeName32="vb_BarGraph.exe"
|
||||
Command32=""
|
||||
Name="BarGraph"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
UseExistingBrowser=0
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
@@ -0,0 +1,9 @@
|
||||
GraphForm = 154, 154, 649, 598, Z, 88, 1, 745, 525, C
|
||||
DataEntry = 0, 0, 0, 0, C
|
||||
CD3DFrame = 22, 22, 671, 419,
|
||||
CD3DMesh = 44, 44, 693, 441,
|
||||
CD3DPick = 44, 44, 693, 441,
|
||||
D3DUtil = 110, 110, 605, 554,
|
||||
D3DInit = 132, 132, 627, 576,
|
||||
CD3DAnimation = 0, 0, 0, 0, C
|
||||
MediaDir = 154, 154, 622, 598, C
|
||||
@@ -0,0 +1,39 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "DataEntry"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: DataEntry.cls
|
||||
' Content: Class for one data point
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Public dataname As String
|
||||
Public X As Single
|
||||
Public Y As Single
|
||||
Public z As Single
|
||||
|
||||
Public datax As Double
|
||||
Public datay As Double
|
||||
Public dataz As Double
|
||||
Public dataSize As Double
|
||||
|
||||
Public size As Double
|
||||
Public color As Long
|
||||
Public data As Variant
|
||||
Public mesh As D3DXMesh
|
||||
|
||||
|
||||
@@ -0,0 +1,60 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: BarGraph Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The BarGraph sample describes how one might use Direct3D for graphic visualization.
|
||||
It makes heavy use of the RenderToSurface features of D3DX to render text and bitmaps
|
||||
dynamically.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\BarGraph
|
||||
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
right click to bring up a pop up menu.
|
||||
from this menu you can load new data from a .csv (comma delimeted file)
|
||||
such a file can be exported from excel or any spreadsheet package.
|
||||
|
||||
The file must be formated such that the first row and columns are headers
|
||||
that title the data. They can contain the tag TEXTURE:filename.bmp to indicate
|
||||
that the header contains a picture. the rest of the data must be numeric
|
||||
see bargraphdata.csv in Mssd\Samples\Multimedia\VBSamples\Media for an example
|
||||
|
||||
Holding the left mouse button and dragging will rotate the graph.
|
||||
|
||||
Right Arrow moves the camera right
|
||||
Left Arrow moves the camera left
|
||||
Up Arrow moves the camera up
|
||||
Down Arrow moves the camera down
|
||||
W moves the camera forward
|
||||
S moves the camera backward
|
||||
E rotates the camera right
|
||||
Q rotates the camera left
|
||||
A rotates the camera up
|
||||
Z rotates the camera down
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
|
||||
|
||||
This sample makes use of common DirectX code (consisting of helper functions,
|
||||
etc.) that is shared with other samples on the DirectX SDK. All common
|
||||
classes and modules can be found in the following directory:
|
||||
DXSDK\Samples\Multimedia\VBSamples\Common
|
||||
|
||||
@@ -0,0 +1,736 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form Form1
|
||||
Caption = "Form1"
|
||||
ClientHeight = 4290
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 5580
|
||||
Icon = "billboard.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 286
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 372
|
||||
StartUpPosition = 3 'Windows Default
|
||||
End
|
||||
Attribute VB_Name = "Form1"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'-----------------------------------------------------------------------------
|
||||
' File: Billboard.frm
|
||||
'
|
||||
' Desc: Example code showing how to do billboarding. The sample uses
|
||||
' billboarding to draw some trees.
|
||||
'
|
||||
' Note: this implementation is for billboards that are fixed to rotate
|
||||
' about the Y-axis, which is good for things like trees. For
|
||||
' unconstrained billboards, like explosions in a flight sim, the
|
||||
' technique is the same, but the the billboards are positioned slightly
|
||||
' different. Try using the inverse of the view matrix, TL-vertices, or
|
||||
' some other technique.
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Option Explicit
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Defines, constants, and global variables
|
||||
'-----------------------------------------------------------------------------
|
||||
Const NUM_TREES = 200
|
||||
Const D3DFVF_TREEVERTEX = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_TEX1)
|
||||
Const NUMTREETEXTURES = 3
|
||||
|
||||
' Custom vertex type for the trees
|
||||
Private Type TREEVERTEX
|
||||
p As D3DVECTOR
|
||||
color As Long
|
||||
tu As Single
|
||||
tv As Single
|
||||
End Type
|
||||
|
||||
Dim m_bInit As Boolean ' Indicates that d3d has been initialized
|
||||
Dim m_bMinimized As Boolean ' Indicates that display window is minimized
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Tree
|
||||
' Desc: Simple structure to hold data for rendering a tree
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Type TREE
|
||||
v(3) As TREEVERTEX
|
||||
vPos As D3DVECTOR
|
||||
iTreeTexture As Long
|
||||
iNext As Long
|
||||
dist As Single
|
||||
End Type
|
||||
|
||||
Private Type HILLVERTEX
|
||||
x As Single
|
||||
y As Single
|
||||
z As Single
|
||||
tu As Single
|
||||
tv As Single
|
||||
End Type
|
||||
|
||||
|
||||
Dim m_vEyePt As D3DVECTOR
|
||||
Dim m_strTreeTextures(3) As String
|
||||
Dim m_media As String
|
||||
|
||||
Dim m_Terrain As CD3DMesh
|
||||
Dim m_SkyBox As CD3DMesh ' Skybox background object
|
||||
Dim m_TreeVB As Direct3DVertexBuffer8 ' Vertex buffer for rendering a tree
|
||||
Dim m_TreeTextures(NUMTREETEXTURES) ' Tree images
|
||||
Dim m_matBillboardMatrix As D3DMATRIX ' Used for billboard orientation
|
||||
Dim m_Trees(NUM_TREES) As TREE ' Array of tree info
|
||||
Dim m_fTime As Single
|
||||
Dim m_iTreeHead As Long
|
||||
Dim m_iSortHead As Long
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Load()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Load()
|
||||
Me.Show
|
||||
DoEvents
|
||||
|
||||
'Setup defaults
|
||||
Init
|
||||
|
||||
' Initialize D3D
|
||||
' Note: D3DUtil_Init will attempt to use D3D Hardware acceleartion.
|
||||
' If it is not available it attempt to use the Software Reference Rasterizer.
|
||||
' If all fail it will display a message box indicating so.
|
||||
'
|
||||
m_bInit = D3DUtil_Init(Me.hwnd, True, 0, 0, D3DDEVTYPE_HAL, Nothing)
|
||||
If Not (m_bInit) Then End
|
||||
|
||||
' Find media and set media directory
|
||||
m_media = FindMediaDir("Tree02S.tga")
|
||||
D3DUtil_SetMediaPath m_media
|
||||
|
||||
' Initialize Application Data
|
||||
OneTimeSceneInit
|
||||
|
||||
' Create and load mesh objects
|
||||
InitDeviceObjects
|
||||
|
||||
' Sets the state for those objects and the current D3D device
|
||||
' (setup camera and lights etc)
|
||||
RestoreDeviceObjects
|
||||
|
||||
' Start application timer
|
||||
DXUtil_Timer TIMER_start
|
||||
|
||||
' Run the simulation forever
|
||||
' See Form_Keydown for exit processing
|
||||
Do While True
|
||||
|
||||
' Increment the simulation
|
||||
FrameMove
|
||||
|
||||
' Render one image of the simulation
|
||||
If Render Then 'Success
|
||||
|
||||
' Present the image to the screen
|
||||
D3DUtil_PresentAll g_focushwnd
|
||||
End If
|
||||
|
||||
' Allow for events to get processed
|
||||
DoEvents
|
||||
|
||||
Loop
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_KeyDown()
|
||||
' Desc: Process key messages for exit and change device
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
|
||||
|
||||
Dim hr As Long
|
||||
|
||||
Select Case KeyCode
|
||||
|
||||
Case vbKeyEscape
|
||||
Unload Me
|
||||
|
||||
Case vbKeyF2
|
||||
|
||||
' Pause the timer
|
||||
DXUtil_Timer TIMER_STOP
|
||||
|
||||
' Bring up the device selection dialog
|
||||
' we pass in the form so the selection process
|
||||
' can make calls into InitDeviceObjects
|
||||
' and RestoreDeviceObjects
|
||||
frmSelectDevice.SelectDevice Me
|
||||
|
||||
' Restart the timer
|
||||
DXUtil_Timer TIMER_start
|
||||
|
||||
Case vbKeyReturn
|
||||
|
||||
' Check for Alt-Enter if not pressed exit
|
||||
If Shift <> 4 Then Exit Sub
|
||||
|
||||
' If we are windowed go fullscreen
|
||||
' If we are fullscreen returned to windowed
|
||||
If g_d3dpp.Windowed Then
|
||||
hr = D3DUtil_ResetFullscreen
|
||||
Else
|
||||
hr = D3DUtil_ResetWindowed
|
||||
End If
|
||||
|
||||
' Call Restore after ever mode change
|
||||
' because calling reset looses state that needs to
|
||||
' be reinitialized
|
||||
If (hr = D3D_OK) Then
|
||||
RestoreDeviceObjects
|
||||
End If
|
||||
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Resize()
|
||||
' Desc: hadle resizing of the D3D backbuffer
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Resize()
|
||||
|
||||
' If D3D is not initialized then exit
|
||||
If Not m_bInit Then Exit Sub
|
||||
|
||||
' If we are in a minimized state stop the timer and exit
|
||||
If Me.WindowState = vbMinimized Then
|
||||
DXUtil_Timer TIMER_STOP
|
||||
m_bMinimized = True
|
||||
Exit Sub
|
||||
|
||||
' If we just went from a minimized state to maximized
|
||||
' restart the timer
|
||||
Else
|
||||
If m_bMinimized = True Then
|
||||
DXUtil_Timer TIMER_start
|
||||
m_bMinimized = False
|
||||
End If
|
||||
End If
|
||||
|
||||
' Dont let the window get too small
|
||||
If Me.ScaleWidth < 10 Then
|
||||
Me.width = Screen.TwipsPerPixelX * 10
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Me.ScaleHeight < 10 Then
|
||||
Me.height = Screen.TwipsPerPixelY * 10
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'reset and resize our D3D backbuffer to the size of the window
|
||||
D3DUtil_ResizeWindowed Me.hwnd
|
||||
|
||||
'All state get losts after a reset so we need to reinitialze it here
|
||||
RestoreDeviceObjects
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Unload()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
DeleteDeviceObjects
|
||||
End
|
||||
End Sub
|
||||
|
||||
' Simple function to define "hilliness" for terrain
|
||||
Function HeightField(x As Single, y As Single) As Single
|
||||
HeightField = 9 * (Cos(x / 20 + 0.2) * Cos(y / 15 - 0.2) + 1#)
|
||||
End Function
|
||||
|
||||
Sub Init()
|
||||
|
||||
m_strTreeTextures(0) = "Tree02S.tga"
|
||||
m_strTreeTextures(1) = "Tree35S.tga"
|
||||
m_strTreeTextures(2) = "Tree01S.tga"
|
||||
|
||||
Me.Caption = ("Billboard: D3D Billboarding Example")
|
||||
|
||||
Set m_SkyBox = New CD3DMesh
|
||||
Set m_Terrain = New CD3DMesh
|
||||
Set m_TreeVB = Nothing
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: OneTimeSceneInit()
|
||||
' Desc: Called during initial app startup, this function performs all the
|
||||
' permanent initialization.
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub OneTimeSceneInit()
|
||||
Dim i As Long
|
||||
Dim fTheta As Single, fRadius As Single, fWidth As Single, fHeight As Single
|
||||
Dim r As Long, g As Long, b As Long, treecolor As Long
|
||||
Rnd (1)
|
||||
|
||||
' Initialize the tree data
|
||||
For i = 0 To NUM_TREES - 1
|
||||
|
||||
' Position the trees randomly
|
||||
fTheta = 2 * g_pi * Rnd()
|
||||
fRadius = 25 + 55 * Rnd()
|
||||
m_Trees(i).vPos.x = fRadius * Sin(fTheta)
|
||||
m_Trees(i).vPos.z = fRadius * Cos(fTheta)
|
||||
m_Trees(i).vPos.y = HeightField(m_Trees(i).vPos.x, m_Trees(i).vPos.z)
|
||||
|
||||
' Size the trees randomly
|
||||
fWidth = 1 + 0.2 * (Rnd() - Rnd())
|
||||
fHeight = 1.4 + 0.4 * (Rnd() - Rnd())
|
||||
|
||||
' Each tree is a random color between red and green
|
||||
r = (255 - 190) + CLng(190 * Rnd())
|
||||
g = (255 - 190) + CLng(190 * Rnd())
|
||||
b = 0
|
||||
treecolor = &HFF000000 + r * 2 ^ 16 + g * 2 ^ 8 + b
|
||||
|
||||
m_Trees(i).v(0).p = vec3(-fWidth, 0 * fHeight, 0)
|
||||
m_Trees(i).v(0).color = treecolor
|
||||
m_Trees(i).v(0).tu = 0: m_Trees(i).v(0).tv = 1
|
||||
m_Trees(i).v(1).p = vec3(-fWidth, 2 * fHeight, 0)
|
||||
m_Trees(i).v(1).color = treecolor
|
||||
m_Trees(i).v(1).tu = 0: m_Trees(i).v(1).tv = 0
|
||||
m_Trees(i).v(2).p = vec3(fWidth, 0 * fHeight, 0)
|
||||
m_Trees(i).v(2).color = treecolor
|
||||
m_Trees(i).v(2).tu = 1: m_Trees(i).v(2).tv = 1
|
||||
m_Trees(i).v(3).p = vec3(fWidth, 2 * fHeight, 0)
|
||||
m_Trees(i).v(3).color = treecolor
|
||||
m_Trees(i).v(3).tu = 1: m_Trees(i).v(3).tv = 0
|
||||
|
||||
' Size the trees randomly
|
||||
m_Trees(i).iTreeTexture = CLng((NUMTREETEXTURES - 1) * Rnd())
|
||||
m_Trees(i).iNext = i + 1
|
||||
Next
|
||||
|
||||
m_Trees(NUM_TREES - 1).iNext = -1 'use -1 to indicate end of the list
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Sort
|
||||
' Desc: Callback function for sorting trees in back-to-front order
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub DoSort()
|
||||
Dim i As Long
|
||||
Dim dx As Single, dz As Single, dist As Single
|
||||
|
||||
'calculate the square of the distance to the eyept
|
||||
'to best approximate sort order
|
||||
'CONSIDER transforming the position into screen space and sorting on z/w
|
||||
For i = 0 To NUM_TREES - 1
|
||||
dx = m_Trees(i).vPos.x - m_vEyePt.x
|
||||
dz = m_Trees(i).vPos.z - m_vEyePt.z
|
||||
m_Trees(i).dist = dx * dx + dz * dz
|
||||
Next
|
||||
|
||||
Dim iAtU As Long
|
||||
Dim iPrevU As Long
|
||||
Dim iNextU As Long
|
||||
|
||||
iAtU = m_iTreeHead
|
||||
iPrevU = -1
|
||||
iNextU = -1
|
||||
m_iSortHead = -1
|
||||
|
||||
Dim z As Long
|
||||
Dim q As Long
|
||||
|
||||
Do While iAtU <> -1
|
||||
dist = m_Trees(iAtU).dist
|
||||
|
||||
iNextU = m_Trees(iAtU).iNext
|
||||
InsertIntoList iAtU, dist
|
||||
|
||||
|
||||
|
||||
'advance to next item in Unsorted list
|
||||
iPrevU = iAtU
|
||||
iAtU = iNextU
|
||||
|
||||
Loop
|
||||
|
||||
m_iTreeHead = m_iSortHead
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InsertIntoList(iNode As Long, dist2 As Single)
|
||||
|
||||
|
||||
|
||||
Dim iAtS As Long
|
||||
Dim iPrevS As Long
|
||||
|
||||
iAtS = m_iSortHead
|
||||
iPrevS = -1
|
||||
|
||||
'If Sorted list is empty add first node
|
||||
If iAtS = -1 Then
|
||||
m_iSortHead = iNode
|
||||
m_Trees(iNode).iNext = -1
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
'see if we need to add at begining
|
||||
If m_Trees(m_iSortHead).dist < dist2 Then
|
||||
m_Trees(iNode).iNext = m_iSortHead
|
||||
m_iSortHead = iNode
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'we dont have an empty list
|
||||
'we dont need to add to front of list
|
||||
Do While iAtS <> -1
|
||||
|
||||
If m_Trees(iAtS).dist < dist2 Then
|
||||
|
||||
'add to sorted list
|
||||
m_Trees(iNode).iNext = m_Trees(iPrevS).iNext
|
||||
m_Trees(iPrevS).iNext = iNode
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'advance to next item in sorted list
|
||||
iPrevS = iAtS
|
||||
iAtS = m_Trees(iAtS).iNext
|
||||
|
||||
Loop
|
||||
|
||||
'must go at end of list
|
||||
m_Trees(iPrevS).iNext = iNode
|
||||
m_Trees(iNode).iNext = -1
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FrameMove()
|
||||
' Desc: Called once per frame, the call is the entry point for animating
|
||||
' the scene.
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub FrameMove()
|
||||
m_fTime = DXUtil_Timer(TIMER_GETAPPTIME)
|
||||
|
||||
' Get the eye and lookat points from the camera's path
|
||||
Dim vUpVec As D3DVECTOR, vEyePt As D3DVECTOR, vLookAtpt As D3DVECTOR
|
||||
vUpVec = vec3(0, 1, 0)
|
||||
|
||||
vEyePt.x = 30 * Cos(0.8 * (m_fTime + 1))
|
||||
vEyePt.z = 30 * Sin(0.8 * (m_fTime + 1))
|
||||
vEyePt.y = 4 + HeightField(vEyePt.x, vEyePt.z)
|
||||
|
||||
vLookAtpt.x = 30 * Cos(0.8 * (m_fTime + 1.5))
|
||||
vLookAtpt.z = 30 * Sin(0.8 * (m_fTime + 1.5))
|
||||
vLookAtpt.y = vEyePt.y - 1
|
||||
|
||||
' Set the app view matrix for normal viewing
|
||||
Dim matView As D3DMATRIX
|
||||
D3DXMatrixLookAtLH matView, vEyePt, vLookAtpt, vUpVec
|
||||
g_dev.SetTransform D3DTS_VIEW, matView
|
||||
|
||||
' Set up a rotation matrix to orient the billboard towards the camera.
|
||||
Dim vDir As D3DVECTOR
|
||||
D3DXVec3Subtract vDir, vLookAtpt, vEyePt
|
||||
|
||||
If (vDir.x > 0) Then
|
||||
D3DXMatrixRotationY m_matBillboardMatrix, -Atn(vDir.z / vDir.x) + (g_pi / 2)
|
||||
Else
|
||||
D3DXMatrixRotationY m_matBillboardMatrix, -Atn(vDir.z / vDir.x) - (g_pi / 2)
|
||||
End If
|
||||
|
||||
' Sort trees in back-to-front order
|
||||
m_vEyePt = vEyePt
|
||||
|
||||
|
||||
DoSort
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: DrawTrees()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub DrawTrees()
|
||||
Dim i As Long
|
||||
|
||||
' Set diffuse blending for alpha set in vertices.
|
||||
g_dev.SetRenderState D3DRS_ALPHABLENDENABLE, 1 'TRUE
|
||||
g_dev.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
|
||||
g_dev.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
|
||||
|
||||
' Enable alpha testing (skips pixels with less than a certain alpha.)
|
||||
If ((g_d3dCaps.AlphaCmpCaps And D3DPCMPCAPS_GREATEREQUAL) = D3DPCMPCAPS_GREATEREQUAL) Then
|
||||
g_dev.SetRenderState D3DRS_ALPHATESTENABLE, 1 'TRUE
|
||||
g_dev.SetRenderState D3DRS_ALPHAREF, &H8&
|
||||
g_dev.SetRenderState D3DRS_ALPHAFUNC, D3DCMP_GREATEREQUAL
|
||||
End If
|
||||
|
||||
' Loop through and render all trees
|
||||
'For i = 0 To NUM_TREES
|
||||
i = m_iTreeHead
|
||||
Do While i <> -1
|
||||
|
||||
' Set the tree texture
|
||||
g_dev.SetTexture 0, m_TreeTextures(m_Trees(i).iTreeTexture)
|
||||
|
||||
' Translate the billboard into place
|
||||
m_matBillboardMatrix.m41 = m_Trees(i).vPos.x
|
||||
m_matBillboardMatrix.m42 = m_Trees(i).vPos.y
|
||||
m_matBillboardMatrix.m43 = m_Trees(i).vPos.z
|
||||
g_dev.SetTransform D3DTS_WORLD, m_matBillboardMatrix
|
||||
|
||||
' Copy tree mesh into vertexbuffer
|
||||
Dim v As TREEVERTEX
|
||||
D3DVertexBuffer8SetData m_TreeVB, 0, Len(v) * 4, 0, m_Trees(i).v(0)
|
||||
|
||||
|
||||
' Render the billboards one at a time
|
||||
' CONSIDER: putting this in larger vertex buffers sorted by texture
|
||||
g_dev.SetStreamSource 0, m_TreeVB, Len(v)
|
||||
g_dev.SetVertexShader D3DFVF_TREEVERTEX
|
||||
g_dev.DrawPrimitive D3DPT_TRIANGLESTRIP, 0, 2
|
||||
|
||||
i = m_Trees(i).iNext
|
||||
Loop
|
||||
'Next
|
||||
|
||||
' Restore state
|
||||
Dim matWorld As D3DMATRIX
|
||||
|
||||
D3DXMatrixIdentity matWorld
|
||||
g_dev.SetTransform D3DTS_WORLD, matWorld
|
||||
g_dev.SetRenderState D3DRS_ALPHATESTENABLE, 0 ' FALSE
|
||||
g_dev.SetRenderState D3DRS_ALPHABLENDENABLE, 0 ' FALSE
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Render()
|
||||
' Desc: Called once per frame, the call is the entry point for 3d
|
||||
' rendering. This function sets up render states, clears the
|
||||
' viewport, and renders the scene.
|
||||
'-----------------------------------------------------------------------------
|
||||
Function Render() As Boolean
|
||||
|
||||
Dim matView As D3DMATRIX, matViewSave As D3DMATRIX, hr As Long
|
||||
|
||||
Render = False
|
||||
'See what state the device is in.
|
||||
hr = g_dev.TestCooperativeLevel
|
||||
If hr = D3DERR_DEVICENOTRESET Then
|
||||
On Error Resume Next
|
||||
g_dev.Reset g_d3dpp
|
||||
If (Err.Number = D3D_OK) Then
|
||||
RestoreDeviceObjects
|
||||
End If
|
||||
On Error GoTo 0
|
||||
ElseIf hr <> 0 Then
|
||||
Exit Function 'dont bother rendering if we are not ready yet
|
||||
End If
|
||||
Render = True
|
||||
' Clear the viewport
|
||||
g_dev.Clear ByVal 0, ByVal 0, D3DCLEAR_ZBUFFER, &H0, 1, 0
|
||||
|
||||
' Begin the scene
|
||||
g_dev.BeginScene
|
||||
|
||||
' Render the Skybox
|
||||
|
||||
' Center view matrix for skybox and disable zbuffer
|
||||
|
||||
g_dev.GetTransform D3DTS_VIEW, matViewSave
|
||||
matView = matViewSave
|
||||
matView.m41 = 0: matView.m42 = -0.3: matView.m43 = 0
|
||||
g_dev.SetTransform D3DTS_VIEW, matView
|
||||
g_dev.SetRenderState D3DRS_ZENABLE, 0 ' FALSE
|
||||
|
||||
' Render the skybox
|
||||
m_SkyBox.Render g_dev
|
||||
|
||||
' Restore the render states
|
||||
g_dev.SetTransform D3DTS_VIEW, matViewSave
|
||||
g_dev.SetRenderState D3DRS_ZENABLE, 1 'TRUE
|
||||
|
||||
' Draw the terrain
|
||||
m_Terrain.Render g_dev
|
||||
|
||||
' Draw the trees
|
||||
DrawTrees
|
||||
|
||||
|
||||
' End the scene.
|
||||
g_dev.EndScene
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitDeviceObjects()
|
||||
' Desc: This creates all device-dependant managed objects, such as managed
|
||||
' textures and managed vertex buffers.
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub InitDeviceObjects()
|
||||
Dim i As Long
|
||||
Dim v As TREEVERTEX
|
||||
|
||||
' Create the tree textures
|
||||
For i = 0 To NUMTREETEXTURES - 1
|
||||
Set m_TreeTextures(i) = g_d3dx.CreateTextureFromFileEx(g_dev, m_media + m_strTreeTextures(i), 256, 256, D3DX_DEFAULT, 0, D3DFMT_A1R5G5B5, D3DPOOL_MANAGED, D3DX_DEFAULT, D3DX_DEFAULT, &HFF000000, ByVal 0, ByVal 0)
|
||||
Next
|
||||
|
||||
' Create a quad for rendering each tree
|
||||
Set m_TreeVB = g_dev.CreateVertexBuffer(4 * Len(v), 0, D3DFVF_TREEVERTEX, D3DPOOL_MANAGED)
|
||||
|
||||
' Load the skybox
|
||||
m_SkyBox.InitFromFile g_dev, m_media + "SkyBox2.x"
|
||||
|
||||
' Load the terrain
|
||||
m_Terrain.InitFromFile g_dev, m_media + "SeaFloor.x"
|
||||
|
||||
|
||||
' Add some "hilliness" to the terrain
|
||||
Dim HillVB As Direct3DVertexBuffer8, NumHillVerts As Long
|
||||
Dim HillVerts() As HILLVERTEX
|
||||
Set HillVB = m_Terrain.mesh.GetVertexBuffer()
|
||||
|
||||
NumHillVerts = m_Terrain.mesh.GetNumVertices
|
||||
ReDim HillVerts(NumHillVerts)
|
||||
|
||||
D3DVertexBuffer8GetData HillVB, 0, NumHillVerts * Len(HillVerts(0)), 0, HillVerts(0)
|
||||
For i = 0 To NumHillVerts - 1
|
||||
HillVerts(i).y = HeightField(HillVerts(i).x, HillVerts(i).z)
|
||||
Next
|
||||
D3DVertexBuffer8SetData HillVB, 0, NumHillVerts * Len(HillVerts(0)), 0, HillVerts(0)
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RestoreDeviceObjects()
|
||||
' Desc: Restore device-memory objects and state after a device is created or
|
||||
' resized.
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub RestoreDeviceObjects()
|
||||
|
||||
' Restore the device objects for the meshes and fonts
|
||||
m_Terrain.RestoreDeviceObjects g_dev
|
||||
m_SkyBox.RestoreDeviceObjects g_dev
|
||||
|
||||
' Set the transform matrices (view and world are updated per frame)
|
||||
Dim matProj As D3DMATRIX
|
||||
D3DXMatrixPerspectiveFovLH matProj, g_pi / 4, Me.ScaleHeight / Me.ScaleWidth, 1, 100
|
||||
g_dev.SetTransform D3DTS_PROJECTION, matProj
|
||||
|
||||
' Set up the default texture states
|
||||
g_dev.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_SELECTARG1
|
||||
g_dev.SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
|
||||
g_dev.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG1
|
||||
g_dev.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_TEXTURE
|
||||
g_dev.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
|
||||
g_dev.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
|
||||
g_dev.SetTextureStageState 0, D3DTSS_ADDRESSU, D3DTADDRESS_CLAMP
|
||||
g_dev.SetTextureStageState 0, D3DTSS_ADDRESSV, D3DTADDRESS_CLAMP
|
||||
|
||||
g_dev.SetRenderState D3DRS_DITHERENABLE, 1 'TRUE
|
||||
g_dev.SetRenderState D3DRS_ZENABLE, 1 'TRUE )
|
||||
g_dev.SetRenderState D3DRS_LIGHTING, 0 'FALSE )
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InvalidateDeviceObjects()
|
||||
' Desc: Called when the device-dependant objects are about to be lost.
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub InvalidateDeviceObjects()
|
||||
|
||||
m_Terrain.InvalidateDeviceObjects
|
||||
m_SkyBox.InvalidateDeviceObjects
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: DeleteDeviceObjects()
|
||||
' Desc: Called when the app is exitting, or the device is being changed,
|
||||
' this function deletes any device dependant objects.
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub DeleteDeviceObjects()
|
||||
|
||||
Dim i As Long
|
||||
|
||||
m_Terrain.Destroy
|
||||
m_SkyBox.Destroy
|
||||
|
||||
For i = 0 To NUMTREETEXTURES - 1
|
||||
Set m_TreeTextures(i) = Nothing
|
||||
Next
|
||||
|
||||
m_bInit = False
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FinalCleanup()
|
||||
' Desc: Called before the app exits, this function gives the app the chance
|
||||
' to cleanup after itself.
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub FinalCleanup()
|
||||
Set m_Terrain = Nothing
|
||||
Set m_SkyBox = Nothing
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: VerifyDevice()
|
||||
' Desc: Called during device intialization, this code checks the device
|
||||
' for some minimum set of capabilities
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function VerifyDevice(usageflags As Long, format As CONST_D3DFORMAT) As Boolean
|
||||
|
||||
' This sample uses alpha textures and/or straight alpha. Make sure the
|
||||
' device supports them
|
||||
|
||||
If ((g_d3dCaps.TextureCaps And D3DPTEXTURECAPS_ALPHAPALETTE) = D3DPTEXTURECAPS_ALPHAPALETTE) Then VerifyDevice = True
|
||||
If ((g_d3dCaps.TextureCaps And D3DPTEXTURECAPS_ALPHA) = D3DPTEXTURECAPS_ALPHA) Then VerifyDevice = True
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,41 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=billboard.frm
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
Module=D3DInit; ..\..\common\D3DInit.bas
|
||||
Module=D3DUtil; ..\..\common\D3DUtil.bas
|
||||
Class=CD3DFrame; ..\..\common\D3DFrame.cls
|
||||
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
|
||||
Class=CD3DMesh; ..\..\common\D3DMesh.cls
|
||||
Form=..\..\common\SelectDevice.frm
|
||||
Startup="Form1"
|
||||
ExeName32="vb_billboard.exe"
|
||||
Command32=""
|
||||
Name="Billboard"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 1.1 KiB |
@@ -0,0 +1,60 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
// Name: Billboard Direct3D Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The Billboard sample illustrates the billboarding technique. Rather than
|
||||
rendering complex 3D models (such as a high-polygon tree model),
|
||||
billboarding renders a 2D image of the model and rotates it to always face
|
||||
the eyepoint. This technique is commonly used to render trees, clouds,
|
||||
smoke, explosions, and more. For more information, see
|
||||
Common Techniques and Special Effects.
|
||||
|
||||
The sample has a camera fly around a 3D scene with a tree-covered hill. The
|
||||
trees look like 3D objects, but they are actually 2-D billboarded images
|
||||
that are rotated towards the eye point. The hilly terrain and the skybox
|
||||
(6-sided cube containing sky textures) are just objects loaded from .x
|
||||
files, used for visual effect, and are unrelated to the billboarding
|
||||
technique.
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\Vbsamples\Direct3D\Billboard
|
||||
Executable: DXSDK\Samples\Multimedia\vbsamples\Direct3D\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
The following keys are implemented. The dropdown menus can be used for the
|
||||
same controls.
|
||||
|
||||
<F2> Prompts user to select a new rendering device or display mode
|
||||
<Alt+Enter> Toggles between fullscreen and windowed modes
|
||||
<Esc> Exits the app.
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
The billboarding technique is the focus of this sample. Each frame, the
|
||||
camera is moved, so the viewpoint changes accordingly. As the viewpoint
|
||||
changes, a rotation matrix is generated to rotate the billboards about
|
||||
the y-axis so that they face the new viewpoint. The computation of the
|
||||
billboard matrix occurs in the FrameMove() function. The trees are also
|
||||
sorted in that function, as required for proper alpha blanding, since
|
||||
billboards typically have some transparent pixels. The trees are
|
||||
rendered from a vertex buffer in the DrawTrees() function.
|
||||
|
||||
Note that the billboards in this sample are constrained to rotate about the
|
||||
y-axis only, as otherwise the tree trunks would appear to not be fixed to
|
||||
the ground. In a 3D flight sim or space shooter, for effects like
|
||||
explosions, billboards are typically not constrained to one axis.
|
||||
|
||||
This sample makes use of common DirectX code (consisting of helper functions,
|
||||
etc.) that is shared with other samples on the DirectX SDK. All common
|
||||
classes and modules can be found in the following directory:
|
||||
DXSDK\Samples\Multimedia\VBSamples\Common
|
||||
|
||||
@@ -0,0 +1,723 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form Form1
|
||||
Caption = "Dolphin: Blending Meshes in Real Time"
|
||||
ClientHeight = 4290
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 5580
|
||||
Icon = "dolphin.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 286
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 372
|
||||
StartUpPosition = 3 'Windows Default
|
||||
End
|
||||
Attribute VB_Name = "Form1"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: Dolphin.frm
|
||||
' Content: Sample of swimming dolphin
|
||||
' This code uses the D3D Framework helper library.
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Globals variables and definitions
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Const WATER_COLOR = &H6688&
|
||||
Const AMBIENT_COLOR = &H33333333
|
||||
Const kMesh1 = 0
|
||||
Const kMesh2 = 1
|
||||
Const kMesh3 = 2
|
||||
|
||||
'Vertex type to be sent to D3D
|
||||
Private Type DOLPHINVERTEX
|
||||
p As D3DVECTOR 'position of vertex
|
||||
n As D3DVECTOR 'normal of vertex
|
||||
tu As Single 'texture coordinate u
|
||||
tv As Single 'texture coordinate v
|
||||
End Type
|
||||
|
||||
'VertexFormat to be sent to D3D to describe what
|
||||
'elements DOLPHINVERTEX uses
|
||||
Const VertexFVF& = D3DFVF_XYZ Or D3DFVF_NORMAL Or D3DFVF_TEX1
|
||||
|
||||
'Helper structure to manage moving vertex information
|
||||
'from d3dvertex buffers to a vb array
|
||||
Private Type MESHTOOL
|
||||
VertB As Direct3DVertexBuffer8
|
||||
NumVertices As Long
|
||||
Vertices() As DOLPHINVERTEX
|
||||
End Type
|
||||
|
||||
'Dolphin objects
|
||||
Dim m_DolphinGroupObject As CD3DFrame ' Frame that contains all mesh poses
|
||||
Dim m_DolphinMesh01 As CD3DMesh ' Dolphin Mesh in pose 1
|
||||
Dim m_DolphinMesh02 As CD3DMesh ' Dolphin Mesh in pose 2 (rest pose)
|
||||
Dim m_DolphinMesh03 As CD3DMesh ' Dolphin Mesh in pose 3
|
||||
Dim m_DolphinObject As CD3DFrame ' Frame that contains current pose
|
||||
Dim m_DolphinMesh As CD3DMesh ' Dolphin Mesh in current pose
|
||||
|
||||
Dim m_DolphinTex As Direct3DTexture8 ' Dolphin texture
|
||||
|
||||
'Seafloor objects
|
||||
Dim m_FloorObject As CD3DFrame ' Frame that contains seafloor mesh
|
||||
Dim m_SeaFloorMesh As CD3DMesh ' Seafloor Mesh
|
||||
|
||||
Dim m_meshtool(3) As MESHTOOL ' VertexInformation on the 3 poses
|
||||
Dim m_dest As MESHTOOL ' VertexInformation on the current pose
|
||||
|
||||
'Textures for the water caustics
|
||||
Dim m_CausticTextures() As Direct3DTexture8 ' Array of caustic textures
|
||||
Dim m_CurrentCausticTexture As Direct3DTexture8 ' Current texture
|
||||
|
||||
Dim m_media As String ' Path to media
|
||||
Dim g_ftime As Single ' Current time in simulation
|
||||
Dim m_bInit As Boolean ' Indicates that d3d has been initialized
|
||||
Dim m_bMinimized As Boolean ' Indicates that display window is minimized
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Load()
|
||||
' Desc: Main entry point for the sample
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Load()
|
||||
|
||||
|
||||
' Show the form
|
||||
Me.Show
|
||||
DoEvents
|
||||
|
||||
|
||||
' Initialize D3D
|
||||
' Note: D3DUtil_Init will attempt to use D3D Hardware acceleartion.
|
||||
' If it is not available it attempt to use the Software Reference Rasterizer.
|
||||
' If all fail it will display a message box indicating so.
|
||||
'
|
||||
m_bInit = D3DUtil_Init(Me.hwnd, True, 0, 0, D3DDEVTYPE_HAL, Nothing)
|
||||
If Not (m_bInit) Then End
|
||||
|
||||
|
||||
' Find and set the path to our media
|
||||
m_media = FindMediaDir("dolphin_group.x")
|
||||
D3DUtil_SetMediaPath m_media
|
||||
|
||||
' Create new D3D mesh objects and loads content from disk
|
||||
InitDeviceObjects
|
||||
|
||||
' Sets the state for those objects and the current D3D device
|
||||
RestoreDeviceObjects
|
||||
|
||||
' Start our timer
|
||||
DXUtil_Timer TIMER_start
|
||||
|
||||
' Run the simulation forever
|
||||
' See Form_Keydown for exit processing
|
||||
Do While True
|
||||
|
||||
' Increment the simulation
|
||||
FrameMove
|
||||
|
||||
' Render one image of the simulation
|
||||
If Render Then 'It was successfull
|
||||
|
||||
' Present the image to the screen
|
||||
D3DUtil_PresentAll g_focushwnd
|
||||
End If
|
||||
|
||||
' Allow for events to get processed
|
||||
DoEvents
|
||||
|
||||
Loop
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_KeyDown()
|
||||
' Desc: Process key messages for exit and change device
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
|
||||
Select Case KeyCode
|
||||
|
||||
Case vbKeyEscape
|
||||
Unload Me
|
||||
|
||||
Case vbKeyF2
|
||||
|
||||
' Pause the timer
|
||||
DXUtil_Timer TIMER_STOP
|
||||
|
||||
' Bring up the device selection dialog
|
||||
' we pass in the form so the selection process
|
||||
' can make calls into InitDeviceObjects
|
||||
' and RestoreDeviceObjects
|
||||
frmSelectDevice.SelectDevice Me
|
||||
|
||||
' Restart the timer
|
||||
DXUtil_Timer TIMER_start
|
||||
|
||||
Case vbKeyReturn
|
||||
|
||||
' Check for Alt-Enter if not pressed exit
|
||||
If Shift <> 4 Then Exit Sub
|
||||
|
||||
' If we are windowed go fullscreen
|
||||
' If we are fullscreen returned to windowed
|
||||
If g_d3dpp.Windowed Then
|
||||
D3DUtil_ResetFullscreen
|
||||
Else
|
||||
D3DUtil_ResetWindowed
|
||||
End If
|
||||
|
||||
' Call Restore after ever mode change
|
||||
' because calling reset looses state that needs to
|
||||
' be reinitialized
|
||||
RestoreDeviceObjects
|
||||
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Resize()
|
||||
' Desc: hadle resizing of the D3D backbuffer
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Resize()
|
||||
|
||||
' If D3D is not initialized then exit
|
||||
If Not m_bInit Then Exit Sub
|
||||
|
||||
' If we are in a minimized state stop the timer and exit
|
||||
If Me.WindowState = vbMinimized Then
|
||||
DXUtil_Timer TIMER_STOP
|
||||
m_bMinimized = True
|
||||
Exit Sub
|
||||
|
||||
' If we just went from a minimized state to maximized
|
||||
' restart the timer
|
||||
Else
|
||||
If m_bMinimized = True Then
|
||||
DXUtil_Timer TIMER_start
|
||||
m_bMinimized = False
|
||||
End If
|
||||
End If
|
||||
|
||||
' Dont let the window get too small
|
||||
If Me.ScaleWidth < 10 Then
|
||||
Me.width = Screen.TwipsPerPixelX * 10
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Me.ScaleHeight < 10 Then
|
||||
Me.height = Screen.TwipsPerPixelY * 10
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
'reset and resize our D3D backbuffer to the size of the window
|
||||
D3DUtil_ResizeWindowed Me.hwnd
|
||||
|
||||
'All state get losts after a reset so we need to reinitialze it here
|
||||
RestoreDeviceObjects
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Unload()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
DeleteDeviceObjects
|
||||
End
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitDeviceObjects()
|
||||
' Desc: Create mesh and texture objects
|
||||
'-----------------------------------------------------------------------------
|
||||
Function InitDeviceObjects() As Boolean
|
||||
|
||||
Dim b As Boolean
|
||||
Dim t As Long
|
||||
Dim strName As String
|
||||
Dim i As Long
|
||||
|
||||
|
||||
'Allocate an array for the caustic textures
|
||||
ReDim m_CausticTextures(32)
|
||||
|
||||
'Load caustic textures into an array
|
||||
For t = 0 To 31
|
||||
strName = m_media + "Caust" + format$(t, "00") + ".tga"
|
||||
Set m_CausticTextures(t) = D3DUtil_CreateTexture(g_dev, strName, D3DFMT_UNKNOWN)
|
||||
If m_CausticTextures(t) Is Nothing Then Debug.Print "Unable to find media " + strName
|
||||
Next
|
||||
|
||||
' Load the file-based mesh objects
|
||||
Set m_DolphinGroupObject = D3DUtil_LoadFromFile(m_media + "dolphin_group.x", Nothing, Nothing)
|
||||
Set m_DolphinObject = D3DUtil_LoadFromFile(m_media + "dolphin.x", Nothing, Nothing)
|
||||
Set m_FloorObject = D3DUtil_LoadFromFile(m_media + "seafloor.x", Nothing, Nothing)
|
||||
|
||||
|
||||
' Gain access to the meshes from the parent frames
|
||||
Set m_DolphinMesh01 = m_DolphinGroupObject.FindChildObject("Dolph01", 0)
|
||||
Set m_DolphinMesh02 = m_DolphinGroupObject.FindChildObject("Dolph02", 0)
|
||||
Set m_DolphinMesh03 = m_DolphinGroupObject.FindChildObject("Dolph03", 0)
|
||||
Set m_DolphinMesh = m_DolphinObject.FindChildObject("Dolph02", 0).GetChildMesh(0)
|
||||
Set m_SeaFloorMesh = m_FloorObject.FindChildObject("SeaFloor", 0)
|
||||
|
||||
' Set the FVF (flexible vertex format) to one we reconginze
|
||||
Call m_DolphinMesh01.SetFVF(g_dev, VertexFVF)
|
||||
Call m_DolphinMesh02.SetFVF(g_dev, VertexFVF)
|
||||
Call m_DolphinMesh03.SetFVF(g_dev, VertexFVF)
|
||||
Call m_DolphinMesh.SetFVF(g_dev, VertexFVF)
|
||||
Call m_SeaFloorMesh.SetFVF(g_dev, VertexFVF)
|
||||
|
||||
' Load the texture for the dolphin's skin
|
||||
Set m_DolphinTex = D3DUtil_CreateTexture(g_dev, m_media + "dolphin.bmp", D3DFMT_UNKNOWN)
|
||||
|
||||
|
||||
' The folowing scales the sea floor vertices, and adds some bumpiness
|
||||
Dim seafloortool As MESHTOOL
|
||||
|
||||
' Meshtool init copies mesh vertices from the mesh object into the
|
||||
' seafloortool.vertices array
|
||||
MESHTOOL_INIT seafloortool, m_SeaFloorMesh.mesh
|
||||
|
||||
' Loop through and modify height (y) of vertices
|
||||
For i = 0 To seafloortool.NumVertices - 1
|
||||
seafloortool.Vertices(i).p.y = seafloortool.Vertices(i).p.y + Rnd(1) + Rnd(1) + Rnd(1)
|
||||
seafloortool.Vertices(i).tu = seafloortool.Vertices(i).tu * 10
|
||||
seafloortool.Vertices(i).tv = seafloortool.Vertices(i).tv * 10
|
||||
Next
|
||||
|
||||
' Save modified vertices back to the vertex buffer and cleanup seafloortool object
|
||||
D3DVertexBuffer8SetData seafloortool.VertB, 0, Len(seafloortool.Vertices(0)) * seafloortool.NumVertices, 0, seafloortool.Vertices(0)
|
||||
MESHTOOL_DESTROY seafloortool
|
||||
|
||||
' Extract vertex information for the 3 dolphin poses
|
||||
MESHTOOL_INIT m_meshtool(kMesh1), m_DolphinMesh01.mesh
|
||||
MESHTOOL_INIT m_meshtool(kMesh2), m_DolphinMesh02.mesh
|
||||
MESHTOOL_INIT m_meshtool(kMesh3), m_DolphinMesh03.mesh
|
||||
|
||||
' size Vertices array for the current pose
|
||||
MESHTOOL_INIT m_dest, m_DolphinMesh.mesh
|
||||
|
||||
|
||||
InitDeviceObjects = True
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RestoreDeviceObjects()
|
||||
' Desc: Restore device-memory objects and state after a device is created or
|
||||
' resized.
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub RestoreDeviceObjects()
|
||||
|
||||
'Restore Mesh objects
|
||||
m_DolphinGroupObject.RestoreDeviceObjects g_dev
|
||||
m_DolphinObject.RestoreDeviceObjects g_dev
|
||||
m_FloorObject.RestoreDeviceObjects g_dev
|
||||
|
||||
|
||||
With g_dev
|
||||
|
||||
|
||||
' Set world transform
|
||||
Dim matWorld As D3DMATRIX
|
||||
D3DXMatrixIdentity matWorld
|
||||
.SetTransform D3DTS_WORLD, matWorld
|
||||
|
||||
|
||||
' Set the view matrix for normal viewing
|
||||
Dim vEyePt As D3DVECTOR, vLookatPt As D3DVECTOR, vUpVec As D3DVECTOR
|
||||
Dim matView As D3DMATRIX
|
||||
vEyePt = vec3(0, 0, -5)
|
||||
vLookatPt = vec3(0, 0, 0)
|
||||
vUpVec = vec3(0, 1, 0)
|
||||
D3DXMatrixLookAtLH matView, vEyePt, vLookatPt, vUpVec
|
||||
.SetTransform D3DTS_VIEW, matView
|
||||
|
||||
|
||||
' Set the projection matrix
|
||||
Dim matProj As D3DMATRIX
|
||||
Dim fAspect As Single
|
||||
fAspect = Me.ScaleHeight / Me.ScaleWidth
|
||||
D3DXMatrixPerspectiveFovLH matProj, g_pi / 3, fAspect, 1, 10000
|
||||
.SetTransform D3DTS_PROJECTION, matProj
|
||||
|
||||
' Set texture stages to modulate the diffuse color with the texture color
|
||||
.SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
|
||||
.SetTextureStageState 0, D3DTSS_COLORARG2, D3DTA_DIFFUSE
|
||||
.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_MODULATE
|
||||
.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
|
||||
.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
|
||||
.SetTextureStageState 1, D3DTSS_MINFILTER, D3DTEXF_LINEAR
|
||||
.SetTextureStageState 1, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
|
||||
|
||||
' Set default render states
|
||||
.SetRenderState D3DRS_DITHERENABLE, 1 'True
|
||||
.SetRenderState D3DRS_SPECULARENABLE, 0 'False
|
||||
.SetRenderState D3DRS_ZENABLE, 1 'True
|
||||
.SetRenderState D3DRS_NORMALIZENORMALS, 1 'True
|
||||
|
||||
' Turn on fog, for underwater effect
|
||||
Dim fFogStart As Single
|
||||
Dim fFogEnd As Single
|
||||
fFogStart = 1
|
||||
fFogEnd = 50
|
||||
.SetRenderState D3DRS_FOGENABLE, 1 ' True
|
||||
.SetRenderState D3DRS_FOGCOLOR, WATER_COLOR
|
||||
.SetRenderState D3DRS_FOGTABLEMODE, D3DFOG_NONE
|
||||
.SetRenderState D3DRS_FOGVERTEXMODE, D3DFOG_LINEAR
|
||||
.SetRenderState D3DRS_RANGEFOGENABLE, 0 'False
|
||||
.SetRenderState D3DRS_FOGSTART, FtoDW(fFogStart)
|
||||
.SetRenderState D3DRS_FOGEND, FtoDW(fFogEnd)
|
||||
|
||||
' Create a directional light pointing straight down
|
||||
Dim light As D3DLIGHT8
|
||||
D3DUtil_InitLight light, D3DLIGHT_DIRECTIONAL, 0, -1, 0
|
||||
.SetLight 0, light
|
||||
.LightEnable 0, 1 'True
|
||||
.SetRenderState D3DRS_LIGHTING, 1 'TRUE
|
||||
.SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
|
||||
End With
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: MESHTOOL_INIT()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub MESHTOOL_INIT(mt As MESHTOOL, m As D3DXMesh)
|
||||
Set mt.VertB = m.GetVertexBuffer
|
||||
mt.NumVertices = m.GetNumVertices
|
||||
ReDim mt.Vertices(mt.NumVertices)
|
||||
D3DVertexBuffer8GetData mt.VertB, 0, mt.NumVertices * Len(mt.Vertices(0)), 0, mt.Vertices(0)
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: MESHTOOL_DESTROY()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub MESHTOOL_DESTROY(mt As MESHTOOL)
|
||||
Set mt.VertB = Nothing
|
||||
ReDim mt.Vertices(0)
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FrameMove()
|
||||
' Desc: Called once per image frame, the call is the entry point for animating
|
||||
' the scene.
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Sub FrameMove()
|
||||
|
||||
'Dont do anything if in a minimized state
|
||||
If m_bMinimized = True Then Exit Sub
|
||||
|
||||
'Get the time as a single
|
||||
g_ftime = DXUtil_Timer(TIMER_GETAPPTIME) * 0.9
|
||||
|
||||
Dim fKickFreq As Single, fPhase As Single, fBlendWeight As Single
|
||||
|
||||
'compute time based inputs
|
||||
fKickFreq = g_ftime * 2
|
||||
fPhase = g_ftime / 3
|
||||
fBlendWeight = Sin(fKickFreq)
|
||||
|
||||
|
||||
' Blend the meshes (which makes the dolphin appear to swim)
|
||||
Call BlendMeshes(fBlendWeight)
|
||||
|
||||
' Move the dolphin in a circle and have it undulate
|
||||
Dim vTrans As D3DVECTOR
|
||||
Dim qRot As D3DQUATERNION
|
||||
Dim matDolphin As D3DMATRIX
|
||||
Dim matTrans As D3DMATRIX, matRotate1 As D3DMATRIX, matRotate2 As D3DMATRIX
|
||||
|
||||
'Scale dolphin geometery to 1/100 original
|
||||
D3DXMatrixScaling matDolphin, 0.01, 0.01, 0.01
|
||||
|
||||
'add up and down roation (since modeled along x axis)
|
||||
D3DXMatrixRotationZ matRotate1, -Cos(fKickFreq) / 6
|
||||
D3DXMatrixMultiply matDolphin, matDolphin, matRotate1
|
||||
|
||||
'add rotation to make dolphin point at tangent to the circle
|
||||
D3DXMatrixRotationY matRotate2, fPhase
|
||||
D3DXMatrixMultiply matDolphin, matDolphin, matRotate2
|
||||
|
||||
|
||||
|
||||
'add traslation to make the dolphin move in a circle and bob up and down
|
||||
'in sync with its flippers
|
||||
D3DXMatrixTranslation matTrans, -5 * Sin(fPhase), Sin(fKickFreq) / 2, 10 - 10 * Cos(fPhase)
|
||||
D3DXMatrixMultiply matDolphin, matDolphin, matTrans
|
||||
|
||||
m_DolphinObject.SetMatrix matDolphin
|
||||
|
||||
' Animate the caustic textures
|
||||
Dim tex As Long
|
||||
tex = CLng((g_ftime * 32)) Mod 32
|
||||
Set m_CurrentCausticTexture = m_CausticTextures(tex)
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: BlendMeshes()
|
||||
' Desc: Does a linear interpolation between all vertex positions and normals
|
||||
' in two source meshes and outputs the result to the destination mesh.
|
||||
' Note: all meshes must contain the same number of vertices, and the
|
||||
' destination mesh must be in device memory.
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub BlendMeshes(ByVal fWeight As Single)
|
||||
|
||||
Dim fWeight1 As Single, fWeight2 As Single
|
||||
Dim vTemp1 As D3DVECTOR, vTemp2 As D3DVECTOR
|
||||
Dim i As Long, j As Long
|
||||
|
||||
If (fWeight < 0) Then
|
||||
j = kMesh3
|
||||
Else
|
||||
j = kMesh1
|
||||
End If
|
||||
|
||||
|
||||
' compute blending factors
|
||||
fWeight1 = fWeight
|
||||
If fWeight < 0 Then fWeight1 = -fWeight1
|
||||
fWeight2 = 1 - fWeight1
|
||||
|
||||
' Linearly Interpolate (LERP)positions and normals
|
||||
For i = 0 To m_dest.NumVertices - 1
|
||||
D3DXVec3Scale vTemp1, m_meshtool(kMesh2).Vertices(i).p, fWeight2
|
||||
D3DXVec3Scale vTemp2, m_meshtool(j).Vertices(i).p, fWeight1
|
||||
D3DXVec3Add m_dest.Vertices(i).p, vTemp1, vTemp2
|
||||
|
||||
D3DXVec3Scale vTemp1, m_meshtool(kMesh2).Vertices(i).n, fWeight2
|
||||
D3DXVec3Scale vTemp2, m_meshtool(j).Vertices(i).n, fWeight1
|
||||
D3DXVec3Add m_dest.Vertices(i).n, vTemp1, vTemp2
|
||||
Next
|
||||
|
||||
'Copy the data into the d3dvertex buffer
|
||||
D3DVertexBuffer8SetData m_dest.VertB, 0, m_dest.NumVertices * Len(m_dest.Vertices(0)), 0, m_dest.Vertices(0)
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Render()
|
||||
' Desc: Called once per frame, the call is the entry point for 3d
|
||||
' rendering. This function sets up render states, clears the
|
||||
' viewport, and renders the scene.
|
||||
'-----------------------------------------------------------------------------
|
||||
Function Render() As Boolean
|
||||
|
||||
'Dont do anything if in a minimized state
|
||||
If m_bMinimized = True Then Exit Function
|
||||
|
||||
On Local Error Resume Next
|
||||
|
||||
Dim mat As D3DMATRIX
|
||||
Dim mat2 As D3DMATRIX
|
||||
Dim hr As Long
|
||||
|
||||
Render = False
|
||||
'See what state the device is in.
|
||||
hr = g_dev.TestCooperativeLevel
|
||||
If hr = D3DERR_DEVICENOTRESET Then
|
||||
g_dev.Reset g_d3dpp
|
||||
RestoreDeviceObjects
|
||||
ElseIf hr <> 0 Then 'dont bother rendering if we are not ready yet
|
||||
Exit Function
|
||||
End If
|
||||
Render = True
|
||||
' Clear the backbuffer
|
||||
D3DUtil_ClearAll WATER_COLOR
|
||||
|
||||
|
||||
With g_dev
|
||||
|
||||
.BeginScene
|
||||
|
||||
' Render the Seafloor. For devices that support one-pass multi-
|
||||
' texturing, use the second texture stage to blend in the animated
|
||||
' water caustics texture.
|
||||
If (g_d3dCaps.MaxTextureBlendStages > 1) Then
|
||||
|
||||
' Set up the 2nd texture stage for the animated water caustics
|
||||
.SetTexture 1, m_CurrentCausticTexture
|
||||
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_MODULATE
|
||||
.SetTextureStageState 1, D3DTSS_COLORARG1, D3DTA_TEXTURE
|
||||
.SetTextureStageState 1, D3DTSS_COLORARG2, D3DTA_CURRENT
|
||||
|
||||
' Tell D3D to automatically generate texture coordinates from the
|
||||
' model's position in camera space. The texture transform matrix is
|
||||
' setup so that the 'x' and 'z' coordinates are scaled to become the
|
||||
' resulting 'tu' and 'tv' texture coordinates. The resulting effect
|
||||
' is that the caustic texture is draped over the geometry from above.
|
||||
|
||||
mat.m11 = 0.05: mat.m12 = 0#
|
||||
mat.m21 = 0#: mat.m22 = 0#
|
||||
mat.m31 = 0#: mat.m32 = 0.05
|
||||
mat.m41 = Sin(g_ftime) / 8: mat.m42 = (Cos(g_ftime) / 10) - (g_ftime / 10)
|
||||
|
||||
.SetTransform D3DTS_TEXTURE1, mat
|
||||
.SetTextureStageState 1, D3DTSS_TEXCOORDINDEX, D3DTSS_TCI_CAMERASPACEPOSITION
|
||||
.SetTextureStageState 1, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2
|
||||
End If
|
||||
g_dev.SetRenderState D3DRS_AMBIENT, &HB0B0B0B0
|
||||
|
||||
|
||||
' Finally, render the actual seafloor with the above states
|
||||
m_FloorObject.Render g_dev
|
||||
|
||||
|
||||
' Disable the second texture stage
|
||||
If (g_d3dCaps.MaxTextureBlendStages > 1) Then
|
||||
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_DISABLE
|
||||
End If
|
||||
|
||||
' Render the dolphin in it's first pass.
|
||||
.SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
|
||||
m_DolphinObject.Render g_dev
|
||||
|
||||
|
||||
|
||||
' For devices that support one-pass multi-texturing, use the second
|
||||
' texture stage to blend in the animated water caustics texture for
|
||||
' the dolphin. This a little tricky because we only want caustics on
|
||||
' the part of the dolphin that is lit from above. To acheive this
|
||||
' effect, the dolphin is rendered alpha-blended with a second pass
|
||||
' which has the caustic effects modulating the diffuse component
|
||||
' which contains lighting-only information) of the geometry.
|
||||
If (g_d3dCaps.MaxTextureBlendStages > 1) Then
|
||||
|
||||
' For the 2nd pass of rendering the dolphin, turn on the caustic
|
||||
' effects. Start with setting up the 2nd texture stage state, which
|
||||
' will modulate the texture with the diffuse component. This actually
|
||||
' only needs one stage, except that using a CD3DFile object makes that
|
||||
' a little tricky.
|
||||
.SetTexture 1, m_CurrentCausticTexture
|
||||
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_MODULATE
|
||||
.SetTextureStageState 1, D3DTSS_COLORARG1, D3DTA_TEXTURE
|
||||
.SetTextureStageState 1, D3DTSS_COLORARG2, D3DTA_DIFFUSE
|
||||
|
||||
|
||||
' Now, set up D3D to generate texture coodinates. This is the same as
|
||||
' with the seafloor the 'x' and 'z' position coordinates in camera
|
||||
' space are used to generate the 'tu' and 'tv' texture coordinates),
|
||||
' except our scaling factors are different in the texture matrix, to
|
||||
' get a better looking result.
|
||||
|
||||
mat2.m11 = 0.5: mat2.m12 = 0#
|
||||
mat2.m21 = 0#: mat2.m22 = 0#
|
||||
mat2.m31 = 0#: mat2.m32 = 0.5
|
||||
mat2.m41 = 0#: mat2.m42 = 0#
|
||||
|
||||
.SetTransform D3DTS_TEXTURE1, mat2
|
||||
.SetTextureStageState 1, D3DTSS_TEXCOORDINDEX, D3DTSS_TCI_CAMERASPACEPOSITION
|
||||
.SetTextureStageState 1, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2
|
||||
|
||||
' Set the ambient color and fog color to pure black. Ambient is set
|
||||
' to black because we still have a light shining from above, but we
|
||||
' don't want any caustic effects on the dolphin's underbelly. Fog is
|
||||
' set to black because we want the caustic effects to fade out in the
|
||||
' distance just as the model does with the WATER_COLOR.
|
||||
.SetRenderState D3DRS_AMBIENT, &H0&
|
||||
.SetRenderState D3DRS_FOGCOLOR, &H0&
|
||||
|
||||
' Set up blending modes to add this caustics-only pass with the
|
||||
' previous pass.
|
||||
.SetRenderState D3DRS_ALPHABLENDENABLE, 1 ' True
|
||||
.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCCOLOR
|
||||
.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
|
||||
|
||||
' Finally, render the caustic effects for the dolphin
|
||||
m_DolphinObject.Render g_dev
|
||||
|
||||
' After all is well and done, restore any munged texture stage states
|
||||
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_DISABLE
|
||||
.SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
|
||||
.SetRenderState D3DRS_FOGCOLOR, WATER_COLOR
|
||||
.SetRenderState D3DRS_ALPHABLENDENABLE, 0 'False
|
||||
|
||||
End If
|
||||
|
||||
|
||||
skipcaustic:
|
||||
|
||||
' End the scene.
|
||||
.EndScene
|
||||
End With
|
||||
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InvalidateDeviceObjects()
|
||||
' Desc: Called when the device-dependant objects are about to be lost.
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub InvalidateDeviceObjects()
|
||||
m_FloorObject.InvalidateDeviceObjects
|
||||
m_DolphinGroupObject.InvalidateDeviceObjects
|
||||
m_DolphinObject.InvalidateDeviceObjects
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: DeleteDeviceObjects()
|
||||
' Desc: Called when the app is exitting, or the device is being changed,
|
||||
' this function deletes any device dependant objects.
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Sub DeleteDeviceObjects()
|
||||
|
||||
m_FloorObject.Destroy
|
||||
m_DolphinGroupObject.Destroy
|
||||
m_DolphinObject.Destroy
|
||||
|
||||
MESHTOOL_DESTROY m_meshtool(0)
|
||||
MESHTOOL_DESTROY m_meshtool(1)
|
||||
MESHTOOL_DESTROY m_meshtool(2)
|
||||
MESHTOOL_DESTROY m_dest
|
||||
|
||||
Set m_DolphinGroupObject = Nothing
|
||||
Set m_DolphinObject = Nothing
|
||||
Set m_DolphinMesh = Nothing
|
||||
Set m_DolphinMesh01 = Nothing
|
||||
Set m_DolphinMesh02 = Nothing
|
||||
Set m_DolphinMesh03 = Nothing
|
||||
Set m_FloorObject = Nothing
|
||||
Set m_SeaFloorMesh = Nothing
|
||||
|
||||
|
||||
Set m_DolphinTex = Nothing
|
||||
|
||||
ReDim m_CausticTextures(0)
|
||||
Set m_CurrentCausticTexture = Nothing
|
||||
|
||||
m_bInit = False
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: VerifyDevice()
|
||||
' Desc: Called when the app is trying to find valid display modes
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function VerifyDevice(usageflags As Long, format As CONST_D3DFORMAT) As Boolean
|
||||
VerifyDevice = True
|
||||
End Function
|
||||
@@ -0,0 +1,41 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=dolphin.frm
|
||||
Module=D3DUtil; ..\..\common\D3DUtil.bas
|
||||
Module=D3DInit; ..\..\common\D3DInit.bas
|
||||
Class=CD3DMesh; ..\..\common\D3DMesh.cls
|
||||
Class=CD3DFrame; ..\..\common\D3DFrame.cls
|
||||
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
Form=..\..\common\SelectDevice.frm
|
||||
Startup="Form1"
|
||||
ExeName32="vb_Dolphin.exe"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
Binary file not shown.
@@ -0,0 +1,58 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
// Name: Dolphin Direct3D Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The Dolphin sample shows an underwater scene of a dolphin swimming, with
|
||||
caustic effects on the dolphin and seafloor. The dolphin is animated using
|
||||
a technique called "tweening". The underwater effect simply uses fog, and
|
||||
the water caustics use an animated set of textures.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Dolphin
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
The following keys are implemented. The dropdown menus can be used for the
|
||||
same controls.
|
||||
|
||||
<F2> Prompts user to select a new rendering device or display mode
|
||||
<Alt+Enter> Toggles between fullscreen and windowed modes
|
||||
<Esc> Exits the app.
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
Several things are happening in this sample. First of all is the use of
|
||||
fog to give an underwater effect. The fog parameters are set up in the
|
||||
InitDeviceObjects() function.
|
||||
|
||||
The water caustics are achieved by animating a set of 32 different textures
|
||||
(caust00.tga through caust31.tga). The caustics can be blending into the
|
||||
scene using multitexturing or multi-pass blending techniques. It is
|
||||
straightforward except for one tricky situation. Since the bottom of the
|
||||
dolphin should not have caustic effects, a separate pass is done where
|
||||
ambient light is removed and the dolphin is lit from above, and then
|
||||
blending the diffuse color with the caustic texture.
|
||||
|
||||
The dolphin is animated using a technique called "tweening", in which the
|
||||
dolphin model's vertices are linearly blending from multiple other sets of
|
||||
vertices. The source models for these other sets of vertices is loaded
|
||||
from dolphin_group.x, which consists of the dolphin model in three
|
||||
different positions. Each frame, a destination mesh is generated by
|
||||
blending some combination of the positions and normals from these meshes
|
||||
together.
|
||||
|
||||
This sample makes use of common DirectX code (consisting of helper functions,
|
||||
etc.) that is shared with other samples on the DirectX SDK. All common
|
||||
classes and modules can be found in the following directory:
|
||||
DXSDK\Samples\Multimedia\VBSamples\Common
|
||||
|
||||
1133
Library/dxx8/samples/Multimedia/VBSamples/Direct3D/Donuts/donuts.frm
Normal file
1133
Library/dxx8/samples/Multimedia/VBSamples/Direct3D/Donuts/donuts.frm
Normal file
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,38 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=Donuts.frm
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
IconForm="frmVBDonuts"
|
||||
Startup="frmVBDonuts"
|
||||
HelpFile=""
|
||||
Title="VB Donuts"
|
||||
ExeName32="VB_Donuts.exe"
|
||||
Command32=""
|
||||
Name="VBDonuts"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="ms"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
@@ -0,0 +1,35 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: Donuts Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The Donuts sample illustrates how to use d3d to create a 2d sprite engine.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Donuts
|
||||
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
<Alt-Enter> will bring you fullscreen to 640x480 and back to windowed mode
|
||||
<Esc> exits the application
|
||||
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
|
||||
The background is rendered with 2 TLVertex (screen space) triangles. The sprites
|
||||
are defined as an array of user defined type that is a container for sprite properties
|
||||
such as position, direction, speed and size. Each of the sprites is rendered as 2
|
||||
TLVertex triangles each frame.
|
||||
@@ -0,0 +1,33 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=frmPixelShader.frm
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
Startup="frmPixelShader"
|
||||
HelpFile=""
|
||||
ExeName32="VB_PixelShader.exe"
|
||||
Command32=""
|
||||
Name="VBPixelShader"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="ms"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,692 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmPixelShader
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "VB Pixel Shader"
|
||||
ClientHeight = 3195
|
||||
ClientLeft = 60
|
||||
ClientTop = 330
|
||||
ClientWidth = 4680
|
||||
Icon = "frmPixelShader.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 3195
|
||||
ScaleWidth = 4680
|
||||
StartUpPosition = 3 'Windows Default
|
||||
End
|
||||
Attribute VB_Name = "frmPixelShader"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: FrmPixelShader.frm
|
||||
' Content: This sample shows how to use Pixel Shaders. It renders a few polys with
|
||||
' different pixel shader functions to manipulate the way the textures look.
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
' This sample will use 7 different shaders.
|
||||
Private Const NUM_PIXELSHADERS = 7
|
||||
|
||||
' A structure to describe the type of vertices the app will use.
|
||||
Private Type VERTEX2TC_
|
||||
x As Single
|
||||
y As Single
|
||||
z As Single
|
||||
rhw As Single
|
||||
color0 As Long
|
||||
color1 As Long
|
||||
tu0 As Single
|
||||
tv0 As Single
|
||||
tu1 As Single
|
||||
tv1 As Single
|
||||
End Type
|
||||
Dim VERTEX2TC(3) As VERTEX2TC_
|
||||
Dim verts(3) As VERTEX2TC_
|
||||
|
||||
' Describe the vertex format that the vertices use.
|
||||
Private Const FVFVERTEX2TC = (D3DFVF_XYZRHW Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX2)
|
||||
|
||||
' Allocate a few DirectX object variables that the app needs to use.
|
||||
Dim dX As DirectX8
|
||||
Dim d3d As Direct3D8
|
||||
Dim dev As Direct3DDevice8
|
||||
Dim d3dx As D3DX8
|
||||
Dim d3dvb As Direct3DVertexBuffer8
|
||||
Dim d3dt(1) As Direct3DTexture8
|
||||
|
||||
'Keep the present params around for resetting the device if needed
|
||||
Dim g_d3dpp As D3DPRESENT_PARAMETERS
|
||||
|
||||
' This string array will store the shader functions
|
||||
Dim sPixelShader(6) As String
|
||||
|
||||
' This array will store the pointers to the assembled pixel shaders
|
||||
Dim hPixelShader(6) As Long
|
||||
|
||||
Private Sub Form_Load()
|
||||
|
||||
'************************************************************************
|
||||
'
|
||||
' Here the app will call functions to set up D3D, create a device,
|
||||
' initialize the vertices, initialize the vertex buffers, create the
|
||||
' textures, setup the shader string arrays, and assemble the pixel shaders.
|
||||
' Finally, it calls Form_Paint to render everything.
|
||||
'
|
||||
'************************************************************************
|
||||
|
||||
'Set the width and height of the window
|
||||
Me.Width = 125 * Screen.TwipsPerPixelX
|
||||
Me.Height = 225 * Screen.TwipsPerPixelY
|
||||
Me.Show
|
||||
DoEvents
|
||||
|
||||
Call InitD3D
|
||||
Call InitTextures
|
||||
Call InitVerts
|
||||
Call SetupShaders
|
||||
Call InitDevice
|
||||
Call PaintMe
|
||||
'Call Form_Paint
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub InitVB()
|
||||
|
||||
'************************************************************************
|
||||
'
|
||||
' This sub creates the vertex buffer that the app will use.
|
||||
'
|
||||
' PARAMETERS:
|
||||
' None.
|
||||
'************************************************************************
|
||||
|
||||
' Create the vertex buffer, It will hold 4 vertices (two primitives).
|
||||
Set d3dvb = dev.CreateVertexBuffer(4 * Len(VERTEX2TC(0)), D3DUSAGE_WRITEONLY, FVFVERTEX2TC, D3DPOOL_MANAGED)
|
||||
|
||||
Call MoveVBVerts(0, 0)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub MoveVBVerts(dX As Single, dY As Single)
|
||||
|
||||
'************************************************************************
|
||||
'
|
||||
' This sub moves the vertices in the vertex buffer to a new location.
|
||||
'
|
||||
' PARAMETERS:
|
||||
' dx: A single that represents the new X coordinate for the upper left hand corner of the vertices.
|
||||
' dy: A single that represents the new Y coordinate for the upper left hand corner of the vertices.
|
||||
'
|
||||
'************************************************************************
|
||||
|
||||
Dim pVBVerts(3) As VERTEX2TC_
|
||||
Dim pData As Long, i As Long, lSize As Long
|
||||
|
||||
'Store the size of a vertex
|
||||
lSize = Len(VERTEX2TC(0))
|
||||
|
||||
'Lock and retrieve the data in the vertex buffer
|
||||
Call D3DAUX.D3DVertexBuffer8GetData(d3dvb, 0, lSize * 4, 0, pVBVerts(0))
|
||||
|
||||
For i = 0 To 3
|
||||
'Set this vertex to equal the global vertex
|
||||
pVBVerts(i) = verts(i)
|
||||
'Add the X component to this vertex
|
||||
pVBVerts(i).x = verts(i).x + dX
|
||||
'Add the Y component to this vertex
|
||||
pVBVerts(i).y = verts(i).y + dY
|
||||
Next
|
||||
|
||||
'Set and unlock the data in the vertex buffer.
|
||||
Call D3DAUX.D3DVertexBuffer8SetData(d3dvb, 0, lSize * 4, 0, pVBVerts(0))
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub InitVerts()
|
||||
|
||||
'************************************************************************
|
||||
'
|
||||
' This sub initializes the vertices
|
||||
'
|
||||
' PARAMETERS:
|
||||
' None.
|
||||
'
|
||||
'************************************************************************
|
||||
|
||||
With verts(0)
|
||||
.x = 10: .y = 10: .z = 0.5
|
||||
.rhw = 1
|
||||
.color0 = MakeRGB(&H0, &HFF, &HFF)
|
||||
.color1 = MakeRGB(&HFF, &HFF, &HFF)
|
||||
.tu0 = 0: .tv0 = 0
|
||||
.tu1 = 0: .tv1 = 0
|
||||
End With
|
||||
|
||||
With verts(1)
|
||||
.x = 40: .y = 10: .z = 0.5
|
||||
.rhw = 1
|
||||
.color0 = MakeRGB(&HFF, &HFF, &H0)
|
||||
.color1 = MakeRGB(&HFF, &HFF, &HFF)
|
||||
.tu0 = 1: .tv0 = 0
|
||||
.tu1 = 1: .tv1 = 0
|
||||
End With
|
||||
|
||||
With verts(2)
|
||||
.x = 40: .y = 40: .z = 0.5
|
||||
.rhw = 1
|
||||
.color0 = MakeRGB(&HFF, &H0, &H0)
|
||||
.color1 = MakeRGB(&H0, &H0, &H0)
|
||||
.tu0 = 1: .tv0 = 1
|
||||
.tu1 = 1: .tv1 = 1
|
||||
End With
|
||||
|
||||
With verts(3)
|
||||
.x = 10: .y = 40: .z = 0.5
|
||||
.rhw = 1
|
||||
.color0 = MakeRGB(&H0, &H0, &HFF)
|
||||
.color1 = MakeRGB(&H0, &H0, &H0)
|
||||
.tu0 = 0: .tv0 = 1
|
||||
.tu1 = 0: .tv1 = 1
|
||||
End With
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub InitTextures()
|
||||
|
||||
'************************************************************************
|
||||
'
|
||||
' This sub initializes the textures that will be used.
|
||||
'
|
||||
' PARAMETERS:
|
||||
' None.
|
||||
'
|
||||
'************************************************************************
|
||||
|
||||
Dim sFile As String
|
||||
|
||||
sFile = FindMediaDir("lake.bmp") & "lake.bmp"
|
||||
Set d3dt(1) = d3dx.CreateTextureFromFile(dev, sFile)
|
||||
sFile = FindMediaDir("seafloor.bmp") & "seafloor.bmp"
|
||||
Set d3dt(0) = d3dx.CreateTextureFromFile(dev, sFile)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub SetupShaders()
|
||||
|
||||
'************************************************************************
|
||||
'
|
||||
' This sub sets up the string arrays that contains each pixel shader.
|
||||
'
|
||||
' PARAMETERS:
|
||||
' None.
|
||||
'
|
||||
'************************************************************************
|
||||
|
||||
' 0: Display texture 0 (t0)
|
||||
sPixelShader(0) = _
|
||||
"ps.1.0 " & _
|
||||
"tex t0 " & _
|
||||
"mov r0,t0"
|
||||
|
||||
' 1: Display texture 1 (t1)
|
||||
sPixelShader(1) = _
|
||||
"ps.1.0 " & _
|
||||
"tex t1 " & _
|
||||
"mov r0,t1"
|
||||
|
||||
' 2: Blend between tex0 and tex1, using vertex 1 as the input (v1)
|
||||
sPixelShader(2) = _
|
||||
"ps.1.0 " & _
|
||||
"tex t0 " & _
|
||||
"tex t1 " & _
|
||||
"mov r1,t1 " & _
|
||||
"lrp r0,v1,r1,t0"
|
||||
|
||||
' 3: Scale texture 0 by vertex color 1 and add to texture 1
|
||||
sPixelShader(3) = _
|
||||
"ps.1.0 " & _
|
||||
"tex t0 " & _
|
||||
"tex t1 " & _
|
||||
"mov r1,t0 " & _
|
||||
"mad r0,t1,r1,v1"
|
||||
|
||||
' 4: Add all: texture 0, 1, and color 0, 1
|
||||
sPixelShader(4) = _
|
||||
"ps.1.0 " & _
|
||||
"tex t0 " & _
|
||||
"tex t1 " & _
|
||||
"add r1,t0,v1 " & _
|
||||
"add r1,r1,t1 " & _
|
||||
"add r1,r1,v0 " & _
|
||||
"mov r0,r1"
|
||||
|
||||
' 5: Modulate t0 by constant register c0
|
||||
sPixelShader(5) = _
|
||||
"ps.1.0 " & _
|
||||
"tex t0 " & _
|
||||
"mul r1,c0,t0 " & _
|
||||
"mov r0,r1"
|
||||
|
||||
' 6: Lerp by t0 and t1 by constant register c1
|
||||
sPixelShader(6) = _
|
||||
"ps.1.0 " & _
|
||||
"tex t0 " & _
|
||||
"tex t1 " & _
|
||||
"mov r1,t1 " & _
|
||||
"lrp r0,c1,t0,r1"
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub InitPixelShaders()
|
||||
|
||||
'************************************************************************
|
||||
'
|
||||
' This sub creates the pixel shaders, and stores the pointer (handle) to them.
|
||||
'
|
||||
' PARAMETERS:
|
||||
' None.
|
||||
'
|
||||
'************************************************************************
|
||||
|
||||
Dim pCode As D3DXBuffer
|
||||
Dim i As Long, lArray() As Long, lSize As Long
|
||||
|
||||
'Loop through each pixel shader string
|
||||
For i = 0 To UBound(sPixelShader)
|
||||
|
||||
'Assemble the pixel shader
|
||||
Set pCode = d3dx.AssembleShader(sPixelShader(i), 0, Nothing)
|
||||
|
||||
'Get the size of the assembled pixel shader
|
||||
lSize = pCode.GetBufferSize() / 4
|
||||
|
||||
'Resize the array
|
||||
ReDim lArray(lSize - 1)
|
||||
|
||||
'Retrieve the contents of the buffer
|
||||
Call d3dx.BufferGetData(pCode, 0, 4, lSize, lArray(0))
|
||||
|
||||
'Create the pixel shader.
|
||||
hPixelShader(i) = dev.CreatePixelShader(lArray(0))
|
||||
|
||||
Set pCode = Nothing
|
||||
|
||||
Next
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub InitDevice()
|
||||
|
||||
'************************************************************************
|
||||
'
|
||||
' This sub initializes the device to states that won't change, and sets
|
||||
' the constant values that some of the pixel shaders use.
|
||||
'
|
||||
' PARAMETERS:
|
||||
' None.
|
||||
'
|
||||
'************************************************************************
|
||||
|
||||
' Constant registers store values that the pixel shaders can use. Each
|
||||
' constant is an array of 4 singles that contain information about color
|
||||
' and alpha components. This 2d array represents two pixel shader constants.
|
||||
Dim fPSConst(3, 1) As Single
|
||||
|
||||
'Used to set the constant values for c0 (used in pixel shader 5)
|
||||
'Red
|
||||
fPSConst(0, 0) = 0.15
|
||||
'Green
|
||||
fPSConst(1, 0) = 0.75
|
||||
'Blue
|
||||
fPSConst(2, 0) = 0.25
|
||||
'Alpha
|
||||
fPSConst(3, 0) = 0
|
||||
|
||||
'Used to set the constant values for c1 (used in pixel shader 6)
|
||||
'Red
|
||||
fPSConst(0, 1) = 0.15
|
||||
'Green
|
||||
fPSConst(1, 1) = 1
|
||||
'Blue
|
||||
fPSConst(2, 1) = 0.5
|
||||
'Alpha
|
||||
fPSConst(3, 1) = 0
|
||||
|
||||
'Create the vertex buffer
|
||||
Call InitVB
|
||||
|
||||
'Create the pixel shaders
|
||||
Call InitPixelShaders
|
||||
|
||||
With dev
|
||||
|
||||
'Lighting isn't needed, since the vertices are prelit
|
||||
Call .SetRenderState(D3DRS_LIGHTING, False)
|
||||
|
||||
'Point the stream source to the vertex buffer that contains the vertices for rendering.
|
||||
Call .SetStreamSource(0, d3dvb, Len(VERTEX2TC(0)))
|
||||
|
||||
'Set the vertex shader to the flexible vertex format the app describes.
|
||||
Call .SetVertexShader(FVFVERTEX2TC)
|
||||
|
||||
'Set the pixel shader constans to the values that were set above.
|
||||
Call .SetPixelShaderConstant(0, fPSConst(0, 0), 2)
|
||||
|
||||
End With
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub PaintMe()
|
||||
|
||||
'************************************************************************
|
||||
'
|
||||
' This sub is where all rendering happens. The vertices get moved to
|
||||
' a new position, and then rendered.
|
||||
'
|
||||
' PARAMETERS:
|
||||
' None.
|
||||
'
|
||||
'************************************************************************
|
||||
|
||||
Dim hr As Long
|
||||
Static bNotReady As Boolean
|
||||
|
||||
If Not dev Is Nothing And Me.ScaleHeight > 0 And Not d3dvb Is Nothing Then
|
||||
|
||||
'Call TestCooperativeLevel to see what state the device is in.
|
||||
hr = dev.TestCooperativeLevel
|
||||
|
||||
If hr = D3DERR_DEVICELOST Then
|
||||
|
||||
'If the device is lost, exit and wait for it to come back.
|
||||
bNotReady = True
|
||||
Exit Sub
|
||||
|
||||
ElseIf hr = D3DERR_DEVICENOTRESET Then
|
||||
|
||||
'The device is back, now it needs to be reset.
|
||||
hr = 0
|
||||
hr = ResetDevice
|
||||
If hr Then Exit Sub
|
||||
|
||||
bNotReady = False
|
||||
|
||||
End If
|
||||
|
||||
'Make sure the app is ready and that the form's height is greater than 0
|
||||
If bNotReady Or Me.ScaleHeight < 1 Then Exit Sub
|
||||
|
||||
With dev
|
||||
|
||||
Call .BeginScene
|
||||
Call .Clear(0, ByVal 0, D3DCLEAR_TARGET, MakeRGB(0, 0, 255), 0, 0)
|
||||
|
||||
'To just show the interpolation of each vertex color, remove all of the textures.
|
||||
Call .SetTexture(0, Nothing)
|
||||
Call .SetTexture(1, Nothing)
|
||||
|
||||
'Move the vertices.
|
||||
Call MoveVBVerts(0, 0)
|
||||
'No pixel shader will be used for this one.
|
||||
Call .SetPixelShader(0)
|
||||
'Draw the two primitives.
|
||||
Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
|
||||
|
||||
'Now set the two textures on the device.
|
||||
Call .SetTexture(0, d3dt(0))
|
||||
Call .SetTexture(1, d3dt(1))
|
||||
|
||||
'Move the vertices
|
||||
Call MoveVBVerts(50, 0)
|
||||
'Use pixel shader 0
|
||||
Call .SetPixelShader(hPixelShader(0))
|
||||
Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
|
||||
|
||||
'The rest of the calls just move the vertices to a new position, set
|
||||
'the next pixel shader, and render the two primitives.
|
||||
Call MoveVBVerts(0, 50)
|
||||
Call .SetPixelShader(hPixelShader(1))
|
||||
Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
|
||||
|
||||
Call MoveVBVerts(50, 50)
|
||||
Call .SetPixelShader(hPixelShader(2))
|
||||
Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
|
||||
|
||||
Call MoveVBVerts(0, 100)
|
||||
Call .SetPixelShader(hPixelShader(3))
|
||||
Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
|
||||
|
||||
Call MoveVBVerts(50, 100)
|
||||
Call .SetPixelShader(hPixelShader(4))
|
||||
Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
|
||||
|
||||
Call MoveVBVerts(0, 150)
|
||||
Call .SetPixelShader(hPixelShader(5))
|
||||
Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
|
||||
|
||||
Call MoveVBVerts(50, 150)
|
||||
Call .SetPixelShader(hPixelShader(6))
|
||||
Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
|
||||
|
||||
Call .EndScene
|
||||
Call .Present(ByVal 0, ByVal 0, 0, ByVal 0)
|
||||
|
||||
End With
|
||||
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Function MakeRGB(r As Long, g As Long, b As Long) As Long
|
||||
|
||||
'************************************************************************
|
||||
'
|
||||
' This function takes three longs and packs them into a single long to
|
||||
' create an RGB color. Each parameter has to be in the range of 0-255.
|
||||
'
|
||||
' PARAMETERS:
|
||||
' r Long that represents the red component
|
||||
' g Long that represents the green component
|
||||
' b Long that represents the blue component
|
||||
'
|
||||
' RETURNS:
|
||||
' A long that.
|
||||
'
|
||||
'************************************************************************
|
||||
|
||||
MakeRGB = b
|
||||
MakeRGB = MakeRGB Or (g * (2 ^ 8))
|
||||
MakeRGB = MakeRGB Or (r * (2 ^ 16))
|
||||
|
||||
End Function
|
||||
|
||||
Private Sub InitD3D()
|
||||
|
||||
'************************************************************************
|
||||
'
|
||||
' This sub initializes all the object variables, and creates the 3d device.
|
||||
'
|
||||
' PARAMETERS:
|
||||
' None.
|
||||
'
|
||||
'************************************************************************
|
||||
|
||||
Dim d3ddm As D3DDISPLAYMODE
|
||||
|
||||
'Turn off error handling, the app will handle any errors that occur.
|
||||
On Local Error Resume Next
|
||||
|
||||
'Get a new D3DX object
|
||||
Set d3dx = New D3DX8
|
||||
'Get a new DirectX object
|
||||
Set dX = New DirectX8
|
||||
'Create a Direct3D object
|
||||
Set d3d = dX.Direct3DCreate()
|
||||
|
||||
'Grab some information about the current display mode to see if the display
|
||||
'was switched to something that isn't supported.
|
||||
Call d3d.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm)
|
||||
|
||||
'Make sure that the adapter is in a color bit depth greater than 8 bits per pixel.
|
||||
If d3ddm.Format = D3DFMT_P8 Or d3ddm.Format = D3DFMT_A8P8 Then
|
||||
|
||||
'Device is running in some variation of an 8 bit format. Sample will have to exit at this point.
|
||||
MsgBox " For this sample to run, the primary display needs to be in 16 bit or higher color depth.", vbCritical
|
||||
Unload Me
|
||||
End
|
||||
|
||||
End If
|
||||
|
||||
With g_d3dpp
|
||||
|
||||
'This app will run windowed.
|
||||
.Windowed = 1
|
||||
|
||||
'The backbuffer format is unknown. Since this is windowed mode,
|
||||
'the app can just use whatever mode the device is in now.
|
||||
.BackBufferFormat = d3ddm.Format
|
||||
|
||||
'When running windowed, the information contained in the
|
||||
'backbuffer is copied to the front buffer when Direct3DDevice.Present is called.
|
||||
.SwapEffect = D3DSWAPEFFECT_COPY
|
||||
|
||||
End With
|
||||
|
||||
'Create the device using the default adapter on the system using software vertex processing.
|
||||
Set dev = d3d.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_REF, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, g_d3dpp)
|
||||
|
||||
'Check to make sure the device was created successfully. If not, exit.
|
||||
If dev Is Nothing Then
|
||||
MsgBox "Unable to initialize Direct3D. App will now exit."
|
||||
Unload Me
|
||||
End
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Paint()
|
||||
|
||||
If d3dvb Is Nothing Then Exit Sub
|
||||
|
||||
'Anytime the window receives a paint message, repaint the scene.
|
||||
Call PaintMe
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Resize()
|
||||
|
||||
If d3dvb Is Nothing Then Exit Sub
|
||||
|
||||
'Anytime the form is resized, redraw the scene.
|
||||
Call PaintMe
|
||||
|
||||
End Sub
|
||||
|
||||
Private Function ResetDevice() As Long
|
||||
|
||||
'***********************************************************************
|
||||
'
|
||||
' This subroutine is called whenever the app needs to be resized, or the
|
||||
' device has been lost.
|
||||
'
|
||||
' Parameters:
|
||||
'
|
||||
' None.
|
||||
'
|
||||
'***********************************************************************
|
||||
|
||||
Dim d3ddm As D3DDISPLAYMODE
|
||||
|
||||
On Local Error Resume Next
|
||||
|
||||
'Call the sub that destroys the vertex buffer and shaders.
|
||||
Call DestroyAll
|
||||
|
||||
'Set the width and height of the window
|
||||
Me.Width = 110 * Screen.TwipsPerPixelX
|
||||
Me.Height = 225 * Screen.TwipsPerPixelY
|
||||
|
||||
'Grab some information about the current adapters display mode.
|
||||
'This may have changed since startup or the last D3DDevice8.Reset().
|
||||
Call d3d.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm)
|
||||
|
||||
'Refresh the backbuffer format using the retrieved format.
|
||||
g_d3dpp.BackBufferFormat = d3ddm.Format
|
||||
|
||||
'Now reset the device.
|
||||
Call dev.Reset(g_d3dpp)
|
||||
|
||||
'If something happens during the reset, trap any possible errors. This probably failed
|
||||
'because the app doesn't have focus yet, but could fail is the user switched to an incompatible
|
||||
'display mode.
|
||||
|
||||
If Err.Number Then
|
||||
|
||||
'Make sure that the adapter is in a color bit-depth greater than 8 bits per pixel.
|
||||
If d3ddm.Format = D3DFMT_P8 Or d3ddm.Format = D3DFMT_A8P8 Then
|
||||
|
||||
'Device is running in some variation of an 8 bit format. Sample will have to exit at this point.
|
||||
MsgBox " For this sample to run, the primary display needs to be in 16 bit or higher color depth.", vbCritical
|
||||
Unload Me
|
||||
End
|
||||
|
||||
Else
|
||||
|
||||
'More than likely the app just lost the display adapter. Keep spinning until the adapter becomes available.
|
||||
ResetDevice = Err.Number
|
||||
Exit Function
|
||||
|
||||
End If
|
||||
End If
|
||||
|
||||
'Now get the device ready again
|
||||
Call InitDevice
|
||||
|
||||
'Redraw the scene
|
||||
PaintMe
|
||||
|
||||
End Function
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
|
||||
' When the app is exiting, call the DestroyAll() function to clean up.
|
||||
Call DestroyAll
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub DestroyAll()
|
||||
|
||||
'***********************************************************************
|
||||
'
|
||||
' This sub releases all the objects and pixel shader handles.
|
||||
'
|
||||
' PARAMETERS:
|
||||
' None.
|
||||
'
|
||||
'***********************************************************************
|
||||
|
||||
Dim i As Long
|
||||
|
||||
On Error Resume Next
|
||||
|
||||
'Loop through and delete all pixel shaders.
|
||||
For i = 0 To UBound(hPixelShader)
|
||||
If hPixelShader(i) Then
|
||||
Call dev.DeletePixelShader(hPixelShader(i))
|
||||
hPixelShader(i) = 0
|
||||
End If
|
||||
Next
|
||||
|
||||
'Destroy the vertex buffer if it exists.
|
||||
If Not d3dvb Is Nothing Then Set d3dvb = Nothing
|
||||
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,43 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
// Name: PixelShader Direct3D Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
This sample shows some of the effects that can be achieved using pixel
|
||||
shaders. Each of the 8 thumbnails shown is the result of using a different
|
||||
pixel shader to render a rectangle
|
||||
|
||||
Pixel shaders use a set of instructions, executed by the 3D
|
||||
device on a per-pixel basis, that can affect the colorof the
|
||||
pixel based on a varient of inputs. Pixel shaders can be used in place of
|
||||
the texture stage pipeline.
|
||||
|
||||
Note that not all cards may support all the various features pixel shaders.
|
||||
For more information on pixel shaders, refer to the DirectX SDK
|
||||
documentation.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\PixelShader
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
This sample has no user interaction
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
Programming pixel shaders is not a trivial task. Please read any pixel
|
||||
shader-specific documentation accompanying the DirectX SDK.
|
||||
|
||||
This sample makes use of common DirectX code (consisting of helper functions,
|
||||
etc.) that is shared with other samples on the DirectX SDK. All common
|
||||
classes and modules can be found in the following directory:
|
||||
DXSDK\Samples\Multimedia\VBSamples\Common
|
||||
@@ -0,0 +1,603 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "CParticle"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Global data for the particles
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Private Type CUSTOMVERTEX
|
||||
v As D3DVECTOR
|
||||
color As Long
|
||||
tu As Single
|
||||
tv As Single
|
||||
End Type
|
||||
|
||||
Const D3DFVF_COLORVERTEX = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_TEX1)
|
||||
|
||||
Private Type PARTICLE
|
||||
m_bSpark As Boolean ' Spark? or real particle?
|
||||
|
||||
m_vPos As D3DVECTOR ' Current position
|
||||
m_vVel As D3DVECTOR ' Current velocity
|
||||
|
||||
m_vPos0 As D3DVECTOR ' Initial Position
|
||||
m_vVel0 As D3DVECTOR ' Initial Velocity
|
||||
m_fTime0 As Single ' Time of creation
|
||||
|
||||
m_clrDiffuse As D3DCOLORVALUE ' Initial diffuse color
|
||||
m_clrFade As D3DCOLORVALUE ' Faded diffuse color
|
||||
m_fFade As Single ' Fade progression
|
||||
|
||||
iNext As Long ' Next particle in list
|
||||
|
||||
End Type
|
||||
|
||||
Dim m_Particles() As PARTICLE 'we leave 0 element unused to make code convenient
|
||||
'so think of this as a 1 based array
|
||||
Dim m_fRadius As Single
|
||||
Dim m_MaxParticles As Long
|
||||
|
||||
Dim m_NumParticles As Long
|
||||
Dim m_ParticlesLim As Long
|
||||
|
||||
Dim m_iFree As Long 'index of first free particle (0 = empty)
|
||||
Dim m_iUsed As Long 'index of first particle in list (0 = empty)
|
||||
Dim m_iLast As Long
|
||||
|
||||
'Geometry
|
||||
Dim m_VertB As Direct3DVertexBuffer8
|
||||
Dim m_IndxB As Direct3DIndexBuffer8
|
||||
|
||||
Dim m_Verts() As CUSTOMVERTEX
|
||||
|
||||
Dim m_binit As Boolean
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Init
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Init(MaxParticles As Long, fRadius As Single)
|
||||
|
||||
m_fRadius = fRadius
|
||||
m_MaxParticles = MaxParticles
|
||||
m_NumParticles = 0
|
||||
m_ParticlesLim = 1800
|
||||
|
||||
m_iFree = 0
|
||||
m_iUsed = 0
|
||||
|
||||
Set m_VertB = Nothing
|
||||
Set m_IndxB = Nothing
|
||||
m_binit = True
|
||||
ReDim m_Verts(MaxParticles * 6)
|
||||
ReDim m_Particles(m_ParticlesLim)
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitDeviceObjects
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub InitDeviceObjects(dev As Direct3DDevice8)
|
||||
|
||||
Dim v As CUSTOMVERTEX
|
||||
Dim j As Long, i As Long
|
||||
Dim indices() As Integer
|
||||
Dim indxbuffsize As Long
|
||||
|
||||
' Create the particle system's vertex buffer and index buffer.
|
||||
' Each particle requires four vertices and 6 indices
|
||||
Set m_VertB = dev.CreateVertexBuffer(4 * m_MaxParticles * Len(v), D3DUSAGE_SOFTWAREPROCESSING, D3DFVF_COLORVERTEX, D3DPOOL_MANAGED)
|
||||
|
||||
indxbuffsize = 6 * m_MaxParticles * 4 'each entry is 4 bytes (vb integer)
|
||||
Set m_IndxB = dev.CreateIndexBuffer(indxbuffsize, D3DUSAGE_SOFTWAREPROCESSING, D3DFMT_INDEX16, D3DPOOL_MANAGED)
|
||||
|
||||
|
||||
' Fill the index buffer
|
||||
ReDim indices(6 * m_MaxParticles) 'we have 2 triangles per particle
|
||||
j = 0
|
||||
For i = 0 To m_MaxParticles - 1
|
||||
indices(j) = 4 * i + 0: j = j + 1
|
||||
indices(j) = 4 * i + 3: j = j + 1
|
||||
indices(j) = 4 * i + 1: j = j + 1
|
||||
indices(j) = 4 * i + 1: j = j + 1
|
||||
indices(j) = 4 * i + 3: j = j + 1
|
||||
indices(j) = 4 * i + 2: j = j + 1
|
||||
Next
|
||||
|
||||
' Set the data on the d3d buffer
|
||||
D3DIndexBuffer8SetData m_IndxB, 0, indxbuffsize, 0, indices(0)
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: DeleteDeviceObjects
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub DeleteDeviceObjects()
|
||||
Set m_VertB = Nothing
|
||||
Set m_IndxB = Nothing
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Class_Terminate
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
DeleteDeviceObjects
|
||||
ReDim m_Particles(0)
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name:
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Update(fSecsPerFrame As Single, NumParticlesToEmit As Long, _
|
||||
clrEmitColor As D3DCOLORVALUE, _
|
||||
clrFadeColor As D3DCOLORVALUE, _
|
||||
fEmitVel As Single, _
|
||||
vPosition As D3DVECTOR)
|
||||
|
||||
If m_binit = False Then Exit Sub
|
||||
|
||||
|
||||
Static fTime As Single
|
||||
Dim i As Long
|
||||
Dim iSpark As Long, inew As Long
|
||||
Dim fRand1 As Single, fRand2 As Single
|
||||
|
||||
'advance simulation
|
||||
fTime = fTime + fSecsPerFrame
|
||||
|
||||
|
||||
Dim iCurrent As Long
|
||||
Dim iPrevious As Long
|
||||
iCurrent = m_iUsed
|
||||
iPrevious = 0
|
||||
|
||||
'For each particle in the In Use list ...
|
||||
'calculate its age and test if the particle is too old
|
||||
|
||||
Do While (iCurrent > 0)
|
||||
|
||||
With m_Particles(iCurrent)
|
||||
|
||||
|
||||
|
||||
Dim ft As Single
|
||||
Dim fGravity As Single
|
||||
|
||||
'Calculate current lifetime
|
||||
ft = fTime - .m_fTime0
|
||||
|
||||
'normal particle become sparks at the end of their
|
||||
'life time and have different behaviour
|
||||
'that we define here
|
||||
If .m_bSpark Then
|
||||
|
||||
'sparks float higher and fade faster
|
||||
fGravity = -5#
|
||||
.m_fFade = .m_fFade - fSecsPerFrame * 2.25
|
||||
|
||||
Else
|
||||
'other particles fall to ground faster but live longer
|
||||
fGravity = -9.8
|
||||
|
||||
End If
|
||||
|
||||
|
||||
'Our newposition computed from velocity and initial position
|
||||
'pNew=pInit+t*velocity + accl * t * t
|
||||
|
||||
'the first terms
|
||||
.m_vPos.x = .m_vVel0.x * ft + .m_vPos0.x
|
||||
.m_vPos.y = .m_vVel0.y * ft + .m_vPos0.y
|
||||
.m_vPos.z = .m_vVel0.z * ft + .m_vPos0.z
|
||||
|
||||
'we add gravity in for the accleration terms on y axis
|
||||
.m_vPos.y = .m_vPos.y + (0.5 * fGravity) * (ft * ft)
|
||||
|
||||
'compute new Velocity given acceleartion
|
||||
'vNew=vInit+t*vCurrent
|
||||
.m_vVel.y = .m_vVel0.y + fGravity * ft
|
||||
|
||||
'clamp fading to zero
|
||||
If (.m_fFade < 0#) Then .m_fFade = 0
|
||||
|
||||
|
||||
'Normal particles die and turn into 5 sparks when they are
|
||||
'above a certain height from the ground
|
||||
|
||||
'Sparks die when they fall below the surface
|
||||
|
||||
'We test here if any particle is dead
|
||||
|
||||
If (.m_vPos.y < m_fRadius) Then '
|
||||
|
||||
'if we have a normal particle
|
||||
'lets turn it into 5 sparks
|
||||
If (Not .m_bSpark) Then
|
||||
|
||||
For i = 0 To 4
|
||||
|
||||
'If there are particles in the free list, use them
|
||||
If (m_iFree) Then
|
||||
iSpark = m_iFree
|
||||
m_iFree = m_Particles(m_iFree).iNext
|
||||
|
||||
'other wise get a new one
|
||||
Else
|
||||
If m_iLast >= m_ParticlesLim Then
|
||||
' 'm_bReset = True
|
||||
Exit For
|
||||
End If
|
||||
m_iLast = m_iLast + 1
|
||||
iSpark = m_iLast
|
||||
|
||||
End If
|
||||
|
||||
'put this new particle on the used list
|
||||
m_Particles(iSpark).iNext = m_iUsed
|
||||
m_iUsed = iSpark
|
||||
m_NumParticles = m_NumParticles + 1
|
||||
|
||||
'have the spark start out in the same position
|
||||
'as where the normal particle is now
|
||||
m_Particles(iSpark).m_bSpark = True
|
||||
m_Particles(iSpark).m_vPos0 = .m_vPos
|
||||
m_Particles(iSpark).m_vPos0.y = m_fRadius
|
||||
|
||||
fRand1 = Rnd(1) * g_pi * 2
|
||||
fRand2 = Rnd(1) * g_pi * 0.25
|
||||
|
||||
'have the sparks velocity vere off from the normal particle
|
||||
m_Particles(iSpark).m_vVel0.x = .m_vVel.x * 0.25 + Cos(fRand1) * Sin(fRand2)
|
||||
m_Particles(iSpark).m_vVel0.z = .m_vVel.z * 0.25 + Sin(fRand1) * Sin(fRand2)
|
||||
m_Particles(iSpark).m_vVel0.y = Cos(fRand2) * Rnd(1) * 1.5
|
||||
|
||||
'set the sparks current position = initial position
|
||||
'set the sparks current velocitu = initial velocity
|
||||
m_Particles(iSpark).m_vPos = .m_vPos0
|
||||
m_Particles(iSpark).m_vVel = .m_vVel0
|
||||
|
||||
' set the initial color of the particle to be that of
|
||||
'what it was as a normal particle
|
||||
D3DXColorLerp m_Particles(iSpark).m_clrDiffuse, .m_clrFade, .m_clrDiffuse, .m_fFade
|
||||
|
||||
'set the spark to fade to blue
|
||||
m_Particles(iSpark).m_clrFade = ColorValue4(0#, 0#, 0#, 1#)
|
||||
|
||||
'set its life time indicator to be newly created
|
||||
m_Particles(iSpark).m_fFade = 1#
|
||||
|
||||
'save the time of creation
|
||||
m_Particles(iSpark).m_fTime0 = fTime
|
||||
Next
|
||||
End If
|
||||
|
||||
' Kill the current particle
|
||||
'remove it form used list
|
||||
'put it on free list
|
||||
If iPrevious > 0 Then
|
||||
m_Particles(iPrevious).iNext = .iNext
|
||||
Else
|
||||
m_iUsed = .iNext
|
||||
End If
|
||||
|
||||
Dim iTemp As Long
|
||||
iTemp = .iNext
|
||||
.iNext = m_iFree
|
||||
m_iFree = iCurrent
|
||||
iCurrent = iTemp
|
||||
|
||||
m_NumParticles = m_NumParticles - 1
|
||||
|
||||
Else
|
||||
iPrevious = iCurrent
|
||||
iCurrent = .iNext
|
||||
End If
|
||||
End With
|
||||
Loop
|
||||
|
||||
' Emit new particles
|
||||
Dim NumParticlesEmit As Long
|
||||
NumParticlesEmit = m_NumParticles + NumParticlesToEmit
|
||||
|
||||
Do While (m_NumParticles < m_ParticlesLim And m_NumParticles < NumParticlesEmit)
|
||||
|
||||
' If there is a particle in the free list, use it
|
||||
If (m_iFree) Then
|
||||
inew = m_iFree
|
||||
m_iFree = m_Particles(m_iFree).iNext
|
||||
|
||||
'other wise get an new one
|
||||
Else
|
||||
If m_iLast >= m_ParticlesLim Then
|
||||
Exit Do
|
||||
End If
|
||||
m_iLast = m_iLast + 1
|
||||
inew = m_iLast
|
||||
|
||||
End If
|
||||
|
||||
'put it on the used list
|
||||
'put this new particle on the used list
|
||||
m_Particles(inew).iNext = m_iUsed
|
||||
m_iUsed = inew
|
||||
|
||||
m_NumParticles = m_NumParticles + 1
|
||||
|
||||
' Emit new particle
|
||||
|
||||
fRand1 = Rnd(1) * g_pi * 2
|
||||
fRand2 = Rnd(1) * g_pi * 0.25
|
||||
|
||||
With m_Particles(inew)
|
||||
.m_bSpark = False
|
||||
D3DXVec3Add .m_vPos0, vPosition, vec3(0, m_fRadius, 0)
|
||||
.m_vVel0.x = Cos(fRand1) * Sin(fRand2) * 2.5
|
||||
.m_vVel0.z = Sin(fRand1) * Sin(fRand2) * 2.5
|
||||
.m_vVel0.y = Cos(fRand2) * (Rnd(1) * fEmitVel)
|
||||
.m_vPos = .m_vPos0
|
||||
.m_vVel = .m_vVel0
|
||||
.m_clrDiffuse = clrEmitColor
|
||||
.m_clrFade = clrFadeColor
|
||||
.m_fFade = 1
|
||||
.m_fTime0 = fTime
|
||||
End With
|
||||
Loop
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Render()
|
||||
' Desc: Renders the particle system using either pointsprites
|
||||
'
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Render(dev As Direct3DDevice8)
|
||||
Dim v As CUSTOMVERTEX
|
||||
Dim iCurrent As Long, i As Long
|
||||
|
||||
With dev
|
||||
|
||||
Dim DWFloat0 As Long
|
||||
Dim DWFloat1 As Long
|
||||
Dim DWFloatp08 As Long
|
||||
DWFloat0 = FtoDW(0)
|
||||
DWFloat1 = FtoDW(1)
|
||||
DWFloatp08 = FtoDW(0.08)
|
||||
' Set the render states for using point sprites
|
||||
.SetRenderState D3DRS_POINTSPRITE_ENABLE, 1 'True
|
||||
.SetRenderState D3DRS_POINTSCALE_ENABLE, 1 'True
|
||||
.SetRenderState D3DRS_POINTSIZE, DWFloatp08
|
||||
.SetRenderState D3DRS_POINTSIZE_MIN, DWFloat0
|
||||
.SetRenderState D3DRS_POINTSCALE_A, DWFloat0
|
||||
.SetRenderState D3DRS_POINTSCALE_B, DWFloat0
|
||||
.SetRenderState D3DRS_POINTSCALE_C, DWFloat1
|
||||
|
||||
' Set up the vertex buffer to be rendered
|
||||
.SetStreamSource 0, m_VertB, Len(v)
|
||||
.SetVertexShader D3DFVF_COLORVERTEX
|
||||
|
||||
End With
|
||||
|
||||
Dim NumParticlesToRender As Long
|
||||
|
||||
' Render each particle
|
||||
iCurrent = m_iUsed
|
||||
|
||||
Dim vPos As D3DVECTOR, vVel As D3DVECTOR
|
||||
Dim fLengthSq As Single, steps As Long
|
||||
Do While (iCurrent <> 0)
|
||||
|
||||
With m_Particles(iCurrent)
|
||||
vPos = .m_vPos
|
||||
vVel = .m_vVel
|
||||
fLengthSq = D3DXVec3LengthSq(vVel)
|
||||
|
||||
|
||||
If (fLengthSq < 1#) Then
|
||||
steps = 2
|
||||
ElseIf (fLengthSq < 4#) Then
|
||||
steps = 3
|
||||
ElseIf (fLengthSq < 9#) Then
|
||||
steps = 4
|
||||
ElseIf (fLengthSq < 12.25) Then
|
||||
steps = 5
|
||||
ElseIf (fLengthSq < 16#) Then
|
||||
steps = 6
|
||||
ElseIf (fLengthSq < 20.25) Then
|
||||
steps = 7
|
||||
Else
|
||||
steps = 8
|
||||
End If
|
||||
|
||||
D3DXVec3Scale vVel, vVel, (-0.04 / steps)
|
||||
|
||||
Dim clrDiffuse As D3DCOLORVALUE
|
||||
|
||||
D3DXColorLerp clrDiffuse, .m_clrFade, .m_clrDiffuse, .m_fFade
|
||||
Dim clrDiffuseLong As Long
|
||||
clrDiffuseLong = D3DCOLORVALUEtoLONG(clrDiffuse)
|
||||
|
||||
|
||||
Dim iVert As Long
|
||||
|
||||
' Render each particle a bunch of times to get a blurring effect
|
||||
For i = 0 To steps - 1
|
||||
|
||||
m_Verts(iVert).v = vPos
|
||||
m_Verts(iVert).color = clrDiffuseLong
|
||||
|
||||
NumParticlesToRender = NumParticlesToRender + 1
|
||||
iVert = iVert + 1
|
||||
If (NumParticlesToRender = m_MaxParticles) Then
|
||||
|
||||
' we have a full Vertex buffer
|
||||
D3DVertexBuffer8SetData m_VertB, 0, Len(v) * m_MaxParticles, 0, m_Verts(0)
|
||||
dev.DrawPrimitive D3DPT_POINTLIST, 0, NumParticlesToRender
|
||||
|
||||
|
||||
NumParticlesToRender = 0
|
||||
iVert = 0
|
||||
End If
|
||||
|
||||
D3DXVec3Add vPos, vPos, vVel
|
||||
|
||||
Next
|
||||
iCurrent = .iNext
|
||||
|
||||
End With
|
||||
|
||||
Loop
|
||||
|
||||
' Render any remaining particles
|
||||
If (NumParticlesToRender <> 0) Then
|
||||
D3DVertexBuffer8SetData m_VertB, 0, Len(v) * NumParticlesToRender, 0, m_Verts(0)
|
||||
g_dev.DrawPrimitive D3DPT_POINTLIST, 0, NumParticlesToRender
|
||||
End If
|
||||
|
||||
' Reset render states
|
||||
g_dev.SetRenderState D3DRS_POINTSPRITE_ENABLE, 0 'False
|
||||
g_dev.SetRenderState D3DRS_POINTSCALE_ENABLE, 0 'False
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RenderLights
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub RenderLights(dev As Direct3DDevice8)
|
||||
|
||||
|
||||
Dim vTL As D3DVECTOR, vBL As D3DVECTOR, vBR As D3DVECTOR, vTR As D3DVECTOR
|
||||
Dim v As CUSTOMVERTEX
|
||||
|
||||
vTL = vec3(-1, 0, 1): vBL = vec3(-1, 0, -1)
|
||||
vBR = vec3(1, 0, -1): vTR = vec3(1, 0, 1)
|
||||
|
||||
With dev
|
||||
.SetStreamSource 0, m_VertB, Len(v)
|
||||
.SetVertexShader D3DFVF_COLORVERTEX
|
||||
.SetIndices m_IndxB, 0
|
||||
End With
|
||||
|
||||
Dim iCurrent As Long
|
||||
|
||||
Dim NumParticlesToRender
|
||||
Dim fY As Single
|
||||
Dim fSize As Single
|
||||
Dim clrDiffuse As D3DCOLORVALUE
|
||||
Dim clrDiffuseTemp As D3DCOLORVALUE
|
||||
Dim lngDiffuse As Long
|
||||
Dim vPos As D3DVECTOR
|
||||
Dim vTemp As D3DVECTOR
|
||||
Dim j As Long
|
||||
|
||||
iCurrent = m_iUsed
|
||||
|
||||
Do While (iCurrent <> 0)
|
||||
|
||||
|
||||
With m_Particles(iCurrent)
|
||||
fY = .m_vPos.y
|
||||
|
||||
|
||||
'if the particle is close to the ground we will add some lights effects
|
||||
If (fY < 1) Then
|
||||
|
||||
'make sure particle cant go below ground
|
||||
If (fY < 0) Then fY = 0
|
||||
|
||||
fSize = fY * 0.25 + m_fRadius
|
||||
|
||||
|
||||
D3DXColorLerp clrDiffuse, .m_clrFade, .m_clrDiffuse, .m_fFade
|
||||
D3DXColorScale clrDiffuseTemp, clrDiffuse, (1 - fY) * 0.5
|
||||
lngDiffuse = D3DCOLORVALUEtoLONG(clrDiffuseTemp)
|
||||
vPos = vec3(.m_vPos.x, 0#, .m_vPos.z)
|
||||
|
||||
|
||||
D3DXVec3Scale vTemp, vTR, fSize
|
||||
D3DXVec3Add m_Verts(j).v, vPos, vTemp
|
||||
m_Verts(j).color = lngDiffuse
|
||||
m_Verts(j).tu = 0: m_Verts(j).tv = 0
|
||||
j = j + 1
|
||||
|
||||
D3DXVec3Scale vTemp, vBR, fSize
|
||||
D3DXVec3Add m_Verts(j).v, vPos, vTemp
|
||||
m_Verts(j).color = lngDiffuse
|
||||
m_Verts(j).tu = 0: m_Verts(j).tv = 1
|
||||
j = j + 1
|
||||
|
||||
D3DXVec3Scale vTemp, vBL, fSize
|
||||
D3DXVec3Add m_Verts(j).v, vPos, vTemp
|
||||
m_Verts(j).color = lngDiffuse
|
||||
m_Verts(j).tu = 1: m_Verts(j).tv = 1
|
||||
j = j + 1
|
||||
|
||||
D3DXVec3Scale vTemp, vTL, fSize
|
||||
D3DXVec3Add m_Verts(j).v, vPos, vTemp
|
||||
m_Verts(j).color = lngDiffuse
|
||||
m_Verts(j).tu = 1: m_Verts(j).tv = 0
|
||||
j = j + 1
|
||||
|
||||
|
||||
NumParticlesToRender = NumParticlesToRender + 1
|
||||
|
||||
If (NumParticlesToRender = m_MaxParticles) Then
|
||||
D3DVertexBuffer8SetData m_VertB, 0, Len(v) * 4 * NumParticlesToRender, 0, m_Verts(0)
|
||||
|
||||
dev.DrawIndexedPrimitive D3DPT_TRIANGLELIST, _
|
||||
0, NumParticlesToRender * 4, _
|
||||
0, NumParticlesToRender * 2
|
||||
|
||||
NumParticlesToRender = 0
|
||||
j = 0
|
||||
End If
|
||||
|
||||
|
||||
|
||||
End If
|
||||
|
||||
iCurrent = .iNext
|
||||
|
||||
End With
|
||||
|
||||
Loop
|
||||
|
||||
|
||||
' Render remaining particles
|
||||
If (NumParticlesToRender <> 0) Then
|
||||
D3DVertexBuffer8SetData m_VertB, 0, Len(v) * 4 * NumParticlesToRender, 0, m_Verts(0)
|
||||
|
||||
dev.DrawIndexedPrimitive D3DPT_TRIANGLELIST, _
|
||||
0, NumParticlesToRender * 4, _
|
||||
0, NumParticlesToRender * 2
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
@@ -0,0 +1,778 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form Form1
|
||||
Caption = "Point Sprites"
|
||||
ClientHeight = 4050
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 5055
|
||||
Icon = "PointSprites.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 270
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 337
|
||||
StartUpPosition = 3 'Windows Default
|
||||
End
|
||||
Attribute VB_Name = "Form1"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: PointSprites.frm
|
||||
' Content: Sample showing how to use point sprites to do particle effects
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
Option Compare Text
|
||||
|
||||
Private Type CUSTOMVERTEX
|
||||
v As D3DVECTOR
|
||||
color As Long
|
||||
tu As Single
|
||||
tv As Single
|
||||
End Type
|
||||
Const D3DFVF_COLORVERTEX = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_TEX1)
|
||||
|
||||
Const GROUND_GRIDSIZE = 8
|
||||
Const GROUND_WIDTH = 256
|
||||
Const GROUND_HEIGHT = 256
|
||||
Const GROUND_TILE = 32
|
||||
Const GROUND_COLOR = &HBBEEEEEE
|
||||
|
||||
Private Enum PARTICLE_COLORS
|
||||
COLOR_WHITE = 0
|
||||
COLOR_RED = 1
|
||||
COLOR_GREEN = 2
|
||||
COLOR_BLUE = 3
|
||||
NUM_COLORS = 4
|
||||
End Enum
|
||||
|
||||
Dim g_clrColor(4) As D3DCOLORVALUE
|
||||
Dim g_clrColorFade(4) As D3DCOLORVALUE
|
||||
|
||||
Dim m_media As String
|
||||
|
||||
Dim m_ParticleSystem As CParticle
|
||||
Dim m_ParticleTexture As Direct3DTexture8
|
||||
Dim m_NumParticlesToEmit As Long
|
||||
Dim m_bStaticParticle As Boolean
|
||||
Dim m_nParticleColor As Long
|
||||
|
||||
Dim m_GroundTexture As Direct3DTexture8
|
||||
Dim m_NumGroundVertices As Long
|
||||
Dim m_NumGroundIndices As Long
|
||||
Dim m_GroundIB As Direct3DIndexBuffer8
|
||||
Dim m_GroundVB As Direct3DVertexBuffer8
|
||||
Dim m_planeGround As D3DPLANE
|
||||
|
||||
Dim m_bDrawReflection As Boolean
|
||||
Dim m_bCanDoAlphaBlend As Boolean
|
||||
Dim m_bCanDoClipPlanes As Boolean
|
||||
Dim m_bDrawHelp As Boolean
|
||||
|
||||
Dim m_matView As D3DMATRIX
|
||||
Dim m_matOrientation As D3DMATRIX
|
||||
|
||||
Dim m_vPosition As D3DVECTOR
|
||||
Dim m_vVelocity As D3DVECTOR
|
||||
Dim m_fYaw As Single
|
||||
Dim m_fYawVelocity As Single
|
||||
Dim m_fPitch As Single
|
||||
Dim m_fPitchVelocity As Single
|
||||
|
||||
Dim m_fElapsedTime As Single
|
||||
|
||||
Dim m_bKey(256) As Boolean
|
||||
|
||||
Dim g_fTime As Single
|
||||
Dim g_fLastTime As Single
|
||||
|
||||
Dim m_grVerts() As CUSTOMVERTEX
|
||||
Dim m_grVerts2() As CUSTOMVERTEX
|
||||
|
||||
Dim m_binit As Boolean
|
||||
Dim m_bMinimized As Boolean
|
||||
Dim m_bStopSim As Boolean
|
||||
|
||||
Const kMaxParticles = 128
|
||||
Const kParticleRadius = 0.01
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_KeyPress()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_KeyPress(KeyAscii As Integer)
|
||||
If Chr$(KeyAscii) = "r" Then m_bDrawReflection = Not m_bDrawReflection
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Load()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Load()
|
||||
Me.Show
|
||||
DoEvents
|
||||
|
||||
'setup defaults
|
||||
Init
|
||||
|
||||
' Initialize D3D
|
||||
' Note: D3DUtil_Init will attempt to use D3D Hardware acceleartion.
|
||||
' If it is not available it attempt to use the Software Reference Rasterizer.
|
||||
' If all fail it will display a message box indicating so.
|
||||
'
|
||||
m_binit = D3DUtil_Init(Me.hwnd, True, 0, 0, D3DDEVTYPE_HAL, Me)
|
||||
If Not (m_binit) Then End
|
||||
|
||||
' find Media and set media path
|
||||
m_media = FindMediaDir("ground2.bmp")
|
||||
D3DUtil_SetMediaPath m_media
|
||||
|
||||
' Set initial state
|
||||
OneTimeSceneInit
|
||||
|
||||
' Load Mesh and textures from media
|
||||
InitDeviceObjects
|
||||
|
||||
' Set device render states, lighting, camera
|
||||
RestoreDeviceObjects
|
||||
|
||||
' Start Timer
|
||||
DXUtil_Timer TIMER_start
|
||||
|
||||
' Start our timer
|
||||
DXUtil_Timer TIMER_start
|
||||
|
||||
' Run the simulation forever
|
||||
' See Form_Keydown for exit processing
|
||||
Do While True
|
||||
|
||||
' Increment the simulation
|
||||
FrameMove
|
||||
|
||||
' Render one image of the simulation
|
||||
If Render Then
|
||||
|
||||
' Present the image to the screen
|
||||
D3DUtil_PresentAll g_focushwnd
|
||||
End If
|
||||
|
||||
' Allow for events to get processed
|
||||
DoEvents
|
||||
|
||||
Loop
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_KeyDown()
|
||||
' Desc: Process key messages for exit and change device
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
|
||||
|
||||
m_bKey(KeyCode) = True
|
||||
|
||||
Select Case KeyCode
|
||||
|
||||
Case vbKeyEscape
|
||||
Unload Me
|
||||
|
||||
Case vbKeyF2
|
||||
|
||||
' Pause the timer
|
||||
DXUtil_Timer TIMER_STOP
|
||||
m_bStopSim = True
|
||||
|
||||
' Bring up the device selection dialog
|
||||
' we pass in the form so the selection process
|
||||
' can make calls into InitDeviceObjects
|
||||
' and RestoreDeviceObjects
|
||||
frmSelectDevice.SelectDevice Me
|
||||
|
||||
' Restart the timer
|
||||
m_bStopSim = False
|
||||
DXUtil_Timer TIMER_start
|
||||
|
||||
Case vbKeyReturn
|
||||
|
||||
' Check for Alt-Enter if not pressed exit
|
||||
If Shift <> 4 Then Exit Sub
|
||||
|
||||
' stop simulation
|
||||
DXUtil_Timer TIMER_STOP
|
||||
m_bStopSim = True
|
||||
|
||||
|
||||
' If we are windowed go fullscreen
|
||||
' If we are fullscreen returned to windowed
|
||||
If g_d3dpp.Windowed Then
|
||||
D3DUtil_ResetFullscreen
|
||||
Else
|
||||
D3DUtil_ResetWindowed
|
||||
End If
|
||||
|
||||
' Call Restore after ever mode change
|
||||
' because calling reset looses state that needs to
|
||||
' be reinitialized
|
||||
RestoreDeviceObjects
|
||||
|
||||
' Restart simulation
|
||||
DXUtil_Timer TIMER_STOP
|
||||
m_bStopSim = False
|
||||
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_KeyUp()
|
||||
' Desc: Process key messages for exit and change device
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
|
||||
m_bKey(KeyCode) = False
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
DXUtil_Timer (TIMER_STOP)
|
||||
m_bStopSim = True
|
||||
End Sub
|
||||
|
||||
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
DXUtil_Timer (TIMER_start)
|
||||
m_bStopSim = False
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Resize()
|
||||
' Desc: hadle resizing of the D3D backbuffer
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Resize()
|
||||
|
||||
' If D3D is not initialized then exit
|
||||
If Not m_binit Then Exit Sub
|
||||
|
||||
' If we are in a minimized state stop the timer and exit
|
||||
If Me.WindowState = vbMinimized Then
|
||||
DXUtil_Timer TIMER_STOP
|
||||
m_bMinimized = True
|
||||
m_bStopSim = True
|
||||
Exit Sub
|
||||
|
||||
' If we just went from a minimized state to maximized
|
||||
' restart the timer
|
||||
Else
|
||||
If m_bMinimized = True Then
|
||||
DXUtil_Timer TIMER_start
|
||||
m_bMinimized = False
|
||||
m_bStopSim = False
|
||||
End If
|
||||
End If
|
||||
|
||||
' Dont let the window get too small
|
||||
If Me.ScaleWidth < 10 Then
|
||||
Me.width = Screen.TwipsPerPixelX * 10
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Me.ScaleHeight < 10 Then
|
||||
Me.height = Screen.TwipsPerPixelY * 10
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
m_ParticleSystem.DeleteDeviceObjects
|
||||
Set m_ParticleSystem = Nothing
|
||||
Set m_ParticleSystem = New CParticle
|
||||
|
||||
'reset and resize our D3D backbuffer to the size of the window
|
||||
D3DUtil_ResizeWindowed Me.hwnd
|
||||
|
||||
'All state get losts after a reset so we need to reinitialze it here
|
||||
RestoreDeviceObjects
|
||||
DXUtil_Timer TIMER_STOP
|
||||
m_ParticleSystem.Init kMaxParticles, kParticleRadius
|
||||
m_ParticleSystem.InitDeviceObjects g_dev
|
||||
DXUtil_Timer TIMER_RESET
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Unload()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
DeleteDeviceObjects
|
||||
End
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Init()
|
||||
' Desc: Constructor
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Init()
|
||||
Me.Caption = "PointSprites: Using particle effects"
|
||||
|
||||
|
||||
|
||||
Set m_ParticleSystem = New CParticle
|
||||
m_ParticleSystem.Init kMaxParticles, kParticleRadius
|
||||
|
||||
Set m_ParticleTexture = Nothing
|
||||
|
||||
m_NumParticlesToEmit = 10
|
||||
m_bStaticParticle = True
|
||||
m_nParticleColor = COLOR_WHITE
|
||||
|
||||
Set m_GroundTexture = Nothing
|
||||
m_NumGroundVertices = (GROUND_GRIDSIZE + 1) * (GROUND_GRIDSIZE + 1)
|
||||
m_NumGroundIndices = (GROUND_GRIDSIZE * GROUND_GRIDSIZE) * 6
|
||||
Set m_GroundVB = Nothing
|
||||
Set m_GroundIB = Nothing
|
||||
m_planeGround = D3DPLANE4(0, 1, 0, 0)
|
||||
|
||||
m_bDrawReflection = False
|
||||
m_bCanDoAlphaBlend = False
|
||||
m_bCanDoClipPlanes = False
|
||||
m_bDrawHelp = False
|
||||
|
||||
|
||||
m_vPosition = vec3(0, 3, -4)
|
||||
m_vVelocity = vec3(0, 0, 0)
|
||||
m_fYaw = 0
|
||||
m_fYawVelocity = 0
|
||||
m_fPitch = 0.5
|
||||
m_fPitchVelocity = 0
|
||||
|
||||
|
||||
g_clrColor(0) = ColorValue4(1, 1, 1, 1)
|
||||
g_clrColor(1) = ColorValue4(1, 0.5, 0.5, 1)
|
||||
g_clrColor(2) = ColorValue4(0.5, 1, 0.5, 1)
|
||||
g_clrColor(3) = ColorValue4(0.125, 0.5, 1, 1)
|
||||
|
||||
|
||||
|
||||
g_clrColorFade(0) = ColorValue4(1, 0.25, 0.25, 1)
|
||||
g_clrColorFade(1) = ColorValue4(1, 0.25, 0.25, 1)
|
||||
g_clrColorFade(2) = ColorValue4(0.25, 0.75, 0.25, 1)
|
||||
g_clrColorFade(3) = ColorValue4(0.125, 0.25, 0.75, 1)
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: OneTimeSceneInit()
|
||||
' Desc: Called during initial app startup, this function performs all the
|
||||
' permanent initialization.
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub OneTimeSceneInit()
|
||||
D3DXMatrixTranslation m_matView, 0, 0, 10
|
||||
D3DXMatrixTranslation m_matOrientation, 0, 0, 0
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FrameMove()
|
||||
' Desc: Called once per frame, the call is the entry point for animating
|
||||
' the scene.
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
Sub FrameMove()
|
||||
|
||||
|
||||
If m_bStopSim = True Then Exit Sub
|
||||
|
||||
|
||||
g_fTime = DXUtil_Timer(TIMER_GETAPPTIME) * 1.3
|
||||
m_fElapsedTime = g_fTime - g_fLastTime
|
||||
g_fLastTime = g_fTime
|
||||
If m_fElapsedTime < 0 Then Exit Sub
|
||||
|
||||
' Slow things down for the REF device
|
||||
If (g_devType = D3DDEVTYPE_REF) Then m_fElapsedTime = 0.05
|
||||
|
||||
Dim fSpeed As Single
|
||||
Dim fAngularSpeed
|
||||
|
||||
fSpeed = 5 * m_fElapsedTime
|
||||
fAngularSpeed = 1 * m_fElapsedTime
|
||||
|
||||
' Slowdown the camera movement
|
||||
D3DXVec3Scale m_vVelocity, m_vVelocity, 0.9
|
||||
m_fYawVelocity = m_fYawVelocity * 0.9
|
||||
m_fPitchVelocity = m_fPitchVelocity * 0.9
|
||||
|
||||
' Process keyboard input
|
||||
If (m_bKey(vbKeyRight)) Then m_vVelocity.x = m_vVelocity.x + fSpeed ' Slide Right
|
||||
If (m_bKey(vbKeyLeft)) Then m_vVelocity.x = m_vVelocity.x - fSpeed ' Slide Left
|
||||
If (m_bKey(vbKeyUp)) Then m_vVelocity.y = m_vVelocity.y + fSpeed ' Move up
|
||||
If (m_bKey(vbKeyDown)) Then m_vVelocity.y = m_vVelocity.y - fSpeed ' Move down
|
||||
|
||||
If (m_bKey(vbKeyW)) Then m_vVelocity.z = m_vVelocity.z + fSpeed ' Move Forward
|
||||
If (m_bKey(vbKeyS)) Then m_vVelocity.z = m_vVelocity.z - fSpeed ' Move Backward
|
||||
|
||||
If (m_bKey(vbKeyE)) Then m_fYawVelocity = m_fYawVelocity + fSpeed ' Yaw right
|
||||
If (m_bKey(vbKeyQ)) Then m_fYawVelocity = m_fYawVelocity - fSpeed ' Yaw left
|
||||
|
||||
If (m_bKey(vbKeyZ)) Then m_fPitchVelocity = m_fPitchVelocity + fSpeed ' turn down
|
||||
If (m_bKey(vbKeyA)) Then m_fPitchVelocity = m_fPitchVelocity - fSpeed ' turn up
|
||||
|
||||
If (m_bKey(vbKeyAdd)) Then
|
||||
If (m_NumParticlesToEmit < 10) Then m_NumParticlesToEmit = m_NumParticlesToEmit + 1
|
||||
End If
|
||||
If (m_bKey(vbKeySubtract)) Then
|
||||
If (m_NumParticlesToEmit > 0) Then m_NumParticlesToEmit = m_NumParticlesToEmit - 1
|
||||
End If
|
||||
|
||||
|
||||
' Update the position vector
|
||||
Dim vT As D3DVECTOR, vTemp As D3DVECTOR
|
||||
D3DXVec3Scale vTemp, m_vVelocity, fSpeed
|
||||
D3DXVec3Add vT, vT, vTemp
|
||||
D3DXVec3TransformNormal vT, vT, m_matOrientation
|
||||
|
||||
D3DXVec3Add m_vPosition, m_vPosition, vT
|
||||
|
||||
If (m_vPosition.y < 1) Then m_vPosition.y = 1
|
||||
|
||||
' Update the yaw-pitch-rotation vector
|
||||
m_fYaw = m_fYaw + fAngularSpeed * m_fYawVelocity
|
||||
m_fPitch = m_fPitch + fAngularSpeed * m_fPitchVelocity
|
||||
If (m_fPitch < 0) Then m_fPitch = 0
|
||||
If (m_fPitch > g_pi / 2) Then m_fPitch = g_pi / 2
|
||||
|
||||
Dim qR As D3DQUATERNION, det As Single
|
||||
D3DXQuaternionRotationYawPitchRoll qR, m_fYaw, m_fPitch, 0
|
||||
D3DXMatrixAffineTransformation m_matOrientation, 1.25, vec3(0, 0, 0), qR, m_vPosition
|
||||
D3DXMatrixInverse m_matView, det, m_matOrientation
|
||||
|
||||
' Update particle system
|
||||
If (m_bStaticParticle) Then
|
||||
m_ParticleSystem.Update m_fElapsedTime, m_NumParticlesToEmit, _
|
||||
g_clrColor(m_nParticleColor), _
|
||||
g_clrColorFade(m_nParticleColor), 8, _
|
||||
vec3(0, 0, 0)
|
||||
Else
|
||||
m_ParticleSystem.Update m_fElapsedTime, m_NumParticlesToEmit, _
|
||||
g_clrColor(m_nParticleColor), _
|
||||
g_clrColorFade(m_nParticleColor), 8, _
|
||||
vec3(3 * Sin(g_fTime), 0, 3 * Cos(g_fTime))
|
||||
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Render()
|
||||
' Desc: Called once per frame, the call is the entry point for 3d
|
||||
' rendering. This function sets up render states, clears the
|
||||
' viewport, and renders the scene.
|
||||
'-----------------------------------------------------------------------------
|
||||
Function Render() As Boolean
|
||||
Dim v As CUSTOMVERTEX
|
||||
Dim hr As Long
|
||||
|
||||
'See what state the device is in.
|
||||
Render = False
|
||||
hr = g_dev.TestCooperativeLevel
|
||||
If hr = D3DERR_DEVICENOTRESET Then
|
||||
g_dev.Reset g_d3dpp
|
||||
RestoreDeviceObjects
|
||||
End If
|
||||
|
||||
'dont bother rendering if we are not ready yet
|
||||
If hr <> 0 Then Exit Function
|
||||
Render = True
|
||||
' Clear the backbuffer
|
||||
D3DUtil_ClearAll &HFF&
|
||||
|
||||
|
||||
With g_dev
|
||||
.BeginScene
|
||||
|
||||
|
||||
' Draw reflection of particles
|
||||
If (m_bDrawReflection) Then
|
||||
Dim matReflectedView As D3DMATRIX
|
||||
|
||||
D3DXMatrixReflect matReflectedView, m_planeGround
|
||||
D3DXMatrixMultiply matReflectedView, matReflectedView, m_matView
|
||||
|
||||
.SetTransform D3DTS_VIEW, matReflectedView
|
||||
'Dim clipplane As D3DCLIPPLANE
|
||||
'LSet clipplane = m_planeGround
|
||||
'.SetClipPlane 0, clipplane
|
||||
.SetRenderState D3DRS_CLIPPLANEENABLE, D3DCLIPPLANE0
|
||||
|
||||
' Draw particles
|
||||
.SetTexture 0, m_ParticleTexture
|
||||
.SetRenderState D3DRS_ZWRITEENABLE, 0 'FALSE
|
||||
.SetRenderState D3DRS_ALPHABLENDENABLE, 1 'TRUE
|
||||
|
||||
m_ParticleSystem.Render g_dev
|
||||
|
||||
.SetRenderState D3DRS_ALPHABLENDENABLE, 0 'False
|
||||
.SetRenderState D3DRS_ZWRITEENABLE, 1 'True
|
||||
|
||||
.SetRenderState D3DRS_CLIPPLANEENABLE, 0 'FALSE
|
||||
|
||||
.SetRenderState D3DRS_ALPHABLENDENABLE, 1 'True
|
||||
.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
|
||||
.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
|
||||
.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE
|
||||
End If
|
||||
|
||||
|
||||
.SetRenderState D3DRS_ALPHABLENDENABLE, 0 'False
|
||||
.SetRenderState D3DRS_ZWRITEENABLE, 1 'True
|
||||
.SetRenderState D3DRS_CLIPPLANEENABLE, 0 'FALSE
|
||||
|
||||
.SetRenderState D3DRS_ALPHABLENDENABLE, 1 '1 'True
|
||||
.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
|
||||
.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
|
||||
.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE
|
||||
|
||||
|
||||
' Draw ground
|
||||
.SetTransform D3DTS_VIEW, m_matView
|
||||
.SetTexture 0, m_GroundTexture
|
||||
.SetVertexShader D3DFVF_COLORVERTEX
|
||||
.SetStreamSource 0, m_GroundVB, Len(v)
|
||||
.SetIndices m_GroundIB, 0
|
||||
.DrawIndexedPrimitive D3DPT_TRIANGLELIST, _
|
||||
0, m_NumGroundVertices, _
|
||||
0, (m_NumGroundIndices / 3)
|
||||
|
||||
' Draw particles
|
||||
.SetRenderState D3DRS_ALPHABLENDENABLE, 1 'True
|
||||
.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
|
||||
.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
|
||||
.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG1
|
||||
|
||||
.SetRenderState D3DRS_ZWRITEENABLE, 0 'False
|
||||
.SetRenderState D3DRS_ZENABLE, 1 'TRUE
|
||||
|
||||
.SetTexture 0, m_ParticleTexture
|
||||
|
||||
.SetRenderState D3DRS_ZENABLE, 0 'False
|
||||
|
||||
.SetTexture 0, m_ParticleTexture
|
||||
m_ParticleSystem.Render g_dev
|
||||
|
||||
.SetRenderState D3DRS_ALPHABLENDENABLE, 0 'False
|
||||
.SetRenderState D3DRS_ZWRITEENABLE, 1 'True
|
||||
|
||||
|
||||
.EndScene
|
||||
End With
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitDeviceObjects()
|
||||
' Desc: Initialize scene objects.
|
||||
'-----------------------------------------------------------------------------
|
||||
Function InitDeviceObjects() As Boolean
|
||||
|
||||
Dim i As Long
|
||||
Dim v As CUSTOMVERTEX
|
||||
|
||||
Set m_GroundTexture = D3DUtil_CreateTexture(g_dev, "Ground2.bmp", D3DFMT_UNKNOWN)
|
||||
|
||||
Set m_ParticleTexture = D3DUtil_CreateTexture(g_dev, "Particle.bmp", D3DFMT_UNKNOWN)
|
||||
|
||||
|
||||
' Check if we can do the reflection effect
|
||||
m_bCanDoAlphaBlend = ((g_d3dCaps.SrcBlendCaps And D3DPBLENDCAPS_SRCALPHA) = D3DPBLENDCAPS_SRCALPHA) And _
|
||||
((g_d3dCaps.DestBlendCaps And D3DPBLENDCAPS_INVSRCALPHA) = D3DPBLENDCAPS_INVSRCALPHA)
|
||||
m_bCanDoClipPlanes = (g_d3dCaps.MaxUserClipPlanes >= 1)
|
||||
|
||||
' Note: all HW with Software Vertex Processing can do clipplanes
|
||||
m_bCanDoClipPlanes = True
|
||||
|
||||
If (m_bCanDoAlphaBlend And m_bCanDoClipPlanes) Then m_bDrawReflection = True
|
||||
|
||||
' Create ground object
|
||||
|
||||
' Create vertex buffer for ground object
|
||||
Set m_GroundVB = g_dev.CreateVertexBuffer(m_NumGroundVertices * Len(v), _
|
||||
0, D3DFVF_COLORVERTEX, D3DPOOL_MANAGED)
|
||||
|
||||
|
||||
' Fill vertex buffer
|
||||
|
||||
Dim zz As Long, xx As Long
|
||||
|
||||
ReDim m_grVerts(GROUND_GRIDSIZE * GROUND_GRIDSIZE * 6)
|
||||
|
||||
|
||||
i = 0
|
||||
For zz = 0 To GROUND_GRIDSIZE
|
||||
For xx = 0 To GROUND_GRIDSIZE
|
||||
|
||||
m_grVerts(i).v.x = GROUND_WIDTH * ((xx / GROUND_GRIDSIZE) - 0.5)
|
||||
m_grVerts(i).v.y = 0
|
||||
m_grVerts(i).v.z = GROUND_HEIGHT * ((zz / GROUND_GRIDSIZE) - 0.5)
|
||||
m_grVerts(i).color = GROUND_COLOR
|
||||
m_grVerts(i).tu = xx * (GROUND_TILE / GROUND_GRIDSIZE)
|
||||
m_grVerts(i).tv = zz * (GROUND_TILE / GROUND_GRIDSIZE)
|
||||
i = i + 1
|
||||
Next
|
||||
Next
|
||||
|
||||
D3DVertexBuffer8SetData m_GroundVB, 0, Len(v) * (GROUND_GRIDSIZE + 1) * (GROUND_GRIDSIZE + 1), 0, m_grVerts(0)
|
||||
|
||||
Dim vtx As Long
|
||||
Dim m_Indices() As Integer
|
||||
ReDim m_Indices(m_NumGroundIndices * 4)
|
||||
Dim z As Long, x As Long
|
||||
|
||||
' Create the index buffer
|
||||
Set m_GroundIB = g_dev.CreateIndexBuffer(m_NumGroundIndices * 2, _
|
||||
0, _
|
||||
D3DFMT_INDEX16, D3DPOOL_MANAGED)
|
||||
|
||||
' Fill in indices
|
||||
i = 0
|
||||
For z = 0 To GROUND_GRIDSIZE - 1
|
||||
For x = 0 To GROUND_GRIDSIZE - 1
|
||||
|
||||
vtx = x + z * (GROUND_GRIDSIZE + 1)
|
||||
m_Indices(i) = vtx + 1: i = i + 1
|
||||
m_Indices(i) = vtx + 0: i = i + 1
|
||||
m_Indices(i) = vtx + 0 + (GROUND_GRIDSIZE + 1): i = i + 1
|
||||
m_Indices(i) = vtx + 1: i = i + 1
|
||||
m_Indices(i) = vtx + 0 + (GROUND_GRIDSIZE + 1): i = i + 1
|
||||
m_Indices(i) = vtx + 1 + (GROUND_GRIDSIZE + 1): i = i + 1
|
||||
|
||||
Next
|
||||
Next
|
||||
|
||||
D3DIndexBuffer8SetData m_GroundIB, 0, 2 * m_NumGroundIndices, 0, m_Indices(0)
|
||||
|
||||
' Initialize the particle system
|
||||
m_ParticleSystem.InitDeviceObjects g_dev
|
||||
|
||||
InitDeviceObjects = True
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: VerifyDevice()
|
||||
'-----------------------------------------------------------------------------
|
||||
Function VerifyDevice(Behavior As Long, format As CONST_D3DFORMAT) As Boolean
|
||||
|
||||
' Make sure device can do ONE:ONE alphablending
|
||||
If (0 = (g_d3dCaps.SrcBlendCaps And D3DPBLENDCAPS_ONE) = D3DPBLENDCAPS_ONE) Then Exit Function
|
||||
If (0 = (g_d3dCaps.DestBlendCaps And D3DPBLENDCAPS_ONE) = D3DPBLENDCAPS_ONE) Then Exit Function
|
||||
|
||||
' We will run this app using software vertex processing
|
||||
If (Behavior = D3DCREATE_HARDWARE_VERTEXPROCESSING) Then Exit Function
|
||||
|
||||
|
||||
VerifyDevice = True
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: DeleteDeviceObjects()
|
||||
' Desc: Called when the app is exitting, or the device is being changed,
|
||||
' this function deletes any device dependant objects.
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub DeleteDeviceObjects()
|
||||
|
||||
Set m_GroundTexture = Nothing
|
||||
Set m_ParticleTexture = Nothing
|
||||
|
||||
Set m_GroundVB = Nothing
|
||||
Set m_GroundIB = Nothing
|
||||
|
||||
If (m_ParticleSystem Is Nothing) Then Exit Sub
|
||||
m_ParticleSystem.DeleteDeviceObjects
|
||||
m_binit = False
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FinalCleanup()
|
||||
' Desc: Called before the app exits, this function gives the app the chance
|
||||
' to cleanup after itself.
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub FinalCleanup()
|
||||
|
||||
Set m_GroundTexture = Nothing
|
||||
Set m_ParticleTexture = Nothing
|
||||
Set m_ParticleSystem = Nothing
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InvalidateDeviceObjects()
|
||||
' Desc: Place code to release non managed objects here
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub InvalidateDeviceObjects()
|
||||
'all objects are managed in this sample
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RestoreDeviceObjects()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub RestoreDeviceObjects()
|
||||
|
||||
' Set the world matrix
|
||||
Dim matWorld As D3DMATRIX
|
||||
D3DXMatrixIdentity matWorld
|
||||
g_dev.SetTransform D3DTS_WORLD, matWorld
|
||||
|
||||
' Set projection matrix
|
||||
Dim matProj As D3DMATRIX
|
||||
D3DXMatrixPerspectiveFovLH matProj, g_pi / 4, Me.ScaleHeight / Me.ScaleWidth, 0.1, 100
|
||||
g_dev.SetTransform D3DTS_PROJECTION, matProj
|
||||
|
||||
' Set renderstates
|
||||
With g_dev
|
||||
Call .SetTextureStageState(0, D3DTSS_MINFILTER, D3DTEXF_LINEAR)
|
||||
Call .SetTextureStageState(0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR)
|
||||
Call .SetTextureStageState(0, D3DTSS_MIPFILTER, D3DTEXF_LINEAR)
|
||||
Call .SetTextureStageState(0, D3DTSS_COLOROP, D3DTOP_MODULATE)
|
||||
Call .SetTextureStageState(0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG1)
|
||||
Call .SetTextureStageState(1, D3DTSS_COLOROP, D3DTOP_DISABLE)
|
||||
Call .SetTextureStageState(1, D3DTSS_ALPHAOP, D3DTOP_DISABLE)
|
||||
|
||||
Call .SetRenderState(D3DRS_SRCBLEND, D3DBLEND_ONE)
|
||||
Call .SetRenderState(D3DRS_DESTBLEND, D3DBLEND_ONE)
|
||||
Call .SetRenderState(D3DRS_LIGHTING, 0) 'FALSE
|
||||
Call .SetRenderState(D3DRS_CULLMODE, D3DCULL_CCW)
|
||||
Call .SetRenderState(D3DRS_SHADEMODE, D3DSHADE_FLAT)
|
||||
End With
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,42 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=PointSprites.frm
|
||||
Module=D3DUtil; ..\..\common\D3DUtil.bas
|
||||
Class=CD3DMesh; ..\..\common\D3DMesh.cls
|
||||
Class=CD3DFrame; ..\..\common\D3DFrame.cls
|
||||
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
|
||||
Class=CParticle; D3DParticle.cls
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
Module=D3DInit; ..\..\common\D3DInit.bas
|
||||
Form=..\..\common\SelectDevice.frm
|
||||
Startup="Form1"
|
||||
ExeName32="vb_PointSprites.exe"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
Binary file not shown.
@@ -0,0 +1,50 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
// Name: PointSprites Direct3D Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The PointSprites sample shows how to use the new Direct3D point sprites
|
||||
feature. A point sprite is simply a forward-facing, textured quad that is
|
||||
referenced only by (x,y,z) position coordinates. Point sprites are most
|
||||
often used for particle systems and related effects.
|
||||
|
||||
Note that not all cards support all features for point sprites. For more
|
||||
information on point sprites, refer to the DirectX SDK documentation.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\PointSprites
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
The following keys are implemented.
|
||||
|
||||
<F2> Prompts user to select a new rendering device or display mode
|
||||
<Alt+Enter> Toggles between fullscreen and windowed modes
|
||||
<Esc> Exits the app.
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
Without Direct3D's support, point sprites can be implemented with four
|
||||
vertices, that are oriented each frame towards the eyepoint (much like a
|
||||
billboard). With Direct3D, though, you can refer to each point sprite by
|
||||
just it's center position and a radius. This saves heavily on processor
|
||||
computation time and on bandwidth uploading vertex information to the
|
||||
graphics card.
|
||||
|
||||
In this sample, a particle system is implemented using point sprites. Each
|
||||
particle is actually implemented using multiple alpha-blended point sprites,
|
||||
giving the particle a motion-blur effect.
|
||||
|
||||
This sample makes use of common DirectX code (consisting of helper functions,
|
||||
etc.) that is shared with other samples on the DirectX SDK. All common
|
||||
classes and modules can be found in the following directory:
|
||||
DXSDK\Samples\VBSamples\Multimedia\Common
|
||||
@@ -0,0 +1,39 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "DataEntry"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: DataEntry.cls
|
||||
' Content: class that holds a data point
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Public dataname As String
|
||||
Public X As Single
|
||||
Public Y As Single
|
||||
Public z As Single
|
||||
|
||||
Public datax As Double
|
||||
Public datay As Double
|
||||
Public dataz As Double
|
||||
Public dataSize As Double
|
||||
|
||||
Public size As Double
|
||||
Public color As Long
|
||||
Public data As Variant
|
||||
Public mesh As D3DXMesh
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,46 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=ScatterGraph.frm
|
||||
Class=DataEntry; DataEntry.cls
|
||||
Class=CD3DFrame; ..\..\common\D3DFrame.cls
|
||||
Class=CD3DMesh; ..\..\common\D3DMesh.cls
|
||||
Class=CD3DPick; ..\..\common\D3DPick.cls
|
||||
Module=D3DUtil; ..\..\common\d3dutil.bas
|
||||
Module=D3DInit; ..\..\common\d3dinit.bas
|
||||
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
Startup="GraphForm"
|
||||
HelpFile=""
|
||||
NoControlUpgrade=1
|
||||
ExeName32="vb_ScatterGraph.exe"
|
||||
Command32=""
|
||||
Name="ScatterGraph"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
UseExistingBrowser=0
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
@@ -0,0 +1,9 @@
|
||||
GraphForm = 154, 154, 649, 598, Z, 149, -10, 644, 434, C
|
||||
DataEntry = 0, 0, 0, 0, C
|
||||
CD3DFrame = 0, 0, 0, 0, C
|
||||
CD3DMesh = 0, 0, 0, 0, C
|
||||
CD3DPick = 0, 0, 0, 0, C
|
||||
D3DUtil = 101, 99, 596, 543,
|
||||
D3DInit = 132, 132, 627, 576, C
|
||||
CD3DAnimation = 0, 0, 0, 0, C
|
||||
MediaDir = 176, 176, 644, 620,
|
||||
@@ -0,0 +1,81 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: ScatterGraph Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The ScatterGraph sample describes how one might use Direct3D for graphic visualization.
|
||||
It makes heavy use of the RenderToSurface features of D3DX to render text and bitmaps
|
||||
dynamically.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\ScatterGraph
|
||||
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
right click to bring up a pop up menu for the following options
|
||||
|
||||
Load Data From File from this menu you can load new data from a .csv
|
||||
(comma delimeted file) such a file can be exported
|
||||
from excel or any spreadsheet package.
|
||||
|
||||
Reset Orientation reset the viewpoint to a know state
|
||||
|
||||
Show Connecting Lines if the order of the data is important
|
||||
this connects the data points
|
||||
|
||||
Show Height Lines makes it easier to see the Y value in comparison
|
||||
to other values
|
||||
|
||||
Show Foot lines makes it easier to see the X Z relation ship
|
||||
|
||||
Show Base plane plane where y=0
|
||||
|
||||
Auto rotate turn on and off rotation
|
||||
|
||||
|
||||
|
||||
Any csv file to be loaded must be formated such that the first row is a header.
|
||||
The formating is as follows with [] indicating optional components:
|
||||
Name, X Axis Name, Y Axis Name, Z Axis Name, [Size Name], [Color Name]
|
||||
Entries for Axis and Size must be numeric. those for color must fit the format
|
||||
&HFF102030, where 10 20 30 is the red,green and blue component.
|
||||
|
||||
see sampledata.csv in Mssd\Samples\Multimedia\VBSamples\Media for an example
|
||||
|
||||
Holding the left mouse button and dragging will rotate the graph.
|
||||
|
||||
Right Arrow moves the camera right
|
||||
Left Arrow moves the camera left
|
||||
Up Arrow moves the camera up
|
||||
Down Arrow moves the camera down
|
||||
W moves the camera forward
|
||||
S moves the camera backward
|
||||
E rotates the camera right
|
||||
Q rotates the camera left
|
||||
A rotates the camera up
|
||||
Z rotates the camera down
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
|
||||
|
||||
This sample makes use of common DirectX code (consisting of helper functions,
|
||||
etc.) that is shared with other samples on the DirectX SDK. All common
|
||||
classes and modules can be found in the following directory:
|
||||
DXSDK\Samples\Multimedia\VBSamples\Common
|
||||
|
||||
@@ -0,0 +1,302 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmSkinnedMesh
|
||||
Caption = "Skinned Mesh"
|
||||
ClientHeight = 6015
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 7530
|
||||
Icon = "SkinnedMesh.frx":0000
|
||||
LinkTopic = "Form3"
|
||||
ScaleHeight = 401
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 502
|
||||
StartUpPosition = 3 'Windows Default
|
||||
End
|
||||
Attribute VB_Name = "frmSkinnedMesh"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: skinnedMesh.frm
|
||||
' Content: Animate Skinned Geometry
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
|
||||
Dim Character As CD3DFrame
|
||||
Dim Animation As CD3DAnimation
|
||||
Dim MediaDir As String
|
||||
Dim m_bInit As Boolean
|
||||
Dim m_bMinimized As Boolean
|
||||
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim hr As Long
|
||||
|
||||
Me.Show
|
||||
DoEvents
|
||||
|
||||
|
||||
'find a path to our media
|
||||
MediaDir = FindMediaDir("tiny.x")
|
||||
D3DUtil_SetMediaPath MediaDir
|
||||
|
||||
' Initialize D3D
|
||||
' Note: D3DUtil_Init will attempt to use D3D Hardware acceleartion.
|
||||
' If it is not available it attempt to use the Software Reference Rasterizer.
|
||||
' If all fail it will display a message box indicating so.
|
||||
'
|
||||
m_bInit = D3DUtil_Init(Me.hwnd, True, 0, 0, D3DDEVTYPE_HAL, Me)
|
||||
If Not (m_bInit) Then End
|
||||
|
||||
|
||||
' Create new D3D mesh and animation objects
|
||||
InitDeviceObjects
|
||||
|
||||
' Sets the state for those objects and the current D3D device
|
||||
RestoreDeviceObjects
|
||||
|
||||
' Start our timer
|
||||
DXUtil_Timer TIMER_start
|
||||
|
||||
' Run the simulation forever
|
||||
' See Form_Keydown for exit processing
|
||||
Do While True
|
||||
|
||||
' Increment the simulation
|
||||
FrameMove
|
||||
|
||||
' Render one image of the simulation
|
||||
If Render Then
|
||||
|
||||
' Present the image to the screen
|
||||
D3DUtil_PresentAll g_focushwnd
|
||||
End If
|
||||
|
||||
' Allow for events to get processed
|
||||
DoEvents
|
||||
|
||||
Loop
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: FrameMove()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub FrameMove()
|
||||
Dim apptime As Single
|
||||
|
||||
'get ellapsed time since start of application
|
||||
apptime = DXUtil_Timer(TIMER_GETAPPTIME)
|
||||
|
||||
'Have our animation pose our character
|
||||
Animation.SetTime (apptime) * 4000
|
||||
|
||||
'Rotate the character
|
||||
Character.AddRotation COMBINE_replace, 0, 0, 1, 3.14 + (apptime) / 8
|
||||
|
||||
'Update all frame matrices (required for skinning)
|
||||
Character.UpdateFrames
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Render()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Function Render() As Boolean
|
||||
Dim hr As Long
|
||||
|
||||
Render = False
|
||||
'See what state the device is in.
|
||||
hr = g_dev.TestCooperativeLevel
|
||||
If hr = D3DERR_DEVICENOTRESET Then
|
||||
g_dev.Reset g_d3dpp
|
||||
RestoreDeviceObjects
|
||||
End If
|
||||
|
||||
'dont bother rendering if we are not ready yet
|
||||
If hr <> 0 Then Exit Function
|
||||
Render = True
|
||||
|
||||
'Clear the background to ARGB grey
|
||||
D3DUtil_ClearAll &HFF9090FF
|
||||
|
||||
|
||||
'Start the Scene
|
||||
g_dev.BeginScene
|
||||
|
||||
'Render the character
|
||||
Character.RenderSkins
|
||||
|
||||
'End the scene
|
||||
g_dev.EndScene
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitDeviceObjects()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub InitDeviceObjects()
|
||||
|
||||
'Create an Animation object to hold any animations
|
||||
Set Animation = New CD3DAnimation
|
||||
|
||||
'Load a skinned character
|
||||
Set Character = D3DUtil_LoadFromFileAsSkin(MediaDir + "tiny.x", Nothing, Animation)
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: RestoreDeviceObjects()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub RestoreDeviceObjects()
|
||||
|
||||
'Set up some lights and camera
|
||||
g_lWindowWidth = Me.ScaleWidth
|
||||
g_lWindowHeight = Me.ScaleHeight
|
||||
D3DUtil_SetupDefaultScene
|
||||
|
||||
'position the camera
|
||||
D3DUtil_SetupCamera vec3(0, 800, 200), vec3(0, 0, 200), vec3(0, 0, 1)
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InvalidateDeviceObjects()
|
||||
' Desc: Place code to release non managed objects here
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub InvalidateDeviceObjects()
|
||||
'all objects are managed
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: DeleteDeviceObjects()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub DeleteDeviceObjects()
|
||||
Set Animation = Nothing
|
||||
Set Character = Nothing
|
||||
m_bInit = False
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_KeyDown()
|
||||
' Desc: Process key messages for exit and change device
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
|
||||
Select Case KeyCode
|
||||
|
||||
Case vbKeyEscape
|
||||
Unload Me
|
||||
|
||||
Case vbKeyF2
|
||||
|
||||
' Pause the timer
|
||||
DXUtil_Timer TIMER_STOP
|
||||
|
||||
' Bring up the device selection dialog
|
||||
' we pass in the form so the selection process
|
||||
' can make calls into InitDeviceObjects
|
||||
' and RestoreDeviceObjects
|
||||
frmSelectDevice.SelectDevice Me
|
||||
|
||||
' Restart the timer
|
||||
DXUtil_Timer TIMER_start
|
||||
|
||||
Case vbKeyReturn
|
||||
|
||||
' Check for Alt-Enter if not pressed exit
|
||||
If Shift <> 4 Then Exit Sub
|
||||
|
||||
' If we are windowed go fullscreen
|
||||
' If we are fullscreen returned to windowed
|
||||
If g_d3dpp.Windowed Then
|
||||
D3DUtil_ResetFullscreen
|
||||
Else
|
||||
D3DUtil_ResetWindowed
|
||||
End If
|
||||
|
||||
' Call Restore after ever mode change
|
||||
' because calling reset looses state that needs to
|
||||
' be reinitialized
|
||||
RestoreDeviceObjects
|
||||
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Resize()
|
||||
' Desc: hadle resizing of the D3D backbuffer
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Resize()
|
||||
|
||||
' If D3D is not initialized then exit
|
||||
If Not m_bInit Then Exit Sub
|
||||
|
||||
' If we are in a minimized state stop the timer and exit
|
||||
If Me.WindowState = vbMinimized Then
|
||||
DXUtil_Timer TIMER_STOP
|
||||
m_bMinimized = True
|
||||
Exit Sub
|
||||
|
||||
' If we just went from a minimized state to maximized
|
||||
' restart the timer
|
||||
Else
|
||||
If m_bMinimized = True Then
|
||||
DXUtil_Timer TIMER_start
|
||||
m_bMinimized = False
|
||||
End If
|
||||
End If
|
||||
|
||||
' Dont let the window get too small
|
||||
If Me.ScaleWidth < 10 Then
|
||||
Me.width = Screen.TwipsPerPixelX * 10
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Me.ScaleHeight < 10 Then
|
||||
Me.height = Screen.TwipsPerPixelY * 10
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'reset and resize our D3D backbuffer to the size of the window
|
||||
D3DUtil_ResizeWindowed Me.hwnd
|
||||
|
||||
'All state get losts after a reset so we need to reinitialze it here
|
||||
RestoreDeviceObjects
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Unload()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
DeleteDeviceObjects
|
||||
End
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Unload()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Public Function VerifyDevice(flags As Long, format As CONST_D3DFORMAT) As Boolean
|
||||
If flags = D3DCREATE_HARDWARE_VERTEXPROCESSING Then Exit Function
|
||||
VerifyDevice = True
|
||||
End Function
|
||||
Binary file not shown.
@@ -0,0 +1,44 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Module=D3DUtil; ..\..\common\D3DUtil.bas
|
||||
Module=D3DInit; ..\..\common\D3DInit.bas
|
||||
Module=MediaDir; ..\..\common\media.bas
|
||||
Class=CD3DPick; ..\..\common\D3DPick.cls
|
||||
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
|
||||
Class=CD3DFrame; ..\..\common\D3DFrame.cls
|
||||
Class=CD3DMesh; ..\..\common\D3DMesh.cls
|
||||
Form=..\..\common\SelectDevice.frm
|
||||
Form=SkinnedMesh.frm
|
||||
Startup="frmSkinnedMesh"
|
||||
HelpFile=""
|
||||
Title="VB Skinned Mesh"
|
||||
ExeName32="vb_SkinnedMesh.exe"
|
||||
Command32=""
|
||||
Name="SkinnedMesh"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 1.1 KiB |
@@ -0,0 +1,48 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: SkinnedMesh Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The SkinnedMesh sample illustrates how to use the d3d framework to load an x-file with
|
||||
skinning and animation information in it.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\SkinnedMesh
|
||||
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
The following keys are implemented. The dropdown menus can be used for the
|
||||
same controls.
|
||||
|
||||
<F2> Prompts user to select a new rendering device or display mode
|
||||
<Alt+Enter> Toggles between fullscreen and windowed modes
|
||||
<Esc> Exits the app.
|
||||
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
Note that the last argument passed to D3DUtil_LoadFromFileAsSkin is a CD3DAnimation
|
||||
class that is the parent to any animations that are found in the xfile.
|
||||
Animation.SetTime must be called but will not pose the model.
|
||||
Character.UpdateFrames computes the matrices for all joints on the character
|
||||
Character.RenderSkin will render the character using the loaded skin
|
||||
|
||||
|
||||
This sample makes use of common DirectX code (consisting of helper functions,
|
||||
etc.) that is shared with other samples on the DirectX SDK. All common
|
||||
classes and modules can be found in the following directory:
|
||||
DXSDK\Samples\Multimedia\VBSamples\Common
|
||||
|
||||
The modeling exporters in the extras directory of the SDK can export to x with skinning infromation.
|
||||
@@ -0,0 +1,194 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form Form1
|
||||
Caption = "Create Device"
|
||||
ClientHeight = 3195
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 4680
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 3195
|
||||
ScaleWidth = 4680
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.PictureBox Picture1
|
||||
Height = 3015
|
||||
Left = 120
|
||||
ScaleHeight = 2955
|
||||
ScaleWidth = 4395
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 4455
|
||||
Begin VB.Timer Timer1
|
||||
Enabled = 0 'False
|
||||
Interval = 40
|
||||
Left = 1920
|
||||
Top = 1320
|
||||
End
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "Form1"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'-----------------------------------------------------------------------------
|
||||
' File: Tut01_CreateDevice.frm
|
||||
'
|
||||
' Desc: This is the first tutorial for using Direct3D. In this tutorial, all
|
||||
' we are doing is create a Direct3D device and using it to clear the
|
||||
' screen.
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' variables
|
||||
'-----------------------------------------------------------------------------
|
||||
Dim g_DX As New DirectX8
|
||||
Dim g_D3D As Direct3D8 'Used to create the D3DDevice
|
||||
Dim g_D3DDevice As Direct3DDevice8 'Our rendering device
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Load()
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Load()
|
||||
|
||||
' Allow the form to become visible
|
||||
Me.Show
|
||||
DoEvents
|
||||
|
||||
' Initialize D3D and D3DDevice
|
||||
b = InitD3D(Picture1.hWnd)
|
||||
If Not b Then
|
||||
MsgBox "Unable to CreateDevice (see InitD3D() source for comments)"
|
||||
End
|
||||
End If
|
||||
|
||||
' Enable Timer to update
|
||||
Timer1.Enabled = True
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Timer1_Timer()
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Timer1_Timer()
|
||||
Render
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Form_Unload()
|
||||
'-----------------------------------------------------------------------------
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
End
|
||||
End Sub
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InitD3D()
|
||||
' Desc: Initializes Direct3D
|
||||
'-----------------------------------------------------------------------------
|
||||
Function InitD3D(hWnd As Long) As Boolean
|
||||
On Local Error Resume Next
|
||||
|
||||
' Create the D3D object, which is needed to create the D3DDevice. It can
|
||||
' also be used to enumerate devices types, modes, etc., which will be
|
||||
' shown in a separate tutorial.
|
||||
Set g_D3D = g_DX.Direct3DCreate()
|
||||
If g_D3D Is Nothing Then Exit Function
|
||||
|
||||
' Get The current Display Mode format
|
||||
Dim mode As D3DDISPLAYMODE
|
||||
g_D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, mode
|
||||
|
||||
' Fill in the type structure used to create the D3DDevice. Most parameters
|
||||
' are left at zero. We set Windowed to 1 for TRUE, since we want to do D3D
|
||||
' in a window, and the set the SwapEffect to flip the backbuffer to the
|
||||
' frontbuffer only on vsync (which prevents "tearing" artifacts).
|
||||
' we set the back buffer format from the current display mode
|
||||
Dim d3dpp As D3DPRESENT_PARAMETERS
|
||||
d3dpp.Windowed = 1
|
||||
d3dpp.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
|
||||
d3dpp.BackBufferFormat = mode.Format
|
||||
|
||||
' Create the D3DDevice. Here we are using the default adapter (most
|
||||
' systems only have one, unless they have multiple graphics hardware cards
|
||||
' installed) and using the HAL (which is saying we prefer the hardware
|
||||
' device or a software one). Software vertex processing is specified
|
||||
' since we know it will work on all cards. On cards that support hardware
|
||||
' vertex processing, though, we would see a big performance gain by using it.
|
||||
'
|
||||
' If you do not have hardware 3d acceleration. Enable the reference rasterizer
|
||||
' using the DirectX control panel and change D3DDEVTYPE_HAL to D3DDEVTYPE_REF
|
||||
|
||||
Set g_D3DDevice = g_D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, hWnd, _
|
||||
D3DCREATE_SOFTWARE_VERTEXPROCESSING, d3dpp)
|
||||
If g_D3DDevice Is Nothing Then Exit Function
|
||||
|
||||
' Device state would normally be set here
|
||||
|
||||
InitD3D = True
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Cleanup()
|
||||
' Desc: Releases all previously initialized objects
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Cleanup()
|
||||
Set g_D3DDevice = Nothing
|
||||
Set g_D3D = Nothing
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: Render()
|
||||
' Desc: Draws the scene
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub Render()
|
||||
|
||||
If g_D3DDevice Is Nothing Then Exit Sub
|
||||
|
||||
' Clear the backbuffer to a blue color (ARGB = 000000ff)
|
||||
'
|
||||
' To clear the entire back buffer we send down
|
||||
' rect count = 0
|
||||
' clearD3DRect = ByVal 0 (ByVal is necessary as param is of type as any)
|
||||
' flags = D3DCLEAR_TARGET to specify the backbuffer
|
||||
' color = &HFF& to specify BLUE (note final & indicates this is a long)
|
||||
' zClear = 1 which is not used
|
||||
' stencil = 0 which is not used
|
||||
g_D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &HFF&, 1#, 0
|
||||
|
||||
|
||||
' Begin the scene
|
||||
g_D3DDevice.BeginScene
|
||||
|
||||
' Rendering of scene objects happens here
|
||||
|
||||
' End the scene
|
||||
g_D3DDevice.EndScene
|
||||
|
||||
|
||||
' Present the backbuffer contents to the front buffer (screen)
|
||||
' parameters are flexible to allow for only showing certain
|
||||
' portions of the back buffer, we want to Present the entire buffer
|
||||
' so we will pass down 0 to all parameters
|
||||
' SourceRect = ByVal 0 (ByVal is necessary as param is of type as any)
|
||||
' DestRect = ByVal 0 (ByVal is necessary as param is of type as any)
|
||||
' hWndOverride = 0 (use same hWnd as passed to CreateDevice)
|
||||
' DirtyRegion = Byval 0 (ByVal is necessary as param is of type as any)
|
||||
g_D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,34 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=Tut01_CreateDevice.frm
|
||||
Startup="Form1"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
ExeName32="vb_Tut01_CreateDevice.exe"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
@@ -0,0 +1,25 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
// Name: CreateDevice Direct3D Tutorial
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The CreateDevice tutorial is the first tutorial for using the new Direct3D
|
||||
interfaces for DirectX 8. It shows how to create a Direct3DDevice8 object.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\D3D\Tutorials\Tut01_CreateDevice
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
The first step of using Direct3D is creating a device. This tutorial is
|
||||
so simple, that nothing is rendered with the device. The device is used
|
||||
to clear the backbuffer and present the backbuffer contents, but that is
|
||||
all.
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user