Difficulty: Medium 4/5
This tutorial is for player to player trading :) I hope this helps a few people.
Let's start this Client Side. In modTypes at the top somewhere add this:
Public Const MAX_PLAYER_TRADES = 8 add this somewhere:
Type PlayerTradeRec InvNum As Long InvName As String End Type Public Trading(1 To MAX_PLAYER_TRADES) As PlayerTradeRec Public Trading2(1 To MAX_PLAYER_TRADES) As PlayerTradeRec In modGameLogic find Sub HandleKeypresses(ByVal KeyAscii As Integer) below ' // Commands // add:
If LCase(Mid(MyText, 1, 6)) = "/trade" Then ' Make sure they are actually sending something If Len(MyText) > 7 Then ChatText = Mid(MyText, 8, Len(MyText) - 7) Call SendTradeRequest(ChatText) Else Call AddText("Usage: /trade playernamehere", AlertColor) End If MyText = "" Exit Sub End If ' Accept Trade If LCase(Mid(MyText, 1, 7)) = "/accept" Then Call SendAcceptTrade MyText = "" Exit Sub End If ' Decline Trade If LCase(Mid(MyText, 1, 8)) = "/decline" Then Call SendDeclineTrade MyText = "" Exit Sub End If Now in modClientTCP add this somewhere in the Sub HandleData:
' ::::::::::::::::::::::::::::::::::::: ' :: Retrieve the player's inventory :: ' ::::::::::::::::::::::::::::::::::::: If LCase(Parse(0)) = "pptrading" Then frmPlayerTrade.Items1.Clear frmPlayerTrade.Items2.Clear For i = 1 To MAX_PLAYER_TRADES Trading(i).InvNum = 0 Trading(i).InvName = "" Trading2(i).InvNum = 0 Trading2(i).InvName = "" frmPlayerTrade.Items1.AddItem i & ": <Nothing>" frmPlayerTrade.Items2.AddItem i & ": <Nothing>" Next i frmPlayerTrade.Items1.ListIndex = 0 Call UpdateTradeInventory frmPlayerTrade.Show vbModeless, frmMirage Exit Sub End If ' :::::::::::::::::::::::::::::: ' :: Stop trading with player :: ' :::::::::::::::::::::::::::::: If LCase(Parse(0)) = "qtrade" Then For i = 1 To MAX_PLAYER_TRADES Trading(i).InvNum = 0 Trading(i).InvName = "" Trading2(i).InvNum = 0 Trading2(i).InvName = "" Next i frmPlayerTrade.Command1.ForeColor = &H0& frmPlayerTrade.Command2.ForeColor = &H0& frmPlayerTrade.Visible = False Exit Sub End If ' :::::::::::::::::::::::::::::: ' :: Stop trading with player :: ' :::::::::::::::::::::::::::::: If LCase(Parse(0)) = "updatetradeitem" Then n = Val(Parse(1)) Trading2(n).InvNum = Val(Parse(2)) Trading2(n).InvName = Parse(3) If STR(Trading2(n).InvNum) <= 0 Then frmPlayerTrade.Items2.List(n - 1) = n & ": <Nothing>" Else frmPlayerTrade.Items2.List(n - 1) = n & ": " & Trim(Trading2(n).InvName) End If Exit Sub End If ' :::::::::::::::::::::::::::::: ' :: Stop trading with player :: ' :::::::::::::::::::::::::::::: If LCase(Parse(0)) = "trading" Then n = Val(Parse(1)) If n = 0 Then frmPlayerTrade.Command2.ForeColor = &H0& If n = 1 Then frmPlayerTrade.Command2.ForeColor = &HFF00& Exit Sub End If Now make a new form and call it frmPlayerTrade In the new form make 3 listboxes. Put 2 at the top beside each other (these are the ones showing the items your trading) Name the left one PlayerInv1 and the right one Items1 Now put the third listbox below those two (the items the other player is trading) Name it Items2 Now make 5 labels. Here is what to name all of them:
Make sure all the ForeColors are black (&H00000000&) Open up the form's source and put all of this in:
Private Sub Command1_Click() Dim Packet As String Dim i As Long
Packet = "swapitems" & SEP_CHAR For i = 1 To MAX_PLAYER_TRADES Packet = Packet & Trading(i).InvNum & SEP_CHAR Next i Packet = Packet & END_CHAR Call SendData(Packet) If Command1.ForeColor = &HFF00& Then Command1.ForeColor = &H0& Else Command1.ForeColor = &HFF00& End If End Sub
Private Sub Command3_Click() Dim i As Long, n As Long i = PlayerInv1.ListIndex + 1
If GetPlayerInvItemNum(MyIndex, i) > 0 And GetPlayerInvItemNum(MyIndex, i) <= MAX_ITEMS Then For n = 1 To MAX_PLAYER_TRADES If Trading(n).InvNum = i Then MsgBox "You can only trade that item once!" Exit Sub End If If Trading(n).InvNum <= 0 Then If Item(GetPlayerInvItemNum(MyIndex, i)).Type = ITEM_TYPE_CURRENCY Then MsgBox "Cant trade currency!" Exit Sub Else If GetPlayerWeaponSlot(MyIndex) = i Or GetPlayerArmorSlot(MyIndex) = i Or GetPlayerHelmetSlot(MyIndex) = i Or GetPlayerShieldSlot(MyIndex) = i Then MsgBox "Cant trade worn items!" Exit Sub Else PlayerInv1.List(i - 1) = PlayerInv1.Text & " **" Items1.List(n - 1) = n & ": " & Trim(Item(GetPlayerInvItemNum(MyIndex, i)).Name) Trading(n).InvNum = i Trading(n).InvName = Trim(Item(GetPlayerInvItemNum(MyIndex, i)).Name) Call SendData("updatetradeinv" & SEP_CHAR & n & SEP_CHAR & Trading(n).InvNum & SEP_CHAR & Trading(n).InvName & SEP_CHAR & END_CHAR) Exit Sub End If End If End If Next n End If End Sub
Private Sub Command4_Click() Dim i As Long, n As Long i = Items1.ListIndex + 1
If Trading(i).InvNum <= 0 Then MsgBox "No item to remove!" Exit Sub End If
PlayerInv1.List(Trading(i).InvNum - 1) = Mid(Trim(PlayerInv1.List(Trading(i).InvNum - 1)), 1, Len(PlayerInv1.List(Trading(i).InvNum - 1)) - 3) Items1.List(i - 1) = n & ": <Nothing>" Trading(i).InvNum = 0 Trading(i).InvName = "" Call SendData("updatetradeinv" & SEP_CHAR & i & SEP_CHAR & 0 & SEP_CHAR & "" & SEP_CHAR & END_CHAR) Command1.ForeColor = &H80000012 End Sub
Private Sub Command5_Click() Call SendData("qtrade" & SEP_CHAR & END_CHAR) End Sub
Private Sub Form_Load() Dim i As Long Dim Ending As String For i = 1 To 3 If i = 1 Then Ending = ".gif" If i = 2 Then Ending = ".jpg" If i = 3 Then Ending = ".png" If FileExist("GUI\Trade" & Ending) Then frmPlayerTrade.Picture = LoadPicture(App.Path & "\GUI\Trade" & Ending) Next i End Sub
Private Sub Form_Unload(Cancel As Integer) Command1.ForeColor = &H0& Command2.ForeColor = &H0& End Sub
Now onto the server! In modTypes at the top add:
Public Const MAX_PLAYER_TRADES = 8 Find Type AccountRec and add:
InTrade As Byte TradePlayer As Long TradeOk As Byte TradeItemMax As Byte TradeItemMax2 As Byte Trading(1 To MAX_PLAYER_TRADES) As PlayerTradeRec Add this BEFORE Type AccountRec:
Type PlayerTradeRec InvNum As Long InvName As String End Type Find Sub ClearPlayer(ByVal index As Long) and add:
Player(index).InTrade = 0 Player(index).TradePlayer = 0 Player(index).TradeOk = 0 Player(index).TradeItemMax = 0 Player(index).TradeItemMax2 = 0 For n = 1 To MAX_PLAYER_TRADES Player(index).Trading(n).InvName = "" Player(index).Trading(n).InvNum = 0 Next n Now in modServerTCP add:
If LCase(Parse(0)) = "pptrade" Then n = FindPlayer(Parse(1)) ' Check if player is online If n < 1 Then Call PlayerMsg(Index, "Player is not online.", White) Exit Sub End If ' Prevent trading with self If n = Index Then Exit Sub End If ' Check if the player is in another trade If Player(Index).InTrade = 1 Then Call PlayerMsg(Index, "Your already in a trade with someone else!", Pink) Exit Sub End If ' Check where both players are Dim CanTrade As Boolean CanTrade = False If GetPlayerX(Index) = GetPlayerX(n) And GetPlayerY(Index) + 1 = GetPlayerY(n) Then CanTrade = True If GetPlayerX(Index) = GetPlayerX(n) And GetPlayerY(Index) - 1 = GetPlayerY(n) Then CanTrade = True If GetPlayerX(Index) + 1 = GetPlayerX(n) And GetPlayerY(Index) = GetPlayerY(n) Then CanTrade = True If GetPlayerX(Index) - 1 = GetPlayerX(n) And GetPlayerY(Index) = GetPlayerY(n) Then CanTrade = True If CanTrade = True Then ' Check to see if player is already in a trade If Player(n).InTrade = 1 Then Call PlayerMsg(Index, "Player is already in a trade!", Pink) Exit Sub End If Call PlayerMsg(Index, "Trade request has been sent to " & GetPlayerName(n) & ".", Pink) Call PlayerMsg(n, GetPlayerName(Index) & " wants you to trade with them. Type /accept to accept, or /decline to decline.", Pink) Player(n).TradePlayer = Index Player(Index).TradePlayer = n Else Call PlayerMsg(Index, "You need to be beside the player to trade!", Pink) Call PlayerMsg(n, "The player needs to be beside you to trade!", Pink) End If Exit Sub End If
If LCase(Parse(0)) = "atrade" Then n = Player(Index).TradePlayer ' Check if anyone requested a trade If n < 1 Then Call PlayerMsg(Index, "No one requested a trade with you.", Pink) Exit Sub End If ' Check if its the right player If Player(n).TradePlayer <> Index Then Call PlayerMsg(Index, "Trade failed.", Pink) Exit Sub End If ' Check where both players are CanTrade = False If GetPlayerX(Index) = GetPlayerX(n) And GetPlayerY(Index) + 1 = GetPlayerY(n) Then CanTrade = True If GetPlayerX(Index) = GetPlayerX(n) And GetPlayerY(Index) - 1 = GetPlayerY(n) Then CanTrade = True If GetPlayerX(Index) + 1 = GetPlayerX(n) And GetPlayerY(Index) = GetPlayerY(n) Then CanTrade = True If GetPlayerX(Index) - 1 = GetPlayerX(n) And GetPlayerY(Index) = GetPlayerY(n) Then CanTrade = True If CanTrade = True Then Call PlayerMsg(Index, "You are trading with " & GetPlayerName(n) & "!", Pink) Call PlayerMsg(n, GetPlayerName(Index) & " accepted your trade request!", Pink) Call SendDataTo(Index, "PPTRADING" & SEP_CHAR & END_CHAR) Call SendDataTo(n, "PPTRADING" & SEP_CHAR & END_CHAR) For I = 1 To MAX_PLAYER_TRADES Player(Index).Trading(I).InvNum = 0 Player(Index).Trading(I).InvName = "" Player(n).Trading(I).InvNum = 0 Player(n).Trading(I).InvName = "" Next I Player(Index).InTrade = 1 Player(Index).TradeItemMax = 0 Player(Index).TradeItemMax2 = 0 Player(n).InTrade = 1 Player(n).TradeItemMax = 0 Player(n).TradeItemMax2 = 0 Else Call PlayerMsg(Index, "The player needs to be beside you to trade!", Pink) Call PlayerMsg(n, "You need to be beside the player to trade!", Pink) End If Exit Sub End If
If LCase(Parse(0)) = "qtrade" Then n = Player(Index).TradePlayer ' Check if anyone trade with player If n < 1 Then Call PlayerMsg(Index, "No one requested a trade with you.", Pink) Exit Sub End If Call PlayerMsg(Index, "Stopped trading.", Pink) Call PlayerMsg(n, GetPlayerName(Index) & " stopped trading with you!", Pink)
Player(Index).TradeOk = 0 Player(n).TradeOk = 0 Player(Index).TradePlayer = 0 Player(Index).InTrade = 0 Player(n).TradePlayer = 0 Player(n).InTrade = 0 Call SendDataTo(Index, "qtrade" & SEP_CHAR & END_CHAR) Call SendDataTo(n, "qtrade" & SEP_CHAR & END_CHAR) Exit Sub End If
If LCase(Parse(0)) = "dtrade" Then n = Player(Index).TradePlayer ' Check if anyone trade with player If n < 1 Then Call PlayerMsg(Index, "No one requested a trade with you.", Pink) Exit Sub End If Call PlayerMsg(Index, "Declined trade request.", Pink) Call PlayerMsg(n, GetPlayerName(Index) & " declined your request.", Pink) Player(Index).TradePlayer = 0 Player(Index).InTrade = 0 Player(n).TradePlayer = 0 Player(n).InTrade = 0 Exit Sub End If
If LCase(Parse(0)) = "updatetradeinv" Then n = Val(Parse(1)) Player(Index).Trading(n).InvNum = Val(Parse(2)) Player(Index).Trading(n).InvName = Trim(Parse(3)) If Player(Index).Trading(n).InvNum = 0 Then Player(Index).TradeItemMax = Player(Index).TradeItemMax - 1 Player(Index).TradeOk = 0 Player(n).TradeOk = 0 Call SendDataTo(Index, "trading" & SEP_CHAR & 0 & SEP_CHAR & END_CHAR) Call SendDataTo(n, "trading" & SEP_CHAR & 0 & SEP_CHAR & END_CHAR) Else Player(Index).TradeItemMax = Player(Index).TradeItemMax + 1 End If Call SendDataTo(Player(Index).TradePlayer, "updatetradeitem" & SEP_CHAR & n & SEP_CHAR & Player(Index).Trading(n).InvNum & SEP_CHAR & Player(Index).Trading(n).InvName & SEP_CHAR & END_CHAR) Exit Sub End If If LCase(Parse(0)) = "swapitems" Then n = Player(Index).TradePlayer If Player(Index).TradeOk = 0 Then Player(Index).TradeOk = 1 Call SendDataTo(n, "trading" & SEP_CHAR & 1 & SEP_CHAR & END_CHAR) ElseIf Player(Index).TradeOk = 1 Then Player(Index).TradeOk = 0 Call SendDataTo(n, "trading" & SEP_CHAR & 0 & SEP_CHAR & END_CHAR) End If If Player(Index).TradeOk = 1 And Player(n).TradeOk = 1 Then Player(Index).TradeItemMax2 = 0 Player(n).TradeItemMax2 = 0
For I = 1 To MAX_INV If Player(Index).TradeItemMax = Player(Index).TradeItemMax2 Then Exit For End If If GetPlayerInvItemNum(n, I) < 1 Then Player(Index).TradeItemMax2 = Player(Index).TradeItemMax2 + 1 End If Next I
For I = 1 To MAX_INV If Player(n).TradeItemMax = Player(n).TradeItemMax2 Then Exit For End If If GetPlayerInvItemNum(Index, I) < 1 Then Player(n).TradeItemMax2 = Player(n).TradeItemMax2 + 1 End If Next I If Player(Index).TradeItemMax2 = Player(Index).TradeItemMax And Player(n).TradeItemMax2 = Player(n).TradeItemMax Then For I = 1 To MAX_PLAYER_TRADES For X = 1 To MAX_INV If GetPlayerInvItemNum(n, X) < 1 Then If Player(Index).Trading(I).InvNum > 0 Then Call GiveItem(n, GetPlayerInvItemNum(Index, Player(Index).Trading(I).InvNum), 1) Call TakeItem(Index, GetPlayerInvItemNum(Index, Player(Index).Trading(I).InvNum), 1) Exit For End If End If Next X Next I
For I = 1 To MAX_PLAYER_TRADES For X = 1 To MAX_INV If GetPlayerInvItemNum(Index, X) < 1 Then If Player(n).Trading(I).InvNum > 0 Then Call GiveItem(Index, GetPlayerInvItemNum(n, Player(n).Trading(I).InvNum), 1) Call TakeItem(n, GetPlayerInvItemNum(n, Player(n).Trading(I).InvNum), 1) Exit For End If End If Next X Next I
Call PlayerMsg(n, "Trade Successfull!", BrightGreen) Call PlayerMsg(Index, "Trade Successfull!", BrightGreen) Call SendInventory(n) Call SendInventory(Index) Else If Player(Index).TradeItemMax2 < Player(Index).TradeItemMax Then Call PlayerMsg(Index, "Your inventory is full!", BrightRed) Call PlayerMsg(n, GetPlayerName(Index) & "'s inventory is full!", BrightRed) End If If Player(n).TradeItemMax2 < Player(n).TradeItemMax Then Call PlayerMsg(n, "Your inventory is full!", BrightRed) Call PlayerMsg(Index, GetPlayerName(n) & "'s inventory is full!", BrightRed) End If End If Player(Index).TradePlayer = 0 Player(Index).InTrade = 0 Player(Index).TradeOk = 0 Player(n).TradePlayer = 0 Player(n).InTrade = 0 Player(n).TradeOk = 0 Call SendDataTo(Index, "qtrade" & SEP_CHAR & END_CHAR) Call SendDataTo(n, "qtrade" & SEP_CHAR & END_CHAR) End If Exit Sub End If
Hopefully this is it :) Err I know it's sloppy but it works ;) Please let me know if this doesnt work or it's missing something! Oh and sorry I didnt explain everything, but im too busy at the moment to do that.
[edit]Oh crap right! Add these in any module client side:
Sub SendTradeRequest(ByVal Name As String) Dim Packet As String
Packet = "PPTRADE" & SEP_CHAR & Name & SEP_CHAR & END_CHAR Call SendData(Packet) End Sub
Sub SendAcceptTrade() Dim Packet As String
Packet = "ATRADE" & SEP_CHAR & END_CHAR Call SendData(Packet) End Sub
Sub SendDeclineTrade() Dim Packet As String
Packet = "DTRADE" & SEP_CHAR & END_CHAR Call SendData(Packet) End Sub
[edit2]Add this somewhere in any module client side:
Public Sub UpdateTradeInventory() Dim i As Long
frmPlayerTrade.PlayerInv1.Clear For i = 1 To MAX_INV If GetPlayerInvItemNum(MyIndex, i) > 0 And GetPlayerInvItemNum(MyIndex, i) <= MAX_ITEMS Then If Item(GetPlayerInvItemNum(MyIndex, i)).Type = ITEM_TYPE_CURRENCY Then frmPlayerTrade.PlayerInv1.AddItem i & ": " & Trim(Item(GetPlayerInvItemNum(MyIndex, i)).Name) & " (" & GetPlayerInvItemValue(MyIndex, i) & ")" Else If GetPlayerWeaponSlot(MyIndex) = i Or GetPlayerArmorSlot(MyIndex) = i Or GetPlayerHelmetSlot(MyIndex) = i Or GetPlayerShieldSlot(MyIndex) = i Then frmPlayerTrade.PlayerInv1.AddItem i & ": " & Trim(Item(GetPlayerInvItemNum(MyIndex, i)).Name) & " (worn)" Else frmPlayerTrade.PlayerInv1.AddItem i & ": " & Trim(Item(GetPlayerInvItemNum(MyIndex, i)).Name) End If End If Else frmPlayerTrade.PlayerInv1.AddItem "<Nothing>" End If Next i frmPlayerTrade.PlayerInv1.ListIndex = 0 End Sub
|