Sistema de Amigos

por thales12 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: [Tens de ter uma conta e sessão iniciada para poderes visualizar 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