[EO] Titulos 1.1

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

• Sistema Completo
  
• Extras
  

Primeiramente faça o download da arquivo 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
    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

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

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

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

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

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

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)

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

Ótimo como sempre Ricardo
+ 1 crédito

Obrigado Marlos, dei uma editadinha no tópico, agora ele está mais leve.

acho q vou usar.... mas só q antes de por, tenho q ver a finalidade, msm assim +1 pra vc

Como faz pra usar ? Tipo, eu baixei e criei o titulo, e agora como faço pro player usar ?

Você define os requerimentos e quando o jogador tiver eles ele ganha o titulo.

Ok, mas aqui está dando um erro estranho na hora de compliar o server.

Zeus escreveu:Ok, mas aqui está dando um erro estranho na hora de compliar o server.

Impressaõ minha ou ta escrito: TITUQS?

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

Baixe os novos Extras, que é encontrado nos Anexos, extraia-o e adicione as formulas e modulos no seu jogo

modCombat

Troque a Function GetPlayerMaxVital por:

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

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

Mude para:

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

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

Código:

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

como faz pra por el alguem?
n tinha q ser tipo spell? por no item e talz?