Sistema de Amigos

    Compartilhe
    avatar
    Thales12
    Administrador
    Administrador

    Mensagens : 140
    Level : 8
    Data de inscrição : 01/11/2011
    Idade : 23
    Localização : Rio de Janeiro

    default Sistema de Amigos

    Mensagem por Thales12 em Seg Fev 13, 2012 1:03 am

    O que este sistema faz a vontade de mostrar seus amigos em uma caixa de listagem. Ao lado de seu nome você terá (online) ou (Offline). Isso indica que eles estão online ou offline.

    Este sistema foi atualizado para trabalhar com EO 2.0 Beta!

    Client~Side

    Adicione isso no final de modClientTCP:

    Código:
    'Crzy's Friends System
    Public Sub AddFriend(ByVal FriendsName As String)
        Dim Buffer As clsBuffer
        Set Buffer = New clsBuffer
        Buffer.WriteLong CAddFriend
        Buffer.WriteString FriendsName
        SendData Buffer.ToArray()
        Set Buffer = Nothing
    End Sub

    Public Sub RemoveFriend(ByVal FriendsName As String)
        Dim Buffer As clsBuffer
        Set Buffer = New clsBuffer
        Buffer.WriteLong CRemoveFriend
        Buffer.WriteString FriendsName
        SendData Buffer.ToArray()
        Set Buffer = Nothing
    End Sub

    Public Sub UpdateFriendList()
        Dim Buffer As clsBuffer
        Set Buffer = New clsBuffer
        Buffer.WriteLong CFriendsList
        SendData Buffer.ToArray
        Set Buffer = Nothing
    End Sub


    Em modConstents, procure por:

    Código:
    Public Const SEX_FEMALE As Byte = 1


    Abaixo adicione:

    Código:
    'Máximo de amigos
    Public Const MAX_FRIENDS As Byte = 50


    Em modEnumerations, procure por:

    Código:
    ' Make sure CMSG_COUNT is below everything else
        CMSG_COUNT


    Acima adicionar:

    Código:
        CFriendsList
        CAddFriend
        CRemoveFriend


    Agora procure por:

    Código:
    ' Make sure SMSG_COUNT is below everything else
        SMSG_COUNT


    Acima adicione:

    Código:
        SFriendsList


    Adicione o seguinte no final do Public Sub InitMessages(), antes da end sub:

    Código:
    'Friends system
        HandleDataSub(SFriendsList) = GetAddress(AddressOf HandleFriendList)


    No final da modHandledata adicione:

    Código:
    Sub HandleFriendList(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim Buffer As clsBuffer
    Dim FriendsName As String
    Dim AmountofFriends As Long
    Dim I As Long


    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()
    AmountofFriends = Buffer.ReadLong
         
            'Prevents error and clears your friends list when you have no friends
            If AmountofFriends = 0 Then
                frmMain.lstFriend.Clear
                frmMain.lstFriend.AddItem "No Friends Online"
                Exit Sub
            End If
     
        'clear lstbox so it can be updated correctly.
        frmMain.lstFriend.Clear
     
        'Adds Friends Name to the List
        For I = 1 To MAX_FRIENDS
            FriendsName = Buffer.ReadString
                If FriendsName = " (OffLine)" Then
                    GoTo Continue
                Else
                    frmMain.lstFriend.AddItem FriendsName
                End If
    Continue:
        Next
     
        If frmMain.lstFriend.ListCount = 0 Then
            frmMain.lstFriend.AddItem "No Friends Online"
        End If
    End Sub


    Em modTypes procure por:

    Código:
    Private Type PlayerRec


    Acima adicione:

    Código:
    Type FriendsListUDT
        FriendName As String
    End Type


    Na:

    Código:
    Private Type PlayerRec


    Procure por:

    Código:
    ' Client use only


    Acima adicione:

    Código:
        'Friends
        Friends(1 To MAX_FRIENDS) As FriendsListUDT
        AmountofFriends As Long


    No final da frmMain adicione isso:

    Código:
    Private Sub lblAddFriend_Click()
    Dim n As Long
    Dim strinput As String
            strinput = InputBox("Friend's Name : ", "Add Friend")
            If StrPtr(strinput) = 0 Or strinput = vbNullString Then Exit Sub
         
                Call AddFriend(Trim$(strinput))
    End Sub

    Private Sub lblRemoveFriend_Click()
    Dim n As Long
    Dim strinput As String
            strinput = InputBox("Friend's Name : ", "Add Friend")
            If StrPtr(strinput) = 0 Or strinput = vbNullString Then Exit Sub
         
                Call RemoveFriend(Trim$(strinput))
    End Sub

    Private Sub lblFriends_Click()
        friendslist.Visible = True
        picInventory.Visible = False
        picCharacter.Visible = False
        picSpells.Visible = False
        picOptions.Visible = False
    End Sub


    Clique duas vezes em todos os botões do seu menu. (Settings, Character, Inventário, Skills + todas as custom que você adicionou). E adicione o seguinte codigo:

    Código:
    friendslist.Visible = False


    Agora crie uma pictureBox com as seguintes configurações:

    Código:
    Name: friendslist
    Visible: False
    Agora dentro dessa picture crie uma ListBox com as seguintes configurações:

    Código:
    Name: lstFriend
    Ainda dentro da picture adicione 2 labels com as seguintes configurações:
    Código:
    1º Label

    Name: lblRemoveFriend

    2º Label

    Name: lblAddFriend

    Crie uma labbel com as seguintes configurações:

    Código:
    Name:  lblFriends


    Serve~Side

    Em modConstants, procure por:

    Código:
    Public Const SEX_FEMALE As Byte = 1


    Abaixo adicione:

    Código:
    'Máximo de amigos
    Public Const MAX_FRIENDS As Byte = 50


    Em modHandleData, dentro da Sub InitMessages () antes do End Sub adicione:

    Código:
        HandleDataSub(CAddFriend) = GetAddress(AddressOf HandleAddFriend)
        HandleDataSub(CRemoveFriend) = GetAddress(AddressOf HandleRemoveFriend)


    Em baixo da modHandleData adicione isso:

    Código:
    Sub HandleAddFriend(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddR As Long, ByVal ExtraVar As Long)
    Dim Buffer As clsBuffer
    Dim FriendName As String
    Dim I As Long
    Dim i2 As Long
    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()
    FriendName = Buffer.ReadString
    Set Buffer = Nothing
     
        'See if character exsists
        If FindChar(FriendName) = False Then
            Call PlayerMsg(Index, "Player doesn't exsist", Red)
            Exit Sub
        Else
            'Add Friend to List
            For I = 1 To MAX_FRIENDS
                If Player(Index).Friends(I).FriendName = vbNullString Then
                    Player(Index).Friends(I).FriendName = FriendName
                    Player(Index).AmountofFriends = Player(Index).AmountofFriends + 1
                    Exit For
                End If
            Next
        End If
     
        'Update Friend List
        Call UpdateFriendsList(Index)
    End Sub

    Sub HandleRemoveFriend(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddR As Long, ByVal ExtraVar As Long)
    Dim Buffer As clsBuffer
    Dim FriendName As String
    Dim I As Long
    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()
    FriendName = Buffer.ReadString
    Set Buffer = Nothing
     
        If FriendName = vbNullString Then Exit Sub
     
        For I = 1 To MAX_FRIENDS
            If Player(Index).Friends(I).FriendName = FriendName Then
                Player(Index).Friends(I).FriendName = vbNullString
                Player(Index).AmountofFriends = Player(Index).AmountofFriends - 1
                Exit For
            End If
        Next
     
        'Update Friend List
        Call UpdateFriendsList(Index)
    End Sub


    'Friends List
    Sub UpdateFriendsList(Index)
    Dim Buffer As clsBuffer
    Dim FriendName As String
    Dim tempName As String
    Dim I As Long
    Dim i2 As Long

        Set Buffer = New clsBuffer
     
        If Player(Index).AmountofFriends = 0 Then
            Buffer.WriteLong SFriendsList
            Buffer.WriteLong Player(Index).AmountofFriends
            GoTo Finish
        End If
     
        Buffer.WriteLong SFriendsList
     
        'Sends the amount of friends in friends list
        Buffer.WriteLong Player(Index).AmountofFriends
     
        'Check to see if they are Online
        For I = 1 To MAX_FRIENDS
            FriendName = Player(Index).Friends(I).FriendName
                For i2 = 1 To MAX_PLAYERS
                    tempName = GetPlayerName(i2)
                        If tempName = FriendName And IsPlaying(i2) Then
                            Buffer.WriteString FriendName
                        End If
                Next
        Next
    Finish:
        SendDataTo Index, Buffer.ToArray()
        Set Buffer = Nothing
    End Sub


    Em modTypes procure por:

    Código:
    Private Type PlayerRec


    Acima adicione:

    Código:
    Type FriendsListUDT
        FriendName As String
    End Type


    Procure por::

    Código:
        ' Position
        Map As Long
        x As Byte
        y As Byte
        Dir As Byte


    Em cima de Dir As Byte adicione:

    Código:
        'Amigos
        Friends(1 To MAX_FRIENDS) As FriendsListUDT
        AmountofFriends As Long


    Em modEnumerations procure por:

    Código:
    ' Make sure SMSG_COUNT is below everything else


    Acima adicione:

    Código:
        SFriendsList


    Procure por:

    Código:
    ' Make sure CMSG_COUNT is below everything else


    Acima adicione:

    Código:
        CFriendsList
        CAddFriend
        CRemoveFriend


    Agora é so excluir as contas do seu jogo

    Creditos:

    crzyone9584

      Data/hora atual: Dom Out 21, 2018 2:15 am