[ALL]Friend's List

PS: isso e muitro grande fassa serto XD Eu em esforcei ams consegui

EDIT (9/26/09): Vestido rótulos e re-escreveu o código inteiro em poucas linhas, em oposição à quantidade de código antes.

Esta é a Lista de Amigos fixo até que eu consegui consertar eu mesmo. Eu fixo-lo antes, mas eu estava enfrentando um pequeno problema com ele, e eu apenas fixa que pequeno problema muito recentemente. Contas diferentes e personagens no mesmo computador vai ter amigos diferentes.

As correções e adições ao código antigo será explicado no final do post.

Vamos começar com o Cliente. Abra o cliente em VB6 e abrir frmMirage.

A primeira coisa que precisamos fazer é criar os objetos necessários:

1) Crie um PictureBox e colocá-lo onde quiser em frmMirage. PicFriendList Nome lo.
2) Coloque 1 selo dentro da PictureBox. Nome que lblFriend.
3) Esquerda clique no rótulo de modo que você selecionou sobre ele. Segure Ctrl e prima C para que você copiá-lo.
4) Clique dentro do PictureBox, e mantenha a tecla Ctrl e pressione V de modo que você colá-lo.
5) É, basicamente, perguntar se você quer fazer parte deste rótulo de uma matriz. Escolha a opção "sim".
6) Repita o passo 4 até que você tenha 10 etiquetas na PictureBox. Por favor, note que você terá de clicar dentro do PictureBox novamente cada vez que você copiar e colar outra etiqueta.
7) Dentro do PictureBox, criar 3 CommandButtons. Nomeá-los: cmdHide, cmdAdd e cmdDelete.
Criar CommandButton ainda outra onde você quiser no frmMirage e nomeá-la: cmdFriendList.
9) Por fim, criar um TextBox dentro do PictureBox, e nomeá-la txtFriend.

Isso é tudo para os objetos! Agora vamos entrar nessa código!

Clique duas vezes em cmdHide. Faça o seu olhar Sub como este:

Código:

Private Sub cmdHide_Click()
picFriendList.Visible = False
End Sub

Procure por cmdFriendList. Certifique-se clicar duas vezes sobre ele para fazer o seu código pop up, e seguida, altere a sua Subcomissão para olhar como este:

Código:

Private Sub cmdFriendList_Click()
picFriendList.Visible = True
'Finds out if players are online or not
Call SendData("friendonlineoffline" & SEP_CHAR & lblFriend(Index).Caption & SEP_CHAR & Index & END_CHAR)

End Sub

Agora clique duas vezes no cmdAdd. Sub para mudar sua aparência:

Código:

Private Sub cmdAdd_Click()
Dim i As Integer

For i = 0 To 8
If LenB(lblFriend(i).Caption) < 2 Then
lblFriend(i).Caption = txtFriend.Text
txtFriend.Text = vbNullString
Call SendData("caption" & SEP_CHAR & lblFriend(i).Caption & SEP_CHAR & i & END_CHAR)
ElseIf LenB(lblFriend(i).Caption) >= 2 And LenB(lblFriend(i + 1).Caption) < 2 Then
lblFriend(i + 1).Caption = txtFriend.Text
txtFriend.Text = vbNullString
Call SendData("caption" & SEP_CHAR & lblFriend(i + 1).Caption & SEP_CHAR & Int(i + 1) & END_CHAR)
End If
Next i

End Sub

Depois de feito isso, encontrar cmdDelete. Dê um duplo clique sobre ele para abrir é o código, e alterar o Sub para algo como isto:

Código:

Private Sub cmdDelete_Click()
Dim i As Integer

For i = 0 To 9
If lblFriend(i).Caption = txtFriend.Text Then
lblFriend(i).Caption = vbNullString
Call SendData("caption" & SEP_CHAR & lblFriend(i).Caption & SEP_CHAR & i & END_CHAR)
txtFriend.Text = vbNullString
End If
Next i

End Sub

Agora estamos a fazer com os botões! Infelizmente, isso não é tudo, no entanto.

