MMORPG Brasil
Ola, visitante! Agradecemos sua visita, para ter acesso a todo nosso conteúdo recomendamos que faça um cadastro no fórum, com ele você pode participar de tópicos e ter acesso a todas áreas da comunidade!

Participe do fórum, é rápido e fácil

MMORPG Brasil
Ola, visitante! Agradecemos sua visita, para ter acesso a todo nosso conteúdo recomendamos que faça um cadastro no fórum, com ele você pode participar de tópicos e ter acesso a todas áreas da comunidade!
MMORPG Brasil
Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Sistema de Rank Funcional

+3
ismaelk
Blizzard
Valentine
7 participantes

Ir para baixo

Sistema de Rank Funcional Empty Sistema de Rank Funcional

Mensagem por Valentine Qui 20 Dez 2012, 09:34

Olá amigos, creio que todos sabem como funciona um sistema de rank, algo imprescindível para um verdadeiro MMORPG, sei que existem alguns sistemas de rank por ai e talvez muitos de vocês já o tenha, porém esta é uma forma simples e completa de faze-lo, sistema totalmente testado e aprovado.

Abra o Cliente
1 - Na frmMain, crie uma Picturebox chamada picRank
Sistema de Rank Funcional 57744486
2 - Dentro da picRank crie uma ListBox chamada lstRank
Sistema de Rank Funcional 60970805
3 - Crie um botão chamado cmdRefresh
Sistema de Rank Funcional 54104775
Obs.: Deverá ficar assim:
Sistema de Rank Funcional Imgahp
4 - Marque a Opção False em Visible na picRank
Sistema de Rank Funcional 69569137
5 - Neste mesmo botão cmdRefresh, dê um duplo clique e substitua:
Código:
Private Sub cmdRefresh_Click()

