Nome: Sistema de Títulos
Versão: 0.1.0
Criador: GameLoop
Creditos: Dooolly

Informações
Esse sistema dá títulos para os jogadores, e cada titulo
poderia ter uma bonificação diferente.

Exemplo

Spoiler:

Spoiler:

Tutorial

Server-Side

Em modCombat procure por:

Código:

Function GetPlayerMaxVital(ByVal index As Long, ByVal Vital As Vitals) As Long
 
    If index > MAX_PLAYERS Then Exit Function


Abaixo adicione:

Código:

Dim AddHP As Byte
    
    If Player(index).UseTitulo > 0 Then
        AddHP = Titulo(Player(index).UseTitulo).AddHP
    End If

Em modConstant procure por:

Código:

Public Const MAX_PARTY_MEMBERS As Long = 4

Abaixo adicione:

Código:

Public Const MAX_TITULOS As Long = 50

No final de modDatabase adicione:

Código:


' *************
' ** Titulos **
' *************
Sub SaveTitulo(ByVal TituloNum As Long)
    Dim filename As String
    Dim F As Long
    filename = App.Path & "\data\titulos\titulo" & TituloNum & ".dat"
    F = FreeFile
    Open filename For Binary As #F
    Put #F, , Titulo(TituloNum)
    Close #F
End Sub

Sub SaveTitulos()
    Dim i As Long
    Call SetStatus("Salvando Titulos... ")

    For i = 1 To MAX_TITULOS
        Call SaveTitulo(i)
    Next

End Sub

Sub LoadTitulos()
    Dim filename As String
    Dim i As Long
    Dim F As Long
    Call CheckTitulos

    For i = 1 To MAX_TITULOS
        filename = App.Path & "\data\titulos\titulo" & i & ".dat"
        F = FreeFile
        Open filename For Binary As #F
        Get #F, , Titulo(i)
        Close #F
    Next

End Sub

Sub CheckTitulos()
    Dim i As Long

    For i = 1 To MAX_TITULOS

        If Not FileExist("\Data\titulos\titulo" & i & ".dat") Then
            Call SaveTitulo(i)
        End If

    Next

End Sub

Sub ClearTitulo(ByVal index As Long)
    Call ZeroMemory(ByVal VarPtr(Titulo(index)), LenB(Titulo(index)))
    Titulo(index).Nome = vbNullString
End Sub

Sub ClearTitulos()
    Dim i As Long

    For i = 1 To MAX_TITULOS
        Call ClearTitulo(i)
    Next

End Sub

Em modEnumerations antes de SMSG_COUNT adicione:

Código:

STitulos
    SUpdateTitulo
    STituloEditor

Ainda em modEnumerations antes de CMSG_COUNT adicione:

Código:

CRequestTitulos
    CSaveTitulo
    CRequestEditTitulo
    CTitulos
    CUseTitulo

Em modGeneral procure por:

Código:

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

Abaixo adicione:

Código:

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

Ainda em modGeneral procure por:

Código:

Call ClearAnimations

Abaixo adicione:

Código:

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

Ainda em modGeneral procure por:

Código:

Call LoadAnimations

Abaixo adicione:

Código:

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

Em modHandleData procure por:

Código:

HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)

Abaixo adicione:

Código:

HandleDataSub(CRequestTitulos) = GetAddress(AddressOf HandleRequestTitulos)
    HandleDataSub(CSaveTitulo) = GetAddress(AddressOf HandleSaveTitulo)
    HandleDataSub(CRequestEditTitulo) = GetAddress(AddressOf HandleRequestEditTitulo)
    HandleDataSub(CTitulos) = GetAddress(AddressOf HandleTitulos)
    HandleDataSub(CUseTitulo) = GetAddress(AddressOf HandleUseTitulo)

No final de modHandleData adicione:

Código:

