Collection Class would appreciate code review

[cafeenman]

I don't like collections. I'm really weak with them.

Don't even get me started on Keys.

Also too, before you suggest Dictionaries, they might be better but I've never worked with them
and unless it's super-simple, I want to move on and not spend the next week learning about them.
So right now not interested in Dictionaries.

This is what's going on.

The app is very meta.

McGuffinTechs are workers who create McGuffins which are the currency.

McGuffinTechs are actually controls on the form.

They can be randomly recruited and they can randomly elope.

They get a recruitment bonus and an elopement penalty that will apply
to several things including if they get recruited again.

They can also be promoted and demoted.

If they elope, getting promoted gets more difficult.

All of this is done randomly. The only time controls are recruited on purpose
is to start the game and give the player some economy.

After that it's all die rolls.

But it is nerfed in favor the player.

I've already got another system doing the same thing in a much worse, much more convoluted and hard-to-follow and maintain way.

It doesn't maintain production counts per tech or have any kind of elopement penalties or ranks.

In fact, they don't do anything at all.

The program just adds up how many techs I've recruited and multiplies them to find out how many mcguffins
got produced that cycle.

I'm leaving it in place and slowly incorporating this into the code.

Right now it's just recruiting techs and some of them are eloping but it's not using the number in the app yet.

There are two instances of the same collection class.

The first class holds ALL techs. Think of it as Pool but even when recruited into the other class they stay in the Pool.

