Changes to a class factory

[tiredofit]

This video shows how to create a class factory, which also allows touches upon polymorphism:

https://www.youtube.com/watch?v=rZ96jR_y4gY

and looks like this:

Here is some of the code:

' Class module cat:

' Cat class derived from Animal interface
Option Explicit

 ' Implements Animal interface requiring the name, age and weight.
Implements animal

Private name_ As String
Private age_ As Long
Private breed_ As String
Private weight_ As Double
Private legs_ As Integer
Private likes_ As Variant
Private arrivalDate_ As Date
Private readyToHouse_ As Boolean
Private icon_ As Shape
Private meow_ As String ' unique to the Cat class

Private Sub Class_Initialize()
    legs_ = 4
    meow_ = "Meoww!"
   '  Set icon_ = Sheets("Icons").Shapes("catPic")
End Sub

Public Sub Init(rng As Range)
    name_ = rng.Cells(1, 1)
    age_ = rng.Cells(1, 3)
    breed_ = rng.Cells(1, 4)
    weight_ = rng.Cells(1, 5)
    likes_ = Split(CStr(rng.Cells(1, 7).Value), ",")
    arrivalDate_ = rng.Cells(1, 6)
    If (rng.Cells(1, 8) = "Y") Then readyToHouse_ = True
End Sub

Public Sub PrintOut()
Debug.Print name_, TypeName(Me), age_, breed_, weight_, arrivalDate_, readyToHouse_, legs_, daysHoused;
End Sub

Public Property Get readyToHouse() As Boolean
    readyToHouse = readyToHouse_
End Property

Private Sub Class_Terminate()
    ' Debug.Print "Cat class instance deleted, meow! (Goodbye)"
End Sub

Public Property Get Legs() As Integer
    Legs = legs_
End Property

Public Property Get Breed() As String
    Breed = breed_
End Property

Public Property Get name() As String
    name = name_
End Property

Public Property Let name(ByVal Value As String)
    name_ = Value
End Property

Public Property Get Age() As Long
    Age = age_
End Property

Public Property Let Age(ByVal Value As Long)
    age_ = Value
End Property

Public Property Get Weight() As Double
    Weight = weight_
End Property

Public Property Let Weight(ByVal Value As Double)
    weight_ = Value
End Property

Public Property Get likes() As Collection
    Set likes = likes_
End Property

Public Property Set likes(Value As Collection)
    Set likes_ = Value
End Property

Public Property Get Talk() As String
    Talk = meow_
End Property

Public Property Get Meow() As String
    Meow = "The cat says: " & meow_
End Property

Public Property Let Talk(ByVal Value As String)
    meow_ = Value
End Property

Public Property Get daysHoused() As Integer
    daysHoused = Now() - arrivalDate_
End Property

' Implement required interface properties
Private Property Get Animal_Name() As String
    Animal_Name = name
End Property

Private Property Get Animal_Age() As Long
    Animal_Age = Age
End Property

Private Property Get Animal_Weight() As Double
    Animal_Weight = Weight
End Property

Private Property Get Animal_Talk() As String
    Animal_Talk = Meow
End Property

class module dog:

' Dog class derived from Animal interface
Option Explicit

 ' Implements Animal interface requiring the name, age and weight.
Implements animal

Private name_ As String
Private age_ As Long
Private breed_ As String
Private weight_ As Double
Private legs_ As Integer
Private arrivalDate_ As Date
Private likes_ As Variant
Private icon_ As Shape
Private bark_ As String ' unique to the Dog class
Private readyToHouse_ As Boolean

Private Sub Class_Initialize()
    legs_ = 4
    bark_ = "Woof!"
    ' Set icon_ = Sheets("Icons").Shapes("fishPic")
End Sub

Public Sub Init(rng As Range)
    name_ = rng.Cells(1, 1)
    age_ = rng.Cells(1, 3)
    breed_ = rng.Cells(1, 4)
    weight_ = rng.Cells(1, 5)
    arrivalDate_ = rng.Cells(1, 6)
        likes_ = Split(CStr(rng.Cells(1, 7).Value), ",")
    If (rng.Cells(1, 8) = "Y") Then readyToHouse_ = True
End Sub

Public Sub PrintOut()
Debug.Print name_, TypeName(Me), age_, breed_, weight_, arrivalDate_, readyToHouse_, legs_, daysHoused;
End Sub

Public Property Get Breed() As String
    Breed = breed_
End Property

Public Property Get readyToHouse() As Boolean
    readyToHouse = readyToHouse_
End Property

Private Sub Class_Terminate()
    ' Debug.Print "Dog class instance deleted, woof! (Goodbye)"
End Sub

Public Property Get Legs() As Integer
    Legs = legs_
End Property

Public Property Get name() As String
    name = name_
End Property

Public Property Let name(ByVal Value As String)
    name_ = Value
End Property

Public Property Get Age() As Long
    Age = age_
End Property

Public Property Let Age(ByVal Value As Long)
    age_ = Value
End Property

Public Property Get Weight() As Double
    Weight = weight_
End Property

Public Property Let Weight(ByVal Value As Double)
    weight_ = Value
End Property

Public Property Get Bark() As String
    Bark = "The dog says: " & bark_
End Property

Public Property Get Talk() As String
    Talk = bark_
End Property

Public Property Let Talk(ByVal Value As String)
    bark_ = Value
End Property

Public Property Get likes() As Collection
    Set likes = likes_
End Property

Public Property Set likes(Value As Collection)
    Set likes_ = Value
End Property

Public Property Get daysHoused() As Integer
    daysHoused = Now() - arrivalDate_
End Property

Private Property Get Animal_Name() As String
    Animal_Name = name
End Property

Private Property Get Animal_Age() As Long
    Animal_Age = Age
End Property

Private Property Get Animal_Weight() As Double
    Animal_Weight = Weight
End Property

Private Property Get Animal_Talk() As String
    Animal_Talk = Bark
End Property

What I don't understand is if some new data was pasted onto the spreadsheet that contained a new animal, eg elephant, how would the program work?

Would the programmer have to create a new class called elephant beforehand?

Thanks

 

[Domenic]

Yes, that's right. You would have to create an Elephant class.

Notice, though, while it implements an Animal interface class, it doesn't actually use the interface properties. That's probably because the tutorial is on classes in general, not interface classes, and the code is there for some another tutorial.

 

[tiredofit]

Yes, that's right. You would have to create an Elephant class.

Notice, though, while it implements an Animal interface class, it doesn't actually use the interface properties. That's probably because the tutorial is on classes in general, not interface classes, and the code is there for some another tutorial.

Thanks for clarifying.

 

[Domenic]

You're very welcome, cheers!