mfvec3f.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 = "MFVec3f"
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: holds an array of x,y,z values defining vertices
'AUTHOR: edx - [e-mail], Oct 98 - all rights reserved
'HISTORY: -
'NOTES: - this class is used to hold vertex data, which is 3 points
'*************************************************************************
Public FieldID As FieldNameIDConstants
Public ID&
Public ChunkID%
Public Parent As CNode
Public TreeNode As Node
'
Dim m_Count&
Dim m_Values() As POINT3F
'

Private Sub Class_Initialize()
    '
End Sub

Private Sub Class_Terminate()
'
End Sub

'----------------------------------------------------------------------------
'set the points defining a vertex
'----------------------------------------------------------------------------
Public Sub SetValue(Index&, v!())
    If Index > m_Count Then
        Debug.Assert 0
        ReDim Preserve m_Values(0 To Index)
        m_Count = Index + 1
    End If
    m_Values(Index).p(0) = v(0)
    m_Values(Index).p(1) = v(1)
    m_Values(Index).p(2) = v(2)
End Sub

Public Sub GetValue(Index&, v!())
    v(0) = m_Values(Index).p(0)
    v(1) = m_Values(Index).p(1)
    v(2) = m_Values(Index).p(2)
End Sub

'----------------------------------------------------------------------------
'you must set the count before adding values to this class.
'----------------------------------------------------------------------------
Public Property Get Count&()
    Count = m_Count
End Property

Public Property Let Count(ByVal NewValue&)
    If NewValue > 0 Then
        ReDim m_Values(0 To NewValue - 1)
        m_Count = NewValue
    Else
        ReDim m_Values(0 To 0)
        m_Count = 0
    End If
End Property

'----------------------------------------------------------------------------
'add this object to the treeview
'----------------------------------------------------------------------------
Public Sub FillTree()
    Set TreeNode = frmMain.TV1.Nodes.Add(Parent.TreeNode, tvwChild, , ChunkName(ChunkID), IMG_FIELD)
End Sub

'Public Sub Draw()
'    glVertexPointer 3, GL_FLOAT, Len(m_Values(1)), m_Values(0).p(0)
'End Sub

'----------------------------------------------------------------------------
'return a ptr to the array, if drawing is to be done elsewhere
'----------------------------------------------------------------------------
Public Function DataPointer&()
    DataPointer = VarPtr(m_Values(0).p(0))
End Function

'----------------------------------------------------------------------------
' for gl drawing routines
'----------------------------------------------------------------------------
Public Property Get Stride&()
    Stride = Len(m_Values(1))
End Property

'----------------------------------------------------------------------------
' Scales a model by a given amount.
' scale - scalefactor (0.5 = half as large, 2.0 = twice as large)
' from glm, not tested
'----------------------------------------------------------------------------
Public Sub Scalef(scalefactor!)
Dim i&
    For i = 0 To m_Count - 1
        m_Values(i).p(0) = m_Values(i).p(0) * scalefactor
        m_Values(i).p(1) = m_Values(i).p(1) * scalefactor
        m_Values(i).p(2) = m_Values(i).p(2) * scalefactor
    Next
End Sub

'----------------------------------------------------------------------------
' "unitize" a model by translating it to the origin and
' scaling it to fit in a unit cube around the origin.  Returns the
' scalefactor used.
' from glm, not tested
'----------------------------------------------------------------------------
Public Function Unitize!()
Dim i&, MaxX!, MinX!, MaxY!, MinY!, MaxZ!, MinZ!
Dim cx!, cy!, cz!, w!, h!, d!, scalefactor!
    If m_Count = 0 Then
        Debug.Assert 0
        Unitize = 1
        Exit Function
    End If
    If m_Count = 0 Then Exit Function
    ' get the max/mins
    MaxX = m_Values(0).p(0)
    MinX = m_Values(0).p(0)
    MaxY = m_Values(0).p(1)
    MinY = m_Values(0).p(1)
    MaxZ = m_Values(0).p(2)
    MinZ = m_Values(0).p(2)
    For i = 0 To m_Count - 1
        If MaxX < m_Values(i).p(0) Then MaxX = m_Values(i).p(0)
        If MinX > m_Values(i).p(0) Then MinX = m_Values(i).p(0)
        If MaxY < m_Values(i).p(1) Then MaxY = m_Values(i).p(1)
        If MinY > m_Values(i).p(1) Then MinY = m_Values(i).p(1)
        If MaxZ < m_Values(i).p(2) Then MaxZ = m_Values(i).p(2)
        If MinZ > m_Values(i).p(2) Then MinZ = m_Values(i).p(2)
    Next

    ' calculate model width, height, and depth
    w = Abs(MaxX) + Abs(MinX)
    h = Abs(MaxY) + Abs(MinY)
    d = Abs(MaxZ) + Abs(MinZ)

    ' calculate center of the model
    cx = (MaxX + MinX) / 2
    cy = (MaxY + MinY) / 2
    cz = (MaxZ + MinZ) / 2

    ' calculate unitizing scale factor
    scalefactor = 2 / Maxf(Maxf(w, h), d)

    ' translate around center then scale
    For i = 1 To m_Count
        m_Values(i).p(0) = m_Values(i).p(0) - cx
        m_Values(i).p(1) = m_Values(i).p(1) - cy
        m_Values(i).p(2) = m_Values(i).p(2) - cz
        m_Values(i).p(0) = m_Values(i).p(0) * scalefactor
        m_Values(i).p(1) = m_Values(i).p(1) * scalefactor
        m_Values(i).p(2) = m_Values(i).p(2) * scalefactor
    Next

    Unitize = scalefactor
