Ranking configurável

Código:

Public Const MAX_PARTY_MEMBERS

Código:

Public Const MAX_RANK = 20

Código:

Public Party(1 To MAX_PARTYS) As PartyRec

Código:

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

Código:

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

Código:

    ' Make sure SMSG_COUNT is below everything else

Código:

SRank

Código:

    ' Make sure CMSG_COUNT is below everything else

Código:

CRank

Código:

    HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)

Código:

HandleDataSub(CRank) = GetAddress(AddressOf HandleRank)

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

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
    if Ranking(i).Name <> vbNullString then
    Buffer.WriteString Ranking(i).Name
    else
    Buffer.WriteString "Nenhum jogador"
    end if
    Buffer.WriteLong Ranking(i).Level
    Next i
    SendDataTo Index, Buffer.ToArray
    Set Buffer = Nothing
End Sub

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

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
End if

Código:

Call CheckRanking(Index)

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

Código:

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

Código:

    HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)

Código:

HandleDataSub(SRank) = GetAddress(AddressOf HandleRank)

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

Código:

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

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)

Código:

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

Name: lstRank
Visible = False

Client~Side e Server~Side

modConstants
Procure por:

Código:

Public Const MAX_PARTY_MEMBERS

Abaixo adicione (Aqui você edita a quantidade maxima de jogadores no ranking):

Código:

Public Const MAX_RANK = 20

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
End if

Client~Side e Server~Side

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

Preste atenção nesta parte, diz CLIENTE E SERVER

Snake escreveu:Essa parte de CLIENT E SERVE eu fiz certo coloquei os códigos no Client e no server, mas ta aparecendo esse erro agora:



Como resolve???? Vlw

Edit:

Ei pow no ModTypes do client não tem esse código: Public Party(1 To MAX_PARTYS) As PartyRec

Código:

Public Party

dazateam escreveu:obs: aki deu tudo certo só q ñ aparece o rank nem quando eu uso o comando /top