Sistema de Rank Funcional

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

2 - Dentro da picRank crie uma ListBox chamada lstRank

3 - Crie um botão chamado cmdRefresh

Obs.: Deverá ficar assim:

4 - Marque a Opção False em Visible na picRank

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:

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

Oi Valentine esse sistema ta ótimo, detalhado e completo nossa deve ter dado trabalho.
Parabens pelo ótimo trabalho.
+1credito .

Como que abre a janela do rank?

após terminar todos os passos do tutorial, você terá que digitar

/rank

para abrir e fechar a janela de rank.

Muito legal, e bom em um jogo para estimular os jogadores a ficar na lista.
Mas cadê meus créditos? Te respondi várias dúvidas e eu q te ensinei programar.

Realmente o sistema de rank não pode faltar em um verdadeiro mmo

@Off-Topic
Ah vá, você que deveria me agradecer por te proteger do joão kkk

Valentine, sei que ja tem muito tempo esse seu post. Mas se eu gravar um tutorial mostrando como eu coloco um sistema voce me fala o que est dando erra? Por avor? Responde ai vlw.

bem lagal

mdomiciano escreveu:bom topico

cara, vc fez triple post, e ressuscitou todos os tópicos em que vc comentou, reportado a administração para tomar as devidas punições na tabela de regras.

Leia as regras para evitar confusões como esta!!

Muito Bom Funcionou sem erro nenhum Muito Obrigado  +1 Credito