[RESOLVED] Item not being removed someplace (transfer between collection classes)
and as I was typing this, the error happened again. Yay!
Code:
------------------------------------------------------------
McGuffinpunk 2.9 5/7/2025 1:44:43 AM
Wild Items.Add(Public Sub)
------------------------------------------------------------
Error Details:
Error 'This key is already associated with an element of this collection' (Error Number: 457) occurred in Wild Items.Add(Public Sub).
Error Number: 457
Parameters and Associated Objects:
Carbon Steel Industry Waist 1
I have to study this because right now it's the only clue I have.
It was in the Backpack, lost and it says it's trying to add it to Backpack. But the output says it was in the Backpack and trying to add it to WildItems.
But the error is in BackpackItems.
Does it think the WildItems are the Backpack? If so then I have bigger problems than I thought.
It began with stealing it. Then somehow it got "Lost" twice which tells me it's the Lost item thing that might be the problem. It's not really getting lost.
I have it set to break on all errors so I can see if it's always the same chain of events which is what I'm hoping for.
This is from the Viewer Window with stats irrelevant to the problem snipped out.
Code:
Carbon Steel Industry Waist 1 Details:
Item Slot: Waist
Minimum Deck to Equip: 8
Current Location: Wild Items
Source: Backpack
Acquisition Method: Lost
Add to Items: Failed
x Found: 0
x Gifted: 0
x Purchased: 0
x Sold: 0
x Lost: 2 <--- Lost two times.
x Stolen: 1 <--- But only Acquired one time.
x Caught Stealing: 0
x Equipped: 2
x Used: 2,922
------------------------------------
I will continue with the above in a follow up post.
------------------------------ This is where I actually started this post until the above error interrupted.
I posted some of this code last week.
I don't know when the bug was introduced. It may have already been there last week when I posted the code but it never came up until I made a lot of changes.
This is what's going on.
The issue is with the Backpack specifically having an Item it shouldn't (the Item was supposedly transferred out of the Backpack) which raises an error when attempting to place that Item in the Backpack later.
The Item is now in two places at the same time - the Backpack and wherever it was transferred.
It can take hours or days from the time the error is created until it is raised.
In the mean time that item can be randomly bought, sold, lost, found and all that over and again before it finds its way back into to the backpack when the error is raised
This is the abridged output to the error log:
Code:
------------------------------------------------------------
McGuffinpunk 2.9 5/6/2025 8:32:57 AM
Error 'This key is already associated with an element of this collection' (Error Number: 457) occurred in Backpack Items.Add(Public Sub).
------------------------------------------------------------
McGuffinpunk 2.9 5/6/2025 10:45:28 AM
Error 'This key is already associated with an element of this collection' (Error Number: 457) occurred in Backpack Items.Add(Public Sub).
------------------------------------------------------------
McGuffinpunk 2.9 5/6/2025 2:56:00 PM
Error 'This key is already associated with an element of this collection' (Error Number: 457) occurred in Backpack Items.Add(Public Sub).
------------------------------------------------------------
and so on... taking place over several hours.
There three ways to transfer an Item from the Backpack; Equip, Sell or Lose.
So that's where I need to be looking.
But I suppose I could accidentally be putting an Item in the Backpack at the same time I'm putting it somewhere else. I think it's the transfer though.
I've gone over the code for a couple days step by step through every single procedure and can't figure out where it's happening
This code is updated from what I posted last week but is not current.
Code:
' BAS Module.
Private Function TransferItem(ByRef Item As cItem, ByRef FromItems As cItems, ByRef ToItems As cItems) As Long
If Not ValidObject(Item) Then Exit Function
If Not ValidObject(FromItems) Then Exit Function
If Not ValidObject(ToItems) Then Exit Function
FromItems.Remove Item
If (FromItems Is EquippedItems) And (Item.DestroyOnUnequip = vbChecked) Then
DestroyedItems.Add Item
Else
ToItems.Add Item
End If
TransferItem = 1
End Function
' cItems Class
Public Sub Add(ByRef Item As cItem)
On Error GoTo errHandler
If Not ValidObject(Item) Then Exit Sub
colItems.Add Item, CStr(Item.Name)
Item.AddTrail Me.Name
RaiseEvent ItemAdded(Item)
Exit Sub
errHandler:
ErrorHandler Error, Err, Item.Name, Name & ".Add(Public Sub)"
AddMessage Item.Trail, vbNullString, -1, idx_MessageWindow_System
End Sub
So I've updated the code to what follows.
I can better trace the Item this way and know how it got to where it is. Or at least reduce my search radius and maybe make it even more refined if I need to.
I already had an Item Trail built in to the Item Class but it only added its new location to the trail with no indication of how it got there.
Code:
' BAS Module.
Public Enum ITEM_SOURCE_INDEX
idx_ItemSource_BackpackItems
idx_ItemSource_DestroyedItems
idx_ItemSource_EquippedItems
idx_ItemSource_ItemRegistry
idx_ItemSource_ItemShuffler
idx_ItemSource_VendorItems
idx_ItemSource_WildItems
End Enum
Public Enum ACQUISITION_METHOD_INDEX
idx_AcquisitionMethod_Find
idx_AcquisitionMethod_Gift
idx_AcquisitionMethod_Lose
idx_AcquisitionMethod_Purchase
idx_AcquisitionMethod_Sell
idx_AcquisitionMethod_Shuffle
idx_AcquisitionMethod_Steal
idx_AcquisitionMethod_Transfer ' Backpack to Equipped or vice-versa.
End Enum
Private Function TransferItem(ByRef Item As cItem, ByRef FromItems As cItems, ByRef ToItems As cItems, ByRef AcquisitionMethodID As ACQUISITION_METHOD_INDEX) As Long
If Not ValidObject(Item) Then Exit Function
If Not ValidObject(FromItems) Then Exit Function
If Not ValidObject(ToItems) Then Exit Function
FromItems.Remove Item
If (FromItems Is EquippedItems) And (Item.DestroyOnUnequip = vbChecked) Then
If Item.TimesUsed = 0 Then
ItemRegistry.Remove Item
Set Item = Nothing
Else
DestroyedItems.Add Item, FromItems.ItemSourceID, AcquisitionMethodID
End If
Else
ToItems.Add Item, FromItems.ItemSourceID, AcquisitionMethodID
End If
TransferItem = 1
End Function
' cItems Class.
Public Sub Add(ByRef Item As cItem, ByRef ItemSourceID As ITEM_SOURCE_INDEX, ByRef AcquisitionMethodID As ACQUISITION_METHOD_INDEX)
On Error GoTo errHandler
If Not ValidObject(Item) Then Exit Sub
colItems.Add Item, CStr(Item.Name)
Item.AddTrail Me.Name & vbCrLf & "Source: " & ItemSourceText(ItemSourceID) & vbCrLf & "Acquisition Method: " & AcquisitionMethodText(AcquisitionMethodID) & "Add to Items: Success"
RaiseEvent ItemAdded(Item)
Exit Sub
errHandler:
ErrorHandler Error, Err, Item.Name, Name & ".Add(Public Sub)"
Item.AddTrail Me.Name & vbCrLf & "Source: " & ItemSourceText(ItemSourceID) & vbCrLf & "Acquisition Method: " & AcquisitionMethodText(AcquisitionMethodID) & "Add to Items: Failed"
AddMessage Item.Trail, vbNullString, -1, idx_MessageWindow_System
ListItemEffects Item, idx_MessageWindow_Viewer
End Sub
Obviously there's a whole trail of code that gets to here but that will be a lot to post.
Also too, I made a lot of the stuff I posted last week more granular.
So instead of when Buying an Item you first got a shot at it being a gift, then if not you would purchase if if you can afford it and if not then try to steal it.
That's all separate stuff now starting here:
Code:
Private Function Random08() As Long
Dim m_DnD As cDoNotDisturb
Dim m_NGS As cNormalizeGameSpeed
Const COOL_DOWN As Long = 60
Const DIE_SIDES As Long = d6
Static dLastEvent As Date
' Anything to do with Items goes here.
If DoNotDisturb Then Exit Function
If ElapsedSeconds(dLastEvent) < COOL_DOWN Then Exit Function
Set m_DnD = New cDoNotDisturb
Set m_NGS = New cNormalizeGameSpeed
m_NGS.DecelerationEvent = idx_DecelerationEvent_Items
Select Case RollFor("Stuff", DIE_SIDES, idx_MessageWindow_Notification)
Case 1: Random08 = GetFreeItem ' Free Item. Includes Finding Random Items, Gifts and Stealing.
Case 2: Random08 = BuyItem ' Buy Item.
Case 3: Random08 = LoseItem ' Lose Item. Can be from EquippedItems or BackpackItems
Case 4: Random08 = SellItem ' Sell Item. Can be from EquippedItems or BackpackItems
Case Else: Random08 = FidgetItem ' Create or Move Items (no loss or gain to Player).
End Select
If Random08 <> 1 Then Exit Function
dLastEvent = Now()
End Function
Private Function GetFreeItem() As Long
Select Case RollFor("Free Stuff", d3, idx_MessageWindow_Notification)
Case 1: GetFreeItem = TryFindRandomItem
Case 2: GetFreeItem = TryGiftRandomItem(VendorItems)
Case 3: GetFreeItem = TryStealRandomItem(VendorItems)
End Select
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 TryRollForItem(ByRef Item As cItem, ByRef RollForText As String, ByRef FailText As String) As Long
Dim nDieSides As Long
If Not ValidObject(Item) Then Exit Function
Select Case RollForCritical(RollForText)
Case idx_CriticalRoll_Success ' Do nothing.
Case idx_CriticalRoll_Fail
AddMessage AddAsterisks(FailText), vbTab, 0, idx_MessageWindow_Primary
Exit Function
Case Else
nDieSides = LevelRequirementDieSides(Item.LevelRequirement)
If RollDie(nDieSides) <> nDieSides Then
AddMessage AddAsterisks(FailText), vbTab, 0, idx_MessageWindow_Primary
Exit Function
End If
End Select
TryRollForItem = 1
End Function
Re: Item not being removed someplace (transfer between collection classes)
This will be the procedures gone through to Lose an Item:
Code:
Private Function LoseItem() As Long
If RollDie(d2) = idx_Heads Then
LoseItem = TryLoseRandomItem(BackpackItems)
Else
LoseItem = TryLoseRandomItem(EquippedItems)
End If
End Function
Public Function TryLoseRandomItem(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
With m_Item
If TryRollForItem(m_Item, "Lose a " & .Name, "You remembered to pack a " & .Name & " before you broke camp.") <> 1 Then Exit Function
.TimesLost = .TimesLost + 1
TransferItem m_Item, FromItems, WildItems, idx_AcquisitionMethod_Lose
AddMessage AddAsterisks("You lost a " & .Name & "."), vbTab, 0, idx_MessageWindow_Primary
End With
TryLoseRandomItem = 1
End Function
Private Function TransferItem(ByRef Item As cItem, ByRef FromItems As cItems, ByRef ToItems As cItems, ByRef AcquisitionMethodID As ACQUISITION_METHOD_INDEX) As Long
If Not ValidObject(Item) Then Exit Function
If Not ValidObject(FromItems) Then Exit Function
If Not ValidObject(ToItems) Then Exit Function
FromItems.Remove Item
If (FromItems Is EquippedItems) And (Item.DestroyOnUnequip = vbChecked) Then
If Item.TimesUsed = 0 Then
ItemRegistry.Remove Item
Set Item = Nothing
Else
DestroyedItems.Add Item, FromItems.ItemSourceID, AcquisitionMethodID
End If
Else
ToItems.Add Item, FromItems.ItemSourceID, AcquisitionMethodID
End If
TransferItem = 1
End Function
Re: Item not being removed someplace (transfer between collection classes)
Item Trail for a Gift Item given to Player when game starts.
Edited to reflect new output format.
This is the Gift Item the player receives when starting the game.
Code:
Carbon Steel Sedately Forgetful Jacket Item Trail
Transfer: The Creator to Item Registry.
Acquisition Method: Gifted
Add to Items: Success
Transfer: Item Registry to Equipped Items
Acquisition Method: Gifted
Add to Items: Success
From the Viewer Window that shows stats and such about the item:
Code:
Carbon Steel Sedately Forgetful Jacket
Details:
"Extraordinary Power's Gift"
Item Slot: Neck
Minimum Deck to Equip: 0
------------------------------------
Effects:
Cheer Multiplicative Buff (x1.025).
------------------------------------
Current Location: Equipment
x Found: 1 <- Fixed this bug. Should be 0 and Gifted = 1.
x Gifted: 0
x Purchased: 0
x Sold: 0
x Lost: 0
x Stolen: 0
x Caught Stealing: 0
x Equipped: 1
x Used: 0
Sum Total Paid (all purchases): 0
Sum Total Refunds: 0
Next Purchase: -4,750 McGuffins.
Sell: +950 McGuffins.
------------------------------------
Cheer Multiplicative Buff: 0
x Applied to Buff: 0
x Applied to Debuff: 0
------------------------------------
Re: Item not being removed someplace (transfer between collection classes)
You could try checking the pointer of the collections to see whether it is the correct collection you think you use.
Code:
Private m_cCol1 As Collection
Private m_cCol2 As Collection
Private Sub Command1_Click()
Dim cCurrentCol As Collection
InitCollections
Set cCurrentCol = m_cCol1
AddItemTo cCurrentCol, "blahblah"
Set cCurrentCol = m_cCol2
AddItemTo cCurrentCol, "nahnah"
End Sub
Private Sub AddItemTo(cCol As Collection, Item As String)
cCol.Add Item
Debug.Print "Added to collection: " & CStr(ObjPtr(cCol))
End Sub
Private Sub InitCollections()
Set m_cCol1 = New Collection: Debug.Print "cCol1 -> " & ObjPtr(m_cCol1)
Set m_cCol2 = New Collection: Debug.Print "cCol2 -> " & ObjPtr(m_cCol2)
End Sub
Re: Item not being removed someplace (transfer between collection classes)
OK, you've done that generically to get the point across and make it easy to follow.
But I want to make sure I'm clear.
First, I've never seen or used ObjPtr. That's built in to vb?
Also, I don't need an InitCollections procedure, right?
I can just do the debug.print in the class when the collection is created.
I'm assuming this is to get the baseline of what the collection is to compare it later.
Then in the Add method I'm just checking it again.
Do I have this right?
Thanks.
Re: Item not being removed someplace (transfer between collection classes)
Actually, the identifying the Collection isn't the problem. It's a Collection Class so if it's going into the right class it's going into the right collection.
So the same thing you did except for Class instead of Collection.
Also too, the whole thing I did with ITEM_SOURCE_INDEX or whatever I named it makes each class self-identifying.
Code:
Public Property Set VendorItems(ByRef Items As cItems)
Set m_VendorItems = Items
m_VendorItems.ItemSourceIndex = idx_ItemSource_VendorItems
End Property
Re: Item not being removed someplace (transfer between collection classes)
Maybe you did, but if you in your code when accessing the class mixed some variable names up then you are in a mess :)
Re: Item not being removed someplace (transfer between collection classes)
I'm about 100% certain that's not it.
This might provide a clue though. App running and I just checked an Item in my Backpack.
This is the Trace on it.
Note that it came from the same place twice in a row.
So now I suspect that it's not being removed from the Vendor properly.
Actually I know it's not. So I've been looking for in and out of backpack very closely but not so much at from the Vendor.
PS. There are only three places an Item can go from the Vendor - Equipped Items, Backpack Items or the Item Shuffler.
So really only two because the Item Shuffler completely empties out Vendor Items and Wild Items before refilling them.
It looks like where I need to be looking is any place the Backpack or Equipped Items get an Item from the Vendor via whatever means.
Code:
Carbon Steel Industry Waist 3 Item Trail
Transfer: The Creator to Item Registry.
Acquisition Method: Gifted
Add to Items: Success
Transfer: The Creator to Wild Items
Acquisition Method: Shuffled
Add to Items: Success
Transfer: Wild Items to Item Shuffler
Acquisition Method: Shuffled
Add to Items: Success
Transfer: Item Shuffler to Vendor Items
Acquisition Method: Shuffled
Add to Items: Success
Transfer: Vendor to Backpack Items <- this one should be ok.
Acquisition Method: Stolen
Add to Items: Success
Transfer: Vendor to Equipped Items <- But not this one. It's supposed to be in Backpack Items. So probably getting it twice (or more) from the Vendor.
Acquisition Method: Stolen
Add to Items: Success <- This happened because I created the Item Trail string in the Add method *after* the error.
Failed <- but it's fixed now.
Transfer: Backpack to Equipped Items
Acquisition Method: Equipped
Add to Items: Success
That Success/Fail thing only happens in the Add Method. It should be one or the other.
Code:
Public Sub Add(ByRef Item As cItem, ByRef ItemSourceID As ITEM_SOURCE_INDEX, ByRef AcquisitionMethodID As ACQUISITION_METHOD_INDEX)
Dim s As String
On Error GoTo errHandler
If Not ValidObject(Item) Then Exit Sub
s = vbCrLf & "Transfer: " & ItemSourceText(ItemSourceID) & " to " & Me.Name & vbCrLf & "Acquisition Method: " & AcquisitionMethodText(AcquisitionMethodID) & vbCrLf & "Add to Items: "
colItems.Add Item, CStr(Item.Name)
' The next line should be above the above line. It's fixed.
's = vbCrLf & "Transfer: " & ItemSourceText(ItemSourceID) & " to " & Me.Name & vbCrLf & "Acquisition Method: " & AcquisitionMethodText(AcquisitionMethodID) & vbCrLf & "Add to Items: "
Item.AddTrail s & "Success", ItemSourceIndex
RaiseEvent ItemAdded(Item)
Exit Sub
errHandler:
ErrorHandler Error, Err, Item.Name, Name & ".Add(Public Sub)"
Item.AddTrail s & "Failed", ItemSourceIndex
AddMessage Item.Trail, vbNullString, -1, idx_MessageWindow_System
ListItemEffects Item, idx_MessageWindow_Viewer
End Sub
Code:
Error Details:
Error 'This key is already associated with an element of this collection' (Error Number: 457) occurred in Backpack Items.Add(Public Sub).
Error Number: 457
Parameters and Associated Objects:
Carbon Steel Industry Waist 3
Re: Item not being removed someplace (transfer between collection classes)
So I'm trying to figure out the story above with the Item Trail.
The part where it says Success immediately followed by Failed should probably be this:
Code:
Transfer: Vendor to Equipped Items
Acquisition Method: Stolen
Add to Items: Success
Then either
Transfer: Vendor to Backpack Items (stolen or purchased)
or
Transfer: Equipped Items to Backpack Items
Acquisition Method: ???
Add to Items: Failed
So it looks like I got it from the Vendor two or three times. Two times for certain. One time it was equipped and the other it was placed in the Backpack.
After that another one was tried to place in the backpack but that could be from either the Vendor (assuming I'm right about them still holding onto it) or from equipped items.
Because of the bug in my Item Trail code in the Add Method I don't know for certain but it will come up again and it's still running.
Unfortunately I have to restart the program to reset the Item Trail but I should be able to see what's going on from new entries.
Re: Item not being removed someplace (transfer between collection classes)
OK.... I think I'm pretty sure where the problem is and why it only shows up as a Backpack issue when it's really not.
The Item Shuffler is created on the fly and takes everything from Wild Items and Vendor items, empties them out and redistributes.
So it can't ever have the same thing twice because Vendor Items can't directly give to Wild Items. It only happens through the shuffler.
Likewise, Equipped Items can't have two of the same item because it checks first to see if that item slot is equipped. If it is then it unequips the item.
So it will never show this error because it can't happen.
Backpack items doesn't have these limits. It will take whatever it's given. And if it already has one of those because the Vendor distributed it multiple times while keeping it for itself, then it's going to look like it's a backpack issue.
I'm almost 100% certain now that it must be the Vendor.
I never liked that guy.
Re: Item not being removed someplace (transfer between collection classes)
Vendor Code:
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
Code:
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
Code:
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
Code:
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
Code:
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
Code:
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
Code:
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
Code:
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
Re: Item not being removed someplace (transfer between collection classes)
OK, so I think I've found the problem. Or at least a problem.
TryStealRandomItem ends up calling StealItem eventually.
Both of those routines try to EquipStoreOrSellItem.
Only one of them should be doing that. It should be StealItem probably.
Re: [RESOLVED] Item not being removed someplace (transfer between collection classes)
Turns out it was exactly that. I made that change and it's been running since then - almost 10 hours.
Log folder is empty. :D