End Function

'----------------------------------------------------------------------------
' Calculates the dimensions (width, height, depth) of
' a model
' dimensions - array of 3 GLfloats (GLfloat dimensions(0 to 2))
' from glm, not tested
'----------------------------------------------------------------------------
Public Sub GetDimensions(v3!())
Dim i&, MaxX!, MinX!, MaxY!, MinY!, MaxZ!, MinZ!
    ' get the max/mins
    MaxX = m_Values(0).p(0)
    MinX = m_Values(0).p(0)
    MaxY = m_Values(0).p(1)
    MinY = m_Values(0).p(1)
    MaxZ = m_Values(0).p(2)
    MinZ = m_Values(0).p(2)
    For i = 0 To m_Count - 1
        If MaxX < m_Values(i).p(0) Then MaxX = m_Values(i).p(0)
        If MinX > m_Values(i).p(0) Then MinX = m_Values(i).p(0)
        If MaxY < m_Values(i).p(1) Then MaxY = m_Values(i).p(1)
        If MinY > m_Values(i).p(1) Then MinY = m_Values(i).p(1)
        If MaxZ < m_Values(i).p(2) Then MaxZ = m_Values(i).p(2)
        If MinZ > m_Values(i).p(2) Then MinZ = m_Values(i).p(2)
    Next

    ' calculate model width, height, and depth
    v3(0) = Abs(MaxX) + Abs(MinX)
    v3(1) = Abs(MaxY) + Abs(MinY)
    v3(2) = Abs(MaxZ) + Abs(MinZ)
End Sub


