[EO] Titulos 1.2

LythZerou(EditDP) escreveu:Sub HandleTitulo ta faltando no modhandledata, foda-se doublepost o cara nao respode saco isso

da erro 9 nessa linha If Titulo(GetPlayerTitulo(index, Slot)).RemoveAnimaçao > 0 Then

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

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:

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

' 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

modHandleData

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:

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

frmMain

Name: lblRemoveTUsando
Caption: Parar de usar

Código:

' 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

Código:

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

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

modDirectDraw7

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

Over~ escreveu:Tranque o tópico para que não aconteça mais problemas como esse.

Abraços,
Over~.

dazateam escreveu:

me ajuda ai aki tah dano esse erro ou sei la da variavel nao definida n serv quando tento compila ajuda ia :/

obs: abre a imagem em uma nova guia :S

Himinato escreveu:Alguem ajuda

https://2img.net/r/ihimg/photo/my-images/713/semttuloocz.png/