VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "RabbitCollection3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"clsRabbit3"
Attribute VB_Ext_KEY = "Member0" ,"clsRabbit3"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
' Guide to the Perplexed - Rabbit Test
' Copyright (c) 1997 by Desaware Inc. all Rights Reserved

Option Explicit

'local variable to hold collection
Private m_Hutch As Collection

' Delegate to the collection
Public Sub Add()
    'create a new object
    Dim obj As New clsRabbit3

    m_Hutch.Add obj
End Sub



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


Public Property Get Item(IndexKey As Long) As clsRabbit3
Attribute Item.VB_UserMemId = 0
    Set Item = m_Hutch(IndexKey)
End Property


Public Sub Remove(IndexKey As Long)
    m_Hutch.Remove IndexKey
End Sub


' Enable For...Each support
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    Set NewEnum = m_Hutch.[_NewEnum]
End Property

' Initialize and destruct the internal collection

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


Private Sub Class_Terminate()
    Set m_Hutch = Nothing
End Sub

' The AddExisting function should not be exposed externally
Friend Sub AddExisting(ExistingRabbit As clsRabbit3)
    m_Hutch.Add ExistingRabbit
End Sub

' Function to obtain a new collection containing
' only white rabbits
Public Function GetWhiteRabbits() As RabbitCollection3
    Dim col As New RabbitCollection3
    Dim obj As clsRabbit3
    For Each obj In m_Hutch
        If obj.Color = "White" Then
            col.AddExisting obj
        End If
    Next
    Set GetWhiteRabbits = col
End Function
