Sistema de Amigos.

por jadieljr Dom Nov 13, 2011 1:52 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:: 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
Riicardo

por gabriel190 Dom Dez 11, 2011 3:43 pm

Desculpe reviver o tópico mas aki deu um erro.
Sistema de Amigos. Semttuloka

Alguem consegue resolver por favor?
Fica dando
Compile error:
Variable not defined.

por **Valentine** Dom Dez 11, 2011 3:49 pm

Isso é porque você colocou essa linha em um local errado, coloque o

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

depois de

Código:: HandleDataSub(SPeechShortWindow) = GetAddress(AddressOf HandleSpeechShortWindow)

por gabriel190 Seg Dez 12, 2011 8:16 am

Vlw Marlos se conseguir coloco aki.

@edit: da outra vez eu tentei fazer isso e coloquei ali onde vc falou só q deu outro erro.Vo tentar de novo e depois coloco aki.

@edit2:consegui! Fiz tudo de novo e nao deu erro, mas nao sei como adiciono um amigo ou retiro. Fiz a pagina dos amigos coloquei a lista e tal, o label(nao entendi pra q serve...) e etc.. + 1 cred pela ajuda e ve se consegue me ajudar a terminar aki por favor?

@edit3:Obrigado, já consegui. foi só prestar atenção...