Posts: 2,605
Threads: 412
Joined: Nov 2021
Reputation:
0
Im going to make a basic party system that allows up to 5 members:
![[Image: partyka8.png]](http://img81.imageshack.us/img81/6772/partyka8.png)
ok O_o.
Looks kewl. Kinda like what i had in mind for Silverdale.
Posts: 2,605
Threads: 412
Joined: Nov 2021
Reputation:
0
Thanks. It was pretty complicated programming this leave party thing:
Code: For iii = 1 To 5
i = FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(iii))
If i > 0 Then
If Index i Then
For ii = 1 To 5
If Player(i).Char(Player(i).CharNum).PartyMembers(ii) = GetPlayerName(Index) Then
Player(i).Char(Player(i).CharNum).PartyMembers(ii) = vbNullString
End If
Next ii
End If
End If
Next iii
The idea behind this part is that it removes your name from the other people in your party when you leave it.
The 'party' itself should be an entity, the base party system is so simple and difficult to work with xP
Posts: 2,742
Threads: 115
Joined: Jun 2006
Reputation:
0
William Wrote:Thanks. It was pretty complicated programming this leave party thing:
Code: For iii = 1 To 5
i = FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(iii))
If i > 0 Then
If Index i Then
For ii = 1 To 5
If Player(i).Char(Player(i).CharNum).PartyMembers(ii) = GetPlayerName(Index) Then
Player(i).Char(Player(i).CharNum).PartyMembers(ii) = vbNullString
End If
Next ii
End If
End If
Next iii
Yeah. I tried to make a graphical GUI of it, and the sending of the new character data to everyone was fucked because I didn't store people's own names in the party array, so the array number of each player was different for each player.
I gave up in the end.
Quote:Robin:
Why aren't maps and shit loaded up in a dynamic array?
Jacob:
the 4 people that know how are lazy
Robin:
Who are those 4 people?
Jacob:
um
you, me, and 2 others?
Posts: 2,605
Threads: 412
Joined: Nov 2021
Reputation:
0
A party system doesn't sound that hard, but it's actually a lot of coding to make it work. There are tons of things to do.
Posts: 2,605
Threads: 412
Joined: Nov 2021
Reputation:
0
Check it out now 
Code: Private Sub HandleSMsgGetPartyInfo(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim Packet As String, i As Byte
Packet = StCPartyInfo & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).PartyMembers(1) & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).PartyMembers(2) & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).PartyMembers(3) & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).PartyMembers(4) & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).PartyMembers(5)
For i = 1 To 5
If FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(i)) > 0 And Player(Index).Char(Player(Index).CharNum).PartyMembers(i) vbNullString Then
Packet = Packet & SEP_CHAR & GetPlayerHP(FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(i))) & SEP_CHAR & GetPlayerMaxHP(FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(i)))
Else
Packet = Packet & SEP_CHAR & "" & SEP_CHAR & ""
End If
Next i
Packet = Packet & SEP_CHAR & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Private Sub HandleSMsgInviteParty(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim Buffer() As Byte
Dim Member As String, i As Long, MIndex As Byte, PartyPlayer As Byte, ii As Byte, Dude As Byte
Buffer = FillBuffer(StartAddr, ByteLen)
Member = GetStringFromBuffer(Buffer, True)
MIndex = FindPlayer(Member)
If Index = MIndex Then
Call PlayerMsg(Index, "You can't invite yourself.", Red)
Exit Sub
End If
For i = 1 To 5
If Member = Player(Index).Char(Player(Index).CharNum).PartyMembers(i) Then
Call PlayerMsg(Index, "This player is already in the party.", Red)
Exit Sub
End If
Next i
If Player(MIndex).InParty = YES Then
Call PlayerMsg(Index, "This player is already in another party.", Red)
Exit Sub
End If
'Add invited player to his list
If MIndex > 0 Then
' For i = 1 To 5
' If Player(MIndex).Char(Player(MIndex).CharNum).PartyMembers(i) = vbNullString Then
' Player(MIndex).Char(Player(MIndex).CharNum).PartyMembers(i) = Member
' i = 5
' End If
' Next i
'Add invited player to all players in your party
' For i = 1 To 5
' PartyPlayer = FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(i))
' If PartyPlayer > 0 Then
' For ii = 1 To 5
' If Player(PartyPlayer).Char(Player(PartyPlayer).CharNum).PartyMembers(ii) = vbNullString Then
' Player(PartyPlayer).Char(Player(PartyPlayer).CharNum).PartyMembers(ii) = Member
' ii = 5
' End If
' Next ii
' End If
' Next i
For i = 1 To 5
If Player(Index).Char(Player(Index).CharNum).PartyMembers(i) = vbNullString Then
Player(Index).Char(Player(Index).CharNum).PartyMembers(i) = Member
i = 5
End If
Next i
For i = 1 To 5
Dude = FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(i))
If Dude > 0 Then
For ii = 1 To 5
Player(Dude).Char(Player(Dude).CharNum).PartyMembers(ii) = Player(Index).Char(Player(Index).CharNum).PartyMembers(ii)
Next ii
End If
Next i
Player(MIndex).InParty = YES
Else
Call PlayerMsg(Index, "Player doesn't exist.", Red)
Exit Sub
End If
End Sub
Private Sub HandleSMsgLeavePartyNow(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim i As Byte, ii As Byte, iii As Byte
If Player(Index).InParty = NO Then
Call PlayerMsg(Index, "You are not in a party so you can't leave.", Red)
Exit Sub
End If
For iii = 1 To 5
i = FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(iii))
If i > 0 Then
If Index i Then
For ii = 1 To 5
If Player(i).Char(Player(i).CharNum).PartyMembers(ii) = GetPlayerName(Index) Then
Player(i).Char(Player(i).CharNum).PartyMembers(ii) = vbNullString
End If
Next ii
End If
End If
Next iii
'Clear old party
For i = 1 To 5
Player(Index).Char(Player(Index).CharNum).PartyMembers(i) = vbNullString
Next i
Player(Index).InParty = NO
End Sub
Private Sub HandleSMsgCreateParty(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim i As Byte
If Player(Index).InParty = YES Then
Call PlayerMsg(Index, "You can't create a party before you leave your current one.", Red)
Exit Sub
End If
'Clear old party
For i = 1 To 5
Player(Index).Char(Player(Index).CharNum).PartyMembers(i) = vbNullString
Next i
' Set Owner
Player(Index).InParty = YES
Player(Index).Char(Player(Index).CharNum).PartyMembers(1) = GetPlayerName(Index)
End Sub
Posts: 2,742
Threads: 115
Joined: Jun 2006
Reputation:
0
You managed to get it to appear on the players GUI properly?
Quote:Robin:
Why aren't maps and shit loaded up in a dynamic array?
Jacob:
the 4 people that know how are lazy
Robin:
Who are those 4 people?
Jacob:
um
you, me, and 2 others?
Posts: 2,605
Threads: 412
Joined: Nov 2021
Reputation:
0
Yeah, I have all that working. But I can't seem to get the damn kick buttons to work correctly. It doesn't clear the name from everybodies list xD
William Wrote:Yeah, I have all that working. But I can't seem to get the damn kick buttons to work correctly. It doesn't clear the name from everybodies list xD
Trial and error. 
You'll get it sooner or later. Can't be too hard for something like that. At least you got the hard part finished, right? 
Posts: 2,742
Threads: 115
Joined: Jun 2006
Reputation:
0
I managed to get the party done, and sharing everything, but I couldn't clear and update everyones lists properly ;\
Quote:Robin:
Why aren't maps and shit loaded up in a dynamic array?
Jacob:
the 4 people that know how are lazy
Robin:
Who are those 4 people?
Jacob:
um
you, me, and 2 others?
Posts: 2,605
Threads: 412
Joined: Nov 2021
Reputation:
0
Everything with the party system was difficult to do. I had no idea it was going to be this hard when I first started. But everything works great now. I'm warning everybody: Dont add a party system!
This is how I did it Robin:
Code: Private Sub HandleSMsgKickPartyMember(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim Buffer() As Byte
Dim Who As Byte, i As Long, NewIndex As Byte
Buffer = FillBuffer(StartAddr, ByteLen)
Who = GetByteFromBuffer(Buffer, True)
NewIndex = FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(Who))
If Who < 1 Or Who > 5 Then
Call PlayerMsg(NewIndex, "Wrong kick, report this to the forum.", Red)
Exit Sub
End If
Dim ii As Byte, iii As Byte
Call PlayerMsg(NewIndex, "You have been kicked from the party by " & GetPlayerName(Index), Red)
'For iii = 1 To 5
' i = FindPlayer(Player(NewIndex).Char(Player(NewIndex).CharNum).PartyMembers(iii))
' If i > 0 Then
' 'If NewIndex i Then
' For ii = 1 To 5
' If Player(i).Char(Player(i).CharNum).PartyMembers(ii) = GetPlayerName(NewIndex) Then
' Player(i).Char(Player(i).CharNum).PartyMembers(ii) = vbNullString
' End If
' Next ii
' 'End If
' End If
'Next iii
'Call PlayerMsg(NewIndex, Player(NewIndex).Char(Player(NewIndex).CharNum).Name, Red)
For i = 1 To 5
ii = FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(i))
If ii 0 Then 'And GetPlayerName(ii) ""
For iii = 1 To 5
'frmServer.List5.AddItem LCase$(Player(ii).Char(Player(ii).CharNum).PartyMembers(iii)) & "-" & LCase$(Player(NewIndex).Char(Player(NewIndex).CharNum).Name)
If Trim(LCase$(Player(ii).Char(Player(ii).CharNum).PartyMembers(iii))) = Trim(LCase$(Player(NewIndex).Char(Player(NewIndex).CharNum).Name)) Then
Player(ii).Char(Player(ii).CharNum).PartyMembers(iii) = vbNullString
'frmServer.List5.AddItem LCase$(Player(ii).Char(Player(ii).CharNum).PartyMembers(iii)) & "-" & LCase$(Player(NewIndex).Char(Player(NewIndex).CharNum).Name) & "YES"
End If
Next iii
End If
Next i
'Clear old party
For i = 1 To 5
Player(NewIndex).Char(Player(NewIndex).CharNum).PartyMembers(i) = vbNullString
Next i
Player(NewIndex).InParty = NO
End Sub
Private Sub HandleSMsgGetPartyInfo(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim Packet As String, i As Byte
Packet = StCPartyInfo & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).PartyMembers(1) & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).PartyMembers(2) & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).PartyMembers(3) & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).PartyMembers(4) & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).PartyMembers(5)
For i = 1 To 5
If FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(i)) > 0 And Player(Index).Char(Player(Index).CharNum).PartyMembers(i) vbNullString Then
Packet = Packet & SEP_CHAR & GetPlayerHP(FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(i))) & SEP_CHAR & GetPlayerMaxHP(FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(i)))
Else
Packet = Packet & SEP_CHAR & "" & SEP_CHAR & ""
End If
Next i
Packet = Packet & SEP_CHAR & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Private Sub HandleSMsgInviteParty(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim Buffer() As Byte
Dim Member As String, i As Long, MIndex As Byte, PartyPlayer As Byte, ii As Byte, Dude As Byte
Buffer = FillBuffer(StartAddr, ByteLen)
Member = GetStringFromBuffer(Buffer, True)
MIndex = FindPlayer(Member)
If Index = MIndex Then
Call PlayerMsg(Index, "You can't invite yourself.", Red)
Exit Sub
End If
For i = 1 To 5
If Member = Player(Index).Char(Player(Index).CharNum).PartyMembers(i) Then
Call PlayerMsg(Index, "This player is already in the party.", Red)
Exit Sub
End If
Next i
If Player(MIndex).InParty = YES Then
Call PlayerMsg(Index, "This player is already in another party.", Red)
Exit Sub
End If
'Add invited player to his list
If MIndex > 0 Then
' For i = 1 To 5
' If Player(MIndex).Char(Player(MIndex).CharNum).PartyMembers(i) = vbNullString Then
' Player(MIndex).Char(Player(MIndex).CharNum).PartyMembers(i) = Member
' i = 5
' End If
' Next i
'Add invited player to all players in your party
' For i = 1 To 5
' PartyPlayer = FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(i))
' If PartyPlayer > 0 Then
' For ii = 1 To 5
' If Player(PartyPlayer).Char(Player(PartyPlayer).CharNum).PartyMembers(ii) = vbNullString Then
' Player(PartyPlayer).Char(Player(PartyPlayer).CharNum).PartyMembers(ii) = Member
' ii = 5
' End If
' Next ii
' End If
' Next i
For i = 1 To 5
If Player(Index).Char(Player(Index).CharNum).PartyMembers(i) = vbNullString Then
Player(Index).Char(Player(Index).CharNum).PartyMembers(i) = Member
i = 5
End If
Next i
For i = 1 To 5
Dude = FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(i))
If Dude > 0 Then
For ii = 1 To 5
Player(Dude).Char(Player(Dude).CharNum).PartyMembers(ii) = Player(Index).Char(Player(Index).CharNum).PartyMembers(ii)
Next ii
End If
Next i
Player(MIndex).InParty = YES
Call PlayerMsg(MIndex, "You have been invited to a party by " & GetPlayerName(Index), Yellow)
Else
Call PlayerMsg(Index, "Player doesn't exist.", Red)
Exit Sub
End If
End Sub
Private Sub HandleSMsgLeavePartyNow(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim i As Byte, ii As Byte, iii As Byte
If Player(Index).InParty = NO Then
Call PlayerMsg(Index, "You are not in a party so you can't leave.", Red)
Exit Sub
End If
For iii = 1 To 5
i = FindPlayer(Player(Index).Char(Player(Index).CharNum).PartyMembers(iii))
If i > 0 Then
If Index i Then
For ii = 1 To 5
If Player(i).Char(Player(i).CharNum).PartyMembers(ii) = GetPlayerName(Index) Then
Player(i).Char(Player(i).CharNum).PartyMembers(ii) = vbNullString
End If
Next ii
End If
End If
Next iii
'Clear old party
For i = 1 To 5
Player(Index).Char(Player(Index).CharNum).PartyMembers(i) = vbNullString
Next i
Player(Index).InParty = NO
End Sub
Private Sub HandleSMsgCreateParty(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim i As Byte
If Player(Index).InParty = YES Then
Call PlayerMsg(Index, "You can't create a party before you leave your current one.", Red)
Exit Sub
End If
'Clear old party
For i = 1 To 5
Player(Index).Char(Player(Index).CharNum).PartyMembers(i) = vbNullString
Next i
' Set Owner
Player(Index).InParty = YES
Player(Index).Char(Player(Index).CharNum).PartyMembers(1) = GetPlayerName(Index)
End Sub
nice job william, your game looks fun
Posts: 2,605
Threads: 412
Joined: Nov 2021
Reputation:
0
frozengod Wrote:nice job william, your game looks fun Thanks
|
Party System
