[RESOLVED] Item not being removed someplace (transfer between collection classes)

[cafeenman]

Vendor Code:

Public Function TryBuyRandomItem(ByRef ItemSlotID As ITEM_SLOT_INDEX, ByRef Vendor As cItems) As Long
Dim m_Item As cItem

Set m_Item = RandomItemSlotItem(ItemSlotID, Vendor)

BuyItemDialog ItemSlotID

If CanBuyItem(m_Item, VendorItems) <> 1 Then Exit Function

BuyItem m_Item

TryBuyRandomItem = 1

End Function

Private Function CanBuyItem(ByRef Item As cItem, ByRef ItemVendor As cItems) As Long
'Dim m_Callstacker As New cCallStacker
Dim nLevelDifference As Long
Dim nRemainingBalance As Long

'm_Callstacker.Add Name & ".CanBuyItem(Private Function)"

If (ItemVendor.Count = 0) Or (Not ValidObject(Item)) Then

  ItemNotAvailable

  Exit Function

End If

nRemainingBalance = McGuffin.Count - Item.Value

If nRemainingBalance < MIN_MCGUFFINS_TO_ACTIVATE_MULTIPLIERS Then

  AddMessage AddAsterisks("You can't afford a " & Item.Name & " (" & FormatWholeNumber(-Item.Value) & ")."), vbTab, 0, idx_MessageWindow_Primary

  Exit Function

End If

nLevelDifference = Item.LevelRequirement - Player.Level

If nLevelDifference > 1 Then

  If RollFor("Buy Deck-Requirement-Not-Met Item", nLevelDifference, idx_MessageWindow_Notification) <> nLevelDifference Then

    AddMessage AddAsterisks("You Have Not Reached the Deck " & Item.LevelRequirement & " Requirement to Equip a " & Item.Name & "."), vbTab, 0, idx_MessageWindow_Primary

    Exit Function

  End If

End If

CanBuyItem = 1

End Function

Private Function BuyItem(ByRef Item As cItem) As Long

If Not ValidObject(Item) Then Exit Function

With Item

  .TimesPurchased = .TimesPurchased + 1

  McGuffin.Add -.Value, idx_Payee_ItemPurchase

  .SumTotalPurchases = .SumTotalPurchases - .Value

  AddMessage AddAsterisks("You bought a " & .Name & " (" & -.Value & ")!"), vbTab, 0, idx_MessageWindow_Primary

End With

EquipStoreOrSellItem Item, VendorItems, idx_AcquisitionMethod_Purchase, False

BuyItem = 1

End Function

Public Function TryGiftRandomItem(ByRef FromItems As cItems) As Long
Dim m_Item As cItem

If Not ValidObject(FromItems) Then Exit Function

Set m_Item = RandomItem(FromItems)

If Not ValidObject(m_Item) Then Exit Function

If TryRollForItem(m_Item, "Receive a Gift", "They're not that into you.") <> 1 Then Exit Function

With m_Item

  .TimesGifted = .TimesGifted + 1

  AddMessage AddAsterisks("A " & .Name & " was given to you!"), vbTab, 0, idx_MessageWindow_Primary

End With

EquipStoreOrSellItem m_Item, FromItems, idx_AcquisitionMethod_Gift, False

TryGiftRandomItem = 1

End Function

Private Function EquipStoreOrSellItem(ByRef Item As cItem, ByRef FromItems As cItems, ByRef AcquisitionMethodID As ACQUISITION_METHOD_INDEX, ByRef AllowSale As Boolean) As Long
Dim nDieSides As Long
Dim nResult As Long

If Not ValidObject(Item) Then Exit Function

If Not ValidObject(FromItems) Then Exit Function

nDieSides = IIf(AllowSale, 3, 2)

Select Case RollFor("What will you do with this New Item?", nDieSides, idx_MessageWindow_Notification)

  Case 3 ' This Case not available if AllowSale = False.

    nResult = SellItem(Item, FromItems, VendorItems)

  Case Else

    If RollDie(d2) = idx_Heads Then ' Attempt to Equip Item.

      nResult = EquipItem(Item, FromItems, AcquisitionMethodID)

      If nResult <> 1 Then ' Equip Failed. Store Item.

        nResult = TransferItem(Item, FromItems, BackpackItems, AcquisitionMethodID)

      End If

    Else ' Store Item.

      nResult = TransferItem(Item, FromItems, BackpackItems, AcquisitionMethodID)

    End If

End Select

EquipStoreOrSellItem = nResult

End Function

Private Function TryStealItem(ByRef Item As cItem) As Long
Dim nRnd As Long
Dim nDieSides As Long

If Not ValidObject(Item) Then Exit Function

nRnd = RollForCritical("Steal a " & Item.Name, d20)

Select Case nRnd

  Case idx_CriticalRoll_Fail

    GotCaughtStealing Item

    Exit Function

  Case idx_CriticalRoll_Success

    ' Do nothing.

  Case Else

    nDieSides = LevelRequirementDieSides(Item.LevelRequirement)

    If RollDie(nDieSides) <> nDieSides Then Exit Function

End Select

StealItem Item, VendorItems

TryStealItem = 1

End Function

Public Function TryStealRandomItem(ByRef Owner As cItems) As Long
Dim m_Item As cItem

Set m_Item = RandomItem(Owner)

BuyItemDialog m_Item.ItemSlotID

If TryStealItem(m_Item) <> 1 Then Exit Function

EquipStoreOrSellItem m_Item, Owner, idx_AcquisitionMethod_Steal, False

TryStealRandomItem = 1

End Function

Private Function StealItem(ByRef Item As cItem, ByRef Victim As cItems)
'Dim m_Callstacker As New cCallStacker

'm_Callstacker.Add Name & ".StealItem(Private Function)"

If Not ValidObject(Item) Then Exit Function

With Item

  .TimesStolen = .TimesStolen + 1
  .TheftSavings = .TheftSavings + .Value

  AddMessage AddAsterisks("Stealing a " & .Name & " from the Vendor saved you " & FormatWholeNumber(.Value) & " McGuffins."), vbTab, 0, idx_MessageWindow_Primary

End With

EquipStoreOrSellItem Item, Victim, idx_AcquisitionMethod_Steal, False

StealItem = 1

End Function