End Sub
6 - Por:
Código:
Private Sub cmdRefresh_Click()
    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler
   
    SendRequestRank
   
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "cmdRefresh_Click", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub
7 - Em modConstants, procure por:
Código:
Public Const MAX_PARTY_MEMBERS As Long = 4
8 - Embaixo adicione:
Código:
Public Const MAX_RANK As Long = 10
9 - No final do modClientTCP, adicione:
Código:
Public Sub SendRequestRank()
Dim Buffer As clsBuffer

    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler
   
    Set Buffer = New clsBuffer
    Buffer.WriteLong CRequestRank
    SendData Buffer.ToArray()
    Set Buffer = Nothing
   
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "SendRequestRank", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub
10 - Em modEnumerations, procure por:
Código:
' Make sure CMSG_COUNT is below everything else
11 - Em cima desta linha e embaixo de:
Código:
CPartyLeave
12 - Adicione:
Código:
CRequestRank
Obs.: Deverá ficar assim:
Sistema de Rank Funcional 27115231
13 - Ainda em modEnumerations, procure por:
Código:
' Make sure SMSG_COUNT is below everything else
14 - Em cima desta linha e embaixo de:
Código:
SPartyVitals
15 - Adicione:
Código:
SRankUpdate
16 - Em modHandleData, procure por:
Código:
HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)
17 - Embaixo adicione:
Código:
HandleDataSub(SRankUpdate) = GetAddress(AddressOf HandleRankUpdate)
18 - No final de modHandleData, adicione:
Código:
Private Sub HandleRankUpdate(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim Buffer As clsBuffer, i As Byte

    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler
   
    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()
   
    frmMain.lstRank.Clear
   
    For i = 1 To MAX_RANK
        frmMain.lstRank.AddItem i & ":Nível: " & Buffer.ReadLong & ", Nome: " & Trim$(Buffer.ReadString)
    Next i
   
    Set Buffer = Nothing
   
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "HandleRankUpdate", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub
19 - No modInput, procure por:
Código:
                    ' Whos Online
                Case "/who"
                    SendWhosOnline
20 - Embaixo adicione:
Código:
                    ' Request Rank
                Case "/rank"
                    SendRequestRank
                    frmMain.picRank.Visible = Not frmMain.picRank.Visible
21 - Em modGeneral, procure por:
Código:
frmMain.picParty.Visible = False
22 - Embaixo adicione:
Código:
frmMain.picRank.Visible = False

Abra o Servidor
1 - Em modConstants, procure por:
Código:
Public Const MAX_PARTY_MEMBERS As Long = 4
2 - Embaixo adicione:
Código:
Public Const MAX_RANK As Long = 10
3 - Em modEnumerations, procure por:
Código:
' Make sure SMSG_COUNT is below everything else
4 - Em cima desta linha e embaixo de:
Código:
SPartyVitals
5 - Adicione:
Código:
SRankUpdate
6 - Ainda em modEnumerations, procure por:
Código:
' Make sure CMSG_COUNT is below everything else
7 - Em cima desta linha e embaixo de:
Código:
CPartyLeave
8 - Adicione:
Código:
CRequestRank
9 - No modHandleData, procure por:
Código:
HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)
10 - Embaixo Adicione:
Código:
HandleDataSub(CRequestRank) = GetAddress(AddressOf HandleRequestRank)
11 - No final de modHandleData, adicione:
Código:
Sub HandleRequestRank(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    SendRankUpdate index
End Sub
12 - No final de modServerTCP, adicione:
Código:
Sub SendRankUpdate(ByVal index As Long)
    Dim i As Byte
    Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    Buffer.WriteLong SRankUpdate
    For i = 1 To MAX_RANK
        Buffer.WriteLong Rank(i).Level
        Buffer.WriteString Trim$(Rank(i).Name)
    Next i
    SendDataTo index, Buffer.ToArray()
    Set Buffer = Nothing
End Sub
13 - No modPlayer, procure por
Código:
Sub CheckPlayerLevelUp(ByVal index As Long)
14 - Embaixo de :
Código:
Dim level_count As Long
15 - Adicione:
Código:
Dim RankPos As Byte
16 - Embaixo de:
Código:
SendPlayerData index
17 - Adicione:
Código:
        ' check rank
        RankPos = CheckRank(index)
        If RankPos > 0 Then
            ChangeRank index, RankPos
        End If
18 - No final de modPlayer, adicione:
Código:
Private Function CheckRank(ByVal index As Long) As Byte
Dim i As Byte
    For i = 1 To MAX_RANK
        If GetPlayerLevel(index) > Rank(i).Level Then
            CheckRank = i
            Exit Function
        End If
    Next i
End Function

Private Sub ChangeRank(ByVal index As Long, RankPos As Byte)
Dim i As Long, ClearPos As Byte

    ' if not change position in rank
    If GetPlayerName(index) = Trim$(Rank(RankPos).Name) Then
        Rank(RankPos).Level = GetPlayerLevel(index)
        SaveRank
        Exit Sub
    End If

    ' search player in rank
    For i = 1 To MAX_RANK
        If GetPlayerName(index) = Trim$(Rank(i).Name) Then
            Rank(i).Name = vbNullString
            Rank(i).Level = 0
            ClearPos = i
            Exit For
        End If
    Next i

    ' down clear position
    If ClearPos > 0 Then
        For i = ClearPos To MAX_RANK
            If i = MAX_RANK Then
                Rank(i).Name = vbNullString
                Rank(i).Level = 0
            Else
                Rank(i).Name = Rank(i + 1).Name
                Rank(i).Level = Rank(i + 1).Level
            End If
        Next i
    End If
   
    ' open space in rank to player
    For i = MAX_RANK To RankPos Step -1
        If i > RankPos Then
            Rank(i).Name = Rank(i - 1).Name
            Rank(i).Level = Rank(i - 1).Level
        End If
    Next i
   
    ' put player in rank
    Rank(RankPos).Name = GetPlayerName(index)
    Rank(RankPos).Level = GetPlayerLevel(index)
   
    SaveRank
End Sub
19 - No final de modDatabase, adicione:
Código:
Public Sub SaveRank()
Dim filename As String, i As Byte

    filename = App.Path & "\data\rank.ini"
   
    For i = 1 To MAX_RANK
        PutVar filename, "RANK", "Name" & i, Trim$(Rank(i).Name)
        PutVar filename, "RANK", "Level" & i, Val(Rank(i).Level)
    Next i
End Sub

Public Sub LoadRank()
Dim filename As String, i As Byte

    filename = App.Path & "\data\rank.ini"
   
    If FileExist(filename, True) Then
        For i = 1 To MAX_RANK
            Rank(i).Name = GetVar(filename, "RANK", "Name" & i)
            Rank(i).Level = Val(GetVar(filename, "RANK", "Level" & i))
        Next i
    Else
        SaveRank
    End If
End Sub
20 - Em modTypes, procure por:
Código:
Public Party(1 To MAX_PARTYS) As PartyRec
21 - Embaixo adicione:
Código:
Public Rank(1 To MAX_RANK) As RankRec
22 - Embaixo de:
Código:
Private Type OptionsRec
    Game_Name As String
    MOTD As String
    Port As Long
    Website As String
End Type
23 - Adicione:
Código:
Private Type RankRec
    Name As String * ACCOUNT_LENGTH
    Level As Long
End Type
24 - Em modPlayer, procure por:
Código:
    ' Send Resource cache
    For i = 0 To ResourceCache(GetPlayerMap(index)).Resource_Count
        SendResourceCacheTo index, i
    Next
25 - Embaixo adicione:
Código:
    ' Check Rank
    For i = 1 To MAX_RANK
        If Trim$(Rank(i).Name) = GetPlayerName(index) Then
            Exit For
        End If
        If GetPlayerLevel(index) > Rank(i).Level Then
            Rank(i).Name = GetPlayerName(index)
            Rank(i).Level = GetPlayerLevel(index)
            SaveRank
            Exit For
        End If
    Next i
26 - Em modGeneral, procure por:
Código:
    Call SetStatus("Loading animations...")
    Call LoadAnimations
27 - Embaixo Adicione:
Código:
    Call SetStatus("Loading rank...")
    Call LoadRank

Créditos:
Valentine


Última edição por Valentine em Seg 31 Dez 2012, 10:40, editado 4 vez(es)
avatar
Valentine
Membro de Honra
Membro de Honra

Mensagens : 472

http://www.aldeiarpgbr.com

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por Blizzard Qui 20 Dez 2012, 10:13

Muito bom bom man,espero que funfe direito,vou testar depois porém vou logo garantir o +1 pela iniciativa.
Blizzard
Blizzard
Membro Vitalicio
Membro Vitalicio

Mensagens : 603

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por ismaelk Qui 20 Dez 2012, 10:20

valentine pq todo mundo me ama todo mundo fala pra eu clicar ali ali ali ali
seis me ama?
ah mais o form e bom vo começar acessar ele inves desse kk
ismaelk
ismaelk
Membro
Membro

Mensagens : 192

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por lucas100vzs Qui 20 Dez 2012, 10:59

Valentine, tem só um probleminha neste sistema....

Cara quando o player passa de level dá muito "LAG" no servidor....acho que é pelo fato de ele fazer aquela checagem....tipo eu abri meu painel Administrador e apertei rápido(5 vezes seguidas) no botão "level up" e deu um pequeno travamento server~cliente.....acho que vai dar problema com mais players online mudando de level ao mesmo tempo...

Teria como colocar o check da "Sub CheckPlayerLevelUp" pra ser tipo:

Código:
RankPos = CheckRank(Index)
        If Getplayerlevel(index) > RankPos Then
            ChangeRank Index, RankPos
        Else
  Exit sub
        End If

Sendo que o RankPos seja os levels do Rank...Assim ele só faria o check no rank se realmente o player tivesse level maior que os já existentes, e não a cada Level Up....Você acha que funcionaria?
Pra isso eu acho teria que colocar "Rank(1 to Max_Rank) as Rankrec"
Depois colocar:

Código:

For x = 1 to Max_Rank
RankPos(x) = CheckRank(Index)
        If Getplayerlevel(index) > RankPos(x) Then
            ChangeRank Index, RankPos(x)
        Else
  Exit sub
        End If
Next x

Eu não sei, mas acho que dessa forma ele checaria de 1 até 10 no rank pra saber o level....
No mais gostei do Rank...se o problema for só aqui a partir do "LAG" , eu vejo um jeito melhor de consertar....Senão se quiser me ajudar a dinamizar o meu caso no código, agradeceria....
+1 pra você, e obrigado por contribuir, continue assim !!! Wink Wink
lucas100vzs
lucas100vzs
Membro Sênior
Membro Sênior

Mensagens : 396

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por Over~ Qui 20 Dez 2012, 11:04

Valeu Ai Valentine Vai Ajudar Muitos!!
+1Cred.

Abraços,
Over~.
Over~
Over~
Membro Vitalicio
Membro Vitalicio

Mensagens : 565

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por Valentine Qui 20 Dez 2012, 11:15

lucas100vzs escreveu: Valentine, tem só um probleminha neste sistema....

Cara quando o player passa de level dá muito "LAG" no servidor....acho que é pelo fato de ele fazer aquela checagem....tipo eu abri meu painel Administrador e apertei rápido(5 vezes seguidas) no botão "level up" e deu um pequeno travamento server~cliente.....acho que vai dar problema com mais players online mudando de level ao mesmo tempo...

Teria como colocar o check da "Sub CheckPlayerLevelUp" pra ser tipo:

Código:
RankPos = CheckRank(Index)
        If Getplayerlevel(index) > RankPos Then
            ChangeRank Index, RankPos
        Else
  Exit sub
        End If

Sendo que o RankPos seja os levels do Rank...Assim ele só faria o check no rank se realmente o player tivesse level maior que os já existentes, e não a cada Level Up....Você acha que funcionaria?
Pra isso eu acho teria que colocar "Rank(1 to Max_Rank) as Rankrec"
Depois colocar:

Código:

For x = 1 to Max_Rank
RankPos(x) = CheckRank(Index)
        If Getplayerlevel(index) > RankPos(x) Then
            ChangeRank Index, RankPos(x)
        Else
  Exit sub
        End If
Next x

Eu não sei, mas acho que dessa forma ele checaria de 1 até 10 no rank pra saber o level....
No mais gostei do Rank...se o problema for só aqui a partir do "LAG" , eu vejo um jeito melhor de consertar....Senão se quiser me ajudar a dinamizar o meu caso no código, agradeceria....
+1 pra você, e obrigado por contribuir, continue assim !!! Wink Wink
Eu testei aqui e não tive nenhum problema com lag, o MAX_RANK é igual a 10, então usar:
Código:
For i = 1 To MAX_RANK
É algo leve, mais leve do que o Do While que está no CheckPlayerLevelUp.

Eu não entendi bem o que você quis dizer nessa parte final, mas ele faz o que você ta dizendo, ele verifica se tem algum jogador no rank com level menor que o seu jogador, se não tiver, então ele simplesmente não continua com o sistema de mudar a posição no rank, caso tenha um jogador com level menor que o seu personagem ele sai imediatamente na Function e leva o id da posição pra o ChangeRank.
avatar
Valentine
Membro de Honra
Membro de Honra

Mensagens : 472

http://www.aldeiarpgbr.com

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por Valentine Qui 20 Dez 2012, 11:36

Desculpem o double post, mais pra não ficar muito bagunçada a minha mensagem

@lucas
A Function CheckRank, verifica de 1 a 10, se o jogador for level mais alto que alguém do rank, ele nem termina o For de 1 a 10, ele já sai de imediato da Function e retorna ao Sub CheckPlayerLevelUp com o valor da posição do rank, caso o jogador não esteja level mais alto que qualquer um dos 10 no rank, as próximas linhas são praticamente ignoradas, nenhuma checagem é feita a mais no rank, então usar:
Código:
For x = 1 to Max_Rank
RankPos(x) = CheckRank(Index)
Seria fazer uma checagem de 100 VEZES, ao invés de 10, lembre-se do For que tem na function CheckRank que é de 1 a 10, e usar um For antes de 1 a 10 novamente, então 10x10 = 100, ai sim da forma como você ta querendo iria dar lag.
avatar
Valentine
Membro de Honra
Membro de Honra

Mensagens : 472

http://www.aldeiarpgbr.com

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por lucas100vzs Qui 20 Dez 2012, 11:39

Está tudo OK mesmo Valentine, o problema é que sou apressadinho e pressiono o botão de "Level Up" do painel do Administrador....Razz

Mas pra isso, se quiser até adicionar no seu tutorial, achei uma coisa útil e boa pra se complementar também, assim:

Na "Sub CheckPlayerLevelUp" , acima de:
Código:

' check rank
        RankPos = CheckRank(Index)
        If RankPos > 0 Then
            ChangeRank Index, RankPos
        Else
        End If
Só adicionei isto:
Código:
If GetPlayerAccess(Index) > ADMIN_MONITOR Then Exit Sub


Com isso, nem ADM/GM/MAPPER/MONITOR/MODERADOR entra no Rank de level, tanto quanto o servidor não faz a checagem pelo o nível deles....Simples e eficiente Very Happy

E agora sim entendi...valeu pela dica acima, quase que faço coisa errada aqui, obrigado vlw
lucas100vzs
lucas100vzs
Membro Sênior
Membro Sênior

Mensagens : 396

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por Valentine Qui 20 Dez 2012, 11:42

Pra você ver como eu pensei em deixar o sistema mais leve o possível, se um jogador que já está no rank, upa level mais não muda a posição ele nem termina de passar pelo Sub ChangeRank, ele só altera o level no rank e sai imediatamente assim:
Código:
    ' if not change position in rank
    If GetPlayerName(index) = Trim$(Rank(RankPos).Name) Then
        Rank(RankPos).Level = GetPlayerLevel(index)
        SaveRank
        Exit Sub
    End If

Então por isso que eu digo, que eu fiz de uma forma que deixasse muito leve.
avatar
Valentine
Membro de Honra
Membro de Honra

Mensagens : 472

http://www.aldeiarpgbr.com

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por xurana321 Ter 12 Fev 2013, 18:19

aqui nao ta abrindo quando eu COLOCO /rank

@EDIT
e nao adianta falar que eu fiz alguma COISA errado pq eu nao fiz, ta tudo CERTO..
xurana321
xurana321
Membro Sênior
Membro Sênior

Mensagens : 297

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por Valentine Ter 12 Fev 2013, 20:41

xurana321 escreveu:aqui nao ta abrindo quando eu COLOCO /rank

@EDIT
e nao adianta falar que eu fiz alguma COISA errado pq eu nao fiz, ta tudo CERTO..
Tem certeza que você adicionou isto:
Código:
                    ' Request Rank
                Case "/rank"
                    SendRequestRank
                    frmMain.picRank.Visible = Not frmMain.picRank.Visible
?
avatar
Valentine
Membro de Honra
Membro de Honra

Mensagens : 472

http://www.aldeiarpgbr.com

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por xurana321 Ter 12 Fev 2013, 21:13

Certeza absoluta, eu digito /rank nao abri o ranking... tipo se eu nao tiVesse ColoCado
' Request Rank
Case "/rank"
SendRequestRank
frmMain.picRank.Visible = Not frmMain.picRank.Visible
ia apareCer q nao existia esse Comando...
xurana321
xurana321
Membro Sênior
Membro Sênior

Mensagens : 297

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por guifs Sex 22 Mar 2013, 15:03

alguem me ajuda pfv na linha : HandleDataSub(CSetRanking) = GetAddress(AddressOf HandleSetRanking) ta dando varivel não definida D:

@EDIT consegui , vlw marlos , mais 3 aew
guifs
guifs
Membro Vitalicio
Membro Vitalicio

Mensagens : 561

Ir para o topo Ir para baixo

Sistema de Rank Funcional Empty Re: Sistema de Rank Funcional

Mensagem por Conteúdo patrocinado


Conteúdo patrocinado


Ir para o topo Ir para baixo

Ir para o topo

- Tópicos semelhantes

 
Permissões neste sub-fórum
Não podes responder a tópicos