Directx

transparent · May 12, 2002

Does anybody know how to load a 3d object in any format (such as .x, .3ds .lwo etc) into the directx framework under vb?

I'm trying to get to grips with directx, with the aim to write a game. Any help will be greatly appreciated.

Cheers

crrrazydan · May 12, 2002

Try messing around with this

Sub Load3DsMesh(Filename As String)
'##BD Load a 3DS file in the mesh. The materials and the texture will be loaded too.
'##PD filename 3Ds filename.
Dim LE As MaterialFactory8
Set LE = New MaterialFactory8

'SetPrimitiveType TV_TRIANGLELIST
'SetVertexType TV_VERTEX
On Error GoTo errs
Dim ErrString As String
ErrString = "3DS: Load3ds"
' AddLog "Load 3ds :" + filename
Dim VbCounter As Long
Dim ColorByte As udColorByte
Dim PercentInt As Integer
Dim cBlock As Byte ' Type of color currently being imported. See colorblock Enum
Dim Materials2() As aMaterial
Dim mCount As Integer ' Number of loaded material
'im MatTexture() As Texture8

Dim Info As tdsHeader ' Header of Chunk
Dim Index As Long ' Index in File -- filepos

Dim MeshName As String ' Current Mesh Name
Dim Done As Boolean
Dim CurrentMat As Integer
Dim NbGroupe As Integer
Dim vcount As Long ' redundant vertex counter
Dim vertices As Integer ' ""
Dim faces As Integer ' Numbder of faces
Dim VertexList() As D3DVECTOR ' #DS file Vertexlist
Dim Facelist() As aFace ' Facelist
Dim vbuf() As Long ' redunant vertexlist for vertex buffer
'Dim MeshVertices() As D3DVERTEX ' Actual constructor for vertex buffer

Dim UVCoords() As UVmap ' #DS file UV coordinates
Dim UVbuf() As UVmap ' Buffer for MeshVertices construction
Dim nBuf() As D3DVECTOR ' Buffer for the temp face Normals
Dim Normals() As D3DVECTOR ' Array to hold temporary face normals

Dim tVector As D3DVECTOR
Dim Char As Byte
Dim Strz As String ' All Generic definitions for reading
Dim Dword As Long ' types stored in #DS file via C typedefs
Dim word As Integer
Dim Real As Single
Dim i As Long
Dim TheScale As Long
Mesh(MeshIndex).Features.PrimType = D3DPT_TRIANGLELIST
TheScale = 1
Dim UVCoordsTrue As Boolean
UVCoordsTrue = False

Dim MinX, MinY, MinZ As Single
Dim MaxX, MaxY, maxZ As Single

Index = 1

TestPAKFile Filename
AddLog "Loading 3DS mesh : " + CStr(Filename) + "..."
Open Filename For Binary As #1

While Not EOF(1)
Get #1, Index, Info
Index = Index + 6
' Debug.Print Hex(Info.Header), Info.Length
Select Case Info.Header

Case &H2: ' 3DS Version Number
ErrString = "3DS Version"
Get #1, Index, Dword
Index = Index + Len(Dword)

Case &H3D3D: ' 3D Editor Header
ErrString = "3D Editor Chunk"

Case &H3D3E: ' Mesh Version
ErrString = "Mesh Version"
Get #1, Index, Dword
Index = Index + Len(Dword)

Case &H4000: ' Object Block -- Includes Name
ErrString = "Object Block"
Done = False
MeshName = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
MeshName = MeshName + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend
Debug.Print "Name :"; MeshName; ""

Case &H4100: ' Triangular Mesh
ErrString = "Triangular Mesh"
NbGroupe = NbGroupe + 1
SetGroupPointer NbGroupe
Debug.Print NbGroupe
Case &H4110: ' Verticies List
ErrString = "Vertices"
Get #1, Index, vertices
Index = Index + Len(vertices)
Debug.Print "Vertex list "; vertices
ReDim VertexList(vertices)
Get #1, Index, VertexList
Index = Index + Len(VertexList(0)) * CLng(vertices)

MinX = 500000: MinY = MinX: MinZ = MinY
MaxX = -500000: MaxY = MaxX: maxZ = MaxY

For i = 0 To vertices - 1
With VertexList(i)
VertexList(i).x = VertexList(i).x * TheScale
VertexList(i).y = VertexList(i).y * TheScale
VertexList(i).z = VertexList(i).z * TheScale
If .x < MinX Then MinX = .x
If .y < MinY Then MinY = .y
If .z < MinZ Then MinZ = .z

If .x > MaxX Then MaxX = .x
If .y > MaxY Then MaxY = .y
If .z > maxZ Then maxZ = .z
End With
Next i

Case &H4120: ' Face List
ErrString = "Face List"
Get #1, Index, faces
Index = Index + Len(faces)
Debug.Print "Face list "; faces

ReDim Facelist(faces)
Get #1, Index, Facelist
Index = Index + Len(Facelist(0)) * CLng(faces)

vcount = -1
ReDim vbuf(faces * 3)
ReDim UVbuf(faces * 3)
For i = 0 To faces - 1
vcount = vcount + 3
'debug.print vcount
If UVCoordsTrue Then
UVbuf(vcount - 2) = UVCoords(Facelist(i).a)
UVbuf(vcount - 1) = UVCoords(Facelist(i).b)
UVbuf(vcount) = UVCoords(Facelist(i).C)
End If
vbuf(vcount - 2) = Facelist(i).a
vbuf(vcount - 1) = Facelist(i).b
vbuf(vcount) = Facelist(i).C

' Make Face Normal
Dim a As D3DVECTOR, b As D3DVECTOR, C As D3DVECTOR
ReDim Preserve nBuf(vcount)
With DirectX
' Face Normal

D3DXVec3Subtract a, VertexList(vbuf(vcount - 2)), VertexList(vbuf(vcount - 1))
D3DXVec3Subtract b, VertexList(vbuf(vcount - 2)), VertexList(vbuf(vcount))
D3DXVec3Cross C, a, b
D3DXVec3Normalize C, C

nBuf(vcount) = C
nBuf(vcount - 1) = C
nBuf(vcount - 2) = C

End With
Next i
UVCoordsTrue = False

ErrString = "Load3ds: Mesh Add"
Debug.Print "Mesh add " + MeshName
With Mesh(MeshIndex)

For i = 0 To vcount
'AddLog "Addvertex :" + CStr(vbuf(I))
AddVertex VertexList(vbuf(i)).x, VertexList(vbuf(i)).y, VertexList(vbuf(i)).z, D3DColorMake(1, 1, 1, 1), UVbuf(i).U, 1 - UVbuf(i).V, nBuf(i).x, nBuf(i).y, nBuf(i).z
Next i
End With

Case &H4130: ' Face Material List
ErrString = "Face Material"
Done = False
Strz = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
Strz = Strz + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend

Dim Q As Integer
For Q = 1 To mCount
If Strz = Materials2(Q).MatName Then
' Store the Material Here
Debug.Print "Selected :"; Strz
Mesh(MeshIndex).Features.Groups(NbGroupe).TextureI = Materials2(Q).MapPercent
Materials(Materials2(Q).MaterialIndex).Mat.Ambient = Materials2(Q).Ambient
Materials(Materials2(Q).MaterialIndex).Mat.Diffuse = DXColor(1, 1, 1, 1)
Materials(Materials2(Q).MaterialIndex).Mat.Specular = Materials2(Q).Specular
Materials(Materials2(Q).MaterialIndex).Mat.emissive = DXColor(0, 0, 0, 0)
'Debug.Print Q, Materials2(Q).Ambient.r, , Materials2(Q).Ambient.g, Materials2(Q).Ambient.B
Mesh(MeshIndex).Features.Groups(NbGroupe).MaterialI = Materials2(Q).MaterialIndex
'SetTexture MatTexture(Q), NbGroupe
Exit For
End If
Next Q

