mreadobj.bas

3ds文件浏览程序

Attribute VB_Name = "mReadObj"
Option Explicit
'*************************************************************************
'FUNCTION: Reads an OBJ file
'AUTHOR: ported by edx - [e-mail], Oct 98, from:
'  Wavefront .obj file format reader.
'  author: Nate Robins
'  email: [e-mail]
'  www: http://www.pobox.com/~ndr
'This module was adapted from the chess sample at the above site.
'There is a port of the chess sample on my site.
'NOTES: this is from the 'glm' library. I lifted the code to generate
'averaged normals and a few other routines which are to be found in the MFxxx
'classes. Thanks, Nate.
'*************************************************************************
Public PathName As String
Public MaterialLibName As String  ' name of the material library
Dim Vertices As MFVec3f ' array of vertices
Dim Normals As MFVec3f ' array of normals
Dim TexVertices As MFVec2f ' array of texture coordinates
Dim FaceIndices As MFVec3L ' array of indexes to Vertices
Dim NormalIndices As MFVec3L ' array of indexes to Normals
Dim TexIndices As MFVec2L 'array of indexes to TexVertices
Dim MatFaces As MFLong 'array of material indexes, one for each face
Dim m_Position!(0 To 2)     ' position of the model
Dim FileSize&, FileEnd&
Dim lx!, rx!, ty!, by!, fz!, bz!

