Isto é uma pré-visualização de um tema em Hitskin.com
Instalar o tema • Voltar para a ficha do tema
Sistema de Rank Funcional
+9
Hooly
falcon459
Felix Blayder
mdomiciano
rangeleo
RD12
AlexsandroChaos
jiraya
Valentine
13 participantes
Página 1 de 2
Página 1 de 2 • 1, 2
Sistema de Rank Funcional
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:
13 - Ainda em modEnumerations, procure por:
Abra o Servidor
1 - Em modConstants, procure por:
Créditos:
Valentine
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
- 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
- Código:
Public Const MAX_PARTY_MEMBERS As Long = 4
- Código:
Public Const MAX_RANK As Long = 10
- 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
- Código:
' Make sure CMSG_COUNT is below everything else
- Código:
CPartyLeave
- Código:
CRequestRank
13 - Ainda em modEnumerations, procure por:
- Código:
' Make sure SMSG_COUNT is below everything else
- Código:
SPartyVitals
- Código:
SRankUpdate
- Código:
HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)
- Código:
HandleDataSub(SRankUpdate) = GetAddress(AddressOf HandleRankUpdate)
- 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
- Código:
' Whos Online
Case "/who"
SendWhosOnline
- Código:
' Request Rank
Case "/rank"
SendRequestRank
frmMain.picRank.Visible = Not frmMain.picRank.Visible
- Código:
frmMain.picParty.Visible = False
- Código:
frmMain.picRank.Visible = False
Abra o Servidor
1 - Em modConstants, procure por:
- Código:
Public Const MAX_PARTY_MEMBERS As Long = 4
- Código:
Public Const MAX_RANK As Long = 10
- Código:
' Make sure SMSG_COUNT is below everything else
- Código:
SPartyVitals
- Código:
SRankUpdate
- Código:
' Make sure CMSG_COUNT is below everything else
- Código:
CPartyLeave
- Código:
CRequestRank
- Código:
HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)
- Código:
HandleDataSub(CRequestRank) = GetAddress(AddressOf HandleRequestRank)
- Código:
Sub HandleRequestRank(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
SendRankUpdate index
End Sub
- 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
- Código:
Sub CheckPlayerLevelUp(ByVal index As Long)
- Código:
Dim level_count As Long
- Código:
Dim RankPos As Byte
- Código:
SendPlayerData index
- Código:
' check rank
RankPos = CheckRank(index)
If RankPos > 0 Then
ChangeRank index, RankPos
End If
- 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
- 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
- Código:
Public Party(1 To MAX_PARTYS) As PartyRec
- Código:
Public Rank(1 To MAX_RANK) As RankRec
- Código:
Private Type OptionsRec
Game_Name As String
MOTD As String
Port As Long
Website As String
End Type
- Código:
Private Type RankRec
Name As String * ACCOUNT_LENGTH
Level As Long
End Type
- Código:
' Send Resource cache
For i = 0 To ResourceCache(GetPlayerMap(index)).Resource_Count
SendResourceCacheTo index, i
Next
- 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
- Código:
Call SetStatus("Loading animations...")
Call LoadAnimations
- 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)
bangaran gosta desta mensagem
Re: Sistema de Rank Funcional
Oi Valentine esse sistema ta ótimo, detalhado e completo nossa deve ter dado trabalho.
Parabens pelo ótimo trabalho.
+1credito .
Parabens pelo ótimo trabalho.
+1credito .
_________________
[roll="Ataque nível 1"]
Se escrevam no meu Canal no Youtube: Eberton Munhoz
Se escrevam no meu Canal no Youtube: Eberton Munhoz
Re: Sistema de Rank Funcional
Como que abre a janela do rank?
AlexsandroChaos- Novato
- Mensagens : 26
Créditos : 5
Re: Sistema de Rank Funcional
após terminar todos os passos do tutorial, você terá que digitar
para abrir e fechar a janela de rank./rank
Re: Sistema de Rank Funcional
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.
Mas cadê meus créditos? Te respondi várias dúvidas e eu q te ensinei programar.
Re: Sistema de Rank Funcional
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
@Off-Topic
Ah vá, você que deveria me agradecer por te proteger do joão kkk
Re: Sistema de Rank Funcional
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.
rangeleo- Novato
- Mensagens : 17
Créditos : 0
Re: Sistema de Rank Funcional
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
Faça uma doação para ajudar nos custos:
https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=3N8T2RJ977RCQ
Felix Blayder- Membro de Honra
- Mensagens : 1406
Créditos : 220
Ficha do personagem
Nível: 1
Experiência:
(0/0)
Vida:
(30/30)
Re: Sistema de Rank Funcional
Muito Bom Funcionou sem erro nenhum Muito Obrigado +1 Credito
falcon459- Novato
- Mensagens : 7
Créditos : 0
Página 1 de 2 • 1, 2
Tópicos semelhantes
» sistema de rank
» Sistema de Rank
» Sistema de Rank Online
» [PEDIDO] Sistema de Rank
» [Pedido] Sistema de Rank para eo 2.0
» Sistema de Rank
» Sistema de Rank Online
» [PEDIDO] Sistema de Rank
» [Pedido] Sistema de Rank para eo 2.0
Página 1 de 2
Permissões neste sub-fórum
Não podes responder a tópicos
|
|