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:
2025-11-29 16:24:34 +09:00
commit e067522598
5135 changed files with 1745744 additions and 0 deletions

File diff suppressed because it is too large Load Diff

View File

@@ -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

View 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

View 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

File diff suppressed because it is too large Load Diff

View 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

File diff suppressed because it is too large Load Diff

View 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

View File

@@ -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