No frmMirage código, faça duplo clique em qualquer rótulo, em seu PictureBox picFriendList para puxar para cima seu código.

Alterá-lo para algo como isto:

Código:

Private Sub lblFriend_Click(Index As Integer)
If lblFriend(Index).Caption <> vbNullString Then
Call SendPlayerChat(Trim$(lblFriend(Index).Caption))
End If
End Sub

Não importa o rótulo que você escolher, porque clicando em qualquer um dos rótulos traz o mesmo código.

No código frmMirage, encontrar isto:

Código:

Private Sub Form_Load()
Dim i As Long
Dim Ending As String

Em qualquer lugar em que a Sub, acrescentar o seguinte:

Código:

picFriendList.Visible = False

Agora estamos a fazer com frmMirage! Nós ainda temos um pouco mais para fazer no cliente, embora, assim que abrir modHandleData.

Encontre este:

Código:

' if a player left the game
If casestring = "left" Then
Call ClearPlayer(parse(1))
Exit Sub
End If

Diretamente abaixo que, colocar tudo isso:

Código:

Function FindPlayer(ByVal Name As String) As Long
Dim i As Long

For i = 1 To MAX_PLAYERS
If IsPlaying(i) Then
' Make sure we dont try to check a name thats to small
If Len(GetPlayerName(i)) >= Len(Trim$(Name)) Then
If UCase$(Mid$(GetPlayerName(i), 1, Len(Trim$(Name)))) = UCase$(Trim$(Name)) Then
FindPlayer = i
Exit Function
End If
End If
End If
Next i

FindPlayer = 0
End Function

Substituí-lo com isto:

Código:

Function FindPlayer(ByVal Name As String) As Long
Dim i As Long

For i = 1 To MAX_PLAYERS
If IsPlaying(i) Then
' Make sure we dont try to check a name thats to small
If Len(GetPlayerName(i)) >= Len(Trim$(Name)) Then
If UCase$(Trim$(GetPlayerName(i))) = UCase$(Trim$(Name)) Then
FindPlayer = i
Exit Function
End If
End If
End If
Next i

FindPlayer = 0
End Function

Esta versão corrige um pequeno erro no online / offline amigos.

Isso deve ser tudo para o cliente!

Agora, por favor certifique-se de abrir o servidor em VB6.

Tragam modHandleData. Encontre este:

Código:

Sub HandleData(ByVal index As Long, ByVal Data As String)
Dim Parse() As String

Alterá-lo para algo como isto:

Código:

Sub HandleData(ByVal index As Long, ByVal Data As String)
Dim Parse() As String
Dim I As Long

Além disso, encontrar o seguinte:

Código:

Case "getclasses"
Call Packet_GetClasses(index)
Exit Sub

Nos termos do que acrescentar o seguinte:

Código:

Case "friendonlineoffline"
Dim Q
I = FindPlayer(Parse(1))
Q = Int(Parse(2))
Call SendDataTo(Index, "friendstatus" & SEP_CHAR & I & SEP_CHAR & Q & END_CHAR)
Exit Sub

Case "caption"
I = Parse(2)
Call PutVar(App.Path & "\Accounts" & "Friend Lists.ini", GetPlayerName(Index), CStr(I + 1), Trim(Parse(1)))
Exit Sub

Isso é tudo para modHandleData no lado do servidor!

Fique comigo, estamos quase acabando!

Abra modGameLogic e encontrar este Sub todo:

Código:

Public Sub JoinGame(ByVal Index As Long)
Dim MOTD As String

' Set the flag so we know the person is in the game
Player(Index).InGame = True

' Send an ok to client to start receiving in game data
Call SendDataTo(Index, "loginok" & SEP_CHAR & Index & END_CHAR)

ReDim Player(Index).Party.Member(1 To MAX_PARTY_MEMBERS)

