Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Party System
#12
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
Reply


Messages In This Thread

Forum Jump:


Users browsing this thread: 1 Guest(s)