mread3ds.bas

3ds文件浏览程序

            Set Field = MyNode.AddField(DL_OFF)
            Field.Value = 0
            Light.Enabled = False
        Case DL_OUTER_RANGE:
            Set Field = MyNode.AddField(DL_OUTER_RANGE)
            If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
            Field.Value = x
        Case DL_INNER_RANGE:
            Set Field = MyNode.AddField(DL_INNER_RANGE)
            If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
            Field.Value = x
        Case DL_MULTIPLIER:
            Set Field = MyNode.AddField(DL_MULTIPLIER)
            If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
            Field.Value = x
        Case DL_EXCLUDE:
            Set Field = MyNode.AddField(DL_EXCLUDE)
            If Not Read3DSString(Str) Then Exit Function
            Field.Value = Str
        Case DL_ATTENUATE:
            Set Field = MyNode.AddField(DL_ATTENUATE)
            Field.Value = "True"
        Case DL_SPOTLIGHT
            GetSize ChunkStart, SpotChunkEnd, Chunk
            'target
            Set Field = MyNode.AddField(DL_SPOTLIGHT)
            If Not Read3Floats(m_Ptr, v) Then Exit Function
            Field.Value = v(0) & "," & v(1) & "," & v(2)
            'hotspot cone
            'Set Field = MyNode.AddField(DL_SPOTLIGHT, FID_CUTOFFANGLE)
            If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
            Light.SpotCutOff = x / 2
            'falloff cone
            Set Field = MyNode.AddField(DL_SPOTLIGHT)
            If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
            Field.Value = x
            'skip the rest
            'm_Ptr = ChunkStart + Chunk.Length
            Do While m_Ptr < SpotChunkEnd
                If Not ReadChunkHeader(Chunk) Then GoTo ErrorHandler
                Select Case Chunk.ID
                'float
                Case DL_SPOT_ROLL, DL_SPOT_ASPECT, DL_RAY_BIAS
                    Set Field = MyNode.AddField(Chunk.ID)
                    If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
                    Field.Value = x
                Case DL_SHADOWED, DL_RAYSHAD, DL_SEE_CONE, DL_SPOT_RECTANGULAR, DL_SPOT_OVERSHOOT
                    Set Field = MyNode.AddField(Chunk.ID)
                    Field.Value = "True"
                Case DL_SPOT_PROJECTOR:
                    Set Field = MyNode.AddField(Chunk.ID)
                    If Not Read3DSString(Str) Then Exit Function
                    Field.Value = Str
                Case DL_LOCAL_SHADOW2:
'                    If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
'                    Light.LocalShadowLowBias = x
'                    If Not ReadFloat(m_Ptr, x) Then GoTo ErrorHandler
'                    Light.LocalShadowFilter = x
'                    If Not ReadShort(m_Ptr, s) Then GoTo ErrorHandler
'                    Light.LocalShadowMapSize = s
                    If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
                Case Else: ' Skip unknown chunks
                    Debug.Assert 0
                    If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
                End Select
            Loop
        Case Else: ' Skip unknown chunks
            Debug.Assert 0
            If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
        End Select
    Loop
    '
    If NextLight < 7 Then
        NextLight = NextLight + 1
    End If
    ReadDLight = True
'----------------------------------------------------
Exit Function
ErrorHandler:
    Debug.Assert 0
    Exit Function
    Resume Next
End Function

'----------------------------------------------------
' Read a Mesh
'----------------------------------------------------
Public Function ReadTriObject(ParentNode As CNode, MyChunk As Chunk3DS) As Boolean
Dim Chunk As Chunk3DS, ChunkStart&
Dim i&, r&, MyChunkEnd&, MyChunkStart&
Dim MatCount&
Dim MyNode As CNode
Dim Vertices As MFVec3f
Dim Normals As MFNormal3f
Dim TexVertices As MFVec2f
Dim Faces As MFVec3L
Dim MatFaces As MFLong
Dim NormalIndices As MFVec3L
Dim TexIndices As MFVec2L
On Error GoTo ErrorHandler
    '
    ' Create a new child node
    ' Set the name of the node to the name of the group
    Set MyNode = Scene.AddNode(ParentNode, N_TRI_OBJECT, NODE_SHAPE)
    With MyNode
        Set Vertices = .Fields(1)
        Set Normals = .Fields(2)
        Set TexVertices = .Fields(3)
        Set Faces = .Fields(4)
        Set NormalIndices = .Fields(5)
        Set TexIndices = .Fields(6)
        Set MatFaces = .Fields(7)
    End With
    '
    GetSize MyChunkStart, MyChunkEnd, MyChunk
    Do While m_Ptr < MyChunkEnd
        ChunkStart = m_Ptr
        If Not ReadChunkHeader(Chunk) Then GoTo ErrorHandler
        Select Case Chunk.ID
        Case POINT_ARRAY:
            If Not ReadPointArray(Vertices) Then GoTo ErrorHandler
        Case FACE_ARRAY:
            If Not ReadFaceArray(Faces) Then GoTo ErrorHandler
        Case MSH_MAT_GROUP:
            If MatFaces.Count = 0 Then
                If Faces.Count = 0 Then Debug.Assert 0
                MatFaces.Count = Faces.Count
            End If
            MatCount = MatCount + 1
            If Not ReadMeshMatGroup(MatFaces) Then GoTo ErrorHandler
        Case TEX_VERTS
            If Not ReadTexVerts(TexVertices) Then GoTo ErrorHandler
        Case MESH_MATRIX, MSH_BOXMAP, POINT_FLAG_ARRAY, SMOOTH_GROUP, _
            MESH_COLOR, MESH_TEXTURE_INFO, PROC_NAME, PROC_DATA
            If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
        Case Else: ' Skip unknown chunks
            Debug.Assert 0
            If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
        End Select
    Loop
    '
    MyNode.MaterialCount = MatCount
    ReadTriObject = True
'----------------------------------------------------
Exit Function
ErrorHandler:
    Debug.Assert 0
    Debug.Print Err.Description
    Exit Function
    Resume Next
End Function

'----------------------------------------------------
'KEYFRAME ROUTINES
'----------------------------------------------------
'----------------------------------------------------
'MDATA - top level objects
'return true if read or skipped, 0 for error
'----------------------------------------------------
Public Function ReadKFDATA(ParentNode As CNode, MyChunk As Chunk3DS)
Dim MyChunkStart&, MyChunkEnd&
Dim s%, b As Byte, i&, Name$
Dim Version&, MScale!, MyNode As CNode
Dim ChunkStart&, Chunk As Chunk3DS
Dim Field As CField, nHack&
On Error GoTo ErrorHandler
    'add this to the nodes collection, makes it the current node
    Set MyNode = Scene.AddNode(Nothing, KFDATA, NODE_ROOT)
    GetSize MyChunkStart, MyChunkEnd, MyChunk
    Do While m_Ptr < MyChunkEnd
        'Read subchunks
        ChunkStart = m_Ptr
        If Not ReadChunkHeader(Chunk) Then Exit Function
        Debug.Print "KF: " & ChunkName(Chunk.ID)
        Select Case Chunk.ID
        'section settings
        Case KFHDR:
            If Not ReadShort(m_Ptr, s) Then Exit Function
            Set Field = MyNode.AddField(KF_VERSION)
            Field.Value = s
            If Not Read3DSString(Name) Then Exit Function
            If Not ReadLong(m_Ptr, i) Then Exit Function
            Set Field = MyNode.AddField(KF_FRAMELENGTH)
            Field.Value = i
        Case KFSEG:
            If Not ReadLong(m_Ptr, i) Then Exit Function
            Set Field = MyNode.AddField(KF_FIRSTFRAME)
            Field.Value = i
            If Not ReadLong(m_Ptr, i) Then Exit Function
            Set Field = MyNode.AddField(KF_LASTFRAME)
            Field.Value = i
        Case KFCURTIME:
            If Not ReadLong(m_Ptr, i) Then Exit Function
            Set Field = MyNode.AddField(KFCURTIME)
            Field.Value = i
        Case AMBIENT_NODE_TAG, OBJECT_NODE_TAG, CAMERA_NODE_TAG, _
            TARGET_NODE_TAG, LIGHT_NODE_TAG, SPOTLIGHT_NODE_TAG, L_TARGET_NODE_TAG
            If Not ReadObjectNodeTag(MyNode, Chunk) Then Exit Function
        'subsections
        Case Else:
            If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
        End Select
    Loop
    ReadKFDATA = True
'----------------------------------------------------
Exit Function
ErrorHandler:
    Debug.Assert 0
    Exit Function
    Resume Next
End Function

'----------------------------------------------------
' Read a Mesh
'----------------------------------------------------
Public Function ReadObjectNodeTag(ParentNode As CNode, MyChunk As Chunk3DS) As Boolean
Dim Chunk As Chunk3DS, ChunkStart&
Dim i&, r&, MyChunkEnd&, MyChunkStart&
Dim s%, l&, f!, Name$, v!(0 To 2)
Dim Field As CField
Dim MyNode As CNode
On Error GoTo ErrorHandler
    '
    ' Create a new child node
    Set MyNode = Scene.AddNode(ParentNode, OBJECT_NODE_TAG, NODE_COORDINATEINTERP)
    '
    GetSize MyChunkStart, MyChunkEnd, MyChunk
    Do While m_Ptr < MyChunkEnd
        ChunkStart = m_Ptr
        If Not ReadChunkHeader(Chunk) Then GoTo ErrorHandler
        Select Case Chunk.ID
        Case NODE_ID:
            If Not ReadShort(m_Ptr, s) Then Exit Function
            Set Field = MyNode.AddField(NODE_ID)
            Field.Value = s
        Case NODE_HDR:
            If Not Read3DSString(Name) Then GoTo ErrorHandler
            Set Field = MyNode.AddField(NODE_HDR)
            Field.Value = Name
            If Not ReadShort(m_Ptr, s) Then Exit Function 'flag1
            Set Field = MyNode.AddField(NODE_HDR_FLAG1)
            Field.Value = s
            If Not ReadShort(m_Ptr, s) Then Exit Function 'flag2
            Set Field = MyNode.AddField(NODE_HDR_FLAG2)
            Field.Value = s
            If Not ReadShort(m_Ptr, s) Then Exit Function 'parent
            Set Field = MyNode.AddField(NODE_HDR_PARENT)
            Field.Value = s
        Case PIVOT:
            Set Field = MyNode.AddField(PIVOT)
            If Not Read3Floats(m_Ptr, v) Then Exit Function
            Field.Value = v(0) & "," & v(1) & "," & v(2)
        Case INSTANCE_NAME:
            If Not Read3DSString(Name) Then GoTo ErrorHandler
            Set Field = MyNode.AddField(INSTANCE_NAME)
            Field.Value = Name
        Case BOUNDBOX:
            Set Field = MyNode.AddField(BOUNDBOX_MIN)
            If Not Read3Floats(m_Ptr, v) Then Exit Function
            Field.Value = v(0) & "," & v(1) & "," & v(2)
            Set Field = MyNode.AddField(BOUNDBOX_MAX)
            If Not Read3Floats(m_Ptr, v) Then Exit Function
            Field.Value = v(0) & "," & v(1) & "," & v(2)
        Case POS_TRACK_TAG, ROT_TRACK_TAG, SCL_TRACK_TAG, MORPH_TRACK_TAG, HIDE_TRACK_TAG, _
            COL_TRACK_TAG, FOV_TRACK_TAG, ROLL_TRACK_TAG, HOT_TRACK_TAG, FALL_TRACK_TAG:
            If Not ReadTrackHeader(MyNode, Chunk) Then GoTo ErrorHandler
        Case MORPH_SMOOTH:
            If Not ReadFloat(m_Ptr, f) Then Exit Function 'bias
            Set Field = MyNode.AddField(MORPH_SMOOTH)
            Field.Value = f
        Case Else: ' Skip unknown chunks
            Debug.Assert 0
            If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
        End Select
    Loop
    '
    ReadObjectNodeTag = True
'----------------------------------------------------
Exit Function
ErrorHandler:
    Debug.Assert 0
    Exit Function
    Resume Next
End Function

'----------------------------------------------------
' Read a track header
'----------------------------------------------------
Public Function ReadTrackHeader(ParentNode As CNode, MyChunk As Chunk3DS) As Boolean
'Dim Chunk As Chunk3DS, ChunkStart&
Dim i&, r&, MyChunkEnd&, MyChunkStart&
Dim s%, l&, f!, Name$, v!(0 To 2), Count&
Dim Field As CField
Dim MyNode As CNode
Dim KeyField As MFKey
On Error GoTo ErrorHandler
    '
    ' Create a new child node
    ' Set the name of the node to the name of the group
    Set MyNode = Scene.AddNode(ParentNode, CLng(MyChunk.ID), NODE_COORDINATEINTERP)
    '
    GetSize MyChunkStart, MyChunkEnd, MyChunk
    'read the track header - 14
    If Not ReadShort(m_Ptr, s) Then Exit Function 'looping flags
    Set Field = MyNode.AddField(KF_TRACKHEADER_LOOP)
    Field.Value = s
    If Not ReadLong(m_Ptr, l) Then Exit Function 'unused
    If Not ReadLong(m_Ptr, l) Then Exit Function 'unused
    If Not ReadLong(m_Ptr, Count) Then Exit Function 'number of keys
    Set Field = MyNode.AddField(KF_TRACKHEADER_KEYCOUNT)
    Field.Value = Count
    Set KeyField = MyNode.AddKeyField(KF_KEYHEADER)
    KeyField.Count = Count
    'read the keys
    For i = 0 To Count - 1
        'key header
        If Not ReadLong(m_Ptr, l) Then Exit Function 'frameno
        KeyField.FrameNum(i) = l