Player/Friend list

[smchronos]

Difficulty: (I have no clue)

This is my own method of doing the following. I've checked and haven't found a tutorial already on this, so I'm posting my way, whether it is the most efficient or not. If the moderators of this community wish to remove this tutorial on the premises that there is already a better (or similiar) tutorial, I have no complaints.

Adding a player list and/or friend list

[client-side]
Control Requirements:
CommandButton Controls (2)
Listbox Controls (2)
Frame Control (1)
OptionButton Controls (2)
Label (1)

-Open up frmMirage and add the following controls:
CommandButton Controls (2)
-cmdAdd
-cmdRemove
Listbox Controls (2)
-lstPlayers
-lstFriends
Frame Control (1)
-Any Name
OptionButton Controls (2)
-optPlayers
-optFriends
Label (1)
-lblPNumber

-Open up frmMirage's code and add the following:

Code:

Private Sub cmdAdd_Click()
If lstPlayers.ListIndex = -1 Then Exit Sub

Call SendData("ADDFRIEND" & SEP_CHAR & lstPlayers.List(lstPlayers.ListIndex) & SEP_CHAR & END_CHAR)
End Sub

Private Sub cmdRemove_Click()
If lstFriends.ListIndex = -1 Then Exit Sub

Call SendData("REMOVEFRIEND" & SEP_CHAR & lstFriends.List(lstFriends.ListIndex) & SEP_CHAR & END_CHAR)
End Sub

Private Sub optFriends_Click()
cmdAdd.Enabled = False
cmdRemove.Enabled = True
lstPlayers.Visible = False 'Only needed if you put one listbox ontop of the other
lstFriends.Visible = True 'Only needed if you put one listbox ontop of the other
End Sub

Private Sub optPlayers_Click()
cmdAdd.Enabled = True
cmdRemove.Enabled = False
lstPlayers.Visible = True 'Only needed if you put one listbox ontop of the other
lstFriends.Visible = False 'Only needed if you put one listbox ontop of the other
End Sub

-Open up Constants.bas and add:

Code:

'Constant for Player Friends
Public Const MAX_FRIENDS = 5

-Open up Types.bas and find Type PlayerRec
-At the end of this type, before closing it with End Type, add:

Code:

'Friends
Friend(1 To MAX_FRIENDS) As String

-Open up HandleData.bas and add:

Code:

Dim p as Integer

-Then, at the bottom of the HandleData subroutine, add the following:

Code:

' :::::::::::::::::::::::
    ' :: PlayerJoin packet :: -smchronos
    ' :::::::::::::::::::::::
    If (LCase(Parse(0)) = "playerjoin") Then
        frmMirage.lstPlayers.AddItem Parse(1)
        If IsFriend(MyIndex, Parse(1)) Then
            frmMirage.lstFriends.AddItem Parse(1)
        End If
    lblPNumber.Caption = CStr(CInt(lblPNumber.Caption) + 1)
        Exit Sub
    End If
    
    ' ::::::::::::::::::::::::
    ' :: PlayerLeave packet :: -smchronos
    ' ::::::::::::::::::::::::
    If (LCase(Parse(0)) = "playerleave") Then
        n = Parse(1)
        frmMirage.lblPNumber.Caption = n
        
        If n = "0" Then
            Exit Sub
        End If
        
        frmMirage.lstPlayers.Clear
        frmMirage.lstFriends.Clear
        
        For p = 2 To (n + 1)
            frmMirage.lstPlayers.AddItem Parse(p)
            If IsFriend(MyIndex, Parse(p)) Then
                frmMirage.lstFriends.AddItem Parse(p)
            End If
        Next p
        Exit Sub
    End If
    
    ' :::::::::::::::::::::::
    ' :: PlayerList packet :: -smchronos
    ' :::::::::::::::::::::::
    If (LCase(Parse(0)) = "plist") Then
        n = Parse(1)
        frmMirage.lblPNumber.Caption = n
        
        If n = "0" Then
            Exit Sub
        End If
        
        For p = 2 To (n + 1)
            frmMirage.lstPlayers.AddItem Parse(p)
            If IsFriend(MyIndex, Parse(p)) Then
                frmMirage.lstFriends.AddItem Parse(p)
            End If
        Next p
        Exit Sub
    End If

    ' ::::::::::::::::::::
    ' :: Friend packets :: -smchronos
    ' ::::::::::::::::::::
    If (LCase(Parse(0)) = "addfriend") Then
        frmMirage.lstFriends.AddItem Parse(1)
    End If
    
    If (LCase(Parse(0)) = "remfriend") Then
        For p = 0 To frmMirage.lstFriends.ListCount
            If frmMirage.lstFriends.List(p) = Parse(1) Then
                frmMirage.lstFriends.RemoveItem (p)
                Exit Sub
            End If
        Next p
    End If

    ' :::::::::::::::::::::::::
    ' :: Friends Load packet ::
    ' :::::::::::::::::::::::::
    If LCase(Parse(0)) = "playerfriends" Then
        For n = 1 To MAX_FRIENDS
           Player(MyIndex).Friend(n) = Parse(n)
        Next n
        Exit Sub
    End If

-Lastly, add this to nearly any module. I placed my in the GameLogic near the bottom:

Code:

Function IsFriend(ByVal Index As Long, ByVal Name As String) As Boolean
Dim n As Integer
IsFriend = False
For n = 1 To MAX_FRIENDS
    If Player(Index).Friend(n) = Name Then
        IsFriend = True
        Exit Function
    End If
Next n
End Function

[server-side]
-Open up Constants.bas and add:

Code:

'Constant for Player Friends
Public Const MAX_FRIENDS = 5

-Open up Types.bas find Type PlayerRec and add within:

Code:

'Friends
    Friend(1 To MAX_FRIENDS) As String

-Open up HandleData.bas and add within the HandleData subroutine

Code:

' ::::::::::::::::::::::::::
    ' :: Remove Friend packet ::
    ' ::::::::::::::::::::::::::
    If LCase(Parse(0)) = "removefriend" Then
        For n = 1 To MAX_FRIENDS
            If Player(Index).Char(Player(Index).CharNum).Friend(n) = Parse(1) Then
                Player(Index).Char(Player(Index).CharNum).Friend(n) = ""
                Packet = "REMFRIEND" & SEP_CHAR & Parse(1) & SEP_CHAR & END_CHAR
                Call SendDataToAll(Packet)
                Exit Sub
            End If
        Next n
    End If
    
    ' :::::::::::::::::::::::
    ' :: Add Friend packet ::
    ' :::::::::::::::::::::::
    If LCase(Parse(0)) = "addfriend" Then
        For n = 1 To MAX_FRIENDS
            If Player(Index).Char(Player(Index).CharNum).Friend(n) = "" Then
                Player(Index).Char(Player(Index).CharNum).Friend(n) = Parse(1)
                Packet = "ADDFRIEND" & SEP_CHAR & Parse(1) & SEP_CHAR & END_CHAR
                Call SendDataToAll(Packet)
                Exit Sub
            ElseIf n = MAX_FRIENDS Then
                Call PlayerMsg(Index, "Too many friends!", Red)
                Exit Sub
            End If
        Next n
    End If

-Open up GameLogic.bas and find the JoinGame subroutine and add with the other sendblah subroutines:

Code:

Call SendFriends(Index)

-This can be placed in nearly any module, but I prefered adding it in the ServerTCP:

Code:

Sub SendFriends(ByVal Index As Long)
Dim Packet As String
Dim n As Integer
    Packet = "PLAYERFRIENDS" & SEP_CHAR
    
    For n = 1 To MAX_FRIENDS
        Packet = Packet & Player(Index).Char(Player(Index).CharNum).Friend(n) & SEP_CHAR
    Next n
    
    Packet = Packet & END_CHAR
    Call SendDataTo(Index, Packet)
End Sub

(This is only needed if you are still using .ini files to save account data. Binary methods will need to be deleted and remade, but no extra code is necessary)
-Open up Database.bas and find the SavePlayer subroutine. It doesn't matter where in here you add the following, but I placed it under the position putvars

Code:

'Set Friends
        For n = 1 To MAX_FRIENDS
            Call PutVar(FileName, "CHAR" & i, "Friend" & n, Player(Index).Char(i).Friend(n))
        Next n

-Still within Database.bas, find the LoadPlayer subroutine and add anywhere:

Code:

'Get Friends
        For n = 1 To MAX_FRIENDS
            Player(Index).Char(i).Friend(n) = GetVar(FileName, "CHAR" & i, "Friend" & n)
        Next n

-Still within Database.bas, find the ClearPlayer subroutine and add anywhere:

Code:

For n = 1 To MAX_FRIENDS
            Player(Index).Char(i).Friend(n) = ""
        Next n

I cut this out of my own server/client, so I may have forgotten something. If you get an error, please post it here.

[William]

We aint removing it, well done.

[Braydok]

Indeed, I was wondering if there was one on here, but hadn't really looked. I'll have to include this in my client.

[William]

Indeed, I was wondering if there was one on here, but hadn't really looked. I'll have to include this in my client.

I think there are a online list somewere but it doesnt hurt to have a new one. The friend list doesnt exist thought.

[Sh4d0ws]

If someone could, i tried to use this Tutorial and it did not work. When i tried to add the fallowing to the Type.bas file, it gave me an error on both the client and the server.

'Friends
Friend(1 To MAX_FRIENDS) As String

---

The error message was this:
Compile Error:
Only valid in object module

I believe that i fallowed the tutorial completely, and i am unsure as to why i am getting this error.

[smchronos]

Make sure that the constant is defined and you've placed this inside the PlayerRec type block in the types.bas

Also, recheck the steps to see if you skipped one.

[Sh4d0ws]

I just re-did the entire tutorial. No change. As far as i can tell, i did everything like you recommended. I'll talk to you on MSN/AIM whenever your online hopefully and we can get this fixed.

[Matt2]

Hey, I might upload mine pretty soon.

It adds/deletes players, shows if they're offline or not, and allows them to communicate.

Also, when you delete a player, both parties are removed from each other's list.

I just ran down this code, and looks like alot for nothing.

then again, mine only sends raw text back and forth...

Anyways, kudos on this.