cnode.cls

3ds文件浏览程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CNode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
'*************************************************************************
'FUNCTION: simple node class for building a scene database.
' This class is used to build simplified Inventor/vrml style
' node trees. The 3d viewer does not implement proper vrml,
' it uses this class as a generic dummy node to represent
' various chunks of data. Its main purpose is organizational,
' to act as a container of fields and parent of other nodes.
' Only if it is assigned a NODE_SHAPE id will it draw. In this
' case, it will create 7 fields to hold the data it needs.
'AUTHOR: edx - [e-mail], Oct 98 - all rights reserved
'HISTORY: -
'NOTES: Since the 3d viewer is dealing with simple meshes,
'transform values aren't currently used.
'*************************************************************************

'Public ID As NodeIDConstants
Private m_NodeID&
Dim m_ListID& 'gl list
Public ChunkID%
Public TreeNode As Node
Public Parent As CNode
Public Fields As Collection
Public Children As Collection
Public Value$
'----------------------------------------------------------------
Dim m_tx!, m_ty!, m_tz!
Dim m_sx!, m_sy!, m_sz!
Dim m_x!, m_y!, m_z!
Dim m_rot!(0 To 15)
Dim m_Selected As Boolean
Dim m_MatCount&
Dim m_Name$
'----------------------------------------------------------------
'

Private Sub Class_Initialize()
    m_x = 1: m_y = 1: m_z = 1
    m_sx = 1: m_sy = 1: m_sz = 1
    M4_Identity m_rot
    Set Fields = New Collection
    Set Children = New Collection
End Sub

'----------------------------------------------------------------
Public Property Get NodeID&()
    NodeID = m_NodeID
End Property

'------------------------------------------------------------
'if this node will represent a mesh, create the fields needed.
'otherwise it will be a grouping or placeholder node.
'------------------------------------------------------------
Public Property Let NodeID(ByVal NewValue&)
Dim Vertices As MFVec3f
Dim Normals As MFNormal3f
Dim TexVertices As MFVec2f
Dim FaceIndices As MFVec3L
Dim NormalIndices As MFVec3L
Dim TexIndices As MFVec2L
Dim MatFaces As MFLong
On Error GoTo ErrorHandler
'only allow this once!
If m_NodeID <> 0 Then Debug.Assert 0
m_NodeID = NewValue
If NewValue = NODE_SHAPE Then
    Set Vertices = New MFVec3f
    Vertices.FieldID = FID_COORD
    Vertices.ChunkID = POINT_ARRAY
    '
    Set Normals = New MFNormal3f
    Normals.FieldID = FID_NORMAL
    Normals.ChunkID = POINT_ARRAY
    '
    Set TexVertices = New MFVec2f
    TexVertices.FieldID = FID_TEXCOORD
    TexVertices.ChunkID = TEX_VERTS
    '
    Set FaceIndices = New MFVec3L
    FaceIndices.FieldID = FID_COORDINDEX
    FaceIndices.ChunkID = FACE_ARRAY
    '
    Set NormalIndices = New MFVec3L
    NormalIndices.FieldID = FID_NORMALINDEX
    NormalIndices.ChunkID = FACE_ARRAY
    '
    Set TexIndices = New MFVec2L
    TexIndices.FieldID = FID_TEXCOORDINDEX
    TexIndices.ChunkID = FACE_ARRAY
    '
    Set MatFaces = New MFLong
    MatFaces.FieldID = FID_COLORPERVERTEX
    MatFaces.ChunkID = MSH_MAT_GROUP
    '
    'must be in this order! other code gets the fields
    'by index
    AddFieldObj Vertices
    AddFieldObj Normals
    AddFieldObj TexVertices
    AddFieldObj FaceIndices
    AddFieldObj NormalIndices
    AddFieldObj TexIndices
    AddFieldObj MatFaces
End If
'----------------------------------------------------
Exit Property
ErrorHandler:
    Debug.Print Err.Description
    Debug.Assert 0
    Exit Property
    Resume Next
End Property

'----------------------------------------------------------------
Public Property Get Name() As String
Name = m_Name
End Property

Public Property Let Name(ByVal NewValue As String)
m_Name = NewValue
End Property

'----------------------------------------------------------------
'Transform properties
'----------------------------------------------------------------

'----------------------------------------------------------------
Public Sub GetBoundingBox(x!, y!, z!)
    x = m_x: y = m_y: z = m_z
End Sub

Public Sub GetTranslation(x!, y!, z!)
    x = m_tx: y = m_ty: z = m_tz
End Sub

'------------------------------------------------------------
Public Sub SetTranslation(x!, y!, z!)
    m_tx = x: m_ty = y: m_tz = z
End Sub

Public Sub GetScale(x!, y!, z!)
    x = m_sx: y = m_sy: z = m_sz
End Sub

