Heya guys, I just got Eclipse last night and noticed that the shop system lacks the ability to trade items for a number of items, instead its always a straight swap just with a varying amount. I've never coded visual basic before so please go easy on me but I intend to implement this system into a crafting system, where a number of items can be used or 'combined' to create a single item. If you follow this tutorial what you should have by the end of it is a trading system that allows of the use of multiple items as currency for an object - >!  Here is an example of it in action! >!  Lets begin! **Server modifications -** **Find -** ``` Private Type TradeItemRec ``` **Add** ``` CostValue1 As Long CostValue2 As Long CostValue3 As Long CostValue4 As Long CostItem1 As Long CostItem2 As Long CostItem3 As Long CostItem4 As Long ``` **Add** in **ModPlayer**, anywhere should be fine ``` Function HasItemamount(ByVal index As Long, ByVal itemnum As Long) As Long Dim i As Long ' Check for subscript out of range If IsPlaying(index) = False Or itemnum MAX_ITEMS Then Exit Function End If For i = 1 To MAX_INV If GetPlayerInvItemNum(index, i) = itemnum Then If Item(itemnum).Type = ITEM_TYPE_CURRENCY Then HasItemamount = GetPlayerInvItemValue(index, i) Else HasItemamount = HasItemamount + 1 End If End If Next End Function ``` Bellow this function add ``` Sub HandleTakeItem(ByVal index As Long, ByVal itemname As Long, ByVal Amount As Long) Dim i As Long If Item(itemname).Type = ITEM_TYPE_CURRENCY Then TakeInvItem index, itemname, Amount Else For i = 1 To Amount TakeInvItem index, itemname, 1 Next End If End Sub ``` **Find** ``` Sub HandleBuyItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) ``` **In the function bellow** ``` Dim itemamount As Long ``` **Add** ``` Dim itemamount1 As Long Dim itemamount2 As Long Dim itemamount3 As Long Dim itemamount4 As Long ``` **Find** ``` ' check has the cost item itemamount = HasItem(index, .costitem) ``` **Replace with** ``` ' check has the cost item itemamount = HasItemamount(index, .CostItem) itemamount1 = HasItemamount(index, .CostItem1) itemamount2 = HasItemamount(index, .CostItem2) itemamount3 = HasItemamount(index, .CostItem3) itemamount4 = HasItemamount(index, .CostItem4) ``` **Find** ``` ' check has the cost item If itemamount = 0 Or itemamount < .costvalue Then PlayerMsg index, "You do not have enough to buy this item.", BrightRed ResetShopAction index Exit Sub End If ``` **Replace with** ``` If .CostValue1 = 0 Then If itemamount = 0 Or itemamount < .CostValue Then PlayerMsg index, "You do not have enough to buy this item.", BrightRed ResetShopAction index Exit Sub End If Else If .CostValue2 = 0 Then If itemamount = 0 Or itemamount < .CostValue Or itemamount1 = 0 Or itemamount1 < .CostValue1 Then PlayerMsg index, "You do not have enough to buy this item.", BrightRed ResetShopAction index Exit Sub End If Else If .CostValue3 = 0 Then If itemamount = 0 Or itemamount < .CostValue Or itemamount1 = 0 Or itemamount1 < .CostValue1 Or itemamount2 = 0 Or itemamount2 < .CostValue2 Then PlayerMsg index, "You do not have enough to buy this item.", BrightRed ResetShopAction index Exit Sub End If Else If .CostValue4 = 0 Then If itemamount = 0 Or itemamount < .CostValue Or itemamount1 = 0 Or itemamount1 < .CostValue1 Or itemamount2 = 0 Or itemamount2 < .CostValue2 Or itemamount3 = 0 Or itemamount3 < .CostValue3 Then PlayerMsg index, "You do not have enough to buy this item.", BrightRed ResetShopAction index Exit Sub End If Else If itemamount = 0 Or itemamount < .CostValue Or itemamount1 = 0 Or itemamount1 < .CostValue1 Or itemamount2 = 0 Or itemamount2 < .CostValue2 Or itemamount3 = 0 Or itemamount3 < .CostValue3 Or itemamount4 = 0 Or itemamount4 < .CostValue4 Then PlayerMsg index, "You do not have enough to buy this item.", BrightRed ResetShopAction index Exit Sub End If End If End If End If End If ``` **Find** ``` it's fine, let's go ahead TakeInvItem index, .costitem, .costvalue End With ``` **Replace with** ``` If .CostValue1 = 0 Then HandleTakeItem index, .CostItem, .CostValue ElseIf .CostValue2 = 0 Then HandleTakeItem index, .CostItem, .CostValue HandleTakeItem index, .CostItem1, .CostValue1 ElseIf .CostValue3 = 0 Then HandleTakeItem index, .CostItem, .CostValue HandleTakeItem index, .CostItem1, .CostValue1 HandleTakeItem index, .CostItem2, .CostValue2 ElseIf .CostValue4 = 0 Then HandleTakeItem index, .CostItem, .CostValue HandleTakeItem index, .CostItem1, .CostValue1 HandleTakeItem index, .CostItem2, .CostValue2 HandleTakeItem index, .CostItem3, .CostValue3 ElseIf .CostValue4 0 Then HandleTakeItem index, .CostItem, .CostValue HandleTakeItem index, .CostItem1, .CostValue1 HandleTakeItem index, .CostItem2, .CostValue2 HandleTakeItem index, .CostItem3, .CostValue3 HandleTakeItem index, .CostItem4, .CostValue4 End If ``` **Thats it for the server!** **Now for the client -** **Find** ``` Private Type TradeItemRec ``` **Replace entire function with** ``` Private Type TradeItemRec Item As Long ItemValue As Long CostItem As Long CostItem1 As Long CostItem2 As Long CostItem3 As Long CostItem4 As Long CostValue As Long CostValue1 As Long CostValue2 As Long CostValue3 As Long CostValue4 As Long End Type ``` **Find** ``` Private Sub cmdUpdate_Click() ``` **Replace the ENTIRE function with** ``` Private Sub cmdUpdate_Click() Dim Index As Long Dim tmpPos As Long Dim i As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler tmpPos = lstTradeItem.ListIndex Index = lstTradeItem.ListIndex + 1 If Index = 0 Then Exit Sub With Shop(EditorIndex).TradeItem(Index) .Item = cmbItem.ListIndex .ItemValue = Val(txtItemValue.text) .CostItem = cmbCostItem(0).ListIndex .CostItem1 = cmbCostItem(1).ListIndex .CostItem2 = cmbCostItem(2).ListIndex .CostItem3 = cmbCostItem(3).ListIndex .CostItem4 = cmbCostItem(4).ListIndex .CostValue = Val(txtCostValue(0).text) .CostValue1 = Val(txtCostValue(1).text) .CostValue2 = Val(txtCostValue(2).text) .CostValue3 = Val(txtCostValue(3).text) .CostValue4 = Val(txtCostValue(4).text) End With UpdateShopTrade tmpPos ' Error handler Exit Sub errorhandler: HandleError "cmdUpdate_Click", "frmEditor_Shop", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ``` **Find** ``` With Shop(EditorIndex).TradeItem(Index) .Item = 0 .ItemValue = 0 .CostItem = 0 .CostValue = 0 End With ``` **Replace with** ``` With Shop(EditorIndex).TradeItem(Index) .Item = 0 .ItemValue = 0 .CostItem = 0 .CostValue = 0 .CostItem1 = 0 .CostItem2 = 0 .CostItem3 = 0 .CostItem4 = 0 .CostValue1 = 0 .CostValue2 = 0 .CostValue3 = 0 .CostValue4 = 0 End With ``` **Find** ``` Public Sub ShopEditorInit() ``` **Replace the ENTIRE function with** ``` Public Sub ShopEditorInit() Dim i As Long Dim x As Long ' If debug mode, handle error then exit out ' My edit If Options.Debug = 1 Then On Error GoTo errorhandler If frmEditor_Shop.Visible = False Then Exit Sub EditorIndex = frmEditor_Shop.lstIndex.ListIndex + 1 frmEditor_Shop.txtName.text = Trim$(Shop(EditorIndex).Name) If Shop(EditorIndex).BuyRate > 0 Then frmEditor_Shop.scrlBuy.Value = Shop(EditorIndex).BuyRate Else frmEditor_Shop.scrlBuy.Value = 100 End If frmEditor_Shop.cmbItem.Clear frmEditor_Shop.cmbItem.AddItem "None" For x = 0 To 4 frmEditor_Shop.cmbCostItem(x).Clear frmEditor_Shop.cmbCostItem(x).AddItem "None" frmEditor_Shop.txtCostValue(x).text = "0" Next x = 0 For i = 1 To MAX_ITEMS frmEditor_Shop.cmbItem.AddItem i & ": " & Trim$(Item(i).Name) For x = 0 To 4 frmEditor_Shop.cmbCostItem(x).AddItem i & ": " & Trim$(Item(i).Name) Next Next frmEditor_Shop.cmbItem.ListIndex = 0 For x = 0 To 4 frmEditor_Shop.cmbCostItem(x).ListIndex = 0 Next UpdateShopTrade Shop_Changed(EditorIndex) = True ' Error handler Exit Sub errorhandler: HandleError "ShopEditorInit", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ``` **Replace ENTIRE Function** ``` Public Sub UpdateShopTrade(Optional ByVal tmpPos As Long = 0) ``` **With** ``` Public Sub UpdateShopTrade(Optional ByVal tmpPos As Long = 0) Dim i As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler frmEditor_Shop.lstTradeItem.Clear For i = 1 To MAX_TRADES With Shop(EditorIndex).TradeItem(i) ' if none, show as none If .Item = 0 And .CostItem = 0 Then frmEditor_Shop.lstTradeItem.AddItem "Empty Trade Slot" Else If .CostValue1 = 0 Then frmEditor_Shop.lstTradeItem.AddItem i & ": " & .ItemValue & "x " & Trim$(Item(.Item).Name) & " for " & .CostValue & "x " & Trim$(Item(.CostItem).Name) ElseIf .CostValue2 = 0 Then frmEditor_Shop.lstTradeItem.AddItem i & ": " & .ItemValue & "x " & Trim$(Item(.Item).Name) & " for " & .CostValue & "x " & Trim$(Item(.CostItem).Name) & " " & .CostValue1 & "x " & Trim$(Item(.CostItem1).Name) ElseIf .CostValue3 = 0 Then frmEditor_Shop.lstTradeItem.AddItem i & ": " & .ItemValue & "x " & Trim$(Item(.Item).Name) & " for " & .CostValue & "x " & Trim$(Item(.CostItem).Name) & " " & .CostValue1 & "x " & Trim$(Item(.CostItem1).Name) & " " & .CostValue2 & "x " & Trim$(Item(.CostItem2).Name) ElseIf .CostValue4 = 0 Then frmEditor_Shop.lstTradeItem.AddItem i & ": " & .ItemValue & "x " & Trim$(Item(.Item).Name) & " for " & .CostValue & "x " & Trim$(Item(.CostItem).Name) & " " & .CostValue1 & "x " & Trim$(Item(.CostItem1).Name) & " " & .CostValue2 & "x " & Trim$(Item(.CostItem2).Name) & " " & .CostValue3 & "x " & Trim$(Item(.CostItem3).Name) Else frmEditor_Shop.lstTradeItem.AddItem i & ": " & .ItemValue & "x " & Trim$(Item(.Item).Name) & " for " & .CostValue & "x " & Trim$(Item(.CostItem).Name) & " " & .CostValue1 & "x " & Trim$(Item(.CostItem1).Name) & " " & .CostValue2 & "x " & Trim$(Item(.CostItem2).Name) & " " & .CostValue3 & "x " & Trim$(Item(.CostItem3).Name) & " " & .CostValue4 & "x " & Trim$(Item(.CostItem4).Name) End If End If End With Next frmEditor_Shop.lstTradeItem.ListIndex = tmpPos ' Error handler Exit Sub errorhandler: HandleError "UpdateShopTrade", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ``` **Replace Entire function** ``` Private Sub picShopItems_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) ``` **with** ``` Private Sub picShopItems_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Dim shopItem As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler shopItem = IsShopItem(x, y) If shopItem > 0 Then Select Case ShopAction Case 0 ' no action, give cost With Shop(InShop).TradeItem(shopItem) If .CostValue1 = 0 Then AddText "You can buy this item for " & .CostValue & " " & Trim$(Item(.CostItem).Name) & ".", White ElseIf .CostValue2 = 0 Then AddText "You can buy this item for " & .CostValue & " " & Trim$(Item(.CostItem).Name) & " + " & .CostValue1 & " " & Trim$(Item(.CostItem1).Name) & ".", White ElseIf .CostValue3 = 0 Then AddText "You can buy this item for " & .CostValue & " " & Trim$(Item(.CostItem).Name) & " + " & .CostValue1 & " " & Trim$(Item(.CostItem1).Name) & " + " & .CostValue2 & " " & Trim$(Item(.CostItem2).Name) & ".", White ElseIf .CostValue4 = 0 Then AddText "You can buy this item for " & .CostValue & " " & Trim$(Item(.CostItem).Name) & " + " & .CostValue1 & " " & Trim$(Item(.CostItem1).Name) & " + " & .CostValue2 & " " & Trim$(Item(.CostItem2).Name) & " + " & .CostValue3 & " " & Trim$(Item(.CostItem3).Name) & ".", White Else AddText "You can buy this item for " & .CostValue & " " & Trim$(Item(.CostItem).Name) & " + " & .CostValue1 & " " & Trim$(Item(.CostItem1).Name) & " + " & .CostValue2 & " " & Trim$(Item(.CostItem2).Name) & " + " & .CostValue3 & " " & Trim$(Item(.CostItem3).Name) & " + " & .CostValue4 & " " & Trim$(Item(.CostItem4).Name) & ".", White End If End With Case 1 ' buy item ' buy item code BuyItem shopItem End Select End If ' Error handler Exit Sub errorhandler: HandleError "picShopItems_MouseDown", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ``` And that's it for the code! Now all that is left is to modify the shop form. You can either download the one attached to the post or simple duplicate the elements shown in the image bellow and you are all set!  Hopefully at least some of you find it useful. I find visual basics standards to be quote strange to what I already know so please excuse and help me improve on what I have made. Thank-you
