modConstants

Procure por:

Código:

Public Const MAX_PARTY_MEMBERS

Abaixo adicione:

Código:

Public Const MAX_RANK = 20

modTypes

Procure por:

Código:

Public Party(1 To MAX_PARTYS) As PartyRec

Abaixo adicione:

Código:

Public Ranking(1 To MAX_RANK) As RankingRec
Public TempRank(1 To MAX_RANK) As RankingRec

No final do modulo adicione:

Código:

Type RankingRec
Name As String * 20
Level As Long
End Type

modEnumerations

Procure por:

Código:

' Make sure SMSG_COUNT is below everything else

Acima adicione:

Código:

SRank

Procure por:

Código:

    ' Make sure CMSG_COUNT is below everything else

Acima adicione:

Código:

CRank

modHandleData

Procure por:

Código:

HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)

Abaixo adicione:

Código:

HandleDataSub(CRank) = GetAddress(AddressOf HandleRank)

No final do modulo adicione:

Código:

Private Sub HandleRank(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Call SendRank(Index)
End Sub

modServerTcp

No final do modulo adicione:

Código:

Sub SendRank(ByVal Index As Long)
Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    Buffer.WriteLong SRank
    Dim i As Long
    For i = 1 To MAX_RANK
    Buffer.WriteString Ranking(i).Name
    Buffer.WriteLong Ranking(i).Level
    Next i
    SendDataTo Index, Buffer.ToArray
    Set Buffer = Nothing
End Sub

modGameLogic

No final do modulo adicione:

Código:

Sub CheckRanking(ByVal Index As Long)
Dim i As Byte
Dim n As Long
Dim o As Long
Dim Level As Long
Dim Nome As String
   
    Level = GetPlayerLevel(Index)
    Nome = GetPlayerName(Index)
   
    If GetPlayerAccess(Index) > 0 Then Exit Sub

    For i = 1 To MAX_RANK
        If Ranking(i).Level < Level Then
            If Not GetPlayerName(Index) = Ranking(i).Name Then
                TempRank(i).Name = Ranking(i).Name
                TempRank(i).Level = Ranking(i).Level
   
                For n = i To MAX_RANK
                    If n = MAX_RANK Then Exit For
                    Ranking(n).Level = TempRank(n).Level
                    Ranking(n).Name = TempRank(n).Name
                Next n

                Ranking(i).Level = Level
                Ranking(i).Name = Nome

                For n = i To MAX_RANK
                    If Ranking(n).Name = Nome Then
                        For o = n To MAX_RANK
                            Ranking(o).Name = Ranking(o).Name
                            Ranking(o).Level = Ranking(o).Level
                        Next o
                    End If
                Next n
               
                Exit For
            End If
        End If
    Next i
   
    Call SaveRanking
    Call SendRank(Index)
End Sub

modPlayer

Na Sub CheckPlayerLevelUp procure por:

Código:

    If level_count > 0 Then
        If level_count = 1 Then
            'singular
            GlobalMsg GetPlayerName(Index) & " ganhou " & level_count & " level!", Brown
        Else
            'plural
            GlobalMsg GetPlayerName(Index) & " ganhou " & level_count & " leveis!", Brown
        End If

E em baixo adicione:

Código:

Call CheckRanking(Index)

modDataBase

No final do modulo adicione:

Código:

Sub SaveRanking()
Dim i As Long
For i = 1 To MAX_RANK
Call PutVar(App.Path & "\Ranking.ini", Val(i), "Nome", Ranking(i).Name)
Call PutVar(App.Path & "\Ranking.ini", Val(i), "Level", Val(Ranking(i).Level))
Next i
End Sub

Sub LoadRanking()
Dim i As Long
For i = 1 To MAX_RANK
Ranking(i).Name = GetVar(App.Path & "\Ranking.ini", Val(i), "Nome")
Ranking(i).Level = Val(GetVar(App.Path & "\Ranking.ini", Val(i), "Level"))
Next i
End Sub

modGeneral

No final da Private Sub LoadGameData, antes do End Sub, adicione:

Código:

Call SetStatus("Loading ranking...")
Call LoadRanking

modHandleData

Procure por:

Código:

 HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)

Abaixo adicione:

Código:

HandleDataSub(SRank) = GetAddress(AddressOf HandleRank)

E no final do modulo adicione:

Código:

Sub HandleRank(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim buffer As clsBuffer
Set buffer = New clsBuffer
buffer.WriteBytes Data()
frmMain.lstRank.Clear
Dim i As Long
Dim Name As String
Dim Level As Long
For i = 1 To MAX_RANK
Name = Trim(buffer.ReadString)
Level = buffer.ReadLong
frmMain.lstRank.AddItem i & " Level:" & Level & " / Name:" & Name
Next i
End Sub

modClientTcp

No final do modulo adicione:

Código:

Sub SendRank()
Dim Buffer As clsBuffer
   
    Set Buffer = New clsBuffer
        Buffer.WriteLong CRank
        SendData Buffer.ToArray
    Set Buffer = Nothing
End Sub

modInput

Procure por:

Código:


                Case "/help"
                    Call AddText("Social Commands:", HelpColor)
                    Call AddText("'msghere = Broadcast Message", HelpColor)
                    Call AddText("-msghere = Emote Message", HelpColor)
                    Call AddText("!namehere msghere = Player Message", HelpColor)
                    Call AddText("Available Commands: /info, /who, /fps, /fpslock", HelpColor)

E abaixo adicione:

Código:

 Case "/top"
                    SendRank
                    If frmMain.picRank.Visible Then
                        frmMain.lstRank.Visible = False
                    Else
                        frmMain.lstRank.Visible = True
                    End If

Na frmMain crie uma listBox com as seguintes configurações:

Name: lstRank
Visible = False

muito bom bruno ;D vai servir muito aos novatos

Obrigado =D

Bem legal, vou por na minha Loja kkk vendo barato R$ 3,00 para coisa que não é minha, mas para coisa que é minha vendo a 5.

Otimo tuto +1