Get #1, Index, word
Index = Index + Len(word)
For i = 1 To word
Get #1, Index, word
Index = Index + Len(word)
Next i

Case &H4140: ' Face Texture Coordinate
Debug.Print "Add texture coordinates"
ErrString = "Face Texture Coordinates"
Get #1, Index, word
Index = Index + Len(word)
ReDim UVCoords(word)
Get #1, Index, UVCoords
Index = Index + Len(UVCoords(0)) * CLng(word)
UVCoordsTrue = True

Case &H4160:
ErrString = "Local Coordinate System"
Get #1, Index, tVector
Index = Index + Len(tVector)
Get #1, Index, tVector
Index = Index + Len(tVector)
Get #1, Index, tVector
Index = Index + Len(tVector)
Get #1, Index, tVector
'DD.MeshParent(ObjName2).Mesh(MeshName).position
Index = Index + Len(tVector)

Case &HA000: ' Material Name
ErrString = "Material Name"
Done = False
Strz = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
Strz = Strz + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend
Materials2(mCount).MatName = Strz
Debug.Print "Material Name :"; Strz
Case &HAFFF: ' Material Editor Chunk
ErrString = "Material Editor Chunk"
mCount = mCount + 1
ReDim Preserve Materials2(mCount) ' Save stored materials
CurrentMat = LE.CreateMaterial
Materials2(mCount).MaterialIndex = CurrentMat
Case &H10: ' Single Color Chunk
ErrString = "Single Color Chunk"
Index = Index + Info.Length - 6

Case &H11: ' Byte Color Chunk
ErrString = "Byte Color Chunk"
Get #1, Index, ColorByte
Index = Index + Len(ColorByte)

Select Case cBlock
Case Ambient:
With Materials2(mCount).Ambient
.a = 1
.r = ColorByte.Red / 255
.g = ColorByte.Green / 255
.b = ColorByte.Blue / 255
Debug.Print " Material Ambient :"; .r; " "; .g; " "; .b
End With
Case Diffuse:
With Materials2(mCount).Diffuse
.a = 1
.r = ColorByte.Red / 255
.g = ColorByte.Green / 255
.b = ColorByte.Blue / 255
Debug.Print " Material Diffuse :"; .r; " "; .g; " "; .b

End With

Case Specular:
With Materials2(mCount).Specular
.a = 1
.r = ColorByte.Red / 255
.g = ColorByte.Green / 255
.b = ColorByte.Blue / 255
Debug.Print " Material Specular :"; .r; " "; .g; " "; .b

End With
End Select

Case &H30: ' Percent Chunk Int format
ErrString = "Percent Chunk INT"
Get #1, Index, PercentInt
Index = Index + Len(PercentInt)

Case &H31: ' Percent Chunk Float format
ErrString = "Percent Chunk Float"
Index = Index + Info.Length - 6

Case &HA010: ' Ambient color
ErrString = "Ambient Color"
cBlock = Ambient

Case &HA020: ' Diffuse Color
ErrString = "Diffuse Color"
cBlock = Diffuse

Case &HA030: ' Specular Color
ErrString = "Specular Color"
cBlock = Specular

Case &HA200: ' Map #1 -- diffuse?
cBlock = Diffuse

Case &HA300: ' Map FileName
ErrString = "Map File Name"
Done = False
Strz = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
Strz = Strz + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend
Select Case cBlock
Case Diffuse:
Materials2(mCount).MapName = Strz

End Select

Debug.Print "Material Map Name: " & Strz
'ReDim Preserve MatTexture(mCount)
'For i = 1 To 256
' If TextureName(i) = "" Then Exit For
'Next i
If Exist(Strz) = False Then
Strz = Left$(Filename, InStrRev(Filename, "\&quot

) + Strz
End If
i = LocTexFactory.LoadTexture(Strz, Strz, , , TV_COLORKEY_BLACK).GetTexIndex
'Set Texture(i) = LoadSimpleTexture(SearchExistPath(Strz, Left$(Filename, InStrRev(Filename, "\&quot

)), 256, 256)
'TextureName(i) = "3DS Texture " + CStr(i)

Materials2(mCount).MapPercent = i
'Set MatTexture(mCount) = LocalScene.LoadTexture("d:\" + Strz, 256, 256)
Case &HA33A: ' Map #2 -- Ambient?
cBlock = Ambient

Case &HA354
ErrString = "V scaling for Map"
Index = Index + Info.Length - 6

Case &HA356
ErrString = "U scaling for Map"
Index = Index + Info.Length - 6

Case &HA358
ErrString = "U offset for Map"
Index = Index + Info.Length - 6

Case &HA35A
ErrString = "V offset for Map"
Index = Index + Info.Length - 6

Case &HA35C
ErrString = "Rotation Angle for Map"
Index = Index + Info.Length - 6

Case &H100: ' One Unit
ErrString = "One Unit"
Get #1, Index, Real
Index = Index + Len(Real)
Case &H4D4D ' OK the object begins

Case Else ' Unknown Chunk
ErrString = "Unknown Chunk"
Index = Index + Info.Length - 6
End Select
Debug.Print " ## "; Hex$(Info.Header); "("; ErrString; &quot

"
AddLog " ## " + Hex$(Info.Header) + " (" + CStr(ErrString) + &quot

"
Wend
Close #1
DeletePAKTemp Filename
AddLog "End of 3DS Loading."
Exit Sub
errs:
Debug.Print "Error :"; ErrString, Err.Number, Err.Description
AddLog "Error in 3Ds loader :" + CStr(Err.Number) + " " + Err.Description + " " + ErrString
Resume Next
End Sub

crrrazydan · May 12, 2002

Here is some code from an engine to load 3DS meshes.
Lol and to think this doesn't even cover texturing and rendering. Your best bet is to probably get a book that tells you how to load 3ds models, or to use an engine. If you use an engine, may I suggest TrueVision 3D for VB, check it out at

http://www.truevision3dsdk.com

Sub Load3DsMesh(Filename As String)
'##BD Load a 3DS file in the mesh. The materials and the texture will be loaded too.
'##PD filename 3Ds filename.
Dim LE As MaterialFactory8
Set LE = New MaterialFactory8

'SetPrimitiveType TV_TRIANGLELIST
'SetVertexType TV_VERTEX
On Error GoTo errs
Dim ErrString As String
ErrString = "3DS: Load3ds"
' AddLog "Load 3ds :" + filename
Dim VbCounter As Long
Dim ColorByte As udColorByte
Dim PercentInt As Integer
Dim cBlock As Byte ' Type of color currently being imported. See colorblock Enum
Dim Materials2() As aMaterial
Dim mCount As Integer ' Number of loaded material
'im MatTexture() As Texture8

Dim Info As tdsHeader ' Header of Chunk
Dim Index As Long ' Index in File -- filepos

Dim MeshName As String ' Current Mesh Name
Dim Done As Boolean
Dim CurrentMat As Integer
Dim NbGroupe As Integer
Dim vcount As Long ' redundant vertex counter
Dim vertices As Integer ' ""
Dim faces As Integer ' Numbder of faces
Dim VertexList() As D3DVECTOR ' #DS file Vertexlist
Dim Facelist() As aFace ' Facelist
Dim vbuf() As Long ' redunant vertexlist for vertex buffer
'Dim MeshVertices() As D3DVERTEX ' Actual constructor for vertex buffer

Dim UVCoords() As UVmap ' #DS file UV coordinates
Dim UVbuf() As UVmap ' Buffer for MeshVertices construction
Dim nBuf() As D3DVECTOR ' Buffer for the temp face Normals
Dim Normals() As D3DVECTOR ' Array to hold temporary face normals

Dim tVector As D3DVECTOR
Dim Char As Byte
Dim Strz As String ' All Generic definitions for reading
Dim Dword As Long ' types stored in #DS file via C typedefs
Dim word As Integer
Dim Real As Single
Dim i As Long
Dim TheScale As Long
Mesh(MeshIndex).Features.PrimType = D3DPT_TRIANGLELIST
TheScale = 1
Dim UVCoordsTrue As Boolean
UVCoordsTrue = False

Dim MinX, MinY, MinZ As Single
Dim MaxX, MaxY, maxZ As Single

Index = 1

TestPAKFile Filename
AddLog "Loading 3DS mesh : " + CStr(Filename) + "..."
Open Filename For Binary As #1

While Not EOF(1)
Get #1, Index, Info
Index = Index + 6
' Debug.Print Hex(Info.Header), Info.Length
Select Case Info.Header

Case &H2: ' 3DS Version Number
ErrString = "3DS Version"
Get #1, Index, Dword
Index = Index + Len(Dword)

Case &H3D3D: ' 3D Editor Header
ErrString = "3D Editor Chunk"

Case &H3D3E: ' Mesh Version
ErrString = "Mesh Version"
Get #1, Index, Dword
Index = Index + Len(Dword)

Case &H4000: ' Object Block -- Includes Name
ErrString = "Object Block"
Done = False
MeshName = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
MeshName = MeshName + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend
Debug.Print "Name :"; MeshName; ""

Case &H4100: ' Triangular Mesh
ErrString = "Triangular Mesh"
NbGroupe = NbGroupe + 1
SetGroupPointer NbGroupe
Debug.Print NbGroupe
Case &H4110: ' Verticies List
ErrString = "Vertices"
Get #1, Index, vertices
Index = Index + Len(vertices)
Debug.Print "Vertex list "; vertices
ReDim VertexList(vertices)
Get #1, Index, VertexList
Index = Index + Len(VertexList(0)) * CLng(vertices)

MinX = 500000: MinY = MinX: MinZ = MinY
MaxX = -500000: MaxY = MaxX: maxZ = MaxY

For i = 0 To vertices - 1
With VertexList(i)
VertexList(i).x = VertexList(i).x * TheScale
VertexList(i).y = VertexList(i).y * TheScale
VertexList(i).z = VertexList(i).z * TheScale
If .x < MinX Then MinX = .x
If .y < MinY Then MinY = .y
If .z < MinZ Then MinZ = .z

If .x > MaxX Then MaxX = .x
If .y > MaxY Then MaxY = .y
If .z > maxZ Then maxZ = .z
End With
Next i

Case &H4120: ' Face List
ErrString = "Face List"
Get #1, Index, faces
Index = Index + Len(faces)
Debug.Print "Face list "; faces

ReDim Facelist(faces)
Get #1, Index, Facelist
Index = Index + Len(Facelist(0)) * CLng(faces)

vcount = -1
ReDim vbuf(faces * 3)
ReDim UVbuf(faces * 3)
For i = 0 To faces - 1
vcount = vcount + 3
'debug.print vcount
If UVCoordsTrue Then
UVbuf(vcount - 2) = UVCoords(Facelist(i).a)
UVbuf(vcount - 1) = UVCoords(Facelist(i).b)
UVbuf(vcount) = UVCoords(Facelist(i).C)
End If
vbuf(vcount - 2) = Facelist(i).a
vbuf(vcount - 1) = Facelist(i).b
vbuf(vcount) = Facelist(i).C

' Make Face Normal
Dim a As D3DVECTOR, b As D3DVECTOR, C As D3DVECTOR
ReDim Preserve nBuf(vcount)
With DirectX
' Face Normal

D3DXVec3Subtract a, VertexList(vbuf(vcount - 2)), VertexList(vbuf(vcount - 1))
D3DXVec3Subtract b, VertexList(vbuf(vcount - 2)), VertexList(vbuf(vcount))
D3DXVec3Cross C, a, b
D3DXVec3Normalize C, C

nBuf(vcount) = C
nBuf(vcount - 1) = C
nBuf(vcount - 2) = C

End With
Next i
UVCoordsTrue = False

ErrString = "Load3ds: Mesh Add"
Debug.Print "Mesh add " + MeshName
With Mesh(MeshIndex)

For i = 0 To vcount
'AddLog "Addvertex :" + CStr(vbuf(I))
AddVertex VertexList(vbuf(i)).x, VertexList(vbuf(i)).y, VertexList(vbuf(i)).z, D3DColorMake(1, 1, 1, 1), UVbuf(i).U, 1 - UVbuf(i).V, nBuf(i).x, nBuf(i).y, nBuf(i).z
Next i
End With

Case &H4130: ' Face Material List
ErrString = "Face Material"
Done = False
Strz = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
Strz = Strz + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend

Dim Q As Integer
For Q = 1 To mCount
If Strz = Materials2(Q).MatName Then
' Store the Material Here
Debug.Print "Selected :"; Strz
Mesh(MeshIndex).Features.Groups(NbGroupe).TextureI = Materials2(Q).MapPercent
Materials(Materials2(Q).MaterialIndex).Mat.Ambient = Materials2(Q).Ambient
Materials(Materials2(Q).MaterialIndex).Mat.Diffuse = DXColor(1, 1, 1, 1)
Materials(Materials2(Q).MaterialIndex).Mat.Specular = Materials2(Q).Specular
Materials(Materials2(Q).MaterialIndex).Mat.emissive = DXColor(0, 0, 0, 0)
'Debug.Print Q, Materials2(Q).Ambient.r, , Materials2(Q).Ambient.g, Materials2(Q).Ambient.B
Mesh(MeshIndex).Features.Groups(NbGroupe).MaterialI = Materials2(Q).MaterialIndex
'SetTexture MatTexture(Q), NbGroupe
Exit For
End If
Next Q

Get #1, Index, word
Index = Index + Len(word)
For i = 1 To word
Get #1, Index, word
Index = Index + Len(word)
Next i

Case &H4140: ' Face Texture Coordinate
Debug.Print "Add texture coordinates"
ErrString = "Face Texture Coordinates"
Get #1, Index, word
Index = Index + Len(word)
ReDim UVCoords(word)
Get #1, Index, UVCoords
Index = Index + Len(UVCoords(0)) * CLng(word)
UVCoordsTrue = True

Case &H4160:
ErrString = "Local Coordinate System"
Get #1, Index, tVector
Index = Index + Len(tVector)
Get #1, Index, tVector
Index = Index + Len(tVector)
Get #1, Index, tVector
Index = Index + Len(tVector)
Get #1, Index, tVector
'DD.MeshParent(ObjName2).Mesh(MeshName).position
Index = Index + Len(tVector)

Case &HA000: ' Material Name
ErrString = "Material Name"
Done = False
Strz = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
Strz = Strz + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend
Materials2(mCount).MatName = Strz
Debug.Print "Material Name :"; Strz
Case &HAFFF: ' Material Editor Chunk
ErrString = "Material Editor Chunk"
mCount = mCount + 1
ReDim Preserve Materials2(mCount) ' Save stored materials
CurrentMat = LE.CreateMaterial
Materials2(mCount).MaterialIndex = CurrentMat
Case &H10: ' Single Color Chunk
ErrString = "Single Color Chunk"
Index = Index + Info.Length - 6

Case &H11: ' Byte Color Chunk
ErrString = "Byte Color Chunk"
Get #1, Index, ColorByte
Index = Index + Len(ColorByte)

Select Case cBlock
Case Ambient:
With Materials2(mCount).Ambient
.a = 1
.r = ColorByte.Red / 255
.g = ColorByte.Green / 255
.b = ColorByte.Blue / 255
Debug.Print " Material Ambient :"; .r; " "; .g; " "; .b
End With
Case Diffuse:
With Materials2(mCount).Diffuse
.a = 1
.r = ColorByte.Red / 255
.g = ColorByte.Green / 255
.b = ColorByte.Blue / 255
Debug.Print " Material Diffuse :"; .r; " "; .g; " "; .b