' Titulos
Sub HandleRequestTitulos(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    SendTitulos index
End Sub

Sub HandleSaveTitulo(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim TituloNum As Long
    Dim Buffer As clsBuffer
    Dim TituloSize As Long
    Dim TituloData() As Byte

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

    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()
    TituloNum = Buffer.ReadLong

    ' Prevent hacking
    If TituloNum < 0 Or TituloNum > MAX_TITULOS Then
        Exit Sub
    End If

    TituloSize = LenB(Titulo(TituloNum))
    ReDim TituloData(TituloSize - 1)
    TituloData = Buffer.ReadBytes(TituloSize)
    CopyMemory ByVal VarPtr(Titulo(TituloNum)), ByVal VarPtr(TituloData(0)), TituloSize
    ' Save it
    Call SendUpdateTituloToAll(TituloNum)
    Call SaveTitulo(TituloNum)
    Call AddLog(GetPlayerName(index) & " saved Titulo #" & TituloNum & ".", ADMIN_LOG)
End Sub

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 HandleTitulos(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Call SendPlayerTitulos(index)
End Sub

Sub HandleUseTitulo(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim n As Long
    Dim Player As Long
    Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()

    ' The sprite
    n = Buffer.ReadLong 'CLng(Parse(1))
    Player = Buffer.ReadLong
    Set Buffer = Nothing
    Call SetPlayerTitulo(Player, n)
    Call SendPlayerData(index)
    Exit Sub
End Sub

Em modPlayer procure por:

Código:

Call SendHotbar(index)

Abaixo adicione:

Código:

Call SendTitulos(index)

No final de modPlayer adicione:

Código:

Sub SetPlayerTitulo(ByVal index As Long, ByVal TituloNum As Long)
 If Player(index).UseTitulo > 0 Then
  Player(index).Vital(1) = Player(index).Vital(1) - Titulo(Player(index).UseTitulo).AddHP
 End If
 
 Player(index).UseTitulo = TituloNum
 
 If Titulo(Player(index).UseTitulo).AddHP > 0 Then
  Player(index).Vital(1) = Player(index).Vital(1) + Titulo(Player(index).UseTitulo).AddHP
 End If
End Sub

Function GetPlayerTitulos(ByVal index As Long, ByVal TituloSlot As Long) As Long

    If index > MAX_PLAYERS Then Exit Function
    GetPlayerTitulos = Player(index).Titulos(TituloSlot)
End Function

Function GetPlayerTitulo(ByVal index As Long) As Long

    If index > MAX_PLAYERS Then Exit Function
    GetPlayerTitulo = Player(index).UseTitulo
End Function

Sub AddPlayerTitulo(ByVal index As Long, ByVal TituloNum As Long)
Dim i As Long

 If index > MAX_PLAYERS Then Exit Sub
 
  For i = 1 To MAX_TITULOS
   If Player(index).Titulos(i) = TituloNum Then
      PlayerMsg index, "Você já tem esse titulo!", BrightRed
      Exit Sub
   End If
  
   If Player(index).Titulos(i) <= 0 Then
      Player(index).Titulos(i) = TituloNum
      PlayerMsg index, "Parabéns você ganhou um novo titulo: " & Titulo(TituloNum).Nome, BrightGreen
      Exit Sub
   End If
  Next
End Sub

Em modServerTCP procure por:

Código:

Buffer.WriteLong GetPlayerClass(index)

Abaixo adicione:

Código:

Buffer.WriteLong GetPlayerTitulo(index)

No final de modServerTCP adicione:

Código:

'///////////////////////////////////////////////
'///// Titulos /////////////////////////////////
'///////////////////////////////////////////////

Sub SendTitulos(ByVal index As Long)
    Dim i As Long

    For i = 1 To MAX_TITULOS

        If LenB(Trim$(Titulo(i).Nome)) > 0 Then
            Call SendUpdateTituloTo(index, i)
        End If

    Next

End Sub

Sub SendUpdateTituloToAll(ByVal TituloNum As Long)
    Dim packet As String
    Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    Dim TituloSize As Long
    Dim TituloData() As Byte
    
    Set Buffer = New clsBuffer
    
    TituloSize = LenB(Titulo(TituloNum))
    ReDim TituloData(TituloSize - 1)
    CopyMemory TituloData(0), ByVal VarPtr(Titulo(TituloNum)), TituloSize
    
    Buffer.WriteLong SUpdateTitulo
    Buffer.WriteLong TituloNum
    Buffer.WriteBytes TituloData
    
    SendDataToAll Buffer.ToArray()
    Set Buffer = Nothing
End Sub

Sub SendUpdateTituloTo(ByVal index As Long, ByVal TituloNum As Long)
    Dim packet As String
    Dim Buffer As clsBuffer
    Dim TituloSize As Long
    Dim TituloData() As Byte
    
    Set Buffer = New clsBuffer
    
    TituloSize = LenB(Titulo(TituloNum))
    ReDim TituloData(TituloSize - 1)
    CopyMemory TituloData(0), ByVal VarPtr(Titulo(TituloNum)), TituloSize
    
    Buffer.WriteLong SUpdateTitulo
    Buffer.WriteLong TituloNum
    Buffer.WriteBytes TituloData
    
    SendDataTo index, Buffer.ToArray()
    Set Buffer = Nothing
End Sub

Sub SendPlayerTitulos(ByVal index As Long)
    Dim packet As String
    Dim i As Long
    Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    Buffer.WriteLong STitulos

    For i = 1 To MAX_TITULOS
        Buffer.WriteLong GetPlayerTitulos(index, i)
    Next

    SendDataTo index, Buffer.ToArray()
    Set Buffer = Nothing
End Sub

'//////////////////////////////////////////////

Em modTypes procure por:

Código:

Public Party(1 To MAX_PARTYS) As PartyRec

Abaixo adicione:

Código:

Public Titulo(1 To MAX_TITULOS) As TitulosRec

Ainda na modTypes logo na PlayeRec procure por:

Código:

Dir As Byte

Abaixo adicione:

Código:


    ' Titulos
    UseTitulo As Long
    Titulos(1 To MAX_TITULOS) As Long

No final da modTypes adicione:

Código:

Public Type TitulosRec
    Nome As String * NAME_LENGTH
    Cor As Byte
    AddHP As Byte
End Type

Servidor Terminado!

Client-Side

Baixe esse arquivo antes: Titulo Files.rar

Adicione as duas forms em seu projeto!

Dê um CTRL + X no picTitulos que está dentro do Form1
Depois dê um CTRL + V na frmMain
Posicione onde você quiser. Lembre-se de verificar se você está com
o frmMain selecionado, você não pode por dentro de outra coisa, apenas no frmMain


Crie um botão e adicione:

Código:

picCharacter.Visible = False
            picInventory.Visible = False
            picSpells.Visible = False
            picOptions.Visible = False
            picParty.Visible = False
            ' picQuestLog.Visible = False
            picTitulo.Visible = True
            ' send packet
                Set Buffer = New clsBuffer
                Buffer.WriteLong CTitulos
                SendData Buffer.ToArray()
                Set Buffer = Nothing
                ' show the window
            PlaySound Sound_ButtonClick

Abra o código dá frmMain e no final adicione:

Código:

' Titulos
Private Sub cmbUsarTitulo_Click()
Dim Titulo As Long
    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler

    If Trim$(lstTitulo.text) = vbNullString Then Exit Sub
       Titulo = GetTituloNum(lstTitulo.text)
       UseTitulo MyIndex, Titulo
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "cmbUsarTitulo_Click", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Em modConstant procure por:

Código:

Public Const MAX_PARTY_MEMBERS As Long = 4

Abaixo adicione:

Código:

Public Const MAX_TITULOS As Long = 50

Ainda em modConstant procure por:

Código:

Public Const EDITOR_ANIMATION As Byte = 6

Abaixo adicione:

Código:

Public Const EDITOR_TITULOS As Byte = 7

Em modEnumerations antes de SMSG_COUNT adicione:

Código:

STitulos
    SUpdateTitulo
    STituloEditor

Ainda em modEnumerations antes de CMSG_COUNT adicione:

Código:

CRequestTitulos
    CSaveTitulo
    CRequestEditTitulo
    CTitulos
    CUseTitulo

No final do modClientTCP adicione:

Código:

' ##### Titulo #####
Public Sub UseTitulo(ByVal Index As Long, ByVal TituloNum As Long)
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 CUseTitulo
    Buffer.WriteLong TituloNum
    Buffer.WriteLong Index
    SendData Buffer.ToArray()
    Set Buffer = Nothing
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "UseTitulo", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Public Sub SendRequestEditTitulo()
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 CRequestEditTitulo
    SendData Buffer.ToArray()
    Set Buffer = Nothing
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "SendRequestEditTitulo", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Public Sub SendSaveTitulo(ByVal TituloNum As Long)
Dim Buffer As clsBuffer
Dim TituloSize As Long
Dim TituloData() As Byte
    
    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler
    
    Set Buffer = New clsBuffer
    TituloSize = LenB(Titulo(TituloNum))
    ReDim TituloData(TituloSize - 1)
    CopyMemory TituloData(0), ByVal VarPtr(Titulo(TituloNum)), TituloSize
    
    Buffer.WriteLong CSaveTitulo
    Buffer.WriteLong TituloNum
    Buffer.WriteBytes TituloData
    SendData Buffer.ToArray()
    
    Set Buffer = Nothing
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "SendSaveTitulo", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Sub SendRequestTitulos()
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 CRequestTitulos
    SendData Buffer.ToArray()
    Set Buffer = Nothing
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "SendRequestTitulos", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub
' #################

No final de modDatabase adicione:

Código:

' ##### Titulos #####

Sub ClearTitulos()
Dim i As Long

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

    For i = 1 To MAX_TITULOS
        Call ClearTitulo(i)
    Next

    ' Error handler
    Exit Sub
errorhandler:
    HandleError "ClearTitulos", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Sub ClearTitulo(ByVal Index As Long)
    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler

    Call ZeroMemory(ByVal VarPtr(Titulo(Index)), LenB(Titulo(Index)))
    Titulo(Index).Nome = vbNullString
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "ClearTitulo", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Sub SetPlayerTitulo(ByVal Index As Long, ByVal Titulo As String)
    ' 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).UseTitulo = Titulo
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "SetPlayerTitulo", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Public Function GetTituloNum(ByVal TituloName As String) As Long
    Dim i As Long
    GetTituloNum = 0
    
    For i = 1 To MAX_TITULOS
        If Trim$(Titulo(i).Nome) = Trim$(TituloName) Then
            GetTituloNum = i
            Exit For
        End If
    Next
End Function
'###############

No final de modGameEditors adicione:

Código:

' ////////////////////
' // Titulos Editor //
' ////////////////////
Public Sub TituloEditorInit()
    
    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler

    If frmEditor_Titulos.Visible = False Then Exit Sub
    EditorIndex = frmEditor_Titulos.lstIndex.ListIndex + 1
    
    With frmEditor_Titulos
        ' set values
        .txtNome.text = Trim$(Titulo(EditorIndex).Nome)
        .optCor(Titulo(EditorIndex).Cor).Value = True
        .scrlHP.Value = Titulo(EditorIndex).AddHP
    End With
    
    Titulo_Changed(EditorIndex) = True
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "TituloEditorInit", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Public Sub TitulosEditorOk()
Dim i As Long

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

    For i = 1 To MAX_TITULOS
        If Titulo_Changed(i) Then
            Call SendSaveTitulo(i)
        End If
    Next
    
    Unload frmEditor_Titulos
    Editor = 0
    ClearChanged_Titulo
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "TitulosEditorOk", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

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

    Editor = 0
    Unload frmEditor_Titulos
    ClearChanged_Titulo
    ClearTitulos
    SendRequestTitulos
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "TituloEditorCancel", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

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

    ZeroMemory Titulo_Changed(1), MAX_TITULOS * 2 ' 2 = boolean length
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "ClearChanged_Titulo", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub


No final de modGlobals adicione:

Código:

' Titulos
Public PlayerTitulos(1 To MAX_TITULOS) As Long
Public Titulo_Changed(1 To MAX_TITULOS) As Boolean


Em modHandledata procure por:

Código:

HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)

Abaixo adicione:

Código:

'/////////////////////
    HandleDataSub(STitulos) = GetAddress(AddressOf HandleTitulos)
    HandleDataSub(SUpdateTitulo) = GetAddress(AddressOf HandleUpdateTitulo)
    HandleDataSub(STituloEditor) = GetAddress(AddressOf HandleTituloEditor)

Ainda em modHandledata procure por:

Código:

Call SetPlayerClass(i, Buffer.ReadLong)

Abaixo adicione:

Código:

Call SetPlayerTitulo(i, Buffer.ReadLong)

No final do modHandledata adicione:

Código:

' ##### Titulos #####
Private Sub HandleUpdateTitulo(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim TituloNum As Long
Dim Buffer As clsBuffer
Dim TituloSize As Long
Dim TituloData() 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()
    
    TituloNum = Buffer.ReadLong
    
    TituloSize = LenB(Titulo(TituloNum))
    ReDim TituloData(TituloSize - 1)
    TituloData = Buffer.ReadBytes(TituloSize)
    CopyMemory ByVal VarPtr(Titulo(TituloNum)), ByVal VarPtr(TituloData(0)), TituloSize
    Set Buffer = Nothing
    
    ' Update the spells on the pic
    Set Buffer = New clsBuffer
    Buffer.WriteLong CTitulos
    SendData Buffer.ToArray()
    Set Buffer = Nothing
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "HandleUpdateTitulo", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Private Sub HandleTituloEditor()
Dim i As Long

    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler
    
    With frmEditor_Titulos
        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

    ' Error handler
    Exit Sub
errorhandler:
    HandleError "HandleTituloEditor", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Sub HandleTitulos(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim i As Long, TituloName As String
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.WriteBytes Data()
    
    frmMain.lstTitulo.Clear
    
    For i = 1 To MAX_TITULOS
        Player(MyIndex).Titulos(i) = Buffer.ReadLong
        If Player(MyIndex).Titulos(i) > 0 Then
         TituloName = Trim$(Titulo(Player(MyIndex).Titulos(i)).Nome)
         frmMain.lstTitulo.AddItem TituloName
         TituloName = vbNullString
        End If
    Next
    
    Set Buffer = Nothing
    
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "HandleTitulos", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub
' ###############

Em modText procure por:

Código:

' Draw name
    Call DrawText(TexthDC, TextX, TextY, Name, color)

Abaixo adicione:

Código:

If Player(Index).UseTitulo > 0 Then
      If GetPlayerSprite(Index) < 1 Or GetPlayerSprite(Index) > NumCharacters Then
        TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - 16 - 14
      Else
        ' Determine location for text
        TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) + 16 - 14
      End If
      
      Select Case Titulo(Player(Index).UseTitulo).Cor
         Case 0
           color = QBColor(BrightRed)
         Case 1
           color = QBColor(BrightBlue)
         Case 2
           color = QBColor(Green)
         Case 3
           color = QBColor(Yellow)
         Case 4
           color = QBColor(Pink)
      End Select
      
      Name = Trim$(Titulo(Player(Index).UseTitulo).Nome)
      TextX = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).XOffset + (PIC_X \ 2) - getWidth(TexthDC, (Trim$(Name)))
      
      Call DrawText(TexthDC, TextX, TextY, Name, color)
    End If

Em modTypes procure por:

Código:

Public Animation(1 To MAX_ANIMATIONS) As AnimationRec

Abaixo adicione:

Código:

Public Titulo(1 To MAX_TITULOS) As TitulosRec

Ainda na modTypes procure por:

Código:

Dir As Byte

Abaixo adicione:

Código:

' Titulos
    UseTitulo As Long
    Titulos(1 To MAX_TITULOS) As Long

No final de modTypes adicione:

Código:

Public Type TitulosRec
    Nome As String * NAME_LENGTH
    Cor As Byte
    AddHP As Byte
End Type

Cliente Terminado!

Informações
Para você adicionar um titulo é só você usar o seguinte codigo no Serve-Side

Código:

AddPlayerTitulo index, 1 'Onde tem o numero 1 você muda para o numero do titulo.

Para abrir a frmTitulos é só utilizar o codigo:

Código:


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

    SendRequestEditTitulo
    

O Sistema está na versão 0.1.0 então é só um teste, vou está sempre atualizando o sistema, espero que não tenha erros, se tiver comenta ai!

Depois faço a parte de ganhar o títulos por item, ou por missões dê sua opinião ai!
Lembrando que se for por missões terá que ser o sistema de quests do alatar.