+- Mirage Source (https://mirage-engine.uk/forums)
+-- Forum: Mirage Source (Nostalgia) (https://mirage-engine.uk/forums/forumdisplay.php?fid=61)
+--- Forum: Archive (2006-2011) (https://mirage-engine.uk/forums/forumdisplay.php?fid=18)
+---- Forum: Staff (https://mirage-engine.uk/forums/forumdisplay.php?fid=41)
+----- Forum: Trash (https://mirage-engine.uk/forums/forumdisplay.php?fid=14)
+------ Forum: Key To Heaven (https://mirage-engine.uk/forums/forumdisplay.php?fid=22)
+------ Thread: Party System (/showthread.php?tid=1355)
Party System - William - 20-10-2007
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)
Re: Party System - Mithlomion - 20-10-2007
ok O_o.
Looks kewl. Kinda like what i had in mind for Silverdale.
Re: Party System - William - 20-10-2007
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 iiiRe: Party System - Coke - 20-10-2007
The 'party' itself should be an entity, the base party system is so simple and difficult to work with xP
Re: Party System - Robin - 20-10-2007
William Wrote:Thanks. It was pretty complicated programming this leave party thing:
The idea behind this part is that it removes your name from the other people in your party when you leave it.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.
Re: Party System - William - 21-10-2007
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.
Re: Party System - William - 21-10-2007
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 SubRe: Party System - Robin - 21-10-2007
You managed to get it to appear on the players GUI properly?
Re: Party System - William - 21-10-2007
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
Re: Party System - Matt - 21-10-2007
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?
Re: Party System - Robin - 21-10-2007
I managed to get the party done, and sharing everything, but I couldn't clear and update everyones lists properly ;\
Re: Party System - William - 21-10-2007
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 SubRe: Party System - frozengod - 21-10-2007
nice job william, your game looks fun
Re: Party System - William - 21-10-2007
frozengod Wrote:nice job william, your game looks funThanks