End With

Case Specular:
With Materials2(mCount).Specular
.a = 1
.r = ColorByte.Red / 255
.g = ColorByte.Green / 255
.b = ColorByte.Blue / 255
Debug.Print " Material Specular :"; .r; " "; .g; " "; .b

End With
End Select

Case &H30: ' Percent Chunk Int format
ErrString = "Percent Chunk INT"
Get #1, Index, PercentInt
Index = Index + Len(PercentInt)

Case &H31: ' Percent Chunk Float format
ErrString = "Percent Chunk Float"
Index = Index + Info.Length - 6

Case &HA010: ' Ambient color
ErrString = "Ambient Color"
cBlock = Ambient

Case &HA020: ' Diffuse Color
ErrString = "Diffuse Color"
cBlock = Diffuse

Case &HA030: ' Specular Color
ErrString = "Specular Color"
cBlock = Specular

Case &HA200: ' Map #1 -- diffuse?
cBlock = Diffuse

Case &HA300: ' Map FileName
ErrString = "Map File Name"
Done = False
Strz = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
Strz = Strz + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend
Select Case cBlock
Case Diffuse:
Materials2(mCount).MapName = Strz

End Select

Debug.Print "Material Map Name: " & Strz
'ReDim Preserve MatTexture(mCount)
'For i = 1 To 256
' If TextureName(i) = "" Then Exit For
'Next i
If Exist(Strz) = False Then
Strz = Left$(Filename, InStrRev(Filename, "\&quot

) + Strz
End If
i = LocTexFactory.LoadTexture(Strz, Strz, , , TV_COLORKEY_BLACK).GetTexIndex
'Set Texture(i) = LoadSimpleTexture(SearchExistPath(Strz, Left$(Filename, InStrRev(Filename, "\&quot

)), 256, 256)
'TextureName(i) = "3DS Texture " + CStr(i)

Materials2(mCount).MapPercent = i
'Set MatTexture(mCount) = LocalScene.LoadTexture("d:\" + Strz, 256, 256)
Case &HA33A: ' Map #2 -- Ambient?
cBlock = Ambient

Case &HA354
ErrString = "V scaling for Map"
Index = Index + Info.Length - 6

Case &HA356
ErrString = "U scaling for Map"
Index = Index + Info.Length - 6

Case &HA358
ErrString = "U offset for Map"
Index = Index + Info.Length - 6

Case &HA35A
ErrString = "V offset for Map"
Index = Index + Info.Length - 6

Case &HA35C
ErrString = "Rotation Angle for Map"
Index = Index + Info.Length - 6

Case &H100: ' One Unit
ErrString = "One Unit"
Get #1, Index, Real
Index = Index + Len(Real)
Case &H4D4D ' OK the object begins

Case Else ' Unknown Chunk
ErrString = "Unknown Chunk"
Index = Index + Info.Length - 6
End Select
Debug.Print " ## "; Hex$(Info.Header); "("; ErrString; &quot

"
AddLog " ## " + Hex$(Info.Header) + " (" + CStr(ErrString) + &quot

"
Wend
Close #1
DeletePAKTemp Filename
AddLog "End of 3DS Loading."
Exit Sub
errs:
Debug.Print "Error :"; ErrString, Err.Number, Err.Description
AddLog "Error in 3Ds loader :" + CStr(Err.Number) + " " + Err.Description + " " + ErrString
Resume Next
End Sub

transparent · May 12, 2002

Cheers for the replies.... Does anybnody suggest ang decfent books on this stuff?

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Directx

transparent

Programmer

crrrazydan

Programmer

crrrazydan

Programmer

transparent

Programmer

Similar threads

Part and Inventory Search

Sponsor