Why use composition?

[tiredofit]

Standard module:

Option Explicit

Dim TheCar As Car

Sub MyCarExperience()
    CreateNewCar
    FillFuel
    DriveTheCar
    
    Dim CarTyreState As Double
    CarTyreState = TheCar.TheTyre.TyreCondition
    
    If CarTyreState < 40 Then
        MsgBox "Car Tyre Condition: " & CarTyreState & "." _
        & vbNewLine & "We will replace tyres now"

        Set TheCar.TheTyre = New Tyre
        
        MsgBox "Car tyres have been replaced."
        MsgBox "Car Tyre Condition: " & CarTyreState & "."
    End If
    
    Set TheCar = Nothing
End Sub

Sub CreateNewCar()
    Set TheCar = New Car
    
    With TheCar
        .Make = "Ford"
        .Model = "Figo"
        .FuelType = "Petrol"
        .FuelCapacity = 40
        .FuelLevel = 0
        .MaxSpeed = 160
        
        MsgBox "The car " & .Make & " - " & _
        .Model & " has been created!"
    End With
End Sub

Sub FillFuel()
    TheCar.AddFuel 30
End Sub

Sub DriveTheCar()
    With TheCar
        .StartCar
        
        .TheGear.GearUp
        .AccelerateTo 10
        .TheGear.GearUp
        .AccelerateTo 50
        .TheGear.GearUp
        .AccelerateTo 100
        .TheGear.GearUp
        .AccelerateTo 120
        .TheGear.GearUp
        .AccelerateTo 155
        .TheGear.GearUp
        .AccelerateTo 200
        
        .TheGear.GearDown
        .DeAccelerateTo 155
        .TheGear.GearDown
        .DeAccelerateTo 120
        .TheGear.GearDown
        .DeAccelerateTo 60
        .TheGear.GearDown
        .DeAccelerateTo 30
        .TheGear.GearDown
        .DeAccelerateTo 0
        
        .StopCar
    End With
End Sub

Class Car

Option Explicit

Private CarMake As String
Private CarModel As String
Private CarFuelType As String
Private CarFuelLevel As Double
Private CarFuelCapacity As Double
Private CarSpeed As Double

Private CurrentCarSpeed As Double

'Private CarGear As New Gear
Public WithEvents CarGear As Gear

Private IsCarStarted As Boolean

Private CarTyre As Tyre

Public Sub CarGear_GearChanged(OldGearNo As Long, NewGearNo As Long)
    MsgBox "Gear moved from " & OldGearNo & " to " & NewGearNo
End Sub

Public Sub Class_Initialize()
    Set CarGear = New Gear
    Set CarTyre = New Tyre
End Sub

'~~> Tyre of the car
Public Property Get TheTyre() As Tyre
    Set TheTyre = CarTyre
End Property
Public Property Set TheTyre(Value As Tyre)
    Set CarTyre = Value
End Property

'~~> Gear of the car
Public Property Get TheGear() As Gear
    Set TheGear = CarGear
End Property

'~~> Make of the car
Public Property Get Make() As String
    Make = CarMake
End Property

Public Property Let Make(Value As String)
    CarMake = Value
End Property

'~~> Model of the car
Public Property Get Model() As String
    Model = CarModel
End Property

Public Property Let Model(Value As String)
    CarModel = Value
End Property

'~~> Fuel Type of the car
Public Property Get FuelType() As String
    FuelType = CarFuelType
End Property

Public Property Let FuelType(Value As String)
    CarFuelType = Value
End Property

'~~> Fuel Level of the car
Public Property Get FuelLevel() As Double
    FuelLevel = CarFuelLevel
End Property

Public Property Let FuelLevel(Value As Double)
    CarFuelLevel = Value
End Property

'~~> Fuel Capacity of the car
Public Property Get FuelCapacity() As Double
    FuelCapacity = CarFuelCapacity
End Property

Public Property Let FuelCapacity(Value As Double)
    CarFuelCapacity = Value
End Property

'~~> Max speed of the car
Public Property Get MaxSpeed() As Double
    MaxSpeed = CarSpeed
End Property

Public Property Let MaxSpeed(Value As Double)
    CarSpeed = Value
End Property

'~~> Adding Fuel to car
Sub AddFuel(Qty As Double)
    '~~> Check if fuel can be added
    If FuelLevel + Qty > CarFuelCapacity Then
        MsgBox "The fuel capacity of the car is " & _
        CarFuelCapacity & " ltrs. The " & Qty & " ltrs fuel that " & _
        "you are trying to add will overflow the tank."
    ElseIf Qty < 0 Then
        MsgBox "Fuel value cannot be negative!"
    Else
        FuelLevel = FuelLevel + Qty
        MsgBox Qty & " ltrs have been added. The car now has " & _
        FuelLevel & " ltrs."
    End If
End Sub

'~~> Start Car
Public Function StartCar() As Boolean
    '~~> Check if car has fuel
    If FuelLevel = 0 Then
        MsgBox "You need to fill fuel first"
        Exit Function
    End If
    
    IsCarStarted = True
    StartCar = True
    
    CurrentCarSpeed = 0
    CarGear.GearNumber = 0
    
    MsgBox "Ignition is turned on"