Call CheckEquippedItems(Index)
Call SendClasses(Index)
Call SendItems(Index)
Call SendEmoticons(Index)
Call SendElements(Index)
Call SendArrows(Index)
Call SendNpcs(Index)
Call SendShops(Index)
Call SendSpells(Index)
Call SendInventory(Index)
Call SendBank(Index)
Call SendHP(Index)
Call SendMP(Index)
Call SendSP(Index)
Call SendPTS(Index)
Call SendStats(Index)
Call SendWeatherTo(Index)
Call SendTimeTo(Index)
Call SendGameClockTo(Index)
Call DisabledTimeTo(Index)
Call SendSprite(Index, Index)
Call SendPlayerSpells(Index)
Call SendOnlineList

' Warp the player to his saved location
Call PlayerWarp(Index, GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index))

If scriptING = 1 Then
Myscript.ExecuteStatement "scripts\Main.txt", "JoinGame " & Index
Else
' Send a global message that he/she joined.
If GetPlayerAccess(Index) = 0 Then
Call GlobalMsg(GetPlayerName(Index) & " has joined " & GAME_NAME & "!", 7)
Else
Call GlobalMsg(GetPlayerName(Index) & " has joined " & GAME_NAME & "!", 15)
End If

Call PlayerMsg(Index, "Welcome to " & GAME_NAME & "!", 15)

' Send the player the welcome message.
MOTD = Trim$(GetVar(App.Path & "\MOTD.ini", "MOTD", "Msg"))
If LenB(MOTD) <> 0 Then
Call PlayerMsg(Index, "MOTD: " & MOTD, 11)
End If

' Update all clients with the player.
Call SendWhosOnline(Index)
End If

' Tell the client the player is in-game.
Call SendDataTo(Index, "ingame" & END_CHAR)

' Update the server console.
Call ShowPLR(Index)

End Sub

Substituir toda a sub com este:

Código:

Public Sub JoinGame(ByVal Index As Long)
Dim MOTD As String
Dim I As Integer

' Set the flag so we know the person is in the game
Player(Index).InGame = True

' Send an ok to client to start receiving in game data
Call SendDataTo(Index, "loginok" & SEP_CHAR & Index & END_CHAR)

ReDim Player(Index).Party.Member(1 To MAX_PARTY_MEMBERS)

Call CheckEquippedItems(Index)
Call SendClasses(Index)
Call SendItems(Index)
Call SendEmoticons(Index)
Call SendElements(Index)
Call SendArrows(Index)
Call SendNpcs(Index)
Call SendShops(Index)
Call SendSpells(Index)
Call SendInventory(Index)
Call SendBank(Index)
Call SendHP(Index)
Call SendMP(Index)
Call SendSP(Index)
Call SendPTS(Index)
Call SendStats(Index)
Call SendWeatherTo(Index)
Call SendTimeTo(Index)
Call SendGameClockTo(Index)
Call DisabledTimeTo(Index)
Call SendSprite(Index, Index)
Call SendPlayerSpells(Index)
Call SendOnlineList

' Warp the player to his saved location
Call PlayerWarp(Index, GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index))

If scriptING = 1 Then
Myscript.ExecuteStatement "scripts\Main.txt", "JoinGame " & Index
Else
' Send a global message that he/she joined.
If GetPlayerAccess(Index) = 0 Then
Call GlobalMsg(GetPlayerName(Index) & " has joined " & GAME_NAME & "!", 7)
Else
Call GlobalMsg(GetPlayerName(Index) & " has joined " & GAME_NAME & "!", 15)
End If

Call PlayerMsg(Index, "Welcome to " & GAME_NAME & "!", 15)

' Send the player the welcome message.
MOTD = Trim$(GetVar(App.Path & "\MOTD.ini", "MOTD", "Msg"))
If LenB(MOTD) <> 0 Then
Call PlayerMsg(Index, "MOTD: " & MOTD, 11)
End If

' Update all clients with the player.
Call SendWhosOnline(Index)
End If

' Tell the client the player is in-game.
Call SendDataTo(Index, "ingame" & END_CHAR)

' Update the server console.
Call ShowPLR(Index)

' Welcome new players

