Content Supported by Sourcelens Consulting
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "SmallBusiness2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' >> Best viewed in Full Module view. <<
'
' Storage for debug ID number.
Private mlngDebugID As Long
Implements IDebug
' Private Collection object is slightly
' more robust than a public Collection
' object, but it has problems.
Private colEmployees As New Collection
' Problem 1: The collection is private,
' so the Add method has to be part of
' the SmallBusiness2 class. Since
' there may be many kinds of objects in
' a business, there may be many such
' methods, such as AddProduct.
'
Public Function AddEmployee(ByVal Name As String, ByVal Salary As Double) As Employee
Dim empNew As New Employee
Static intEmpNum As Integer
' Using With shortens property references (.ID instead of empNew.ID)
' and speeds up execution.
With empNew
' Generate a unique ID for the new employee.
intEmpNum = intEmpNum + 1
.ID = "E" & Format$(intEmpNum, "00000")
.Name = Name
.Salary = Salary
' Add the Employee object reference to the collection, using its
' ID property as the key.
colEmployees.Add empNew, .ID
End With
' The Add method should return a reference to
' the new object.
Set AddEmployee = empNew
End Function
' Problem 1, continued: There will also
' be Count functions for all the
' different business objects, and
' Delete methods, and so on. Even
' with just Employee objects, the
' SmallBusiness2 class becomes very
' cluttered.
'
Public Function EmployeeCount() As Long
EmployeeCount = colEmployees.Count
End Function
Public Sub DeleteEmployee(ByVal Index As Variant)
colEmployees.Remove Index
End Sub
' Problem 2: The Employees method can't
' be used with For Each. You could make
' it work with For Each by returning a
' reference to the private collection,
' but then it's not a private collection
' any more, and you're right back in
' the House of Straw.
'
Public Function Employees(ByVal Index As Variant) As Employee
Set Employees = colEmployees.Item(Index)
End Function
' Problem 3: It's still possible for
' coding errors, this time within the
' vastly more complicated SmallBusiness
' object, to add invalid objects to the
' collection.
Public Sub Trouble()
Dim X As New Employee
' Because the Collection object accepts
' a reference to any object, it's
' still possible for an internal
' coding error to add an uninitialized
' Employee object.
colEmployees.Add X
End Sub
Private Sub Class_Initialize()
mlngDebugID = DebugInit(Me)
End Sub
Private Sub Class_Terminate()
DebugTerm Me
End Sub
' -------- IDebug Implementation --------
'
' IDebug.DebugID gives you a way to tell
' ====== ------- objects apart. It's
' required by the DebugInit, DebugTerm,
' and DebugShow debugging procedures
' declared in modFriend.
'
Private Property Get IDebug_DebugID() As Long
IDebug_DebugID = mlngDebugID
End Property