'----------------------------------------------------------------------------
' glmWeld: eliminate (weld) vectors that are within an epsilon of
' each other.
' *
' model      - initialized GLMmodel structure
' epsilon    - maximum difference between vertices
'              ( 0.00001 is a good start for a unitized model)
' from glm, not tested
'----------------------------------------------------------------------------
Public Sub Weld(epsilon!)
'Dim copies!()
'Dim numvectors&
'Dim i&
'
'    ' vertices
'    numvectors = m_NumVertices
'    ReDim copies(0 To numvectors - 1)
'    numvectors = m_WeldVectors(m_Vertices, numvectors, epsilon, copies)
'
'    Debug.Print "Weld(): " & (m_NumVertices - numvectors - 1) & " redundant vertices."
'
'    For i = 0 To m_NumTriangles - 1
'        m_Triangles(i).Vindices(0) = m_Vertices(3 * m_Triangles(i).Vindices(0) + 0)
'        m_Triangles(i).Vindices(1) = m_Vertices(3 * m_Triangles(i).Vindices(1) + 0)
'        m_Triangles(i).Vindices(2) = m_Vertices(3 * m_Triangles(i).Vindices(2) + 0)
'    Next
'
'    ' free space for old vertices
'    Erase m_Vertices
'
'    ' allocate space for the new vertices
'    NumVertices = numvectors
'
'    ' copy the optimized vertices into the actual vertex list
'    For i = 1 To m_NumVertices
'        m_Vertices(3 * i + 0) = copies(3 * i + 0)
'        m_Vertices(3 * i + 1) = copies(3 * i + 1)
'        m_Vertices(3 * i + 2) = copies(3 * i + 2)
'    Next
'
'    'free copies
'    Erase copies
''#if 0
''  ' normals
''  if (m_numnormals then
''  numvectors = m_numnormals;
''  vectors    = m_normals;
''  copies = _glmOptimizeVectors(vectors, &numvectors);
''
''  debug.print("glmOptimize(): %d redundant normals.\n",
''     m_numnormals - numvectors);
''
''  for (i = 0; i < m_numtriangles; i++) {
''    m_Triangles(i).nindices(0) = (GLuint)vectors(3 * m_Triangles(i).nindices(0) + 0);
''    m_Triangles(i).nindices(1) = (GLuint)vectors(3 * m_Triangles(i).nindices(1) + 0);
''    m_Triangles(i).nindices(2) = (GLuint)vectors(3 * m_Triangles(i).nindices(2) + 0);
''  }
''
''  ' free space for old normals
''  free(vectors);
''
''  ' allocate space for the new normals
''  m_numnormals = numvectors;
''  m_normals = (GLfloat*)malloc(sizeof(GLfloat) *
''                    3 * (m_numnormals + 1));
''
''  ' copy the optimized vertices into the actual vertex list
''  for (i = 1; i <= m_numnormals; i++) {
''    m_normals(3 * i + 0) = copies(3 * i + 0);
''    m_normals(3 * i + 1) = copies(3 * i + 1);
''    m_normals(3 * i + 2) = copies(3 * i + 2);
''  }
''
''  free(copies);
''  }
''
''  ' texcoords
''  if (m_numtexcoords then
''  numvectors = m_numtexcoords;
''  vectors    = m_texcoords;
''  copies = _glmOptimizeVectors(vectors, &numvectors);
''
''  debug.print("glmOptimize(): %d redundant texcoords.\n",
''     m_numtexcoords - numvectors);
''
''  for (i = 0; i < m_numtriangles; i++) {
''    for (j = 0; j < 3; j++) {
''      m_Triangles(i).tindices(j) = (GLuint)vectors(3 * m_Triangles(i).tindices(j) + 0);
''    }
''  }
''
''  ' free space for old texcoords
''  free(vectors);
''
''  ' allocate space for the new texcoords
''  m_numtexcoords = numvectors;
''  m_texcoords = (GLfloat*)malloc(sizeof(GLfloat) *
''                      2 * (m_numtexcoords + 1));
''
''  ' copy the optimized vertices into the actual vertex list
''  for (i = 1; i <= m_numtexcoords; i++) {
''    m_texcoords(2 * i + 0) = copies(2 * i + 0);
''    m_texcoords(2 * i + 1) = copies(2 * i + 1);
''  }
''
''  free(copies);
''  }
''#End If
'
''#If 0 Then
''  ' look for unused vertices
''  ' look for unused normals
''  ' look for unused texcoords
''  for (i = 1; i <= m_numvertices; i++) {
''    for (j = 0; j < m_numtriangles; i++) {
''      if (m_Triangles(j).vindices(0) == i ||
''      m_Triangles(j).vindices(1) == i ||
''      m_Triangles(j).vindices(1) == i)
''    break;
''    }
''  }
''#End If
End Sub

'----------------------------------------------------------------------------
' _glmWeldVectors: eliminate (weld) vectors that are within an
' epsilon of each other.
' *
' vectors    - array of GLfloat(0 to 2)'s to be welded
' numvectors - number of GLfloat(0 to 2)'s in vectors
' epsilon    - maximum difference between vectors
' from glm, not tested
'----------------------------------------------------------------------------
Private Function m_WeldVectors&(vectors!(), numvectors&, epsilon!, copies!())
'Dim NumCopied&, i&, j&
'    'copies = (GLfloat*)malloc(sizeof(GLfloat) * 3 * (*numvectors + 1));
'    'memcpy(copies, vectors, (sizeof(GLfloat) * 3 * (*numvectors + 1)));
'
'    NumCopied = 1
'    For i = 1 To numvectors
'        j = 1
'        Do While j <= NumCopied
'            If m_Equal(vectors, 3 * i, copies, 3 * j, epsilon) Then
'                GoTo duplicate
'            End If
'        Loop
'
'        ' must not be any duplicates -- add to the copies array
'        copies(3 * NumCopied + 0) = vectors(3 * i + 0)
'        copies(3 * NumCopied + 1) = vectors(3 * i + 1)
'        copies(3 * NumCopied + 2) = vectors(3 * i + 2)
'        j = NumCopied          ' pass this along for below
'        NumCopied = NumCopied + 1
'
'duplicate:
'    ' set the first component of this vector to point at the correct
'    '   index into the new copies array
'    vectors(3 * i + 0) = j
'    Next
'
'    numvectors = NumCopied - 1
'    m_WeldVectors = numvectors
End Function

'----------------------------------------------------------------------------
' Reverse the polygon winding
'----------------------------------------------------------------------------
Public Sub ReverseWinding()
Dim i&, swap&
    Select Case FieldID
    Case FID_NORMAL
        ' reverse vertex normals
        For i = 1 To m_Count
            m_Values(i).p(0) = -m_Values(i).p(0)
            m_Values(i).p(1) = -m_Values(i).p(1)
            m_Values(i).p(2) = -m_Values(i).p(2)
        Next
    End Select
End Sub