Arena RPG Maker
Olá, visitante!
Seja bem-vindo ao fórum Arena RPG Maker, caso queira aprender sobre criação de jogos, está no fórum certo. Esperamos que possa aprender tanto quanto possa nos ensinar aqui.

Atenciosamente,
Equipe Arena RPG Maker.
Arena RPG Maker

Estamos de volta o/ ... Ou não.Eu amo a -Dark
Doações para o fórum abertas, clique aqui e saiba mais.
Últimos assuntos
» Pokémon Genesis Online! (PGO)
Qua 05 Jul 2017, 17:08 por Lexar

» Tileset Converter to MV
Sex 12 Maio 2017, 13:07 por Douggi

» [Dúvida] Como tirar a porcentagem de esquiva
Ter 09 Maio 2017, 22:15 por Neil Flame Runner

» Pack Resources, Sprites e etc
Qua 23 Dez 2015, 09:30 por raydengv

» Download RPG Maker 2003 + RTP em português
Ter 22 Dez 2015, 08:14 por ::KimMax::

» Fantasy Art Online
Dom 18 Out 2015, 16:42 por daviih123

» Você vai ter medo do Nerve gear?
Sab 25 Jul 2015, 16:02 por Kirito-kun

» O Barato é louco
Sab 27 Jun 2015, 15:26 por Halt

» Download RPG Maker 2000 + RTP em português
Qui 21 Maio 2015, 19:28 por Wismael

» Divulgando meu grupo e página do Facebook
Ter 19 Maio 2015, 13:06 por Halt


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]

1Tutorial Sistema de Rank funcional em Seg 24 Dez 2012, 19:25

Halt

avatar
Administrador
Administrador
Valentine escreveu: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 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 este link.]
Ei Convidado, sim você mesmo! Ajude o fórum à crescer postando coisas úteis, dê sugestões para melhorar-mos e divulgue o fórum.

Step inside, see the devil in I.

Gifts-
[Você precisa estar registrado e conectado para ver este link.] - [Você precisa estar registrado e conectado para ver este link.] - [Você precisa estar registrado e conectado para ver este link.] - [Você precisa estar registrado e conectado para ver este link.] - [Você precisa estar registrado e conectado para ver este link.]

Zerei a internet
Ver perfil do usuário http://arenarpgmaker.eclipserpg.com

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