Suporte ao desenvolvimento de jogos!


    Sistema de Rank Funcional

    Compartilhe
    avatar
    Valentine
    Administrador
    Administrador

    Medalhas :
    Mensagens : 4863
    Créditos : 1040

    Sistema de Rank Funcional

    Mensagem por Valentine em Qui Dez 20, 2012 12:10 pm

    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


    Última edição por Valentine em Qui Maio 29, 2014 7:35 am, editado 5 vez(es)


    _________________
    avatar
    jiraya
    Membro Ativo
    Membro Ativo

    Mensagens : 262
    Créditos : 26

    Re: Sistema de Rank Funcional

    Mensagem por jiraya em Sex Dez 21, 2012 12:04 am

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


    _________________
    Afim de descolar uns trocados se inscreva  pagamento por Paypal, Mercado Pago  até mesmo na sua conta bancaria:

    _____________________________________________________________________________________________



    Se escrevam no meu Canal no Youtube: Eberton Munhoz
    avatar
    AlexsandroChaos
    Novato
    Novato

    Mensagens : 26
    Créditos : 5

    Re: Sistema de Rank Funcional

    Mensagem por AlexsandroChaos em Sex Dez 21, 2012 4:48 pm

    Como que abre a janela do rank?
    avatar
    Valentine
    Administrador
    Administrador

    Medalhas :
    Mensagens : 4863
    Créditos : 1040

    Re: Sistema de Rank Funcional

    Mensagem por Valentine em Sex Dez 21, 2012 6:51 pm

    após terminar todos os passos do tutorial, você terá que digitar
    /rank
    para abrir e fechar a janela de rank.


    _________________
    avatar
    RD12
    Lenda
    Lenda

    Medalhas :
    Mensagens : 1967
    Créditos : 743

    Re: Sistema de Rank Funcional

    Mensagem por RD12 em Sex Dez 21, 2012 7:57 pm

    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.
    avatar
    Valentine
    Administrador
    Administrador

    Medalhas :
    Mensagens : 4863
    Créditos : 1040

    Re: Sistema de Rank Funcional

    Mensagem por Valentine em Sex Dez 21, 2012 8:56 pm

    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


    _________________

    rangeleo
    Novato
    Novato

    Mensagens : 17
    Créditos : 0

    Re: Sistema de Rank Funcional

    Mensagem por rangeleo em Sex Jan 11, 2013 6:43 am

    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.
    avatar
    mdomiciano
    Banido
    Banido

    Mensagens : 5
    Créditos : 13

    Re: Sistema de Rank Funcional

    Mensagem por mdomiciano em Qui Jan 17, 2013 8:28 am

    bem lagal
    avatar
    Felix Blayder
    Membro de Honra
    Membro de Honra

    Mensagens : 1502
    Créditos : 219

    Re: Sistema de Rank Funcional

    Mensagem por Felix Blayder em Qui Jan 17, 2013 9:37 am

    @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!!


    _________________

    Se inscreva em meu Canal no YouTube:
    https://www.youtube.com/localnerd

    Faça uma doação para ajudar nos custos:

    https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=3N8T2RJ977RCQ


    falcon459
    Novato
    Novato

    Mensagens : 7
    Créditos : 0

    Re: Sistema de Rank Funcional

    Mensagem por falcon459 em Qua Maio 28, 2014 5:48 pm

    Muito Bom Funcionou sem erro nenhum Muito Obrigado Successful +1 Credito

    Conteúdo patrocinado

    Re: Sistema de Rank Funcional

    Mensagem por Conteúdo patrocinado


      Data/hora atual: Ter Maio 22, 2018 2:56 pm