?? mread3ds.bas
字號:
If Not ReadShort(m_Ptr, s) Then Exit Function 'spline terms
KeyField.Spline(i) = s
's indicates which of the following are present
'Debug.Print Hex(s)
If s Then
If s And 1 Then
If Not ReadFloat(m_Ptr, f) Then Exit Function 'tension
KeyField.Tension(i) = f
End If
If s And 2 Then
If Not ReadFloat(m_Ptr, f) Then Exit Function 'continuity
KeyField.Continuity(i) = f
End If
If s And 4 Then
If Not ReadFloat(m_Ptr, f) Then Exit Function 'bias
KeyField.Bias(i) = f
End If
If s And 8 Then
If Not ReadFloat(m_Ptr, f) Then Exit Function 'ease to
KeyField.EaseTo(i) = f
End If
If s And 16 Then
If Not ReadFloat(m_Ptr, f) Then Exit Function 'ease from
KeyField.EaseFrom(i) = f
End If
End If
Select Case MyChunk.ID
Case POS_TRACK_TAG
If Not Read3Floats(m_Ptr, v) Then Exit Function
KeyField.SetXYZ i, v
Case ROT_TRACK_TAG:
If Not ReadFloat(m_Ptr, f) Then Exit Function 'angle
If Not Read3Floats(m_Ptr, v) Then Exit Function
KeyField.SetXYZ i, v, f
Case SCL_TRACK_TAG:
If Not Read3Floats(m_Ptr, v) Then Exit Function
KeyField.SetXYZ i, v
Case MORPH_TRACK_TAG:
If Not Read3DSString(Name) Then GoTo ErrorHandler
KeyField.Name(i) = Name
Case HIDE_TRACK_TAG, FOV_TRACK_TAG, ROLL_TRACK_TAG, FALL_TRACK_TAG, HOT_TRACK_TAG:
If Not ReadFloat(m_Ptr, f) Then Exit Function
KeyField.x(i) = f
Case COL_TRACK_TAG
If Not Read3Floats(m_Ptr, v) Then Exit Function
KeyField.SetXYZ i, v
Case Else: Debug.Assert 0
End Select
If m_Ptr > MyChunkEnd Then
Debug.Assert 0
Exit For
End If
Next
'
ReadTrackHeader = True
'----------------------------------------------------
Exit Function
ErrorHandler:
Debug.Assert 0
Debug.Print Err.Description
Exit Function
Resume Next
End Function
'----------------------------------------------------
'UTILITY ROUTINES
'----------------------------------------------------
'----------------------------------------------------
' Read vertices
'----------------------------------------------------
Public Function ReadPointArray(Vertices As MFVec3f)
Dim Count%, i&, j&, Value!, vec!(0 To 2)
On Error GoTo ErrorHandler
If Not ReadShort(m_Ptr, Count) Then Exit Function
Vertices.Count = Count
For j = 0 To Count - 1
For i = 0 To 2
If Not ReadFloat(m_Ptr, Value) Then Exit Function
vec(i) = Value
'get bounding box
Select Case i
Case 0 'x
If Value < lx Then
lx = Value
End If
If Value > rx Then
rx = Value
End If
Case 1 'y
If Value < by Then
by = Value
End If
If Value > ty Then
ty = Value
End If
Case 2 'z
If Value < bz Then
bz = Value
End If
If Value > fz Then
fz = Value
End If
End Select
Next
Vertices.SetValue j, vec
Next
ReadPointArray = True
'----------------------------------------------------
Exit Function
ErrorHandler:
Debug.Assert 0
Exit Function
End Function
'----------------------------------------------------
' Read the materials used by the group
'----------------------------------------------------
Public Function ReadMeshMatGroup(MatFaces As MFLong) 'mats&(), Matcount&,
Dim Count%, FaceIndex%, Name$
Dim Index&, i&
On Error GoTo ErrorHandler
' Read the material name
If Not Read3DSString(Name) Then Exit Function
' look up its index
Index = Materials.GetIndex(Name)
'
' Read the number of faces to map
If Not ReadShort(m_Ptr, Count) Then Exit Function
' set this index to the current material
For i = 0 To Count - 1
If Not ReadShort(m_Ptr, FaceIndex) Then Exit Function
MatFaces.Value(CLng(FaceIndex)) = Index
Next
ReadMeshMatGroup = True
'----------------------------------------------------
Exit Function
ErrorHandler:
Debug.Assert 0
Debug.Print Err.Description
Exit Function
Resume Next
End Function
'----------------------------------------------------
' Read polygons
'----------------------------------------------------
Public Function ReadFaceArray(Faces As MFVec3L)
Dim Count%, v&(0 To 2), i&, j&, Value%
On Error GoTo ErrorHandler
' Read the count
If Not ReadShort(m_Ptr, Count) Then Exit Function
Faces.Count = Count '
' Read the faces
For j = 0 To Count - 1
' Read the triangle
For i = 0 To 2
If Not ReadShort(m_Ptr, Value) Then Exit Function
v(i) = Value
Next
Faces.SetValue j, v
' Read the visible edges and discard?
If Not ReadShort(m_Ptr, Value) Then Exit Function
Next
ReadFaceArray = True
'----------------------------------------------------
Exit Function
ErrorHandler:
Debug.Assert 0
Exit Function
End Function
'----------------------------------------------------
'Reads in the mapping list/texture coords. for the current mesh object '
'----------------------------------------------------
Public Function ReadTexVerts(TexCoords As MFVec2f) As Boolean
Dim Count%, v!(0 To 1), i&, Value%
On Error GoTo ErrorHandler
' Read the count
If Not ReadShort(m_Ptr, Count) Then Exit Function
TexCoords.Count = Count
For i = 0 To Count - 1
If Not ReadFloat(m_Ptr, v(0)) Then Exit Function
If Not ReadFloat(m_Ptr, v(1)) Then Exit Function
TexCoords.SetValue i, v
Next
ReadTexVerts = True
'----------------------------------------------------
Exit Function
ErrorHandler:
Debug.Assert 0
Exit Function
End Function
'----------------------------------------------------
' Read a Percent Chunk
' assumes the chunk header is not yet read
'----------------------------------------------------
Public Function ReadPercentage(ParentNode As Object, Value!) As Boolean
Dim Chunk As Chunk3DS
Dim ChunkStart&
Dim svalue%
On Error GoTo ErrorHandler
ChunkStart = m_Ptr
If Not ReadChunkHeader(Chunk) Then Exit Function
Select Case Chunk.ID
Case INT_PERCENTAGE
If Not ReadShort(m_Ptr&, svalue) Then Exit Function
Value = svalue / 100
ReadPercentage = True
Case FLOAT_PERCENTAGE
If Not ReadFloat(m_Ptr, Value) Then Exit Function
ReadPercentage = True
Case Else
Debug.Assert 0
If Not SkipChunk(ParentNode, Chunk) Then Exit Function
Exit Function
End Select
'----------------------------------------------------
Exit Function
ErrorHandler:
Debug.Assert 0
Exit Function
End Function
'----------------------------------------------------
' Read a color definition
' assumes header not yet read
'----------------------------------------------------
Public Function ReadColor(ParentNode As Object, red!, green!, blue!)
Dim Chunk As Chunk3DS
Dim ChunkStart&, tmp As Byte
On Error GoTo ErrorHandler
ChunkStart = m_Ptr
If Not ReadChunkHeader(Chunk) Then Exit Function
Select Case Chunk.ID
Case COLOR_F, LIN_COLOR_F:
If Not ReadFloat(m_Ptr, red) Then Exit Function
If Not ReadFloat(m_Ptr, green) Then Exit Function
If Not ReadFloat(m_Ptr, blue) Then Exit Function
Case COLOR_24, LIN_COLOR_24:
If Not ReadByte(m_Ptr, tmp) Then Exit Function
red = tmp / 255
If Not ReadByte(m_Ptr, tmp) Then Exit Function
green = tmp / 255
If Not ReadByte(m_Ptr, tmp) Then Exit Function
blue = tmp / 255
Case Else
Debug.Assert 0
If Not SkipChunk(ParentNode, Chunk) Then Exit Function
Exit Function
End Select
ReadColor = True
'----------------------------------------------------
Exit Function
ErrorHandler:
Debug.Assert 0
Exit Function
End Function
'----------------------------------------------------
' Read a string to a '\0'
' assumes header already read
'----------------------------------------------------
Public Function Read3DSString(Name$) As Boolean
Dim c&, i&, s$, Value As Byte
Const MAX_SIZE = 255
On Error GoTo ErrorHandler
s = String(256, Chr$(0))
Do
CopyToByteFromPtr Value, m_Ptr, 1
m_Ptr = m_Ptr + 1
Debug.Print Chr$(Value), Value
If Value = 0 Then Exit Do
i = i + 1
If i < MAX_SIZE Then
Mid$(s, i, 1) = Chr$(Value)
End If
Loop
Name = Left$(s, i)
Debug.Print Name
Read3DSString = True
'----------------------------------------------------
Exit Function
ErrorHandler:
Debug.Assert 0
Exit Function
Resume Next
End Function
'----------------------------------------------------
'DEBUG UTILITY ROUTINES
'----------------------------------------------------
Public Function Offset&()
Offset = m_Ptr - base_Ptr
End Function
Public Sub IncPtr(n&)
m_Ptr = m_Ptr + n
End Sub
'we don't want to read past eof if we get lost
Public Sub GetSize(ChunkStart&, ChunkEnd&, Chunk As Chunk3DS)
ChunkStart = m_Ptr - SizeofChunk
ChunkEnd = ChunkStart + Chunk.Length
If ChunkStart > ChunkEnd Then
Debug.Assert 0
End If
If ChunkEnd > FileEnd Then
Debug.Assert 0
ChunkEnd = FileEnd
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -