mread3ds.bas

3ds文件浏览程序

Attribute VB_Name = "mRead3ds"
Option Explicit

'*************************************************************************
'FUNCTION: reads a 3ds file and displays all known chunks in
'   a treeview control.
'AUTHOR: edx - [e-mail], Feb 98 - all rights reserved
'NOTES: based in part on the following:
'   XRoads, in '3D Graphic File Formats', by Keith D. Rule
'   'Chess', by Nate Robbins
'   'View3ds', by David Farrel
'   AutoDesk's 3DSFileToolkit
'   Almost all chunks are currently read. Many chunks which are
'   not relevant are deliberately skipped but added to the treeview control.
'   The gl rendering is pretty primitive - lights and cameras aren't
'   drawn, and the texturing uses only the main map.
'*************************************************************************
'OVERVIEW.
'There are 3 main collections: Scene, Materials, Textures.
'
'   Scene - a collection of top level nodes. Nodes may have other
'     |      other nodes as children. Nodes also may contain a collection
'     |      of Fields (the CField or the MFxxx classes).
'     |
'   Node  - Nodes represent major sections (MDATA, KFDATA) and minor
'     |      sections which define objects (NAMED_OBJECTS, and the objects
'     |      themselves (camera, light, mesh).
'     |
'   Fields - Fields store data for Node objects.
'
'
'   Materials - a collection of Material objects.
'     |
'   Material - a named material. Materials do not have children, but
'     |          may contain a collections of Maps (image files) and a collection
'     |          of Fields (color, etc).
'     |
'   Maps    - a collection of Map objects.
'     |
'   Map     - the filename and settings for an image file used for texturing.
'               A Map notifies the Textures collection to actually load the
'               file and create a gl texture.
'
'
'   Textures - a collection of Texture objects.
'     |
'   Texture  - loads an image file to use for texturing.
'
'   The Scene collection holds all the top-level nodes, typically about 3 nodes.
'   Most nodes are children of other nodes. To draw, the Scene tells each child
'   node to draw. The nodes recurse telling their children to draw. Most nodes
'   don't draw anything - only mesh nodes are drawn.
'
'   Materials are maintained in a collection, but a reference to each Material
'   is added to a special 'Materials' node so that when 'FillTree' is called, the
'   materials will be added to the the treeview control.
'
'   Textures are not shown in the tree. Each map in a material is shown in the
'   tree as a field of the material.
'
'   A second window with an ocx acts as a material viewer. It draws a sphere
'   for each material and applies whatever texture it uses.
'*************************************************************************
'
Const SizeofChunk = 6
'File mapping handles and such
Dim hFile&, hMap&, base_Ptr&, m_Ptr&
Dim FileSize&, FileVersion&
Dim FileEnd&
Dim lx!, rx!, ty!, by!, fz!, bz! 'bounding box
Dim NextLight& 'gl light
Dim BadLength As Boolean

'----------------------------------------------------
'Read the ChunkID and Length
'abort if this fails
'----------------------------------------------------
Public Function ReadChunkHeader(Chunk As Chunk3DS)
On Error GoTo ErrorHandler
    If m_Ptr + SizeofChunk <= FileEnd Then
        If Not ReadShort(m_Ptr, Chunk.ID) Then Exit Function
        If Not ReadLong(m_Ptr, Chunk.Length) Then Exit Function
        'Debug.Print "Chunk==========================="
        'Debug.Print "Offset:" & Offset
        'Debug.Print "ID:" & ChunkName(Chunk.ID) & " - " & "&H" & Hex(Chunk.ID)
        'Debug.Print "ChunkLength:" & Chunk.Length
        'Debug.Print "Filesize:" & FileSize
        If (m_Ptr + Chunk.Length - SizeofChunk) > FileEnd Then
            Debug.Print m_Ptr + Chunk.Length
            Debug.Print FileEnd
            Debug.Print "ID:" & ChunkName(Chunk.ID) & " - " & "&H" & Hex(Chunk.ID)
            Debug.Assert 0
            If BadLength Then
                Debug.Assert 0
            End If
            Exit Function
        End If
        ReadChunkHeader = True
    Else
        Debug.Assert 0
    End If
'----------------------------------------------------
Exit Function
ErrorHandler:
    Debug.Assert 0
    Exit Function
End Function

'----------------------------------------------------
'skip the chunk, but add a field to the current node for it
'abort if this fails
'----------------------------------------------------
Public Function SkipChunk(ParentNode As Object, Chunk As Chunk3DS) As Boolean
Dim Field As CField, lng&, s$, ChunkStart&
On Error GoTo ErrorHandler
    'make sure we're not lost
    If Chunk.Length < SizeofChunk Then
        Debug.Assert 0
        Exit Function
    End If
    ChunkStart = m_Ptr - SizeofChunk
    If ChunkStart + Chunk.Length > FileEnd Then
        Debug.Assert 0
        Exit Function
    End If
    Debug.Print "Skipping: " & ChunkName(Chunk.ID)
    'm_Ptr = chunkStart + chunk.length
    lng = Chunk.Length - Len(Chunk)
    'save any data
    If lng > 0 Then
        m_Ptr = ChunkStart + Len(Chunk)
        s = String(lng + 1, Chr$(0))
        CopyToStrFromPtr s, m_Ptr, lng
    Else
        'probably a boolean flag
        s = "[True]"
    End If
    m_Ptr = m_Ptr + lng
    If Not ParentNode Is Nothing Then
        Set Field = ParentNode.AddField(Chunk.ID)
    Else
        Dim Node As CNode
        Set Node = Scene.AddNode(Nothing, Chunk.ID, NODE_ROOT, "Error")
        Set Field = Node.AddField(Chunk.ID)
    End If
    Field.Value = s
    SkipChunk = True
'----------------------------------------------------
Exit Function
ErrorHandler:
    Debug.Print Err.Description
    Debug.Assert 0
    Exit Function
    Resume Next
End Function

'----------------------------------------------------
' Main loop for reading 3ds file.
'----------------------------------------------------
Public Sub Read3ds(Filename$)
Dim Chunk As Chunk3DS, FileTitle$, r&, Path$
Dim HeaderNode As CNode, Field As CField
'On Error GoTo ErrorHandler
    ReadyToDraw = False
    '----------------------------------------------
    ' map the file
    If Not LoadFile(Filename, hFile, hMap, base_Ptr) Then
        MsgBox "Failed to open file."
        GoTo done
    End If
    m_Ptr = base_Ptr
    FileSize = GetFileSize(hFile, 0)
    FileEnd = m_Ptr + FileSize
    ' Verify file type
    If Not ReadChunkHeader(Chunk) Then Exit Sub
    Select Case Chunk.ID
    Case M3DMAGIC, MLIBMAGIC
    Case Else
        MsgBox "File is not a 3ds binary file."
        GoTo done
    End Select
    ' Get File Size
    If Chunk.Length <> FileSize Then
        BadLength = True
        Debug.Assert 0
    End If
    '----------------------------------------------
    'clear the old scene
    Scene.Clear
    NextLight = 1
    ELog = ""
    Materials.Clear
    Textures.Clear
    '----------------------------------------------
    'add a special node for the file header chunks
    Set HeaderNode = Scene.AddNode(Nothing, X3DS_HEADER, NODE_ROOT)
    'add a field for the magic chunk
    Set Field = HeaderNode.AddField(Chunk.ID)
    Field.Value = Chunk.Length
    '
    '----------------------------------------------
    'set the form caption and status line
    r = GetLast(Filename, "\")
    If r Then
        FileTitle = Mid$(Filename, r + 1)
        Path = Left$(Filename, r)
    Else: FileTitle = Filename
    End If
    frmMain.Caption = "View3d - " & FileTitle
    frmMain.sts.Panels(1) = "Reading " & FileSize & " bytes..."
    frmMain.sts.Refresh
    Debug.Print Filename & "  Size: " & FileSize
    '
    '----------------------------------------------
    'initialize bounding box
    lx = 10000000
    rx = -lx: ty = rx: fz = rx
    by = lx: bz = lx
    '----------------------------------------------
    ' Loop through the chunks
    Do While m_Ptr < FileEnd
        r = m_Ptr
        If Not ReadChunkHeader(Chunk) Then GoTo ErrorHandler
        Select Case Chunk.ID
        'file header chunks
        Case M3D_VERSION:
            If Not ReadLong(m_Ptr, r) Then GoTo ErrorHandler
            Set Field = HeaderNode.AddField(M3D_VERSION)
            Field.Value = r
        Case MLIBMAGIC, CMAGIC
            If Not SkipChunk(Nothing, Chunk) Then GoTo ErrorHandler
        'major section chunks
        Case MDATA:
            If Not ReadMDATA(Nothing, Chunk) Then GoTo ErrorHandler
        Case KFDATA
            If Not ReadKFDATA(Nothing, Chunk) Then GoTo ErrorHandler
        Case Else
            If Not SkipChunk(Nothing, Chunk) Then GoTo ErrorHandler
        End Select
    Loop
    GL.SetCenter lx, rx, by, ty, bz, fz
done:
    CloseFile hFile, hMap, base_Ptr
    Scene.FillTree
    Materials.LoadMaps Path
    ReadyToDraw = True
    Scene.Draw 'force the scene to compile
    Exit Sub
'----------------------------------------------------
ErrorHandler:
    CloseFile hFile, hMap, base_Ptr
    Debug.Assert 0
    Scene.FillTree
    ReadyToDraw = True
    Scene.Draw 'force the scene to compile
End Sub

'----------------------------------------------------
'CHUNK READING ROUTINES
'the header will have already been read. These routines will create
'a node and read the subchunks
'----------------------------------------------------
'----------------------------------------------------
'MDATA - top level objects
'return true if read or skipped, 0 for error
'----------------------------------------------------
Public Function ReadMDATA(ParentNode As CNode, MyChunk As Chunk3DS)
Dim MyChunkStart&, MyChunkEnd&
Dim Version&, MScale!, MyNode As CNode
Dim ChunkStart&, Chunk As Chunk3DS
Dim Field As CField, r!, g!, b!
Dim Mats As CNode
On Error GoTo ErrorHandler
    'add this to the nodes collection, makes it the current node
    Set MyNode = Scene.AddNode(ParentNode, MDATA, NODE_ROOT)
    GetSize MyChunkStart, MyChunkEnd, MyChunk
    Do While m_Ptr < MyChunkEnd
        'Read subchunks
        ChunkStart = m_Ptr
        If Not ReadChunkHeader(Chunk) Then Exit Function
        Select Case Chunk.ID
        'section settings
        Case MESH_VERSION:
            If Not ReadLong(m_Ptr, Version) Then Exit Function
            Set Field = MyNode.AddField(MESH_VERSION)
            Field.Value = Version
        Case MASTER_SCALE:
            If Not ReadFloat(m_Ptr, MScale) Then Exit Function
            Set Field = MyNode.AddField(MASTER_SCALE)
            Field.Value = MScale
            GL.MasterScale = MScale
        'section chunks
        Case MAT_ENTRY
            If Mats Is Nothing Then
                Set Mats = Scene.AddNode(MyNode, X3DS_MATERIALS, NODE_ROOT)
            End If
            If Not ReadMatEntry(Mats, Chunk) Then Exit Function
        Case NAMED_OBJECT
            If Not ReadNamedObject(MyNode, Chunk) Then Exit Function
        Case AMBIENT_LIGHT
            If Not ReadColor(MyNode, r, g, b) Then Exit Function
            Set Field = MyNode.AddField(AMBIENT_LIGHT)
            Field.Value = r & "," & g & "," & b
        'sections which are skipped
        Case SOLID_BGND, BIT_MAP, V_GRADIENT, USE_BIT_MAP, USE_SOLID_BGND, USE_V_GRADIENT, _
            FOG, LAYER_FOG, DISTANCE_CUE, USE_FOG, USE_LAYER_FOG, USE_DISTANCE_CUE
            If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
        Case VIEWPORT_LAYOUT, LO_SHADOW_BIAS, HI_SHADOW_BIAS, SHADOW_MAP_SIZE, SHADOW_SAMPLES, _
            SHADOW_RANGE, SHADOW_FILTER, RAY_BIAS, O_CONSTS, DEFAULT_VIEW
            If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
        'unknown
        Case Else:
            Debug.Assert 0
            If Not SkipChunk(MyNode, Chunk) Then GoTo ErrorHandler
        End Select
    Loop
    ReadMDATA = True
'----------------------------------------------------