The second holds only those that have been recruited (and haven't eloped)

The reason I'm doing this is so that each tech maintains lifetime totals.

I could have techs move back and forth between classes but I decided I didn't want to mess with that so the Recruitment class just checks if a tech already exists before adding (recruiting) it.

I also have a flag to allow multiple instances of control arrays since I want all the controls in the Pool class but only one instance in the recruitment class.

For the sake of this (the code is already long) just assume everything got initialized properly. That is working fine.

E.g. I'm not getting any errors.

I don't want to get much farther into this if I have to do major revisions per your feedback.

Also too, I'm not worried about the numbers being generated. That's just adjusting constants and equations until I get something I like which I will work on after it's incorporated and working properly.

The code should work regardless as long as I'm not dividing by zero or something stupid like that.

Lastly, any time you see PartyMember, those are now McGuffinTechs. I haven't changed the procedure names yet but that's on the list of things to do.

Declarations (these are in a few different places but consolidated here):

' Declarations.

Private m_TechPool As cMcGuffinTechs

Private WithEvents m_TechRecruits As cMcGuffinTechs

Public Enum MCGUFFIN_TECH_RANK

  idx_McGuffinTechRank_Recruit = 0
  idx_McGuffinTechRank_Tech1
  idx_McGuffinTechRank_Tech2
  idx_McGuffinTechRank_Tech3
  idx_McGuffinTechRank_Tech4
  idx_McGuffinTechRank_Tech5
  idx_McGuffinTechRank_Tech6
  idx_McGuffinTechRank_Tech7
  idx_McGuffinTechRank_Tech8
  idx_McGuffinTechRank_Tech9

End Enum

Public Const MIN_MCGUFFIN_TECH_RANK As Long = idx_McGuffinTechRank_Recruit
Public Const MAX_MCGUFFIN_TECH_RANK As Long = idx_McGuffinTechRank_Tech9

Public Const MAX_MCGUFFIN_VALUE As Long = 10

Populating the Pool:

Private Sub CreateMcGuffinTechs()
Dim m_CallStacker As New cCallStacker
Dim m_McGuffinTech As cMcGuffinTech
Dim ctl As VB.Control

m_CallStacker.Add Name & ".CreateMcGuffinTechs(Private Sub)"

Set m_TechPool = New cMcGuffinTechs

For Each ctl In Controls

  Set m_McGuffinTech = New cMcGuffinTech

  m_McGuffinTech.Initialize ctl

  m_TechPool.Add m_McGuffinTech, True ' Load all controls into m_TechPool
                                      ' Once in, they never come out.

Next ctl

End Sub

Recruiting McGuffinTechs:

Private Function AddPartyMember(ByRef Control As VB.Control) As RANDOM_PARTY_MEMBER_JOIN
Dim m_CallStacker As New cCallStacker
Dim m_McGuffinTech As cMcGuffinTech
Dim n As Long

m_CallStacker.Add Name & ".AddPartyMember(Private Function)"

If Control Is descendent Then Exit Function

AddPartyMember = Player.PartyMemberRandomJoin(Control) ' This is the part being used currently.

' This is the new code but eventually will be replaced with

'm_TechRecruits.Recruit m_TechPool.McGuffinTech(RollDie(m_TechPool.Count))

For n = 1 To m_TechPool.Count

  If m_TechPool.McGuffinTech(n).McGuffinTechName = Control.Name Then

    m_TechRecruits.Recruit m_TechPool.McGuffinTech(n)

    m_TechRecruits.RandomElope

    Exit Function

  End If

Next n

End Function

Checking output:

Private Sub mnuCrouchingMenuVisibleSubmenu_Click()
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".mnuCrouchingMenuVisibleSubmenu_Click(Private Sub)"

AddPlayerMessage "McGuffinTechs: " & m_TechRecruits.Count

AddPlayerMessage vbCrLf & m_TechRecruits.DoProduction

Stop

End Sub

McGuffinTech Class:

Option Explicit

' Simple Counts are stored as Long Integers.

' Other Values are calculated and stored as Doubles but presented to
' the Player as  Longs to keep notifications and the interface tidy.


' // Constants, Types and Enums.

Private Const Name As String = "cMcGuffinTech"

Private Const FIRST_PROMOTION As Long = 100

' / Constants, Types and Enums.


' // Objects.

Private m_Control As VB.Control

' / Objects.


' // Events.

Public Event Promoted(ByRef McGuffinTechName As String, ByRef NewRank As MCGUFFIN_TECH_RANK)
Public Event Demoted(ByRef McGuffinTechName As String, ByRef NewRank As MCGUFFIN_TECH_RANK)

Public Event Recruited(ByRef McGuffinTechName As String, ByRef RecruitmentBonus As Long)
Public Event Eloped(ByRef McGuffinTechName As String, ByRef ElopementPenalty As Long)

Public Event DescendentDisassembled(ByRef McGuffinTechName As String, ByRef DisassembledValue As Long)

' / Events.


' // Properties.

Private nRank As MCGUFFIN_TECH_RANK

Private nRecruitments As Long
Private rRecruitmentBonus As Double

Private nElopements As Long
Private rElopementPenalty As Double

Private nPromotions As Long

Private nDemotions As Long
Private fDemoted As Boolean

Private rLifetimeCost As Double
Private rLifetimeProduction As Double

Private nDescendentsDisassembled As Long

' / Properties.

Private Sub CalculateElopementPenalty()
Dim m_CallStacker As New cCallStacker
Dim n As Long

m_CallStacker.Add Name & ".CalculateElopementPenalty(Private Sub)"

rElopementPenalty = 0

For n = MIN_MCGUFFIN_TECH_RANK To nRank

  rElopementPenalty = rElopementPenalty + RollDie(MAX_MCGUFFIN_VALUE)

Next n

End Sub
Private Sub CalculateRecruitmentBonus()
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".CalculateRecruitmentBonus(Private Sub)"

rRecruitmentBonus = RollDie(MAX_MCGUFFIN_VALUE * (1 + nRank)) * (1 - DemotionPenalty)

End Sub
Public Property Get Control() As VB.Control
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Control(Public Property Get)"

If m_Control Is Nothing Then Exit Property

Set Control = m_Control

End Property
Public Property Get CycleCost() As Double
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".CycleCost(Public Property Get)"

CycleCost = nRank + 1

End Property
Private Function Demote() As Boolean
Dim m_CallStacker As New cCallStacker
Dim n As Long

m_CallStacker.Add Name & ".Demote(Private Function)"

If (RollDie(d2) = 2) Or (nElopements = 0) Then Exit Function ' Half a chance to not get Demoted.

If nRank > idx_McGuffinTechRank_Recruit Then nRank = nRank - 1

' It counts as getting Demoted even if you're at the lowest rank.
' Don't screw-up next time.

nDemotions = nDemotions + 1

fDemoted = True

Demote = True

End Function
Public Property Get Demoted() As Boolean
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Demoted(Public Property Get)"

Demoted = fDemoted

End Property
Public Property Get DemotionPenalty() As Double
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".DemotionPenalty(Public Property Get)"

If Not fDemoted Then Exit Property

DemotionPenalty = 0.5

End Property
Public Property Get Demotions() As Long
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Demotions(Public Property Get)"

Demotions = nDemotions

End Property
Public Property Get DescendentsDisassembled() As Long
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".DescendentsDisassembled(Public Property Get)"

DescendentsDisassembled = nDescendentsDisassembled

End Property
Private Sub DisassembleDescendent()
Dim m_CallStacker As New cCallStacker
Dim nValue As Long
Dim n As Long

m_CallStacker.Add Name & ".DisassembleDescendent(Private Sub)"

If RollDie(d4) <> 4 Then Exit Sub

For n = 1 To RollDie(d4)

  nDescendentsDisassembled = nDescendentsDisassembled + 1

  nValue = DisassemblyValue

  RaiseEvent DescendentDisassembled(m_Control.Name, nValue)

  LifetimeProduction = rLifetimeProduction + nValue

Next n

End Sub
Private Function DisassemblyValue() As Long
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".DisassemblyValue(Private Function)"

DisassemblyValue = RollDie(MAX_MCGUFFIN_VALUE * (1 + nRank)) * (1 - DemotionPenalty)

End Function
Public Sub Elope()
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Elope(Public Sub)"

nElopements = nElopements + 1

rLifetimeCost = rLifetimeCost + rElopementPenalty

RaiseEvent Eloped(Name, ElopementPenalty)

End Sub
Public Property Get ElopementPenalty() As Long
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".ElopmentCost(Public Property Get)"

ElopementPenalty = CLng(rElopementPenalty)

End Property
Public Property Get Elopements() As Long
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Elopements(Public Property Get)"

Elopements = nElopements

End Property
Private Property Let Elopements(ByRef NumTimesEloped As Long)
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Elopements(Private Property Let)"

If NumTimesEloped <= nElopements Then Exit Property

nElopements = NumTimesEloped

End Property
Public Sub Initialize(ByRef Control As VB.Control)
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".LifetimeCost(Public Sub)"

If Control Is Nothing Then Exit Sub

Set m_Control = Control

End Sub
Public Property Get LifetimeCost() As Double
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".LifetimeCost(Public Property Get)"

LifetimeCost = rLifetimeCost

End Property
Public Property Get LifetimeProduction() As Double
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".LifetimeProduction(Public Property Get)"

LifetimeProduction = rLifetimeProduction

End Property
Private Property Let LifetimeProduction(ByRef ProductionByMcGuffinTech As Double)
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".LifetimeProduction(Private Property Let)"

rLifetimeProduction = ProductionByMcGuffinTech

Promote

End Property
Public Property Get McGuffinTechName() As String
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Name(Public Property Get)"

If m_Control Is Nothing Then Exit Property

McGuffinTechName = m_Control.Name

End Property
Private Property Get NextPromotionStandard() As Boolean
Dim m_CallStacker As New cCallStacker
Dim rNextPromotion
Dim n As Long

m_CallStacker.Add Name & ".NextPromotionStandard(Private Property Get)"

If nRank = MAX_MCGUFFIN_TECH_RANK Then Exit Property

For n = 1 To nRank + 1

  rNextPromotion = 2 * (n + Elopements) * FIRST_PROMOTION

Next n

If LifetimeProduction >= rNextPromotion Then

  NextPromotionStandard = True

End If

End Property
Public Property Get Production() As Double
Dim m_CallStacker As New cCallStacker
Dim rProduction As Double
Dim rRank As Double

' Returns number of McGuffins produced in a Cycle.

m_CallStacker.Add Name & ".Production(Public Property Get)"

rRank = CDbl(nRank) ' Probably not necessary but do it explicitly instead of letting VB handle it.

rProduction = ((1 + rRank) / 2) * Player.TotalMultiplier(idx_Player_Attribute_Development) * (1 - DemotionPenalty)

Production = rProduction

LifetimeProduction = rLifetimeProduction + rProduction - CycleCost

rLifetimeCost = rLifetimeCost + CycleCost

End Property
Private Sub Promote()
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Promote(Private Sub)"

If Not NextPromotionStandard Then Exit Sub

nRank = nRank + 1

nPromotions = nPromotions + 1

fDemoted = False

RaiseEvent Promoted(Name, nRank)

End Sub
Public Property Get Promotions() As Long
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Promotions(Public Property Get)"

Promotions = nPromotions

End Property
Public Property Get Rank() As MCGUFFIN_TECH_RANK
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Rank(Public Property Get)"

Rank = nRank

End Property
Public Sub Recruit()
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Recruit(Public Sub)"

nRecruitments = nRecruitments + 1

CalculateRecruitmentBonus

CalculateElopementPenalty

' Tech can be demoted if previously Eloped.

If Demote Then rElopementPenalty = rElopementPenalty * 2

LifetimeProduction = LifetimeProduction + rRecruitmentBonus

RaiseEvent Recruited(Name, RecruitmentBonus)

End Sub
Public Property Get RecruitmentBonus() As Long
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".RecruitmentBonus(Public Property Get)"

RecruitmentBonus = CLng(rRecruitmentBonus)

End Property
Public Property Get Recruitments() As Long
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Recruit(Public Property Get)"

Recruitments = nRecruitments

End Property

' Pool/Recruitment (Collection) Class:

Option Explicit

' // Constants, Types and Enums.

Private Const Name As String = "cMcGuffinTechs"

' / Constants, Types and Enums.


' // Objects.

Private colMcGuffinTechs As Collection

' / Objects.


' // Events.

Public Event Recruited(ByRef McGuffinTechName As String, ByRef RecruitmentBonus As Long)
Public Event Eloped(ByRef McGuffinTechName As String, ByRef ElopementCost As Long)
Public Event McGuffinsProduced(ByRef NumberProduced As Long)

' / Events.


Friend Function Add(ByRef McGuffinTech As cMcGuffinTech, ByRef AllowControlArrays As Boolean) As Boolean
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Class_Initialize(Friend Function)"

Add = False

' Two Collections hold cMcGuffinTechs.
' One class holds all of them.
' The second Class does not allow more than one control instance in a given array.

If Exists(McGuffinTech, AllowControlArrays) Then Exit Function

colMcGuffinTechs.Add McGuffinTech

Add = True

End Function
Public Property Get Count() As Long
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Class_Initialize(Public Property Get)"

Count = colMcGuffinTechs.Count

End Property
Public Function DoProduction() As Long
Dim m_CallStacker As New cCallStacker
Dim m_McGuffinTech As cMcGuffinTech
Dim rTotal As Double

m_CallStacker.Add Name & ".DoProduction(Public Sub)"

If colMcGuffinTechs.Count = 0 Then Exit Function

For Each m_McGuffinTech In colMcGuffinTechs

  rTotal = rTotal + m_McGuffinTech.Production

Next m_McGuffinTech

DoProduction = CLng(rTotal)

RaiseEvent McGuffinsProduced(CLng(rTotal))

End Function
Public Function Elope(ByRef McGuffinTech As cMcGuffinTech) As Boolean
Dim m_CallStacker As New cCallStacker
Dim n As Long

m_CallStacker.Add Name & ".Elope(Public Function)"

Elope = False

If colMcGuffinTechs.Count = 0 Then Exit Function

For n = 1 To colMcGuffinTechs.Count

  If colMcGuffinTechs(n) Is McGuffinTech Then

    colMcGuffinTechs(n).Elope

    colMcGuffinTechs.Remove n

    Elope = True

    RaiseEvent Eloped(McGuffinTech.McGuffinTechName, McGuffinTech.ElopementPenalty)

    Exit Function

  End If

Next n

End Function
Private Function Exists(ByRef McGuffinTech As cMcGuffinTech, ByRef AllowControlArrays As Boolean) As Boolean
Dim m_CallStacker As New cCallStacker
Dim m_McGuffinTech As cMcGuffinTech

m_CallStacker.Add Name & ".Exists(Private Function)"

Exists = False

If colMcGuffinTechs.Count = 0 Then Exit Function

If AllowControlArrays Then

  For Each m_McGuffinTech In colMcGuffinTechs

    If m_McGuffinTech Is McGuffinTech Then

      Exists = True

      Exit Function

    End If

  Next m_McGuffinTech

Else

  For Each m_McGuffinTech In colMcGuffinTechs

    If m_McGuffinTech.McGuffinTechName = McGuffinTech.McGuffinTechName Then

      Exists = True

      Exit Function

    End If

  Next m_McGuffinTech

End If

End Function
Public Property Get McGuffinTech(ByRef Index As Long) As cMcGuffinTech
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".McGuffinTech(Public Property Get)"

If (Index < 1) Or (Index > colMcGuffinTechs.Count) Then Exit Property

Set McGuffinTech = colMcGuffinTechs(Index)

End Property
Public Function RandomElope() As Boolean
Dim m_CallStacker As New cCallStacker
Dim m_McGuffinTech As cMcGuffinTech

m_CallStacker.Add Name & ".RandomElope(Public Function)"

If colMcGuffinTechs.Count = 0 Then Exit Function

If RollDie(d8) <> 1 Then Exit Function

Set m_McGuffinTech = colMcGuffinTechs(RollDie(colMcGuffinTechs.Count))

RandomElope = Elope(m_McGuffinTech)

End Function
Public Function Recruit(ByRef McGuffinTech As cMcGuffinTech) As Boolean
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".McGuffinTech(Public Function)"

If Add(McGuffinTech, False) Then

  McGuffinTech.Recruit

  Recruit = True

End If

End Function
Private Sub Class_Initialize()
Dim m_CallStacker As New cCallStacker

m_CallStacker.Add Name & ".Class_Initialize(Private Sub)"

Set colMcGuffinTechs = New Collection

End Sub