'----------------------------------------------------------------------------
'ReadOBJ: Reads a model description from a Wavefront .OBJ file.
'Constructs a tree of nodes.
'----------------------------------------------------------------------------
Public Function ReadOBJ(FileName$) As Boolean
Dim Node As CNode, Field As CField, FileTitle$, r&
Dim fn&, s$, vf!(0 To 3), vi&(0 To 3), ni&(0 To 3), ti&(0 To 3)
Dim vCount&      ' number of vertices in model
Dim nCount&      ' number of normals in model
Dim tCount&      ' number of texcoords in model
Dim triCount&    ' number of triangles in model
'Dim group As MFLong          ' current group pointer
Dim material&    ' current material
Dim cnt& 'GroupTriCount&
Dim token$, pos&, fv!
On Error GoTo ErrorHandler
    PathName = ExtractPath(FileName)
    fn = FreeFile
    Open FileName For Input As fn
    FileSize = LOF(fn)
    'clear the old scene
    Scene.Clear
    Materials.Clear
    'set the form caption and status line
    r = GetLast(FileName, "\")
    If r Then
        FileTitle = Mid$(FileName, r + 1)
    Else: FileTitle = FileName
    End If
    frmMain.Caption = "View3d - " & FileTitle
    frmMain.sts.Panels(1) = "Reading " & FileSize & " bytes..."
    frmMain.sts.Refresh
    'add a default group node
    Set Node = Scene.AddNode(Nothing, OBJ_GROUP, NODE_SHAPE, "Default group")
    With Node
        Set Vertices = .Fields(1)
        Set Normals = .Fields(2)
        Set TexVertices = .Fields(3)
        Set FaceIndices = .Fields(4)
        Set NormalIndices = .Fields(5)
        Set TexIndices = .Fields(6)
        Set MatFaces = .Fields(7)
    End With
    'initialize bounding box
    lx = 10000000
    rx = -lx: ty = rx: fz = rx
    by = lx: bz = lx
    '
    ' on the first pass, size the arrays
    m_FirstPass fn
    ' now read in the data
    Seek #fn, 1
    Do While Not EOF(fn)
        Line Input #fn, s 'assumes <CR> delimits each statement
        Select Case Left$(s, 1)
        Case "#": ' comment
        Case "v": ' v, vn, vt
            Select Case Mid$(s, 2, 1)
            Case " " ' vertex
                pos = 3
                If Not GetNextToken(token, s, pos) Then Exit Do
                vf(0) = Val(token)
                If Not GetNextToken(token, s, pos) Then Exit Do
                vf(1) = Val(token)
                If Not GetNextToken(token, s, pos) Then Exit Do
                vf(2) = Val(token)
                Vertices.SetValue vCount, vf
                vCount = vCount + 1
            Case "n": ' normal
                pos = 4
                If Not GetNextToken(token, s, pos) Then Exit Do
                vf(0) = Val(token)
                If Not GetNextToken(token, s, pos) Then Exit Do
                vf(1) = Val(token)
                If Not GetNextToken(token, s, pos) Then Exit Do
                vf(2) = Val(token)
                Normals.SetValue nCount, vf
                nCount = nCount + 1
            Case "t": ' texcoord
                pos = 4
                If Not GetNextToken(token, s, pos) Then Exit Do
                vf(0) = Val(token)
                If Not GetNextToken(token, s, pos) Then Exit Do
                vf(1) = Val(token)
                TexVertices.SetValue tCount, vf
                tCount = tCount + 1
            End Select
        Case "u": 'usemat
            pos = 3
            If Not GetNextToken(token, s, pos) Then Exit Do
            ' look up its index
            material = Materials.GetIndex(s) 'm_FindMaterial (s)
            'group.material = material
        Case "g": ' group ' eat up rest of line
            token = Mid(s, 3)
            'group.NumTriangles = GroupTriCount
            'Set group = m_AddGroup(token)
            'group.material = material
            'GroupTriCount = 0
        Case "f": ' face
            'v = 0: n = 0: t = 0
            cnt = GetFaceIndices(vi, ti, ni, s)
            If cnt < 0 Then Exit Do 'error
            FaceIndices.SetValueOBJ triCount, vi ' v
            If cnt = 2 Then ' v//n
                NormalIndices.SetValueOBJ triCount, ni
            ElseIf cnt = 1 Then ' v/t
                TexIndices.SetValueOBJ triCount, ti
            Else  ' v/t/n
                NormalIndices.SetValueOBJ triCount, ni
                TexIndices.SetValue triCount, ti
            End If
            MatFaces.Value(triCount) = material
            triCount = triCount + 1
        Case Else 'ignore
        End Select
    Loop

    GL.SetCenter lx, rx, by, ty, bz, fz
    ' close the file
    Close #fn
    Scene.FillTree
    'Materials.FillTree
    ReadyToDraw = True
    Scene.Draw 'force the scene to compile
    ReadOBJ = True
    Exit Function
ErrorHandler:
    Close #fn
    Debug.Print Err.Description
    Debug.Assert 0
    MsgBox "Error reading file." & vbCrLf & Err.Description
    Exit Function
    Resume Next
End Function

'----------------------------------------------------------------------------
' _m_FirstPass: first pass at a Wavefront OBJ file that gets all the
' statistics of the model (such as #vertices, #normals, etc)
' fn - file number from FreeFile()
'----------------------------------------------------------------------------
Private Sub m_FirstPass(fn&)
Dim vCount&      ' number of vertices in model
Dim nCount&      ' number of normals in model
Dim tCount&      ' number of texcoords in model
Dim triCount&    ' number of triangles in model
'Dim group As MFLong           ' current group
Dim GroupTriCount&, s$
    'Set group = m_Groups(1) '"default"
    Do While Not EOF(fn)
        Line Input #fn, s
        'Debug.Print s
        Select Case Left$(s, 1)
        Case "#":  ' comment
        Case "v": ' v, vn, vt
            Select Case Mid$(s, 2, 1)
            Case " ": vCount = vCount + 1
            Case "n": nCount = nCount + 1
            Case "t": tCount = tCount + 1
            End Select
        Case "m":
            ReadMTL Mid$(s, 3)
        Case "u": ' eat up rest of line
        Case "g": ' eat up rest of line
            'If group Is Nothing Then
            '    Debug.Assert GroupTriCount = 0
            'Else
            '    group.Count = GroupTriCount
            'End If
            'Set group = m_AddGroup(Mid$(s, 3))
            'GroupTriCount = 0
        Case "f":               ' face
            triCount = triCount + 1
            'GroupTriCount = GroupTriCount + 1
        End Select
    Loop
    ' size the arrays
    Vertices.Count = vCount
    Normals.Count = nCount
    TexVertices.Count = tCount
    FaceIndices.Count = triCount
    NormalIndices.Count = triCount
    TexIndices.Count = triCount