Universo Games
Ola , Convidado



Você ainda não e cadastrado então cadastre-se e veja todas as atualizações no mundo rpg!!!
Universo Games

Suporte e Desenvolvimento só no Universo Games

Ola Convidado, Seja Bem vindo a equipe lhe deseja boa sorte no seu projeto!

Você não está conectado. Conecte-se ou registre-se

Sistema de Amigos

Ver o tópico anterior Ver o tópico seguinte Ir em baixo  Mensagem [Página 1 de 1]

1Tutorial Sistema de Amigos em Ter 28 Jun 2011, 08:46

RicardoxD


Membro
Membro
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:
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(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


Dentro dessa picture crie uma labbel com as seguintes configurações:

Código:
Name:  lblFriends


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

Código:
Name: lstFriend


Agora fora dessa picture cre outra picture e adicione isso dentro dela:

Código:
friendslist.Visible = True


Serve~Side

Em modConstants, procure por:

Código:
Public Const SEX_FEMALE As Byte = 1


Abaixo adicione:

Código:
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:
    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

Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo  Mensagem [Página 1 de 1]

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