Você não está conectado. Conecte-se ou registre-se

Ver o tópico anterior Ver o tópico seguinte Ir em baixo  Mensagem [Página 1 de 1]

1 Sistema de rank por valentine em 9/3/2013, 02:18

Warrior

avatar
Ajudante
Ajudante
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
[Você precisa estar registrado e conectado para ver esta imagem.]
2 - Dentro da picRank crie uma ListBox chamada lstRank
[Você precisa estar registrado e conectado para ver esta imagem.]
3 - Crie um botão chamado cmdRefresh
[Você precisa estar registrado e conectado para ver esta imagem.]
Obs.: Deverá ficar assim:
[Você precisa estar registrado e conectado para ver esta imagem.]
4 - Marque a Opção False em Visible na picRank
[Você precisa estar registrado e conectado para ver esta imagem.]
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:
[Você precisa estar registrado e conectado para ver esta imagem.]
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



[Você precisa estar registrado e conectado para ver esta imagem.]
Ver perfil do usuário

Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo  Mensagem [Página 1 de 1]

Permissão deste fórum:
Você não pode responder aos tópicos neste fórum