• Correção - Ao remover algum titulo sobrecarregar o servidor;
  
• Nova formula de recompeça dos titulos;
  
• Agora o titulo pode ser arrastado para a hotbar;
  
• Menssagens quando usar/remover um titulo;
  
• Remover o titulo que está usando;
  

• Sistema Completo
  
• Extras
  

Começando

Primeiramente faça o download da arquivo [i]Extras, que é encontrado nos Anexos, extraia-o e adicione as formulas e modulos no seu jogo.

frmServer

Crie um commandButton com as seguintes configurações:

Name: cmdReloadTitulos
Caption: Titulos

Dentro dele adicione:

Código:

Dim i As Long
    Call LoadTitulos
    Call TextAdd("All Titulos reloaded.")
    For i = 1 To Player_HighIndex
        If IsPlaying(i) Then
            SendTitulos i
        End If
    Next

modCombat

Troque a Function GetPlayerMaxVital por:

Código:

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

    Select Case Vital
        Case HP
            x = ((GetPlayerLevel(index) / 2)  (GetPlayerStat(index, Endurance) / 2)) * 15  150
        Case MP
            x = ((GetPlayerLevel(index) / 2)  (GetPlayerStat(index, Intelligence) / 2)) * 5  25
    End Select
   
    For i = 1 To MAX_PLAYER_TITULOS
        If GetPlayerTitulo(index, i) > 0 Then
            If Titulo(GetPlayerTitulo(index, i)).Passivo = True Then
                x = x  Titulo(GetPlayerTitulo(index, i)).VitalRec(Vital)
            End If
        End If
    Next
   
    If GetPlayerTUsando(index) > 0 Then x = x + Titulo(GetPlayerTUsando(index)).VitalRec(Vital)

    GetPlayerMaxVital = x
End Function

modDataBase

Na Sub AddChar abaixo de:

Código:

    Dim spritecheck As Boolean

Adicione:

Código:

    Dim y As Long, tituloRec As Long

Procure por:

Código:

' set start spells
        If Class(ClassNum).startSpellCount > 0 Then
            For n = 1 To Class(ClassNum).startSpellCount
                If Class(ClassNum).StartSpell(n) > 0 Then
                    ' spell exist?
                    If Len(Trim$(Spell(Class(ClassNum).StartItem(n)).Name)) > 0 Then
                        Player(index).Spell(n) = Class(ClassNum).StartSpell(n)
                    End If
                End If
            Next
        End If

Abaixo adicione:

Código:

        ' set start titulos
        For n = 1 To MAX_TITULOS
            If Len(Trim$(Titulo(n).Nome)) > 0 Then
                If Titulo(n).Tipo = TITULO_TYPE_INICIAL Then
                    Call SetPlayerTitulo(index, FindOpenTituloSlot(index), n)
                End If
            End If
        Next

modEnumerations

Procure por:

Código:

' Make sure SMSG_COUNT is below everything else

Acima adicione:

Código:

STituloEditor
    SUpdateTitulo
    STitulos

Procure por:

Código:

' Make sure CMSG_COUNT is below everything else

Acima adicione:

Código:

CRequestEditTitulo
    CSaveTitulo
    CRequestTitulos
    CSwapTituloSlots
    CTituloComando

Procure por:

Código:

Public Enum SoundEntity
    seAnimation = 1
    seItem
    seNpc
    seResource
    seSpell

Abaixo adicione:

Código:

seTitulo

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("Clearing titulos...")
    Call ClearTitulos

Procure por:

Código:

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

Abaixo adicione:

Código:

