ctextures.cls

来自「3ds文件浏览程序」· CLS 代码 · 共 86 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CTextures"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'*************************************************************************
'FUNCTION: collection of textures.
'AUTHOR: VB wizard
'HISTORY: -
'NOTES: the glxTextures are kept in memory in case we want to
'implement various texture effects and find we need to modify
'the texture.
'*************************************************************************
Private mCol As Collection

Private Sub Class_Initialize()
    Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
    Set mCol = Nothing
End Sub

Public Function Add(Filename As String) As CTexture
Dim Tex As CTexture, i&
On Error GoTo ErrorHandler
    For i = 1 To mCol.Count
        If mCol(i).Filename = Filename Then
            Set Add = mCol(i)
            Exit Function
        End If
    Next
    'the file hasn't been loaded yet
    Set Tex = New CTexture
    Tex.Filename = Filename
    mCol.Add Tex
    Set Add = Tex
'----------------------------------------------------
Exit Function
ErrorHandler:
    Debug.Assert 0
    Debug.Print Err.Description
    Exit Function
    Resume Next
End Function

Public Property Get Item(Name$) As CMaterial
Attribute Item.VB_UserMemId = 0
    Set Item = mCol(Name)
End Property

Public Property Get ItemFromIndex(Index&) As CMaterial
    Set ItemFromIndex = mCol(Index)
End Property

Public Property Get Count() As Long
    Count = mCol.Count
End Property

Public Sub Remove(Index&)
    mCol.Remove Index
End Sub

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = mCol.[_NewEnum]
End Property

Public Sub Clear()
Dim i&
    For i = 1 To mCol.Count
        mCol.Remove 1
    Next
End Sub