Public Sub SetScale(x!, y!, z!)
    m_sx = x: m_sy = y: m_sz = z
End Sub

Public Sub UniformScale(f!)
    m_sx = m_sx * f: m_sy = m_sy * f: m_sz = m_sz * f
End Sub

Public Sub GetRotationMatrix(m!())
Dim i&
    For i = 0 To 15
        m(i) = m_rot(i)
    Next
End Sub

Public Sub SetRotationMatrix(m!())
Dim i&
    For i = 0 To 15
        m_rot(i) = m(i)
    Next
End Sub

'----------------------------------------------------------------
Public Property Get Selected() As Boolean
    Selected = m_Selected
End Property

Public Property Let Selected(ByVal NewValue As Boolean)
    m_Selected = NewValue
End Property

'----------------------------------------------------------------
'METHODS
'----------------------------------------------------------------

'----------------------------------------------------------------
'Node children can be other CNodes
'----------------------------------------------------------------
Public Sub AddChild(Node As CNode)
    Children.Add Node
    Set Node.Parent = Me
End Sub

'----------------------------------------------------------------
'Add a field which is not a CField (MFxxx, CMaterials)
'----------------------------------------------------------------
Public Sub AddFieldObj(Field As Object)
    Fields.Add Field
    Set Field.Parent = Me
End Sub

'----------------------------------------------------------------
'creates a new CField and adds it to the collection
'----------------------------------------------------------------
Public Function AddField(ChunkID%) As CField
Dim Field As CField
    Set Field = New CField
    Field.ChunkID = ChunkID
    Fields.Add Field
    Set Field.Parent = Me
    Set AddField = Field
End Function

'----------------------------------------------------------------
'creates a new MFKey field and adds it to the collection
'----------------------------------------------------------------
Public Function AddKeyField(ChunkID%) As MFKey
Dim Field As MFKey
    Set Field = New MFKey
    Field.ChunkID = ChunkID
    Fields.Add Field
    Set Field.Parent = Me
    Set AddKeyField = Field
End Function

'----------------------------------------------------------------
Public Sub SetField(ID&, values)
Debug.Assert 0
End Sub

'----------------------------------------------------------------
'this value is set by the file parser
'----------------------------------------------------------------
Public Property Get MaterialCount() As Long
MaterialCount = m_MatCount
End Property

Public Property Let MaterialCount(ByVal NewValue As Long)
m_MatCount = NewValue
End Property

'----------------------------------------------------------------
'add this object to the treeview
'----------------------------------------------------------------
Public Sub FillTree()
Dim ParentNode As Node, i&, s$, s1$
On Error GoTo ErrorHandler
    'If Err Then Debug.Assert 0
    'compose a caption for the Treeview
    Debug.Print Name
    s = Name
    If Len(s) Then s = s & " - "
    s1 = s & ChunkName(ChunkID)
    '
    With frmMain
    If Parent Is Nothing Then
        'If .TV1.Nodes.Count Then
            'Debug.Assert 0
        'End If
        Set TreeNode = .TV1.Nodes.Add(, , , s1, ChunkImage(ChunkID))
    Else
        Set ParentNode = Parent.TreeNode
        Set TreeNode = .TV1.Nodes.Add(ParentNode, tvwChild, , s1, ChunkImage(ChunkID))
    End If
    '
    If TreeNode Is Nothing Then Debug.Assert 0
    For i = 1 To Fields.Count
        Fields(i).FillTree
    Next
    For i = 1 To Children.Count
        Children(i).FillTree
    Next
    End With
'----------------------------------------------------
    Exit Sub
ErrorHandler:
    Debug.Print Err.Description
    Debug.Assert 0
    Exit Sub
    Resume Next
End Sub

'----------------------------------------------------------------
Public Sub Draw()
Dim i&
    'GL.GetCenterv center
    If m_NodeID = NODE_SHAPE Then
        glPushMatrix
        If m_ListID = 0 Then
            m_Compile
        Else
            glCallList m_ListID
        End If
        glPopMatrix
    End If
    For i = 1 To Children.Count
        If TypeOf Children(i) Is CNode Then
        Children(i).Draw
        End If
    Next
End Sub

'----------------------------------------------------------------
Public Sub Compile()
Dim i&
    'GL.GetCenterv center
    If m_NodeID = NODE_SHAPE Then
        glPushMatrix
        m_Compile
        glPopMatrix
    End If
    For i = 1 To Children.Count
        If TypeOf Children(i) Is CNode Then
        Children(i).Compile
        End If
    Next
End Sub

'----------------------------------------------------------------
Private Sub m_Compile()
Dim i&, Count&, FacePtr&, curMat&
Dim Faces As MFVec3L
Dim MatFaces As MFLong, NextIdx&, Range&
Dim Normals As MFNormal3f
Dim FacetNormals As MFNormal3f
Dim Vertices As MFVec3f
Dim TexVertices As MFVec2f
Dim Mat As CMaterial
    'the node has these fields .