Call SetStatus("Loading 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)
    HandleDataSub(CSwapTituloSlots) = GetAddress(AddressOf HandleSwapTituloSlots)
    HandleDataSub(CTituloComando) = GetAddress(AddressOf HandleTituloComando)

Procure por:

Código:

' Send the update
    'Call SendStats(Index)

Abaixo adicione:

Código:

CheckTitulo index

Procure por:

Código:

Case 2 ' spell
            If Slot > 0 And Slot <= MAX_PLAYER_SPELLS And Player(index).Spell(Slot) Then
                If Len(Trim$(Spell(Player(index).Spell(Slot)).Name)) > 0 Then
                    If FindHotbar(index, Player(index).Spell(Slot), SType) = False Then
                        Player(index).Hotbar(hotbarNum).Slot = Player(index).Spell(Slot)
                        Player(index).Hotbar(hotbarNum).SType = SType
                    End If
                End If
            End If

Abaixo adicione:

Código:

Case 3 ' titulo
            If Slot > 0 And Slot <= MAX_PLAYER_TITULOS Then
                If GetPlayerTitulo(index, Slot) > 0 Then
                    If Len(Trim$(Titulo(GetPlayerTitulo(index, Slot)).Nome)) > 0 Then
                        Player(index).Hotbar(hotbarNum).Slot = GetPlayerTitulo(index, Slot)
                        Player(index).Hotbar(hotbarNum).SType = SType
                    End If
                End If
            End If

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

Abaixo adicione:

Código:

CheckTitulo index

Troque a Function GetplayerStat por:

Código:

Public Function GetPlayerStat(ByVal index As Long, ByVal Stat As Stats) As Long
    Dim x As Long, i As Long
    If index > MAX_PLAYERS Then Exit Function
   
    x = Player(index).Stat(Stat)
   
    For i = 1 To MAX_PLAYER_TITULOS
        If GetPlayerTitulo(index, i) > 0 Then
            If Titulo(GetPlayerTitulo(index, i)).Passivo = True Then
                x = x  Titulo(GetPlayerTitulo(index, i)).StatRec(Stat)
            End If
        End If
    Next
   
    If GetPlayerTUsando(index) > 0 Then x = x  Titulo(GetPlayerTUsando(index)).StatRec(Stat)
   
    For i = 1 To Equipment.Equipment_Count - 1
        If Player(index).Equipment(i) > 0 Then
            If Item(Player(index).Equipment(i)).Add_Stat(Stat) > 0 Then
                x = x  Item(Player(index).Equipment(i)).Add_Stat(Stat)
            End If
        End If
    Next
   
    GetPlayerStat = x
End Function

modServerTcp

Procure por:

Código:

Buffer.WriteLong GetPlayerPK(index)

Abaixo adicione:

Código:

Buffer.WriteLong GetPlayerTUsando(index)
   
    For i = 1 To MAX_PLAYER_TITULOS
        Buffer.WriteLong GetPlayerTitulo(index, i)
    Next

modTypes

Acima da Type PlayerRec adicione:

Código:

Private Type PlayerTituloRec
    Titulo(1 To MAX_PLAYER_TITULOS) As Long
    Usando As Long
End Type

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

Código:

' Titulo
    Titulo As PlayerTituloRec
    ' AddVital
    AddVital(1 To Vitals.Vital_Count - 1) As Long

frmMain

Dentro da picAdmin crie um commandButton com as seguintes configurações:

Name: cmdATitulo
Caption: Titulos

Crie uma image com as seguintes configurações:

Name: imgButton
Index: 7

Dentro dele, logo após a case 6, adicione:

Código:

Case 7
            picTitulos.Visible = Not picTitulos.Visible
            ' show the window
            picCharacter.Visible = False
            picInventory.Visible = False
            picSpells.Visible = False
            picOptions.Visible = False
            picParty.Visible = False
            BltPlayerTitulos
            ' play sound
            PlaySound Sound_ButtonClick

Agora crie três pictureBox com as seguintes configurações:

PictureBox1

Name: picTitulos
Height: 270
Width: 194

PictureBox2

Name: picTempTitulo
Height: 36
Width: 36

PictureBox3

Name: picTituloDesc

Dentro da picTituloDesc crie uma pictureBox e duas labeis com as seguintes configurações:

Picturebox1

Name: picTituloDescPic
Height: 64
Width: 64

Label1

Name: lblTituloName

Label2

Name: lblTituloDesc

Procure por:

Código:

picSpellDesc.Visible = False

Abaixo adicione:

Código:

picTituloDesc.Visible = False

Na Sub imgButton no final de cada case, menos da case 7, adicione:

Código:

picTitulos.Visible = False

Dentro da picTitulos crie uma label com as seguintes configurações:

Name: lblRemoveTUsando
Caption: Parar de usar

No final do modulo adicione:

Código:

Private Sub cmdATitulo_Click()
    ' 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 "cmdATitulo_Click", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Private Sub picTituloDesc_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler

    picTituloDesc.Visible = False
 
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "picTituloDesc_MouseMove", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Private Sub picTitulos_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim titulonum As Long
   
    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler

    titulonum = IsPlayerTitulo(TituloX, TituloY)
    If Button = 1 Then ' left click
        If titulonum <> 0 Then
            SendTituloComando "Usar", titulonum
            DragTitulo = titulonum
            Exit Sub
        End If
    ElseIf Button = 2 Then ' right click
        If titulonum <> 0 Then
            SendTituloComando "Remover", titulonum
            DragTitulo = 0
            Exit Sub
        End If
    End If
   
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "picTitulos_MouseDown", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Private Sub picTitulos_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim tituloslot As Long
Dim x2 As Long, y2 As Long

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

    TituloX = x
    TituloY = y
   
    tituloslot = IsPlayerTitulo(x, y)
   
    If DragTitulo > 0 Then
        Call BltDraggedTitulo(x  picTitulos.Left, y  picTitulos.top)
    Else
        If tituloslot <> 0 Then
            x2 = x  picTitulos.Left - picTituloDesc.width - 1
            y2 = y  picTitulos.top - picTituloDesc.height - 1
            UpdateTituloWindow GetPlayerTitulo(MyIndex, tituloslot), x2, y2
            LastTituloDesc = GetPlayerTitulo(MyIndex, tituloslot)
            Exit Sub
        End If
    End If
   
    picTituloDesc.Visible = False
    LastTituloDesc = 0
   
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "picTitulos_MouseMove", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Private Sub picTitulos_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim i As Long
Dim rec_pos As RECT

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

    If DragTitulo > 0 Then
        ' drag  drop
        For i = 1 To MAX_PLAYER_TITULOS
            With rec_pos
                .top = TituloTop  ((TituloOffsetY  32) * ((i - 1) \ TituloColumns))
                .Bottom = .top  PIC_Y
                .Left = TituloLeft  ((TituloOffsetX  32) * (((i - 1) Mod TituloColumns)))
                .Right = .Left  PIC_X
            End With

            If x >= rec_pos.Left And x <= rec_pos.Right Then
                If y >= rec_pos.top And y <= rec_pos.Bottom Then
                    If DragTitulo <> i Then
                        SendChangeTituloSlots DragTitulo, i
                        Exit For
                    End If
                End If
            End If
        Next
       
        ' hotbar
        For i = 1 To MAX_HOTBAR
            With rec_pos
                .top = picHotbar.top - picTitulos.top
                .Left = picHotbar.Left - picTitulos.Left  (HotbarOffsetX * (i - 1))  (32 * (i - 1))
                .Right = .Left  32
                .Bottom = picHotbar.top - picTitulos.top  32
            End With
           
            If x >= rec_pos.Left And x <= rec_pos.Right Then
                If y >= rec_pos.top And y <= rec_pos.Bottom Then
                    SendHotbarChange 3, DragTitulo, i
                    DragTitulo = 0
                    picTempTitulo.Visible = False
                    Exit Sub
                End If
            End If
        Next
    End If

    DragTitulo = 0
    picTempTitulo.Visible = False
   
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "picTitulos_MouseUp", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Private Sub lblRemoveTUsando_Click()

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

    SendTituloComando "RemoveTUsando", 0

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

Procure por:

Código:

        ElseIf Hotbar(SlotNum).sType = 2 Then ' spell
            x = x  picHotbar.Left  1
            y = y  picHotbar.top - picSpellDesc.height - 1
            UpdateSpellWindow Hotbar(SlotNum).Slot, x, y
            LastSpellDesc = Hotbar(SlotNum).Slot  ' set it so you don't re-set values
            Exit Sub

Abaixo adicione:

Código:

        ElseIf Hotbar(SlotNum).sType = 3 Then ' titulo
            x = x  picHotbar.Left  1
            y = y  picHotbar.top - picTituloDesc.height - 1
            UpdateTituloWindow Hotbar(SlotNum).Slot, x, y
            LastTituloDesc = Hotbar(SlotNum).Slot  ' set it so you don't re-set values
            Exit Sub

modClientTcp

Troque a Sub SendHotbarUse por:

Código:

Public Sub SendHotbarUse(ByVal Slot As Long)
Dim Buffer As clsBuffer, x As Long

    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler
   
    ' check if spell
    If Hotbar(Slot).sType = 2 Then ' spell
        For x = 1 To MAX_PLAYER_SPELLS
            ' is the spell matching the hotbar?
            If PlayerSpells(x) = Hotbar(Slot).Slot Then
                ' found it, cast it
                CastSpell x
                Exit Sub
            End If
        Next
        ' can't find the spell, exit out
        Exit Sub
    ' verificar se é titulo
    ElseIf Hotbar(Slot).sType = 3 Then ' titulo
        For x = 1 To MAX_PLAYER_TITULOS
            If GetPlayerTitulo(MyIndex, x) = Hotbar(Slot).Slot Then
                Call SendTituloComando("Usar", x)
                Exit Sub
            End If
        Next
        Exit Sub
    End If

    Set Buffer = New clsBuffer
    Buffer.WriteLong CHotbarUse
    Buffer.WriteLong Slot
    SendData Buffer.ToArray()
    Set Buffer = Nothing
   
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "SendHotbarUse", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

modConstants

Procure por:

Código:

Public Const MAX_MAINBUTTONS As Long = 6

Mude para:

Código:

Public Const MAX_MAINBUTTONS As Long = 7

modDirectDraw7

Procure por:

Código:

For i = 1 To NumFaces
        Set DDS_Face(i) = Nothing
        ZeroMemory ByVal VarPtr(DDSD_Face(i)), LenB(DDSD_Face(i))
    Next

Abaixo adicione:

Código:

For i = 1 To NumTitulos
        Set DDS_Titulo(i) = Nothing
        ZeroMemory ByVal VarPtr(DDSD_Titulo(i)), LenB(DDSD_Titulo(i))
    Next

Procure por:

Código:

Call DrawPlayerName(i)

Abaixo adicione:

Código:

Call DrawPlayerTitulo(i)

Troque a Sub BltHotbar por:

Código:

Public Sub BltHotbar()
Dim sRECT As RECT, dRECT As RECT, i As Long, num As String, n As Long

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

    frmMain.picHotbar.Cls
    For i = 1 To MAX_HOTBAR
        With dRECT
            .top = HotbarTop
            .Left = HotbarLeft  ((HotbarOffsetX  32) * (((i - 1) Mod MAX_HOTBAR)))
            .Bottom = .top  32
            .Right = .Left  32
        End With
       
        With sRECT
            .top = 0
            .Left = 32
            .Bottom = 32
            .Right = 64
        End With
       
        Select Case Hotbar(i).sType
            Case 1 ' inventory
                If Len(Item(Hotbar(i).Slot).Name) > 0 Then
                    If Item(Hotbar(i).Slot).Pic > 0 Then
                        If DDS_Item(Item(Hotbar(i).Slot).Pic) Is Nothing Then
                            Call InitDDSurf("Items" & Item(Hotbar(i).Slot).Pic, DDSD_Item(Item(Hotbar(i).Slot).Pic), DDS_Item(Item(Hotbar(i).Slot).Pic))
                        End If
                        Engine_BltToDC DDS_Item(Item(Hotbar(i).Slot).Pic), sRECT, dRECT, frmMain.picHotbar, False
                    End If
                End If
            Case 2 ' spell
                With sRECT
                    .top = 0
                    .Left = 0
                    .Bottom = 32
                    .Right = 32
                End With
                If Len(Spell(Hotbar(i).Slot).Name) > 0 Then
                    If Spell(Hotbar(i).Slot).Icon > 0 Then
                        If DDS_SpellIcon(Spell(Hotbar(i).Slot).Icon) Is Nothing Then
                            Call InitDDSurf("Spellicons" & Spell(Hotbar(i).Slot).Icon, DDSD_SpellIcon(Spell(Hotbar(i).Slot).Icon), DDS_SpellIcon(Spell(Hotbar(i).Slot).Icon))
                        End If
                        ' check for cooldown
                        For n = 1 To MAX_PLAYER_SPELLS
                            If PlayerSpells(n) = Hotbar(i).Slot Then
                                ' has spell
                                If Not SpellCD(i) = 0 Then
                                    sRECT.Left = 32
                                    sRECT.Right = 64
                                End If
                            End If
                        Next
                        Engine_BltToDC DDS_SpellIcon(Spell(Hotbar(i).Slot).Icon), sRECT, dRECT, frmMain.picHotbar, False
                    End If
                End If
            Case 3 ' titulo
                With sRECT
                    .top = 0
                    .Left = 0
                    .Bottom = 32
                    .Right = 32
                End With
                If Len(Titulo(Hotbar(i).Slot).Nome) > 0 Then
                    If Titulo(Hotbar(i).Slot).Icone > 0 Then
                        If DDS_Titulo(Titulo(Hotbar(i).Slot).Icone) Is Nothing Then
                            Call InitDDSurf("titulos" & Titulo(Hotbar(i).Slot).Icone, DDSD_Titulo(Titulo(Hotbar(i).Slot).Icone), DDS_Titulo(Titulo(Hotbar(i).Slot).Icone))
                        End If
                        Engine_BltToDC DDS_Titulo(Titulo(Hotbar(i).Slot).Icone), sRECT, dRECT, frmMain.picHotbar, False
                    End If
                End If
        End Select
       
        ' render the letters
        num = "F" & Str(i)
        DrawText frmMain.picHotbar.hDC, dRECT.Left  2, dRECT.top  16, num, QBColor(White)
    Next
    frmMain.picHotbar.Refresh
   
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "BltHotbar", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

modEnumerations

Procure por:

Código:

' Make sure SMSG_COUNT is below everything else

Acima adicione:

Código:

STituloEditor
    SUpdateTitulo
    STitulos

Procure por:

Código:

' Make sure CMSG_COUNT is below everything else

Acima adicione:

Código:

CRequestEditTitulo
    CSaveTitulo
    CRequestTitulos
    CSwapTituloSlots
    CTituloComando

Procure por:

Código:

Public Enum SoundEntity
    seAnimation = 1
    seItem
    seNpc
    seResource
    seSpell

Abaixo adicione:

Código:

seTitulo

modGameLogic

Procure por:

Código:

' faces
            If NumFaces > 0 Then
                For i = 1 To NumFaces    'Check to unload surfaces
                    If FaceTimer(i) > 0 Then 'Only update surfaces in use
                        If FaceTimer(i) < Tick Then  'Unload the surface
                            Call ZeroMemory(ByVal VarPtr(DDSD_Face(i)), LenB(DDSD_Face(i)))
                            Set DDS_Face(i) = Nothing
                            FaceTimer(i) = 0
                        End If
                    End If
                Next
            End If

Abaixo adicione:

Código:

' titulos
            If NumTitulos > 0 Then
                For i = 1 To NumTitulos    ' Check to unload surfaces
                    If TituloTimer(i) > 0 Then ' Only update surfaces in use
                        If TituloTimer(i) < Tick Then  ' Unload the surface
                            Call ZeroMemory(ByVal VarPtr(DDSD_Titulo(i)), LenB(DDSD_Titulo(i)))
                            Set DDS_Titulo(i) = Nothing
                            TituloTimer(i) = 0
                        End If
                    End If
                Next
            End If

Procure por:

Código:

' spells
        Case SoundEntity.seSpell
            If entityNum > MAX_SPELLS Then Exit Sub
            soundName = Trim$(Spell(entityNum).Sound)

Abaixo adicione:

Código:

' titulos
        Case SoundEntity.seTitulo
            If entityNum > MAX_TITULOS Then Exit Sub
            soundName = Trim$(Titulo(entityNum).Som)

modGeneral

Procure por:

Código:

ChkDir App.Path & "\data files\graphics", "faces"

Abaixo adicione:

Código:

ChkDir App.Path & "\data files\graphics", "titulos"

Procure por:

Código:

Call CheckFaces

Abaixo adicione:

Código:

Call CheckTitulos

Procure por:

Código:

frmMain.picSpellDesc.Picture = LoadPicture(App.Path & "\data files\graphics\gui\main\description_spell.jpg")

Abaixo adicione:

Código:

frmMain.picTituloDesc.Picture = LoadPicture(App.Path & "\data files\graphics\gui\main\description_titulo.jpg")
    frmMain.picTempTitulo.Picture = LoadPicture(App.Path & "\data files\graphics\gui\main\dragbox.jpg")
    frmMain.picTitulos.Picture = LoadPicture(App.Path & "\data files\graphics\gui\main\titulos.jpg")

Procure por:

Código:

SpellX = 0
    SpellY = 0

Abaixo adicione:

Código:

TituloX = 0
    TituloY = 0

Procure por:

Código:

Unload frmEditor_Spell

Abaixo adicione:

Código:

Unload frmEditor_Titulo

Procure por:

Código:

frmMain.picParty.Visible = False

Abaixo adicione:

Código:

frmMain.picTitulos.Visible = False

Procure por:

Código:

' blt hotbar
    BltHotbar

Abaixo adicione:

Código:

' blt titulos
    BltPlayerTitulos

Procure por:

Código:

' main - party
    With MainButton(6)
        .fileName = "party"
        .state = 0 ' normal
    End With

Abaixo adicione:

Código:

' main - titulos
    With MainButton(7)
        .fileName = "titulos"
        .state = 0 ' normal
    End With

modHandleData

Procure por:

Código:

HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)

Abaixo adicione:

Código:

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

Procure por:

Código:

Call SetPlayerPK(i, Buffer.ReadLong)

Abaixo adicione:

Código:

Call SetPlayerTUsando(i, Buffer.ReadLong)
   
    For x = 1 To MAX_PLAYER_TITULOS
        Call SetPlayerTitulo(i, x, Buffer.ReadLong)
    Next

No final do modulo adicione:

Código:

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_Titulo
        Editor = EDITOR_TITULO
        .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

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

    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler
   
    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
   
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "HandleUpdateTitulo", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

modImput

Procure por:

Código:

' Editing spell request
                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

Acima da Type PlayerRec adicione:

Código:

Private Type PlayerTituloRec
    Titulo(1 To MAX_PLAYER_TITULOS) As Long
    Usando As Long
End Type

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

Código:

' Titulo
    Titulo As PlayerTituloRec