End Function

'~~> Stop Car
Public Sub StopCar()
    '~~> Set carsepped to 0
    CurrentCarSpeed = 0
    
    '~~> Set current gear to 0
    CarGear.GearNumber = 0
    
    IsCarStarted = False
    MsgBox "Ignition is turned off"
End Sub

Public Sub AccelerateTo(IncreaseSpeedTo As Double)
    '~~> Check if car has started
    If Not IsCarStarted Then
        MsgBox "You need to start the car first"
        Exit Sub
    End If
    
    '~~> Check for max speed
    If IncreaseSpeedTo > MaxSpeed Then
        CurrentCarSpeed = MaxSpeed
        MsgBox "Max speed reached. Can't accelerate any further!"
    Else
        CurrentCarSpeed = IncreaseSpeedTo
        
        CarTyre.TyreCondition = CarTyre.TyreCondition - 7
        
        If TheTyre.TyreCondition < 40 Then
            MsgBox "Accelerating: The new car speed is " & CurrentCarSpeed & "." _
            & vbNewLine & "Car Tyre Condition : " & CarTyre.TyreCondition & "." _
            & vbNewLine & "Alert: Change car tyres as soon as possible."
        Else
            MsgBox "Accelerating: The new car speed is " & CurrentCarSpeed & "." _
            & vbNewLine & "Car Tyre Condition : " & CarTyre.TyreCondition
        End If
    End If
End Sub

Public Sub DeAccelerateTo(ReduceSpeedTo As Double)
    '~~> Check if car has started
    If Not IsCarStarted Then
        MsgBox "You need to start the caer first"
        Exit Sub
    End If
    
    '~~> Check if car is standstill
    If ReduceSpeedTo < 0 Then
        CurrentCarSpeed = 0
        MsgBox "Car is standstill!"
    Else
        CurrentCarSpeed = ReduceSpeedTo
        
        CarTyre.TyreCondition = CarTyre.TyreCondition - 7
        
        If TheTyre.TyreCondition < 40 Then
            MsgBox "Deaccelerating: The new car speed is " & CurrentCarSpeed & "." _
            & vbNewLine & "Car Tyre Condition : " & CarTyre.TyreCondition & "." _
            & vbNewLine & "Change car tyres as soon as possible."
        Else
            MsgBox "Deaccelerating: The new car speed is " & CurrentCarSpeed & "." _
            & vbNewLine & "Car Tyre Condition : " & CarTyre.TyreCondition
        End If
    End If
End Sub

Class Gear

Option Explicit

Private CurrentGear As Long

Public Event GearChanged(OldGearNo As Long, NewGearNo As Long)

'~~> Gear Number
Public Property Get GearNumber() As Long
    GearNumber = CurrentGear
End Property

Public Property Let GearNumber(Value As Long)
    Dim oldGear As Long
    oldGear = CurrentGear
    CurrentGear = Value
    If oldGear <> CurrentGear Then RaiseEvent GearChanged(oldGear, CurrentGear)
End Property

'~~> Shift Gear up
Public Function GearUp() As Boolean
    If GearNumber < 5 Then
        GearNumber = GearNumber + 1
        GearUp = True
        'MsgBox "Gear moved from " & GearNumber - 1 & " to " & GearNumber
    Else
        MsgBox "Top gear reached."
    End If
End Function

'~~> Shift Gear down
Public Function GearDown() As Boolean
    If GearNumber > 0 Then
        GearNumber = GearNumber - 1
        GearDown = True
        'MsgBox "Gear moved from " & GearNumber + 1 & " to " & GearNumber
    Else
        MsgBox "Gear is in neutral"
    End If
End Function

Class Tyre

Option Explicit

Dim CarTyreCondition As Long

Private Sub Class_Initialize()
    CarTyreCondition = 100
End Sub

Public Property Let TyreCondition(Value As Long)
    CarTyreCondition = Value
End Property

Public Property Get TyreCondition() As Long
    TyreCondition = CarTyreCondition
End Property

What I don't understand is the point of composition in the above example.

Instead, is it not simpler to create a new variable in the Standard module that references the class Gear, eg:

Dim abc As Gear

then write the following:

Sub DriveTheCar()
    With TheCar
        .StartCar
        
        abc.GearUp
        .AccelerateTo 10
                abc.GearUp
        .AccelerateTo 50
               abc.GearUp
        .AccelerateTo 100
               .abc.GearUp
        .AccelerateTo 120
               .abc.GearUp
        .AccelerateTo 155
               .abc.GearUp
        .AccelerateTo 200
        
        'etc.

    End With
End Sub

Thanks

 

[RoryA]

Why would you create and manipulate a gear independent of the car?

 

[tiredofit]

Why would you create and manipulate a gear independent of the car?

So I suppose the point has to do with relationships, making Car related to Gear?

 

[RoryA]

Yes, it's a much more logical construction.