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:
Em modConstents, procure por:
Abaixo adicione:
Em modEnumerations, procure por:
Acima adicionar:
Agora procure por:
Acima adicione:
Adicione o seguinte no final do Public Sub InitMessages(), antes da end sub:
No final da modHandledata adicione:
Em modTypes procure por:
Acima adicione:
Na:
Procure por:
Acima adicione:
No final da frmMain adicione isso:
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:
Agora crie uma pictureBox com as seguintes configurações:
Crie uma labbel com as seguintes configurações:
Serve~Side
Em modConstants, procure por:
Abaixo adicione:
Em modHandleData, dentro da Sub InitMessages () antes do End Sub adicione:
Em baixo da modHandleData adicione isso:
Em modTypes procure por:
Acima adicione:
Procure por::
Em cima de Dir As Byte adicione:
Em modEnumerations procure por:
Acima adicione:
Procure por:
Acima adicione:
Agora é so excluir as contas do seu jogo
Creditos:
crzyone9584
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
- Código:
Name: lstFriend
- 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