'   1. Vertices
'   2. Normals
'   3. TexVertices
'   4. FaceIndices
'   5. NormalIndices
'   6. TexIndices
'   7. MatFaces
    Set Faces = Fields(4)
    If Faces.Count = 0 Then
        'lines
        'Debug.Assert 0
        Exit Sub
    End If
    FacePtr = Faces.DataPointer
    Set MatFaces = Fields(7)
    Count = Faces.Count
    '
    Set Vertices = Fields(1)
    Set Normals = Fields(2)
    Set TexVertices = Fields(3)
    If Normals.Count <> Vertices.Count Then
        Set FacetNormals = New MFNormal3f
        FacetNormals.GenFacetNormals Vertices, Faces
        'for 1 normal per vertex, for vertex arrays
        Normals.GenVertexNormals Vertices, Faces, FacetNormals
    Else
        'it will crash GL or draw nonsense if we use vertex arrays
        'Debug.Assert 0
    End If
    '
    '
    'set the vertex pointer
    glVertexPointer 3, GL_FLOAT, Vertices.Stride, ByVal Vertices.DataPointer
    'set the normal pointer
    glNormalPointer GL_FLOAT, Normals.Stride, ByVal Normals.DataPointer
    'set the texcoord pointer
    'glTexCoordPointer 2, GL_FLOAT, 0, ByVal TexVertices.DataPointer
    If TexVertices.Count Then
        If TexVertices.Count <> Vertices.Count Then
            Debug.Assert 0
            glDisableClientState GL_TEXTURE_COORD_ARRAY
        Else
            glEnableClientState GL_TEXTURE_COORD_ARRAY
            glTexCoordPointer 2, GL_FLOAT, 0, ByVal TexVertices.DataPointer
        End If
    Else
        glDisableClientState GL_TEXTURE_COORD_ARRAY
    End If
    '
    m_ListID = glGenLists(1)
    glNewList m_ListID, GL_COMPILE
        If m_MatCount Then
            Do While i < Count
                'get start of next different material
                NextIdx = MatFaces.GetNextMatIndex(i)
                Range = NextIdx - i
                'set the material
                curMat = MatFaces.Value(i)
                Set Mat = Materials.SetMaterial(curMat)
                'draw a block or vertices
                'glDrawElements GL_TRIANGLES, Range, GL_UNSIGNED_INT, ByVal FacePtr + (i - 1) * 3
                Faces.DrawElements i, Range
                i = i + Range
                Mat.UnSetMaterial
            Loop
        Else
            Materials.SetMaterial 0
            glDrawElements GL_TRIANGLES, Count * 3, GL_UNSIGNED_INT, ByVal FacePtr
        End If
    glEndList
End Sub

'----------------------------------------------------------------
'used to the retrieve the value of a field when the treeview is clicked
'----------------------------------------------------------------
Public Function FindField(TreeNode As Node) As Object
Dim i&, o As Object
    For i = 1 To Fields.Count
        If Fields(i).TreeNode Is TreeNode Then
            Set FindField = Fields(i)
            Exit Function
        End If
    Next
    'didn't find it, query children
    For i = 1 To Children.Count
        Set o = Children(i).FindField(TreeNode)
        If Not o Is Nothing Then
            Set FindField = o
            Exit Function
        End If
    Next
End Function

'----------------------------------------------------------------
'used to the retrieve the value of a field when the treeview is clicked
'----------------------------------------------------------------
Public Function FindFieldorNode(TreeNode As Node) As Object
Dim i&, o As Object, n As CNode
    For i = 1 To Fields.Count
        If Fields(i).TreeNode Is TreeNode Then
            Set FindFieldorNode = Fields(i)
            Exit Function
        End If
    Next
    'didn't find it, query children
    For i = 1 To Children.Count
        Set o = Children(i)
        Select Case TypeName(o)
        Case "CNode"
            Set n = o
            If n.TreeNode Is TreeNode Then
                Set FindFieldorNode = n
                Exit Function
            End If
            Set o = n.FindFieldorNode(TreeNode)
            If Not o Is Nothing Then
                Set FindFieldorNode = o
                Exit Function
            End If
        Case "CMaterial"
        Case Else: Debug.Assert 0
        End Select
    Next
End Function

'----------------------------------------------------------------------------
' ReverseWinding: Reverse the polygon winding for all polygons in children
'----------------------------------------------------------------------------
Public Sub ReverseWinding()
Dim i&, swap&
    For i = 0 To Fields.Count
        Select Case Fields(i).FieldID
        Case FID_COORD, FID_NORMAL, FID_TEXCOORD
            Fields(i).ReverseWinding
        End Select
    Next
    For i = 0 To Children.Count
        Children(i).ReverseWinding
    Next
End Sub