[EO] Titulos 1.2

Imagens




Log - Versão 1.1 a Versão 1.2

• 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;
  

frmServer

Name: cmdReloadTitulos
Caption: Titulos

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

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

Código:

    Dim spritecheck As Boolean

Código:

    Dim y As Long, tituloRec As Long

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

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

Código:

' Make sure SMSG_COUNT is below everything else

Código:

STituloEditor
    SUpdateTitulo
    STitulos

Código:

' Make sure CMSG_COUNT is below everything else

Código:

CRequestEditTitulo
    CSaveTitulo
    CRequestTitulos
    CSwapTituloSlots
    CTituloComando

Código:

Public Enum SoundEntity
    seAnimation = 1
    seItem
    seNpc
    seResource
    seSpell

Código:

seTitulo

modGeneral

Código:

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

Código:

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

Código:

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

Código:

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

Código:

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

Código:

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

modHandleData

Código:

HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)

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)

Código:

' Send the update
    'Call SendStats(Index)

Código:

CheckTitulo index

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

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

Código:

Call SendHotbar(index)

Código:

Call SendTitulos(index)

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

Código:

CheckTitulo index

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

Código:

Buffer.WriteLong GetPlayerPK(index)

Código:

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

modTypes

Código:

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

Código:

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

frmMain

Name: cmdATitulo
Caption: Titulos

Name: imgButton
Index: 7

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

Name: picTitulos
Height: 270
Width: 194

Name: picTempTitulo
Height: 36
Width: 36

Name: picTituloDesc

Name: picTituloDescPic
Height: 64
Width: 64

Name: lblTituloName

Name: lblTituloDesc

Código:

picSpellDesc.Visible = False

Código:

picTituloDesc.Visible = False

Código:

picTitulos.Visible = False

Name: lblRemoveTUsando
Caption: Parar de usar

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

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

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

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

Código:

Public Const MAX_MAINBUTTONS As Long = 6

Código:

Public Const MAX_MAINBUTTONS As Long = 7

modDirectDraw7

Código:

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

Código:

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

Código:

Call DrawPlayerName(i)

Código:

Call DrawPlayerTitulo(i)

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

Código:

' Make sure SMSG_COUNT is below everything else

Código:

STituloEditor
    SUpdateTitulo
    STitulos

Código:

' Make sure CMSG_COUNT is below everything else

Código:

CRequestEditTitulo
    CSaveTitulo
    CRequestTitulos
    CSwapTituloSlots
    CTituloComando

Código:

Public Enum SoundEntity
    seAnimation = 1
    seItem
    seNpc
    seResource
    seSpell

Código:

seTitulo

modGameLogic

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

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

Código:

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

Código:

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

modGeneral

Código:

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

Código:

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

Código:

Call CheckFaces

Código:

Call CheckTitulos

Código:

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

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")

Código:

SpellX = 0
    SpellY = 0

Código:

TituloX = 0
    TituloY = 0

Código:

Unload frmEditor_Spell

Código:

Unload frmEditor_Titulo

Código:

frmMain.picParty.Visible = False

Código:

frmMain.picTitulos.Visible = False

Código:

' blt hotbar
    BltHotbar

Código:

' blt titulos
    BltPlayerTitulos

Código:

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

Código:

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

modHandleData

Código:

HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)

Código:

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

Código:

Call SetPlayerPK(i, Buffer.ReadLong)

Código:

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

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

Código:

' Editing spell request
                Case "/editspell"
                    If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then GoTo Continue

                    SendRequestEditSpell

Código:

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

                    SendRequestEditTitulo

modTypes

Código:

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

Código:

' Titulo
    Titulo As PlayerTituloRec

+1 De Credito

Serafinguildets escreveu:#fato

• Removido erro de quando usar ou remover um titulo em branco sobrecarrgar o servidor;
  
• Animação quando usar e remover os titulos;
  
• Recompença de vital no titulo;
  
• Titulo passivo;
  
• Cor na descrição do nome dos titulos;
  

modCombat

Código:

Function GetPlayerMaxVital(ByVal index As Long, ByVal Vital As Vitals) As Long
    If index > MAX_PLAYERS Then Exit Function
    Select Case Vital
        Case HP
            GetPlayerMaxVital = ((GetPlayerLevel(index) / 2) + (GetPlayerStat(index, Endurance) / 2)) * 15 + 150 + Player(index).AddVital(Vital)
        Case MP
            GetPlayerMaxVital = ((GetPlayerLevel(index) / 2) + (GetPlayerStat(index, Intelligence) / 2)) * 5 + 25 + Player(index).AddVital(Vital)
    End Select
End Function

modDataBase

Código:

Dim spritecheck As Boolean

Código:

Dim y As Long, tituloRec As Long

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

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)
                 
                    ' Recompenças
                    TituloRec = GetPlayerTitulo(index, FindTituloSlot(index, n))
                    If Titulo(TituloRec).Passivo = True Then
                        For y = 1 To Stats.Stat_Count - 1
                            Call SetPlayerStat(index, y, GetPlayerStat(index, y) + Titulo(TituloRec).StatRec(y))
                        Next
                         
                        For y = 1 To Vitals.Vital_Count - 1
                            Player(index).AddVital(y) = Player(index).AddVital(y) + Titulo(TituloRec).VitalRec(y)
                        Next
                    End If
                End If
            End If
        Next

Código:

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

Spoiler:

Spoiler: