Makers Brasil
Bem Vindos a Maker´s Brasil (um forum para criação de servidores 2D e 3D)Nos desejamos boa sorte no seu projeto!

Sistema de Amigos

Ver o tópico anterior Ver o tópico seguinte Ir em baixo

Sistema de Amigos

Mensagem por thales12 em Qua Jun 29, 2011 9:41 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:

Name: friendslist
Visible: False

Agora dentro dessa picture crie uma ListBox com as seguintes configurações:

Name: lstFriend

Ainda dentro da picture adicione 2 labels com as seguintes configurações:

1º Label

Name: lblRemoveFriend

2º Label

Name: lblAddFriend

Crie uma labbel com as seguintes configurações:

Name: lblFriends

Serve~Side

Em modConstants, procure por:

Código: [Você precisa estar registrado e conectado para ver este link.]
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

Fim , o tutorzin grande.. e.e
avatar
thales12
Moderador
Moderador

Mensagens : 184
Estrelas Makers : 406
Creditos : 55
Data de inscrição : 22/03/2011
Idade : 22
Localização : Rio de Janeiro

http://www.rdmgames.tk

Voltar ao Topo Ir em baixo

Re: Sistema de Amigos

Mensagem por spectrus em Qua Jun 29, 2011 9:52 am

Uso e aprovo! sistema que deixa o EO mais organizado e mais comunicativo!


Divulgue nosso Forum!
[Você precisa estar registrado e conectado para ver este link.]
Código:
[url=http://makersbrasil.forumeiros.com/]
src="http://img841.imageshack.us/img841/9522/92324935.png"
border="0">[/url]



E meu fan? entao use:

Código:
[img]http://www.baixa.la/arquivos/3908525_imagem.gif[/img]

Sign:
Spoiler:



avatar
spectrus
Administrador
Administrador

Mensagens : 299
Estrelas Makers : 1466
Creditos : 49
Data de inscrição : 01/01/2011
Idade : 23
Localização : V.da conquista bahia

Voltar ao Topo Ir em baixo

Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo

- Tópicos similares

 
Permissão deste fórum:
Você não pode responder aos tópicos neste fórum