If GetVar(App.Path & "\Accounts" & "WelcomeMsg.ini", GetPlayerName(Index), "WelcomeMsg") = vbNullString Then
Call SendDataTo(Index, "welcomemsg" & END_CHAR)
End If

' Loads Friends Lists
For I = 1 To 10
Call SendDataTo(Index, "caption" & SEP_CHAR & Trim(GetVar(App.Path & "\Accounts" & "Friend Lists.ini", GetPlayerName(Index), CStr("" & I & ""))) & SEP_CHAR & I & END_CHAR)
Next I

End Sub

Isso é tudo! Espero não esquecer de nada.

Para mim, isso funciona muito bem e não tem falhas ou erros. Se alguém vir a acontecer por todo, por favor, postá-lo aqui, e eu vou olhar para ele. Além disso, se alguém acha que eu esqueci alguma coisa, porque o código não funciona para você, então também por favor postar aqui.

Eu não quero O Fleshlightman para sentir como eu estou tendo ao longo deste tópico, eu só estou postando uma correção para o seu código.

Correções ao código old:
-Changed abrir aspas ( "") para vbNullString. Isso permite que os comandos para serem processados mais rapidamente.
Fixa-se o código cmdDelete. Antes, não exclua nada de qualquer arquivo INI, que acabou de remover a legenda.
-Vestido os rótulos para que o código pode ser escrito em uma enorme quantidade de código menos

Adições ao antigo código:
Made-lo para que você não pode enviar um pedido de chat para um amigo que não existe na lista de amigos.
-Tornou o texto para obter txtFriend limpo depois de eliminar um amigo. Antes, ele permaneceu como o que você escreveu no passado.
-Claro, permitiu que diferentes personagens e as contas para ter amigos diferentes. O mesmo computador, amigos mesma regra não existe mais.
-Adicionado em online / offline reconhecimento para os amigos. Amigos on-line terá o seu nome de usuário amigos verde, e fora de linha terá o seu nome de usuário no vermelho.

Enquanto eu estava fazendo isso, eu estava pensando em implementar um recurso legal para isso. Since I've been codificação por algumas horas agora, e estou bastante cansado de isso agora, eu decidi sucata essa idéia.

Scrapped idéia:
-Não permitindo que você escreva o nome de um personagem não-existant. Por exemplo, se você digitou em "fjdhfd", e ninguém nunca criou um personagem com esse nome, uma caixa que aparecer, informando que você não pode adicionar essa pessoa porque o nome do personagem que não existe.

Uma pequena nota sobre isso: eu sei como chegar a este trabalho, e eu realmente obteve alguma parte dele para trabalhar com sucesso. Depois que eu terminei que, embora, eu percebi que era um pouco mais trabalho do que eu esperava, então eu desisti da idéia. Se você quer isso em sua lista de amigos, posso refazer o código e postá-lo aqui para todos.

Obrigado

O agradecimento vai para Fleshlightman para o código original. Enormes agradecimentos vai para GodLord por, basicamente, me ensinando como usar pacotes quando eu postei um problema que você precisava usar pacotes para resolver. Graças adicional vai para GodLord para fixar a linha pequena / bug amigos offline e sugerindo a disposição minhas etiquetas (Zetta Monkey propôs esta ideia também). Graças extra vai para o Robin para ajudar a consertar o online / offline reconhecimento. Ele não estava funcionando corretamente antes.

Crédito

Wilclefison
e
WkW Produtions

1º O nome do autor vem primeiro .
2º Tá mal traduzido , se "traduzir" fosse pegar e jogar no GOOGLE TRADUTOR todo mundo ia fazer isso, mas olha como que fica ...
3º Não adianta falar que não é TRADUTOR ! olha o erro do tradutor como é :

Clique duas vezes em cmdHide. Faça o seu olhar Sub como este:

Agora olha o seu :

isso e muitro grande fassa serto XD Eu em esforcei ams consegui

MEGA ULTRA X-COMBO.

Mesmo que seja traduzido no google da de entende + ou -, o Pior é que não da pro eclipse stable.(Eu não consegui)

Parei de ler no "Serto"