Titulo

frmServer

Crie um ComandButton com as seguintes configurações:

Name: cmdReloadTitulos
Caption: Titulos

Dentro dele adicione:

Código:

Dim i As Long
    Call LoadTitulos
    Call TextAdd("Todos titulos foram recarregados.")
    For i = 1 To Player_HighIndex
        If IsPlaying(i) Then
            SendTitulos i
        End If
    Next

modDataBase

Procure por:

Código:

        Player(Index).Vital(Vitals.MP) = GetPlayerMaxVital(Index, Vitals.MP)

Abaixo adicione:

Código:

        For n = 1 To MAX_TITULOS
            If Titulo(n).Inicial = 1 Then
                Player(Index).Titulo = Titulo(n).Nome
            End If
        Next

modEnumerations

Procure por:

Código:

    ' Make sure SMSG_COUNT is below everything else

Acima adicione:

Código:

    STituloEditor
    SUpdateTitulo

Procure por:

Código:

    ' Make sure CMSG_COUNT is below everything else

Acima adicione:

Código:

    CRequestEditTitulo
    CSaveTitulo
    CRequestTitulos

modGeneral

Procure por:

Código:

    ChkDir App.Path & "\Data", "spells"

Abaixo adicione:

Código:

    ChkDir App.Path & "\Data", "titulos"

Procure por:

Código:

    Call SetStatus("Clearing animations...")
    Call ClearAnimations

Abaixo adicione:

Código:

    Call SetStatus("Limpando titulos...")
    Call ClearTitulos

Procure por:

Código:

    Call SetStatus("Loading animations...")
    Call LoadAnimations

Abaixo adicione:

Código:

    Call SetStatus("Carregando titulos...")
    Call LoadTitulos

modHandleData

Procure por:

Código:

    HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)

Abaixo adicione:

Código:

    HandleDataSub(CRequestEditTitulo) = GetAddress(AddressOf HandleRequestEditTitulo)
    HandleDataSub(CSaveTitulo) = GetAddress(AddressOf HandleSaveTitulo)
    HandleDataSub(CRequestTitulos) = GetAddress(AddressOf HandleRequestTitulos)

No final do modulo adicione:

Código:

Sub HandleRequestEditTitulo(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim Buffer As clsBuffer

    ' Prevent hacking
    If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
        Exit Sub
    End If

    Set Buffer = New clsBuffer
    Buffer.WriteLong STituloEditor
    SendDataTo Index, Buffer.ToArray()
    Set Buffer = Nothing
End Sub

Sub HandleSaveTitulo(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim n As Long
    Dim Buffer As clsBuffer
    Dim TituloSize As Long
    Dim TituloData() As Byte
    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()

    ' Prevent hacking
    If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
        Exit Sub
    End If

    n = Buffer.ReadLong 'CLng(Parse(1))

    If n < 0 Or n > MAX_TITULOS Then
        Exit Sub
    End If
   
    ' Update the Titulo
    TituloSize = LenB(Titulo(n))
    ReDim TituloData(TituloSize - 1)
    TituloData = Buffer.ReadBytes(TituloSize)
    CopyMemory ByVal VarPtr(Titulo(n)), ByVal VarPtr(TituloData(0)), TituloSize
    Set Buffer = Nothing
   
    ' Save it
    Call SendUpdateTituloToAll(n)
    Call SaveTitulo(n)
    Call AddLog(GetPlayerName(Index) & " saved Titulo #" & n & ".", ADMIN_LOG)
End Sub

Sub HandleRequestTitulos(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    SendTitulos Index
End Sub

modPlayer

Procure por:

Código:

    Call SendHotbar(Index)

Abaixo adicione:

Código:

    Call SendTitulos(Index)

Procure por:

Código:

    If level_count > 0 Then
        If level_count = 1 Then
            'singular
            GlobalMsg GetPlayerName(Index) & " has gained " & level_count & " level!", Brown
        Else
            'plural
            GlobalMsg GetPlayerName(Index) & " has gained " & level_count & " levels!", Brown
        End If
        SendEXP Index
        SendPlayerData Index

Abaixo adicione:

Código:

        CheckNewTitulo Index

modServerTcp

Procure por:

Código:

    Buffer.WriteLong GetPlayerPK(Index)

Abaixo adicione:

Código:

    Buffer.WriteString GetPlayerTitulo(Index)

No final da Private Type PlayerRec, antes do End Type adicione:

Código:

    Titulo As String

frmMain

Na picAdmin crie um ComandButton com as seguintes configurações:

Name: cmdATitulo
Caption: Titulo

Dentro dele adicione:

Código:

    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler

    If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
       
        Exit Sub
    End If

    SendRequestEditTitulo
   
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "cmdTitulo_Click", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub

modDirectDraw7

Procure por:

Código:

            Call DrawPlayerName(i)

Abaixo adicione:

Código:

            Call DrawTituloName(i)

modEnumerations

Procure por:

Código:

    ' Make sure SMSG_COUNT is below everything else

Acima adicione:

STituloEditor
SUpdateTitulo

Procure por:

Código:

    ' Make sure CMSG_COUNT is below everything else

Acima adicione:

Código:

    CRequestEditTitulo
    CSaveTitulo
    CRequestTitulos

modGlobals

Procure por:

Código:

Public Shop_Changed(1 To MAX_SHOPS) As Boolean

Abaixo adicione:

Código:

Public Titulo_Changed(1 To MAX_TITULOS) As Boolean

modHandleData

Procure por:

Código:

    HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)

Abaixo adicione:

Código:

    HandleDataSub(STituloEditor) = GetAddress(AddressOf HandleTituloEditor)
    HandleDataSub(SUpdateTitulo) = GetAddress(AddressOf HandleUpdateTitulo)

Procure por:

Código:

    Call SetPlayerPK(i, Buffer.ReadLong)

Abaixo adicione:

Código:

    Call SetPlayerTitulo(i, Buffer.ReadString)

No final do modulo adicione:

Código:

Private Sub HandleTituloEditor()
    Dim i As Long
   
    With frmEditor_Titulo
        Editor = EDITOR_TITULOS
        .lstIndex.Clear

        ' Add the names
        For i = 1 To MAX_TITULOS
            .lstIndex.AddItem i & ": " & Trim$(Titulo(i).Nome)
        Next

        .Show
        .lstIndex.ListIndex = 0
        TituloEditorInit
    End With

End Sub

Private Sub HandleUpdateTitulo(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim n As Long
    Dim Buffer As clsBuffer
    Dim TituloSize As Long
    Dim TituloData() As Byte
    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()
    n = Buffer.ReadLong
    ' Update the Titulo
    TituloSize = LenB(Titulo(n))
    ReDim TituloData(TituloSize - 1)
    TituloData = Buffer.ReadBytes(TituloSize)
    CopyMemory ByVal VarPtr(Titulo(n)), ByVal VarPtr(TituloData(0)), TituloSize
    Set Buffer = Nothing
End Sub

modImput

Procure por:

Código:

                Case "/editspell"
                    If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then GoTo Continue

                    SendRequestEditSpell

Abaixo adicione:

Código:

                    ' Editing titulo request
                Case "/edittitulo"
                    If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then GoTo Continue
                    SendRequestEditTitulo

modTypes

No final da Private Type PlayerRec, antes do End Type adicione:

Código:

    Titulo As String

Ótimo tutorial ricardo, está de parabéns.
+ 1 crédito.

Os arquivos foram apagados =s