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 [EO] Sistema de Rank Ninja em 6/3/2013, 21:54

Myke ~

avatar
Membro Honorário I
Membro Honorário I
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.

Ver perfil do usuário

2 Re: [EO] Sistema de Rank Ninja em 6/3/2013, 23:03

Warrior

avatar
Ajudante
Ajudante
Esse sistema e bem massa cara '-' +1



[Você precisa estar registrado e conectado para ver este link.]
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