[EO] Sistema de Rank Ninja

Myke ~ · 1 [EO] Sistema de Rank Ninja 6/3/2013, 21:54

Myke ~

Membro Honorário I

Mensagens : 184
<b> T$: </b>

T$: : 5075

Idade : 27

OBS: isso e um sistema de rank ninja tipo, Estudante, gennin, etc..
OBS2: mais vc pode por para outras coisas, so alterar o nome..

Vamos começar..

Abra o Server~Side:

na addchar procure por:

Código:: For n = 1 To Stats.Stat_Count - 1 Player(Index).Stat(n) = Class(ClassNum).Stat(n) Next n

e em baixo add:

Código:: Player(index).Rank = 1

OBS: isso e para caso queira q ja começe com o rank, se nao quizer nao ponha isso.

no final da modDataBase adicione:

Código:: Function GetPlayerRank(ByVal index As Long) As Long If index > MAX_PLAYERS Then Exit Function GetPlayerRank = Player(index).Rank End Function Sub SetPlayerRank(ByVal index As Long, ByVal Rank As Long) Player(index).Rank = Rank End Sub

em baixo de:

Código:: HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)

add:

Código:: HandleDataSub(CSetRank) = GetAddress(AddressOf HandleSetRank)

no final add:

Código:: Sub HandleSetRank(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim u As String Dim n As Long Dim i As Long Dim Buffer As clsBuffer Set Buffer = New clsBuffer Buffer.WriteBytes Data() ' Prevent hacking If GetPlayerAccess(index) < ADMIN_CREATOR Then Exit Sub End If n = FindPlayer(Buffer.ReadString) i = Buffer.ReadLong Set Buffer = Nothing If IsPlaying(n) = False Then Exit Sub Player(n).Rank = i SendPlayerData n SavePlayer n Select Case i Case 1 u = "Estudante" Case 2 u = "Gennin" Case 3 u = "Chunnin" Case 4 u = "Jounnin" Case 5 u = "Anbu" Case 6 u = "Sennin" Case 7 u = "Desertor" Case 8 u = "Hokage" Case 9 u = "Kazekage" Case 10 u = "Mizukage" Case 11 u = "Raikage" Case 12 u = "Tsuchikage" Case Else Exit Sub End Select GlobalMsg " Parabéns, o jogador: " & GetPlayerName(n) & " Se tornou " & u & "!", Blue End Sub

procure por:

Código:: Buffer.WriteLong GetPlayerAccess(index)

em baixo add:

Código:: Buffer.WriteByte Player(index).Rank

na Private Type PlayerRec adicione:

Código:: Rank As Byte

procure por:

Código:: CPartyLeave

em baixo add:

Código:: CSetRank

agora vamos ao Client~Side:

no final da modText add:

Código:: Public Sub DrawPlayerRank(ByVal Index As Long) If Player(Index).Rank < 0 Then Exit Sub Dim TextX As Long Dim TextY As Long Dim color As Long Dim Name As String Select Case Player(Index).Rank Case 1 Name = "Estudante" color = QBColor(Blue) Case 2 Name = "Gennin" color = QBColor(BrightGreen) Case 3 Name = "Chunnin" color = QBColor(BrightBlue) Case 4 Name = "Jounnin" color = QBColor(Blue) Case 5 Name = "ANBU" color = QBColor(DarkGrey) Case 6 Name = "Sennin" color = QBColor(Pink) Case 7 Name = "Nukenin" color = QBColor(Red) Case 8 Name = "Hokage" color = QBColor(BrightRed) Case 9 Name = "Kazekage" color = QBColor(Yellow) Case 10 Name = "Mizukage" color = QBColor(Cyan) Case 11 Name = "Raikage" color = QBColor(Yellow) Case 12 Name = "Tshuchikage" color = QBColor(Yellow) Exit Sub End Select ' calc pos TextX = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).XOffset + (PIC_X \ 2) - getWidth(TexthDC, (Trim$(Name))) If GetPlayerSprite(Index) < 1 Or GetPlayerSprite(Index) > NumCharacters Then TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - 18 Else ' Determine location for text TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) + 9 End If ' Draw name Call DrawText(TexthDC, TextX, TextY, Name, color) End Sub

na Type PlayerRec adicione:

Código:: Rank As Byte

na modClientTcp adicione:

Código:: Public Sub SendSetRank(ByVal Name As String, ByVal Access As Byte) Dim Buffer As clsBuffer Set Buffer = New clsBuffer Buffer.WriteLong CSetRank Buffer.WriteString Name Buffer.WriteLong Access SendData Buffer.ToArray() Set Buffer = Nothing End Sub

no final da modDataBase adicione:

Código:: Sub SetPlayerRank(ByVal Index As Long, ByVal Rank As Long) ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Index > MAX_PLAYERS Then Exit Sub Player(Index).Rank = Rank ' Error handler Exit Sub errorhandler: HandleError "SetPlayerRank", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Function GetPlayerRank(ByVal Index As Long) As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Index > MAX_PLAYERS Then Exit Function GetPlayerRank = Player(Index).Rank ' Error handler Exit Function errorhandler: HandleError "GetPlayerRank", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Function End Function

procure por:

Código:: Call DrawPlayerName(i)

em baixo add:

Código:: DrawPlayerRank i

procure por:

Código:: CPartyLeave

em baixo add:

Código:: CSetRank

em baixo de:

Código:: Call SetPlayerAccess(i, Buffer.ReadLong)

add:

Código:: Player(i).Rank = Buffer.ReadByte

em cima de:

Código:: Case "/info" adicione:

Código:: Case "/rank" If GetPlayerAccess(MyIndex) < ADMIN_CREATOR Then GoTo Continue If UBound(Command) < 1 Then AddText "Usage: /rank (nome) (num)", AlertColor GoTo Continue End If If IsNumeric(Command(1)) Or Not IsNumeric(Command(2)) Then AddText "Usage: /rank (nome) (num)", AlertColor GoTo Continue End If SendSetRank Command(1), CLng(Command(2))

OBS: se quizer pode usar isso para Org tbm.. so modificar o codigo !
OBS2: agora vai aparecer [Gennin] ou outro titulo ao lado do seu nome !
OBS3: vc pode configurar de outras maneiras, ta ai o sistema, utilezem-o como bem entenderem.,
OBS4: para setar novo rank é exemplo: /Rank thales 3

Créditos: Thales12 pelo sistema.