Sistema de Pet Com atributos e Level Up por .ini

Primeiro vamos ao servidor.

Procure por :

Código:

' /////////////////////////////////////////////
                ' // This is used for npcs to attack targets //
                ' /////////////////////////////////////////////
                ' Make sure theres a npc with the map
                If Map(mapNum).Npc(x) > 0 And MapNpc(mapNum).Npc(x).Num > 0 Then
                    target = MapNpc(mapNum).Npc(x).target
                    targetType = MapNpc(mapNum).Npc(x).targetType

                    ' Check if the npc can attack the targeted player player
                    If target > 0 Then
                   
                        If targetType = 1 Then ' player

                            ' Is the target playing and on the same map?
                            If IsPlaying(target) And GetPlayerMap(target) = mapNum Then
                                TryNpcAttackPlayer x, target
                            Else
                                ' Player left map or game, set target to 0
                                MapNpc(mapNum).Npc(x).target = 0
                                MapNpc(mapNum).Npc(x).targetType = 0 ' clear
                            End If
                        Else
                            ' lol no npc combat :(
                        End If
                    End If
                End If

Mude para:

Código:

' /////////////////////////////////////////////
                ' // This is used for npcs to attack targets //
                ' /////////////////////////////////////////////
                ' Make sure theres a npc with the map
If Map(MapNum).Npc(x) > 0 And MapNpc(MapNum).Npc(x).Num > 0 Then
                    target = MapNpc(MapNum).Npc(x).target
                    targetType = MapNpc(MapNum).Npc(x).targetType

                    ' Check if the npc can attack the targeted player player
                    If target > 0 Then
                   
                        If targetType = 1 Then ' player
                            ' Is the target playing and on the same map?
                            If IsPlaying(target) And GetPlayerMap(target) = MapNum Then
                                TryNpcAttackPlayer x, target
                            Else
                                ' Player left map or game, set target to 0
                                MapNpc(MapNum).Npc(x).target = 0
                                MapNpc(MapNum).Npc(x).targetType = 0 ' clear
                            End If
                        ElseIf targetType = 2 Then
                            ' lol no npc combat :( DATS WAT YOU THINK
                             
                            If Map(MapNum).Npc(x) > 0 And MapNpc(MapNum).Npc(x).Num > 0 Then
                            If Npc(MapNpc(MapNum).Npc(x).Num).Behaviour = NPC_BEHAVIOUR_PET And Npc(MapNpc(MapNum).Npc(target).Num).Behaviour = NPC_BEHAVIOUR_PET Then
                            If CanNpcAttackNpc(MapNum, x, MapNpc(MapNum).Npc(x).target) = True Then
                            Call PetAttackPet(MapNum, x, MapNpc(MapNum).Npc(x).target, Npc(Map(MapNum).Npc(x)).Damage)
                            End If
                            ElseIf Npc(MapNpc(MapNum).Npc(x).Num).Behaviour = NPC_BEHAVIOUR_PET Then
                            If CanNpcAttackNpc(MapNum, x, MapNpc(MapNum).Npc(x).target) = True Then
                            Call PetAttackNpc(MapNum, x, MapNpc(MapNum).Npc(x).target, Npc(Map(MapNum).Npc(x)).Damage)
                            End If
                            End If
                            End If
                           
                            If Map(MapNum).Npc(target) > 0 And MapNpc(MapNum).Npc(target).Num > 0 Then
                            If Npc(MapNpc(MapNum).Npc(target).Num).Behaviour = NPC_BEHAVIOUR_PET And Npc(MapNpc(MapNum).Npc(x).Num).Behaviour = NPC_BEHAVIOUR_PET Then
                            MapNpc(MapNum).Npc(target).target = x
                            MapNpc(MapNum).Npc(target).targetType = TARGET_TYPE_NPC
                            If CanNpcAttackNpc(MapNum, target, MapNpc(MapNum).Npc(target).target) = True Then
                            Call PetAttackPet(MapNum, target, MapNpc(MapNum).Npc(target).target, Npc(Map(MapNum).Npc(target)).Damage)
                            End If
                            ElseIf Npc(MapNpc(MapNum).Npc(target).Num).Behaviour <> NPC_BEHAVIOUR_PET Then
                            MapNpc(MapNum).Npc(target).target = x
                            MapNpc(MapNum).Npc(target).targetType = TARGET_TYPE_NPC
                            If CanNpcAttackNpc(MapNum, target, MapNpc(MapNum).Npc(target).target) = True Then
                          Call NpcAttackPet(MapNum, target, MapNpc(MapNum).Npc(target).target, Npc(Map(MapNum).Npc(target)).Damage)
                          End If
                          End If
                          End If
                          End If
                          End If
                          Else
                           
                      End If

Procure por:

Código:

' Make sure SMSG_COUNT is below everything else

Acima adicione:

Código:

SPetWindow

Procure por:

Código:

' Make sure CMSG_COUNT is below everything else

Acima adicione:

Código:

CPetFollowOwner
    CPetAttackTarget
    CPetWander
    CPetWindow
    CPetDisband

Na PlayerWarp,Procure por:

Código:

 ' Save old map to send erase player data to
    OldMap = GetPlayerMap(index)

    If OldMap <> MapNum Then
        Call SendLeaveMap(index, OldMap)
    End If

    Call SetPlayerMap(index, MapNum)
    Call SetPlayerX(index, x)
    Call SetPlayerY(index, y)

Abaixo adicione:

Código:

'If 'refreshing' map
    If (OldMap <> MapNum) And TempPlayer(index).TempPetSlot > 0 Then
        'switch maps
      PetDisband index, OldMap
        SpawnPet index, MapNum
    End If

Procure por:

Código:

Sub CheckPlayerLevelUp

Após essa sub,abaixo adicione:

Código:

Sub CheckPetLevelUp(ByVal index As Long)
    Dim i As Long
    Dim expRollover As Long
    Dim level_count As Long
   
    level_count = 0
   
    Do While GetPetExp(index) >= GetPetNextLevel(index)
        expRollover = GetPetExp(index) - GetPetNextLevel(index)
       
        ' can level up?
        If Not SetPetLevel(index, GetPetLevel(index) + 1) Then
            Exit Sub
        End If
       
        Call SetPetExp(index, expRollover)
        Player(index).Pet.PetDamage(Player(index).Pet.PetNum) = Player(index).Pet.PetDamage(Player(index).Pet.PetNum) + RAND(1, 3)
        Player(index).Pet.PetMaxHP(Player(index).Pet.PetNum) = Player(index).Pet.PetMaxHP(Player(index).Pet.PetNum) + RAND(5, 20)
        Call SetPetVital(index, HP, GetPetMaxVital(index, HP))
        level_count = level_count + 1
    Loop
   
    If level_count > 0 Then
        If level_count = 1 Then
            'singular
            PlayerMsg index, "Your pet has gained " & level_count & " level!", BrightGreen
        Else
            'plural
            PlayerMsg index, "Your pet has gained " & level_count & " levels!", BrightGreen
        End If
    End If
   
    PetWindow index
End Sub
Sub CheckPlayerSkillLevelUp(ByVal index As Long, ByVal ResourceNum As Long)
    Dim i As Long
    Dim expRollover As Long
    Dim level_count As Long
   
    level_count = 0
   
    Do While GetPlayerSkillExp(index, ResourceNum) >= GetPlayerNextSkillLevel(index, ResourceNum)
        expRollover = GetPlayerSkillExp(index, ResourceNum) - GetPlayerNextSkillLevel(index, ResourceNum)
       
        ' can level up?
        If Not SetPlayerSkillLevel(index, ResourceNum, Int(GetPlayerSkillLevel(index, ResourceNum)) + 1) Then
            Exit Sub
        End If
       
        Call SetPlayerSkillExp(index, ResourceNum, expRollover)
        SkillLog index
        level_count = level_count + 1
    Loop
   
    If level_count > 0 Then
        If level_count = 1 Then
            'singular
            PlayerMsg index, "You have gained " & level_count & " " & Trim(Resource(ResourceNum).Name) & " level!", BrightGreen
        Else
            'plural
            PlayerMsg index, "You have gained " & level_count & " " & Trim(Resource(ResourceNum).Name) & " levels!", BrightGreen
        End If
    End If
   
End Sub

Procure por:

Código:

Function GetPlayerLevel(ByVal index As Long) As Long

Depois dessa function,abaixo adicione:

Código:

Function GetPetLevel(ByVal index As Long) As Long

    If index > MAX_PLAYERS Then Exit Function
    GetPetLevel = Player(index).Pet.PetLevel(Player(index).Pet.PetNum)
End Function
Function GetPlayerSkillLevel(ByVal index As Long, ByVal ResourceNum As Long) As Long

    If index > MAX_PLAYERS Then Exit Function
    GetPlayerSkillLevel = Player(index).ResourceLv(ResourceNum)
End Function

Procure por:

Código:

Function SetPlayerLevel(ByVal index As Long, ByVal Level As Long) As Boolean

após essa function adicione:

Código:

Function SetPetLevel(ByVal index As Long, ByVal Level As Long) As Boolean
    SetPetLevel = False
    If Level > MAX_LEVELS Then Exit Function
    Player(index).Pet.PetLevel(Player(index).Pet.PetNum) = Level
    SetPetLevel = True
End Function
Function SetPlayerSkillLevel(ByVal index As Long, ByVal ResourceNum As Long, ByVal Level As Long) As Boolean
    SetPlayerSkillLevel = False
    If Level > MAX_LEVELS Then Exit Function
    Player(index).ResourceLv(ResourceNum) = Level
    SetPlayerSkillLevel = True
End Function

Procure por:

Código:

Function GetPlayerNextLevel

após essa function adicione:

Código:

Function GetPetNextLevel(ByVal index As Long) As Long
    GetPetNextLevel = (50 / 3) * ((GetPetLevel(index) + 1) ^ 3 - (6 * (GetPetLevel(index) + 1) ^ 2) + 17 * (GetPetLevel(index) + 1) - 12) / 4
End Function
Function GetPlayerNextSkillLevel(ByVal index As Long, ByVal ResourceNum As Long) As Long
    GetPlayerNextSkillLevel = (50 / 3) * ((GetPlayerSkillLevel(index, ResourceNum) + 1) ^ 3 - (6 * (GetPlayerSkillLevel(index, ResourceNum) + 1) ^ 2) + 17 * (GetPlayerSkillLevel(index, ResourceNum) + 1) - 12) / 6
End Function

Procure por:

Código:

Function GetPlayerExp

após essa function adicione:

Código:

Function GetPetExp(ByVal index As Long) As Long
    GetPetExp = Player(index).Pet.PetExp(Player(index).Pet.PetNum)
End Function
Function GetPlayerSkillExp(ByVal index As Long, ByVal ResourceNum As Long) As Long
        GetPlayerSkillExp = Player(index).ResourceExp(ResourceNum)
End Function

Procure por:

Código:

Sub SetPlayerExp(ByVal index As Long, ByVal Exp As Long)

após essa sub adicione:

Código:

Sub SetPetExp(ByVal index As Long, ByVal Exp As Long)
    Player(index).Pet.PetExp(Player(index).Pet.PetNum) = Exp
End Sub
Sub SetPlayerSkillExp(ByVal index As Long, ByVal ResourceNum As Long, ByVal Exp As Long)
    Player(index).ResourceExp(ResourceNum) = Exp
End Sub

procure por:

Código:

Function GetPlayerVita

após function adicione:

Código:

Function GetPetVital(ByVal index As Long, ByVal Vital As Vitals) As Long
    If index > MAX_PLAYERS Then Exit Function
   
    If Player(index).Pet.PetHP(Player(index).Pet.PetNum) <= 0 Then
    GetPetVital = 0
    End If
   
    GetPetVital = Player(index).Pet.PetHP(Player(index).Pet.PetNum)
End Function
Function GetPetMaxVital(ByVal index As Long, ByVal Vital As Vitals) As Long
If index > MAX_PLAYERS Then Exit Function
GetPetMaxVital = Player(index).Pet.PetMaxHP(Player(index).Pet.PetNum)
End Function
Sub SetPetVital(ByVal index As Long, ByVal Vital As Vitals, ByVal value As Long)
    Player(index).Pet.PetHP(Player(index).Pet.PetNum) = value
   
    If GetPetVital(index, Vital) > GetPetMaxVital(index, Vital) Then
        Player(index).Pet.PetHP(Player(index).Pet.PetNum) = GetPetMaxVital(index, Vital)
    End If

    If GetPetVital(index, Vital) < 0 Then
        Player(index).Pet.PetHP(Player(index).Pet.PetNum) = 0
    End If

End Sub

Depois procure por:

Código:

 ' exit out early
        If IsSpell Then
            If npcNum > 0 Then
                If Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_FRIENDLY And Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_SHOPKEEPER Then
                    CanPlayerAttackNpc = True
                    Exit Function
                End If
            End If
        End If

Mude para:

Código:

' exit out early
        If IsSpell Then
            If npcNum > 0 Then
                If Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_FRIENDLY And Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_SHOPKEEPER  And Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_PET Then
                    CanPlayerAttackNpc = True
                    Exit Function
                End If
            End If
        End If

Depois procure por:

Código:

If NpcX = GetPlayerX(attacker) Then
                If NpcY = GetPlayerY(attacker) Then
                    If Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_FRIENDLY And Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_SHOPKEEPER Then
                        CanPlayerAttackNpc = True

Mude para:

Código:

If NpcX = GetPlayerX(Attacker) Then
                If NpcY = GetPlayerY(Attacker) Then
                    If Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_FRIENDLY And Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_SHOPKEEPER And Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_PET Then
                        CanPlayerAttackNpc = True

Depois procure por:

Código:

' in party?
        If TempPlayer(attacker).inParty > 0 Then
            ' pass through party sharing function
            Party_ShareExp TempPlayer(attacker).inParty, exp, attacker
        Else

Após o Else,adicione:

Código:

 If Player(Attacker).Pet.IsOut = True Then
        If GetPetLevel(Attacker) < MAX_LEVELS Then
        Call SetPetExp(Attacker, GetPetExp(Attacker) + (Exp / 4))
        Call CheckPetLevelUp(Attacker)
        End If
        PetWindow Attacker
        End If

Procure por:

Código:

MapNpc(mapNum).Npc(mapNpcNum).AttackTimer = GetTickCount

Acima coloque:

Código:

'check if the NPC attacking us is actually our pet.
'We don't want a rebellion on our hands now do we?
     
    If MapNpc(MapNum).Npc(mapNpcNum).PetData.Owner = index Then Exit Function

Procure por:

Código:

Case SPELL_TYPE_WARP
                    SendAnimation mapNum, Spell(spellnum).SpellAnim, 0, 0, TARGET_TYPE_PLAYER, index
                    PlayerWarp index, Spell(spellnum).Map, Spell(spellnum).x, Spell(spellnum).y
                    SendAnimation GetPlayerMap(index), Spell(spellnum).SpellAnim, 0, 0, TARGET_TYPE_PLAYER, index
                    DidCast = True

Abaixo coloque:

Código:

 Case SPELL_TYPE_PET
                    SpawnPet index, GetPlayerMap(index), Spell(spellnum).PetNum
                    DidCast = True

No final da modCombat adicione:

Código:

Sub PetAttackNpc(ByVal MapNum As Long, ByVal Attacker As Long, ByVal Victim As Long, ByVal Damage As Long)
    'Old EO version coding. Lightning's Edit.
    Dim i As Long
    Dim Buffer As clsBuffer
    Dim aNpcNum As Long
    Dim vNpcNum As Long
    Dim n As Long
    Dim petowner As Long
    Dim extradamage As Long
   
    If Attacker <= 0 Or Attacker > MAX_MAP_NPCS Then Exit Sub
    If Victim <= 0 Or Victim > MAX_MAP_NPCS Then Exit Sub
 
    If Damage <= 0 Then Exit Sub

    aNpcNum = MapNpc(MapNum).Npc(Attacker).Num
    vNpcNum = MapNpc(MapNum).Npc(Victim).Num
 
    If aNpcNum <= 0 Then Exit Sub
    If vNpcNum <= 0 Then Exit Sub
 
    ' Send this packet so they can see the person attacking
    Set Buffer = New clsBuffer
    Buffer.WriteLong SNpcAttack
    Buffer.WriteLong Attacker
    SendDataToMap MapNum, Buffer.ToArray()
    Set Buffer = Nothing

petowner = MapNpc(MapNum).Npc(Attacker).PetData.Owner

extradamage = Player(petowner).Pet.PetDamage(Player(petowner).Pet.PetNum)
       
    If (Damage + extradamage) >= MapNpc(MapNum).Npc(Victim).Vital(Vitals.HP) Then
        SendActionMsg MapNum, "-" & (Damage + extradamage), BrightRed, 1, (MapNpc(MapNum).Npc(Victim).x * 32), (MapNpc(MapNum).Npc(Victim).y * 32)
        SendBlood MapNum, MapNpc(MapNum).Npc(Victim).x, MapNpc(MapNum).Npc(Victim).y
     
        ' npc is dead.
        'Call GlobalMsg(CheckGrammar(Trim$(Npc(vNpcNum).Name), 1) & " has been killed by " & CheckGrammar(Trim$(Npc(aNpcNum).Name)) & "!", BrightRed)

       
        ' Set NPC target to 0
        MapNpc(MapNum).Npc(Victim).target = 0
        MapNpc(MapNum).Npc(Victim).targetType = 0
        'reset the targetter for the player
        TempPlayer(MapNpc(MapNum).Npc(Attacker).PetData.Owner).target = 0
        TempPlayer(MapNpc(MapNum).Npc(Attacker).PetData.Owner).targetType = TARGET_TYPE_NONE
       
        SendTarget petowner
        ' Drop the goods if they get it
        'For n = 1 To MAX_NPC_DROPS
        If Npc(vNpcNum).DropItem <> 0 Then
            If Rnd <= Npc(vNpcNum).DropChance Then
                Call SpawnItem(Npc(vNpcNum).DropItem, Npc(vNpcNum).DropItemValue, MapNum, MapNpc(MapNum).Npc(Victim).x, MapNpc(MapNum).Npc(Victim).y)
            End If
        End If
        'Next
                      ' Record a NPC Quest kill for player.
                For i = 1 To MAX_QUEST
        If Player(petowner).IsKillQuest(i) = True Then
        If Player(petowner).NPCKills(vNpcNum) >= QuestMaker(i).KillsNeeded(vNpcNum) Then
        Player(petowner).IsKillQuest(i) = False
        Call SpeechWindow(petowner, "Quest Note: " & Trim(QuestMaker(i).QuestName) & " have been completed, speak to the quest giver.", i, 1)
        Exit For
        Else
        Player(petowner).NPCKills(vNpcNum) = Int(Player(petowner).NPCKills(vNpcNum)) + 1
        Call PlayerMsg(petowner, "" & Player(petowner).NPCKills(vNpcNum) & "/" & QuestMaker(i).KillsNeeded(vNpcNum) & " kills", Yellow)
        Exit For
        End If
        End If
        Next
       
        'Give the player the pet owner some experience from the kill
        If GetPlayerLevel(petowner) < MAX_LEVELS Then
        Call SetPlayerExp(petowner, GetPlayerExp(petowner) + (Npc(MapNpc(MapNum).Npc(Victim).Num).Exp) / 2)
        SendActionMsg MapNum, "+" & (Npc(MapNpc(MapNum).Npc(Victim).Num).Exp / 2) & "EXP", Green, 1, GetPlayerX(petowner) * 32, GetPlayerY(petowner) * 32
        SendEXP petowner
        End If
       
        If GetPetLevel(petowner) < MAX_LEVELS Then
        Call SetPetExp(petowner, (GetPetExp(petowner) + (Npc(MapNpc(MapNum).Npc(Victim).Num).Exp)))
        End If
       
        Call CheckPetLevelUp(petowner)
        Call CheckPlayerLevelUp(petowner)
       
        ' Reset victim's stuff so it dies in loop
        MapNpc(MapNum).Npc(Victim).Num = 0
        MapNpc(MapNum).Npc(Victim).SpawnWait = GetTickCount
        MapNpc(MapNum).Npc(Victim).Vital(Vitals.HP) = 0
     
        ' send npc death packet to map
        Set Buffer = New clsBuffer
        Buffer.WriteLong SNpcDead
        Buffer.WriteLong Victim
        SendDataToMap MapNum, Buffer.ToArray()
        Set Buffer = Nothing
     
        PetFollowOwner petowner
    Else
        ' npc not dead, just do the damage
        MapNpc(MapNum).Npc(Victim).Vital(Vitals.HP) = MapNpc(MapNum).Npc(Victim).Vital(Vitals.HP) - (Damage + extradamage)
        ' Say damage
        SendActionMsg MapNum, "-" & (Damage + extradamage), BrightRed, 1, (MapNpc(MapNum).Npc(Victim).x * 32), (MapNpc(MapNum).Npc(Victim).y * 32)
        SendBlood MapNum, MapNpc(MapNum).Npc(Victim).x, MapNpc(MapNum).Npc(Victim).y
       
        End If

End Sub
Sub NpcAttackPet(ByVal MapNum As Long, ByVal Attacker As Long, ByVal Victim As Long, ByVal Damage As Long)
    'Old EO version coding. Lightning's Edit.
    Dim i As Long
    Dim Buffer As clsBuffer
    Dim aNpcNum As Long
    Dim vNpcNum As Long
    Dim n As Long
    Dim petowner As Long
   
    If Attacker <= 0 Or Attacker > MAX_MAP_NPCS Then Exit Sub
    If Victim <= 0 Or Victim > MAX_MAP_NPCS Then Exit Sub
 
    If Damage <= 0 Then Exit Sub

    aNpcNum = MapNpc(MapNum).Npc(Attacker).Num
    vNpcNum = MapNpc(MapNum).Npc(Victim).Num
 
    If aNpcNum <= 0 Then Exit Sub
    If vNpcNum <= 0 Then Exit Sub
 
    ' Send this packet so they can see the person attacking
    Set Buffer = New clsBuffer
    Buffer.WriteLong SNpcAttack
    Buffer.WriteLong Attacker
    SendDataToMap MapNum, Buffer.ToArray()
    Set Buffer = Nothing

petowner = MapNpc(MapNum).Npc(Victim).PetData.Owner
   
    If Damage >= GetPetVital(petowner, HP) Then
        SendActionMsg MapNum, "-" & Damage, BrightRed, 1, (MapNpc(MapNum).Npc(Victim).x * 32), (MapNpc(MapNum).Npc(Victim).y * 32)
        SendBlood MapNum, MapNpc(MapNum).Npc(Victim).x, MapNpc(MapNum).Npc(Victim).y
        ' npc is dead.
        'Call GlobalMsg(CheckGrammar(Trim$(Npc(vNpcNum).Name), 1) & " has been killed by " & CheckGrammar(Trim$(Npc(aNpcNum).Name)) & "!", BrightRed)

        ' Set NPC target to 0
        MapNpc(MapNum).Npc(Attacker).target = petowner
        MapNpc(MapNum).Npc(Attacker).targetType = TARGET_TYPE_PLAYER
        'reset the targetter for the player
        TempPlayer(MapNpc(MapNum).Npc(Victim).PetData.Owner).target = 0
        TempPlayer(MapNpc(MapNum).Npc(Victim).PetData.Owner).targetType = TARGET_TYPE_NONE
     
        SendTarget petowner
       
        SetPetVital petowner, HP, 0
        Call PlayerMsg(petowner, "Your summoning pet has died, the writing on the summoning tablet fades away, to begin anew!", BrightRed)
        Player(petowner).Pet.SpriteNum = Npc(Victim).Sprite
        Player(petowner).Pet.PetLevel(Player(petowner).Pet.PetNum) = 1
        Player(petowner).Pet.PetExp(Player(petowner).Pet.PetNum) = 0
        Player(petowner).Pet.PetDamage(Player(petowner).Pet.PetNum) = RAND(1, 3)
       
        PetDisband petowner, MapNum
       
        SetPetVital petowner, HP, GetPetMaxVital(petowner, HP)
       
        ' send npc death packet to map
        Set Buffer = New clsBuffer
        Buffer.WriteLong SNpcDead
        Buffer.WriteLong Victim
        SendDataToMap MapNum, Buffer.ToArray()
        Set Buffer = Nothing
     
    Else
        ' npc not dead, just do the damage
        Call SetPetVital(petowner, HP, GetPetVital(petowner, HP) - Damage)
        ' Say damage
        SendActionMsg MapNum, "-" & Damage, BrightRed, 1, (MapNpc(MapNum).Npc(Victim).x * 32), (MapNpc(MapNum).Npc(Victim).y * 32)
        SendBlood MapNum, MapNpc(MapNum).Npc(Victim).x, MapNpc(MapNum).Npc(Victim).y
        PetWindow petowner
        End If

End Sub

Sub PetAttackPet(ByVal MapNum As Long, ByVal Attacker As Long, ByVal Victim As Long, ByVal Damage As Long)
    'Old EO version coding. Lightning's Edit.
    Dim i As Long
    Dim Buffer As clsBuffer
    Dim aNpcNum As Long
    Dim vNpcNum As Long
    Dim n As Long
    Dim petowner As Long
    Dim petvictim As Long
    Dim petpwnexp As Long
    Dim extradamage As Long
   
    If Attacker <= 0 Or Attacker > MAX_MAP_NPCS Then Exit Sub
    If Victim <= 0 Or Victim > MAX_MAP_NPCS Then Exit Sub
 
    If Damage <= 0 Then Exit Sub

    aNpcNum = MapNpc(MapNum).Npc(Attacker).Num
    vNpcNum = MapNpc(MapNum).Npc(Victim).Num
 
    If aNpcNum <= 0 Then Exit Sub
    If vNpcNum <= 0 Then Exit Sub
 
    ' Send this packet so they can see the person attacking
    Set Buffer = New clsBuffer
    Buffer.WriteLong SNpcAttack
    Buffer.WriteLong Attacker
    SendDataToMap MapNum, Buffer.ToArray()
    Set Buffer = Nothing

petowner = MapNpc(MapNum).Npc(Attacker).PetData.Owner
petvictim = MapNpc(MapNum).Npc(Victim).PetData.Owner
extradamage = Player(petowner).Pet.PetDamage(Player(petowner).Pet.PetNum)

    If (Damage + extradamage) >= GetPetVital(petvictim, HP) Then
        SendActionMsg MapNum, "-" & (Damage + extradamage), BrightRed, 1, (MapNpc(MapNum).Npc(Victim).x * 32), (MapNpc(MapNum).Npc(Victim).y * 32)
        SendBlood MapNum, MapNpc(MapNum).Npc(Victim).x, MapNpc(MapNum).Npc(Victim).y
        ' npc is dead.
        'Call GlobalMsg(CheckGrammar(Trim$(Npc(vNpcNum).Name), 1) & " has been killed by " & CheckGrammar(Trim$(Npc(aNpcNum).Name)) & "!", BrightRed)

        ' Set NPC target to 0
        TempPlayer(MapNpc(MapNum).Npc(Attacker).PetData.Owner).target = 0
        TempPlayer(MapNpc(MapNum).Npc(Attacker).PetData.Owner).targetType = TARGET_TYPE_NONE
        'reset the targetter for the player
        TempPlayer(MapNpc(MapNum).Npc(Victim).PetData.Owner).target = 0
        TempPlayer(MapNpc(MapNum).Npc(Victim).PetData.Owner).targetType = TARGET_TYPE_NONE
     
        SendTarget petowner
        PetFollowOwner petowner
               
        SetPetVital petvictim, HP, 0
       
        petpwnexp = (GetPetExp(petvictim) / 3)
       
        Call PlayerMsg(petvictim, "Your summoning pet has died, the experience on the summoning tablet fades a third away!", BrightRed)
        Player(petvictim).Pet.PetExp(Player(petvictim).Pet.PetNum) = petpwnexp
       
        PetDisband petvictim, MapNum
       
        SetPetVital petvictim, HP, GetPetMaxVital(petvictim, HP)
       
        ' send npc death packet to map
        Set Buffer = New clsBuffer
        Buffer.WriteLong SNpcDead
        Buffer.WriteLong Victim
        SendDataToMap MapNum, Buffer.ToArray()
        Set Buffer = Nothing
     
    Else
        ' npc not dead, just do the damage
        Call SetPetVital(petvictim, HP, (GetPetVital(petvictim, HP) - (Damage + extradamage)))
        ' Say damage
        SendActionMsg MapNum, "-" & (Damage + extradamage), BrightRed, 1, (MapNpc(MapNum).Npc(Victim).x * 32), (MapNpc(MapNum).Npc(Victim).y * 32)
        SendBlood MapNum, MapNpc(MapNum).Npc(Victim).x, MapNpc(MapNum).Npc(Victim).y
        PetWindow petvictim
        End If

End Sub


Procure por:

Código:

Public Const NPC_BEHAVIOUR_GUARD As Byte = 4

Abaixo coloque:

Código:

Public Const NPC_BEHAVIOUR_PET As Byte = 5

Procure por:

Código:

Public Const SPELL_TYPE_WARP As Byte = 4

Abaixo coloque:

Código:

Public Const SPELL_TYPE_PET As Byte = 5

Procure por:

Código:

Player(index).Vital(Vitals.MP) = GetPlayerMaxVital(index, Vitals.MP)

Abaixo coloque:

Código:

Player(index).Pet.IsOut = False

Procure por:

Código:

For x = 0 To Map(i).MaxX
            For y = 0 To Map(i).MaxY
                Get #F, , Map(i).Tile(x, y)
            Next
        Next

Depois procure por:

Código:

For x = 1 To MAX_MAP_NPCS
            Get #F, , Map(i).Npc(x)
            MapNpc(i).Npc(x).Num = Map(i).Npc(x)
        Next

E troque para:

Código:

For x = 1 To MAX_MAP_NPCS
            Get #F, , Map(i).Npc(x)
            MapNpc(i).Npc(x).Num = Map(i).Npc(x)
            If MapNpc(i).Npc(x).Num > 0 Then
            If Npc(MapNpc(i).Npc(x).Num).Behaviour = NPC_BEHAVIOUR_PET Then
            ClearSingleMapNpc x, i
            End If
            End If
        Next

Procure por:

Código:

Public Sub SpawnNpc(ByVal mapNpcNum As Long, ByVal mapNum As Long)
    Dim Buffer As clsBuffer
    Dim npcNum As Long
    Dim i As Long
    Dim x As Long
    Dim y As Long
    Dim Spawned As Boolean

    ' Check for subscript out of range
    If mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or mapNum <= 0 Or mapNum > MAX_MAPS Then Exit Sub
    npcNum = Map(mapNum).Npc(mapNpcNum)

    If npcNum > 0 Then
   
        MapNpc(mapNum).Npc(mapNpcNum).Num = npcNum
        MapNpc(mapNum).Npc(mapNpcNum).target = 0
        MapNpc(mapNum).Npc(mapNpcNum).targetType = 0 ' clear
       
        MapNpc(mapNum).Npc(mapNpcNum).Vital(Vitals.HP) = GetNpcMaxVital(npcNum, Vitals.HP)
        MapNpc(mapNum).Npc(mapNpcNum).Vital(Vitals.MP) = GetNpcMaxVital(npcNum, Vitals.MP)
       
        MapNpc(mapNum).Npc(mapNpcNum).Dir = Int(Rnd * 4)
       
        'Check if theres a spawn tile for the specific npc
        For x = 0 To Map(mapNum).MaxX
            For y = 0 To Map(mapNum).MaxY
                If Map(mapNum).Tile(x, y).Type = TILE_TYPE_NPCSPAWN Then
                    If Map(mapNum).Tile(x, y).Data1 = mapNpcNum Then
                        MapNpc(mapNum).Npc(mapNpcNum).x = x
                        MapNpc(mapNum).Npc(mapNpcNum).y = y
                        MapNpc(mapNum).Npc(mapNpcNum).Dir = Map(mapNum).Tile(x, y).Data2
                        Spawned = True
                        Exit For
                    End If
                End If
            Next y
        Next x
       
        If Not Spawned Then
   
            ' Well try 100 times to randomly place the sprite
            For i = 1 To 100
                x = Random(0, Map(mapNum).MaxX)
                y = Random(0, Map(mapNum).MaxY)
   
                If x > Map(mapNum).MaxX Then x = Map(mapNum).MaxX
                If y > Map(mapNum).MaxY Then y = Map(mapNum).MaxY
   
                ' Check if the tile is walkable
                If NpcTileIsOpen(mapNum, x, y) Then
                    MapNpc(mapNum).Npc(mapNpcNum).x = x
                    MapNpc(mapNum).Npc(mapNpcNum).y = y
                    Spawned = True
                    Exit For
                End If
   
            Next
           
        End If

        ' Didn't spawn, so now we'll just try to find a free tile
        If Not Spawned Then

            For x = 0 To Map(mapNum).MaxX
                For y = 0 To Map(mapNum).MaxY

                    If NpcTileIsOpen(mapNum, x, y) Then
                        MapNpc(mapNum).Npc(mapNpcNum).x = x
                        MapNpc(mapNum).Npc(mapNpcNum).y = y
                        Spawned = True
                    End If

                Next
            Next

        End If

        ' If we suceeded in spawning then send it to everyone
        If Spawned Then
            Set Buffer = New clsBuffer
            Buffer.WriteLong SSpawnNpc
            Buffer.WriteLong mapNpcNum
            Buffer.WriteLong MapNpc(mapNum).Npc(mapNpcNum).Num
            Buffer.WriteLong MapNpc(mapNum).Npc(mapNpcNum).x
            Buffer.WriteLong MapNpc(mapNum).Npc(mapNpcNum).y
            Buffer.WriteLong MapNpc(mapNum).Npc(mapNpcNum).Dir
            SendDataToMap mapNum, Buffer.ToArray()
            Set Buffer = Nothing
        End If
       
        SendMapNpcVitals mapNum, mapNpcNum
    End If

End Sub

Mude toda a sub para:

Código:

Public Sub SpawnNpc(ByVal mapNpcNum As Long, ByVal MapNum As Long, Optional PetX As Long, Optional PetY As Long)
    Dim Buffer As clsBuffer
    Dim npcNum As Long
    Dim i As Long
    Dim x As Long
    Dim y As Long
    Dim Spawned As Boolean

    ' Check for subscript out of range
    If mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or MapNum <= 0 Or MapNum > MAX_MAPS Then Exit Sub
    npcNum = Map(MapNum).Npc(mapNpcNum)

    If npcNum > 0 Then
   
        MapNpc(MapNum).Npc(mapNpcNum).Num = npcNum
        MapNpc(MapNum).Npc(mapNpcNum).target = 0
        MapNpc(MapNum).Npc(mapNpcNum).targetType = 0 ' clear
       
        MapNpc(MapNum).Npc(mapNpcNum).Vital(Vitals.HP) = GetNpcMaxVital(npcNum, Vitals.HP)
        MapNpc(MapNum).Npc(mapNpcNum).Vital(Vitals.MP) = GetNpcMaxVital(npcNum, Vitals.MP)
       
        MapNpc(MapNum).Npc(mapNpcNum).Dir = Int(Rnd * 4)
       
        'Check if theres a spawn tile for the specific npc
        For x = 0 To Map(MapNum).MaxX
            For y = 0 To Map(MapNum).MaxY
                If Map(MapNum).Tile(x, y).Type = TILE_TYPE_NPCSPAWN Then
                    If Map(MapNum).Tile(x, y).Data1 = mapNpcNum Then
                        MapNpc(MapNum).Npc(mapNpcNum).x = x
                        MapNpc(MapNum).Npc(mapNpcNum).y = y
                        MapNpc(MapNum).Npc(mapNpcNum).Dir = Map(MapNum).Tile(x, y).Data2
                        Spawned = True
                        Exit For
                    End If
                End If
            Next y
        Next x
       
        If Npc(npcNum).Behaviour = NPC_BEHAVIOUR_PET Then
        If PetX > 0 And PetY > 0 Then
        MapNpc(MapNum).Npc(mapNpcNum).x = PetX
        MapNpc(MapNum).Npc(mapNpcNum).y = PetY
        Spawned = True
        End If
        End If
       
        If Not Spawned Then
   
            ' Well try 100 times to randomly place the sprite
            For i = 1 To 100
                x = Random(0, Map(MapNum).MaxX)
                y = Random(0, Map(MapNum).MaxY)
   
                If x > Map(MapNum).MaxX Then x = Map(MapNum).MaxX
                If y > Map(MapNum).MaxY Then y = Map(MapNum).MaxY
   
                ' Check if the tile is walkable
                If NpcTileIsOpen(MapNum, x, y) Then
                    MapNpc(MapNum).Npc(mapNpcNum).x = x
                    MapNpc(MapNum).Npc(mapNpcNum).y = y
                    Spawned = True
                    Exit For
                End If
   
            Next
           
        End If

        ' Didn't spawn, so now we'll just try to find a free tile
        If Not Spawned Then

            For x = 0 To Map(MapNum).MaxX
                For y = 0 To Map(MapNum).MaxY

                    If NpcTileIsOpen(MapNum, x, y) Then
                        MapNpc(MapNum).Npc(mapNpcNum).x = x
                        MapNpc(MapNum).Npc(mapNpcNum).y = y
                        Spawned = True
                    End If

                Next
            Next

        End If

        ' If we suceeded in spawning then send it to everyone
        If Spawned Then
            Set Buffer = New clsBuffer
            Buffer.WriteLong SSpawnNpc
            Buffer.WriteLong mapNpcNum
            Buffer.WriteLong MapNpc(MapNum).Npc(mapNpcNum).Num
            Buffer.WriteLong MapNpc(MapNum).Npc(mapNpcNum).x
            Buffer.WriteLong MapNpc(MapNum).Npc(mapNpcNum).y
            Buffer.WriteLong MapNpc(MapNum).Npc(mapNpcNum).Dir
            SendDataToMap MapNum, Buffer.ToArray()
            Set Buffer = Nothing
        End If
       
        SendMapNpcVitals MapNum, mapNpcNum
    End If

End Sub

No final da modGameLogic adicione:

Código:

'makes the pet follow its owner
Sub PetFollowOwner(ByVal index As Long)
'Lightning's Pet System
    If TempPlayer(index).TempPetSlot < 1 Then Exit Sub
 
    MapNpc(GetPlayerMap(index)).Npc(TempPlayer(index).TempPetSlot).targetType = 1
    MapNpc(GetPlayerMap(index)).Npc(TempPlayer(index).TempPetSlot).target = index
End Sub

'makes the pet wander around the map
Sub PetWander(ByVal index As Long)
'Lightning's Pet System
    If TempPlayer(index).TempPetSlot < 1 Then Exit Sub

    MapNpc(GetPlayerMap(index)).Npc(TempPlayer(index).TempPetSlot).targetType = TARGET_TYPE_NONE
    MapNpc(GetPlayerMap(index)).Npc(TempPlayer(index).TempPetSlot).target = 0
End Sub

'Clear the npc from the map
Sub PetDisband(ByVal index As Long, ByVal MapNum As Long, Optional spellnum As Long)
Dim i As Integer
'Lightning's Pet System

    If TempPlayer(index).TempPetSlot < 1 Then Exit Sub
 
    Call ClearSingleMapNpc(TempPlayer(index).TempPetSlot, MapNum)
    Map(GetPlayerMap(index)).Npc(TempPlayer(index).TempPetSlot) = 0
    TempPlayer(index).TempPetSlot = 0
   
                For i = 1 To Player_HighIndex
                If GetPlayerMap(i) = GetPlayerMap(index) Then
                    SendMap i, GetPlayerMap(index)
                End If
            Next
           
                're-warp the players on the map
    For i = 1 To Player_HighIndex
        If IsPlaying(i) Then
            If GetPlayerMap(i) = GetPlayerMap(index) Then
                Call PlayerWarp(index, GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index))
            End If
        End If
    Next
   
    PetWindow index
   
    Player(index).Pet.IsOut = False
End Sub

Sub SpawnPet(ByVal index As Long, ByVal MapNum As Long, Optional spellnum As Long)
'Lightning's Pet System

    Dim PlayerMap As Long
    Dim i As Integer
    Dim PetSlot As Byte
 
    'Prevent multiple pets for the same owner
    If TempPlayer(index).TempPetSlot > 0 Then Exit Sub
 
    PlayerMap = GetPlayerMap(index)
    PetSlot = 0
 
    For i = 1 To MAX_MAP_NPCS
        If Map(PlayerMap).Npc(i) = 0 Then
            PetSlot = i
            Exit For
        End If
    Next
 
    If PetSlot = 0 Then
        Call PlayerMsg(index, "The map is too crowded for you to call on your pet!", Red)
        Exit Sub
    End If

    If spellnum > 0 Then
    Player(index).Pet.PetNum = spellnum
   
    Map(PlayerMap).Npc(PetSlot) = Player(index).Pet.PetNum
    MapNpc(PlayerMap).Npc(PetSlot).Num = Player(index).Pet.PetNum
    'set its Pet Data
    MapNpc(PlayerMap).Npc(PetSlot).IsPet = YES
    MapNpc(PlayerMap).Npc(PetSlot).PetData.Name = Trim(Npc(Player(index).Pet.PetNum).Name)
    MapNpc(PlayerMap).Npc(PetSlot).PetData.Owner = index
        'If Pet doesn't exist with player, link it to the player
    If Player(index).Pet.SpriteNum <> Npc(Player(index).Pet.PetNum).Sprite Then
        Player(index).Pet.SpriteNum = Npc(Player(index).Pet.PetNum).Sprite
        Player(index).Pet.Name = Trim(Npc(Player(index).Pet.PetNum).Name)
    End If
    End If
   
    If Player(index).Pet.PetLevel(Player(index).Pet.PetNum) < 1 Then
    Player(index).Pet.PetDamage(Player(index).Pet.PetNum) = Npc(Player(index).Pet.PetNum).Damage + RAND(1, 3)
    Player(index).Pet.PetExp(Player(index).Pet.PetNum) = 0
    Player(index).Pet.PetLevel(Player(index).Pet.PetNum) = 1
    Player(index).Pet.PetHP(Player(index).Pet.PetNum) = GetPetVital(index, HP)
    Player(index).Pet.PetMaxHP(Player(index).Pet.PetNum) = Npc(Player(index).Pet.PetNum).HP + (GetPetLevel(index) + RAND(5, 20))
    End If
   
    Player(index).Pet.Name = Trim(Npc(Player(index).Pet.PetNum).Name)
   
    If GetPetVital(index, HP) <= 0 Then
    SetPetVital index, HP, GetPetMaxVital(index, HP)
    End If
 
    TempPlayer(index).TempPetSlot = PetSlot
     
    'cache the map for sending
    MapCache_Create (PlayerMap)
    'save the map
    SaveMap (PlayerMap)
 
    'send the update
    For i = 1 To Player_HighIndex
        If IsPlaying(i) Then
            If GetPlayerMap(i) = GetPlayerMap(index) Then
                SendMap i, PlayerMap
            End If
        End If
    Next
   
            If GetPlayerX(index) <= 0 Or GetPlayerY(index) <= 0 Then
            If NpcTileIsOpen(MapNum, GetPlayerX(index), GetPlayerY(index) + 1) Then
            Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index), GetPlayerY(index) + 1)
            ElseIf NpcTileIsOpen(MapNum, GetPlayerX(index) + 1, GetPlayerY(index)) Then
            Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index) + 1, GetPlayerY(index))
            ElseIf NpcTileIsOpen(MapNum, GetPlayerX(index), GetPlayerY(index) - 1) Then
            Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index), GetPlayerY(index) - 1)
            ElseIf NpcTileIsOpen(MapNum, GetPlayerX(index) - 1, GetPlayerY(index)) Then
            Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index) - 1, GetPlayerY(index))
            Else
            Call SpawnNpc(PetSlot, PlayerMap)
            End If
            Else
           
            If NpcTileIsOpen(MapNum, GetPlayerX(index), GetPlayerY(index) - 1) Then
            Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index), GetPlayerY(index) - 1)
            ElseIf NpcTileIsOpen(MapNum, GetPlayerX(index), GetPlayerY(index) + 1) Then
            Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index), GetPlayerY(index) + 1)
            ElseIf NpcTileIsOpen(MapNum, GetPlayerX(index) + 1, GetPlayerY(index)) Then
            Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index) + 1, GetPlayerY(index))
            ElseIf NpcTileIsOpen(MapNum, GetPlayerX(index) - 1, GetPlayerY(index)) Then
            Call SpawnNpc(PetSlot, PlayerMap, GetPlayerX(index) - 1, GetPlayerY(index))
            Else
            Call SpawnNpc(PetSlot, PlayerMap)
            End If
              End If
             
    're-warp the players on the map
    For i = 1 To Player_HighIndex
        If IsPlaying(i) Then
            If GetPlayerMap(i) = GetPlayerMap(index) Then
                Call PlayerWarp(index, PlayerMap, GetPlayerX(index), GetPlayerY(index))
            End If
        End If
    Next
 
  Player(index).Pet.IsOut = True
  PetFollowOwner index
  PetWindow index
End Sub


Procure por:

Código:

Public Sub DestroyServer()

Abaixo de :

Código:

 Dim i As Long

Coloque:

Código:

For i = 1 To MAX_PLAYERS
        If Player(i).Pet.IsOut = True Then
        PetDisband i, GetPlayerMap(i)
        End If
    Next

Procure por:

Código:

HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)

Abaixo adicione:

Código:

HandleDataSub(CPetFollowOwner) = GetAddress(AddressOf HandlePetFollowOwner)
    HandleDataSub(CPetAttackTarget) = GetAddress(AddressOf HandlePetAttackTarget)
    HandleDataSub(CPetWander) = GetAddress(AddressOf HandlePetWander)
    HandleDataSub(CPetWindow) = GetAddress(AddressOf HandlePetWindow)
    HandleDataSub(CPetDisband) = GetAddress(AddressOf HandlePetDisband)

No final da modhandledata adicione:

Código:

Public Sub HandlePetFollowOwner(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    'Lightning's Pet System
    Dim Buffer As clsBuffer
      If Player(index).Pet.IsOut = True Then
    PetFollowOwner index
    Else
    PlayerMsg index, "Your pet needs to be summoned to use this command.", BrightRed
    End If
End Sub

Public Sub HandlePetAttackTarget(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    'Lightning's Pet System
    Dim Buffer As clsBuffer
   
    If Not TempPlayer(index).target > 0 Then
    PlayerMsg index, "Invalid target for attack.", BrightRed
    Exit Sub
    End If
   
    If TempPlayer(index).targetType = 1 Then
    PlayerMsg index, "Summoned pets can only attack NPC's or other players summoned pets.", BrightRed
    Exit Sub
    End If
   
      If Player(index).Pet.IsOut = True Then
    If Npc(MapNpc(GetPlayerMap(index)).Npc(TempPlayer(index).target).Num).Behaviour = NPC_BEHAVIOUR_SHOPKEEPER Or Npc(MapNpc(GetPlayerMap(index)).Npc(TempPlayer(index).target).Num).Behaviour = NPC_BEHAVIOUR_FRIENDLY Or Npc(MapNpc(GetPlayerMap(index)).Npc(TempPlayer(index).target).Num).Behaviour = NPC_BEHAVIOUR_SCRIPTED Then
    PlayerMsg index, "Invalid target for attack.", BrightRed
    Exit Sub
    End If
   

    If MapNpc(GetPlayerMap(index)).Npc(TempPlayer(index).TempPetSlot).PetData.Owner < 1 Then Exit Sub
 
    MapNpc(GetPlayerMap(index)).Npc(TempPlayer(index).TempPetSlot).targetType = TempPlayer(index).targetType
    MapNpc(GetPlayerMap(index)).Npc(TempPlayer(index).TempPetSlot).target = TempPlayer(index).target
Else
PlayerMsg index, "Your pet needs to be summoned to use this command.", BrightRed
End If

End Sub

Public Sub HandlePetWander(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    'Lightning's Pet System
    Dim Buffer As clsBuffer
      If Player(index).Pet.IsOut = True Then
    PetWander index
    Else
    PlayerMsg index, "Your pet needs to be summoned to use this command.", BrightRed
    End If
End Sub

Public Sub HandlePetWindow(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    'Lightning's Pet System
    Dim Buffer As clsBuffer
 
    PetWindow index
End Sub

Public Sub HandlePetDisband(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    'Lightning's Pet System
   
    Dim Buffer As clsBuffer
      If Player(index).Pet.IsOut = True Then
    PetDisband index, GetPlayerMap(index)
    Else
    PlayerMsg index, "Your pet needs to be summoned to use this command.", BrightRed
    End If
End Sub


Procure por:

Código:

Sub CloseSocket

Abaixo de :

Código:

If index > 0 Then

Ponha:

Código:

If TempPlayer(index).TempPetSlot > 0 Then
            Call PetDisband(index, GetPlayerMap(index))
      End If

No final da modServerTCP coloque:

Código:

Sub PetWindow(ByVal index As Long)
' Modification(S)
Dim Buffer As clsBuffer
Dim IsOut As Long
Dim Name As String
Dim Level As Long
Dim HP As Long
Dim MaxHP As Long
Dim Exp As Long
Dim NextExp As Long
Dim Damage As Long

If Player(index).Pet.IsOut = True Then
IsOut = Int(Player(index).Pet.IsOut)
Name = Trim(Player(index).Pet.Name)
Level = Player(index).Pet.PetLevel(Player(index).Pet.PetNum)
HP = GetPetVital(index, HP)
MaxHP = GetPetMaxVital(index, HP)
Exp = GetPetExp(index)
NextExp = GetPetNextLevel(index)
Damage = Player(index).Pet.PetDamage(Player(index).Pet.PetNum) + Npc(Player(index).Pet.PetNum).Damage

    Set Buffer = New clsBuffer
    Buffer.WriteLong SPetWindow
    Buffer.WriteLong IsOut
    Buffer.WriteString Name
    Buffer.WriteLong Level
    Buffer.WriteLong HP
    Buffer.WriteLong MaxHP
    Buffer.WriteLong Exp
    Buffer.WriteLong NextExp
    Buffer.WriteLong Damage
   
    SendDataTo index, Buffer.ToArray()
    End If
   
    Set Buffer = Nothing
          End Sub


Procure por:

Código:

Public Type HotbarRec
    Slot As Long
    sType As Byte
End Type

Abaixo coloque:

Código:

Public Type PetRec
'Lightning's Pet Rec
    SpriteNum As Byte
    Name As String * NAME_LENGTH
    Owner As Long
    IsOut As Boolean
    PetLevel(1 To MAX_NPCS) As Byte
    PetNextLevel(1 To MAX_NPCS) As Long
    PetExp(1 To MAX_NPCS) As Long
    PetDamage(1 To MAX_NPCS) As Long
    PetHP(1 To MAX_NPCS) As Long
    PetNum As Long
    PetMaxHP(1 To MAX_NPCS) As Long
End Type

Procure por:

Código:

Private Type PlayerRec

Antes do end type coloque:

Código:

Pet As PetRec

Procure por:

Código:

Public Type TempPlayerRec

No final,antes do end type coloque:

Código:

TempPetSlot As Byte

Procure por:

Código:

Private Type MapNpcRec

No final,antes do end type coloque:

Código:

'Pet Data
    IsPet As Byte
    PetData As PetRec

Procure por:

Código:

Private Type SpellRec

Antes do end type coloque:

Código:

PetNum As Long

Agora no final do modDataBase,adicione:

Código:

' *****************
' ** PetExp **
' *****************
Sub LoadPetExp()
    Dim filename As String
    Dim i As Long
   
    filename = App.Path & "\data\petexp.ini"
   
    If FileExist("data\petexp.ini") Then
        ReDim Experiencia(1 To MAX_LEVELS)
       
        For i = 1 To MAX_LEVELS
            Experiencia(i) = Val(GetVar(filename, "Experiencia", "Exp" & CStr(i)))
        Next i
    Else
        ReDim Experiencia(1 To MAX_LEVELS)
       
        For i = 1 To MAX_LEVELS
            Experiencia(i) = i * 25
            Call PutVar(filename, "PetExp", "Exp" & CStr(i), STR(Experiencia(i)))
        Next
    End If
End Sub

Depois no modGeneral procure por:

Código:

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

Em seguida coloque:

Código:

 Call SetStatus("Carregando experiencia...")
    Call LoadPetExp

No final do modGlobals coloque:

Código:

Public PetExp()

Depois mude a Function GetPlayerNextLeve por:

Código:

Function GetPlayerNextLevel(ByVal index As Long) As Long
    GetPlayerNextLevel = PetExp(GetPlayerLevel(index))
End Function

Continuação

obs: o sistema é muito grande e não coube em uma unica mensagem
No final da frmEditor_Spell adicione:

Código:

Private Sub scrlPetNpc_Change()
    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler
    
    If scrlPetNpc.Value > 0 Then
    lblPetNpc.Caption = "Pet Npc: " & Trim(Npc(scrlPetNpc.Value).Name)
    Else
    lblPetNpc.Caption = "Pet Npc: None"
    End If
    
    Spell(EditorIndex).PetNum = scrlPetNpc.Value
    ' Error handler
    Exit Sub
errorhandler:
    HandleError "scrlPetNpc_Change", "frmEditor_Spell", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Agora crie:

Código:

1:Frame
1:label
1:scrollbar

Para cada ferramenta citada acima coloque as seguintes configurações:

Código:

Frame=
Name:frame4
Label=
Name:lblPetNpc
Caption:Pet Npc:
Scroll=
Name:scrlPetNpc

Agora na cmbType,do frmEditor_Spell,em sua list adicione:

Código:

Pet

Procure por:

Código:

Private Sub imgButton_Click(Index As Integer)

Agora na Case 1 depois de:

Código:

frmMain.picParty.Visible = False

Adicione:

Código:

frmMain.PetBox.Visible = False

Agora na Case 2 depois de:

Código:

frmMain.picParty.Visible = False

Adicione:

Código:

frmMain.PetBox.Visible = False

Agora na Case 3 depois de:

Código:

frmMain.picParty.Visible = False

Adicione:

Código:

frmMain.PetBox.Visible = False

Agora na Case 4 depois de:

Código:

frmMain.picParty.Visible = False

Adicione:

Código:

frmMain.PetBox.Visible = False

Agora na Case 6 depois de:

Código:

frmMain.picOptions.Visible = False

Adicione:

Código:

frmMain.picParty.Visible = True

Agora ainda na Case 6 depois de:

Código:

PlaySound Sound_ButtonClick

Adicione:

Código:

Case 7
                Set Buffer = New clsBuffer
                Buffer.WriteLong CPetWindow
                SendData Buffer.ToArray()
                Set Buffer = Nothing
                frmMain.picSkillLog.Visible = False
                frmMain.picInventory.Visible = False
                frmMain.picCharacter.Visible = False
                frmMain.picSpells.Visible = False
                frmMain.picOptions.Visible = False
                frmMain.picParty.Visible = False
                frmMain.picQuestLog.Visible = False
                frmMain.PetBox.Visible = True
                PlaySound Sound_ButtonClick

No final da frmMain adicione:

Código:

Private Sub Label9_Click()
PetAttack MyIndex
End Sub
Private Sub lblPetAttack_Click()
PetAttack MyIndex
End Sub

Private Sub lblPetFollow_Click()
PetFollow MyIndex
End Sub

Private Sub lblPetWander_Click()
PetWander MyIndex
End Sub
Private Sub PetButton_Click(Index As Integer)
Select Case Index

Case 1
PetAttack MyIndex
Case 2
PetFollow MyIndex
Case 3
PetWander MyIndex
Case 4
PetDisband MyIndex
End Select
End Sub

Agora procure por:

Código:

Case NPC_BEHAVIOUR_GUARD
color = QBColor(Brown)

Após isso adicione:

Código:

Case NPC_BEHAVIOUR_PET
            color = QBColor(White)

Agora acima de :

Código:

Private Type PlayerRec

Adicione:

Código:

Public Type PetRec
'Lightning's Pet Rec
    SpriteNum As Byte
    Name As String * NAME_LENGTH
    Owner As Long
    IsOut As Boolean
    PetLevel(1 To MAX_NPCS) As Byte
    PetNextLevel(1 To MAX_NPCS) As Long
    PetExp(1 To MAX_NPCS) As Long
    PetDamage(1 To MAX_NPCS) As Long
    PetHP(1 To MAX_NPCS) As Long
    PetNum As Long
    PetMaxHP(1 To MAX_NPCS) As Long
End Type

Agora na:

Código:

Private Type PlayerRec

antes do end type adicione:

Código:

' Lightning's PetRec
    Pet As PetRec

Agora na:

Código:

Private Type MapNpcRec

Antes do end type adicione:

Código:

'Lightning's Pet Data
    IsPet As Byte
    PetData As PetRec

Agonra na:

Código:

Private Type SpellRec

antes do end type adicione:

Código:

PetNum As Long

No final do client tpc adicione:

Código:

Sub PetFollow(ByVal Index As Long)
'Lightning's Pet System
    Dim Buffer As clsBuffer
  
    Set Buffer = New clsBuffer
  
    Buffer.WriteLong CPetFollowOwner
  
    SendData Buffer.ToArray()
  
    Set Buffer = Nothing
End Sub
Sub PetDisband(ByVal Index As Long)
'Lightning's Pet System
    Dim Buffer As clsBuffer
  
    Set Buffer = New clsBuffer
  
    Buffer.WriteLong CPetDisband
  
    SendData Buffer.ToArray()
  
    Set Buffer = Nothing
End Sub
Sub PetAttack(ByVal Index As Long)
'Lightning's Pet System
    Dim Buffer As clsBuffer
  
    Set Buffer = New clsBuffer
  
    Buffer.WriteLong CPetAttackTarget
  
    SendData Buffer.ToArray()
  
    Set Buffer = Nothing
End Sub

Sub PetWander(ByVal Index As Long)
'Lightning's Pet System
    Dim Buffer As clsBuffer
  
    Set Buffer = New clsBuffer
  
    Buffer.WriteLong CPetWander
  
    SendData Buffer.ToArray()
  
    Set Buffer = Nothing
End Sub


Procure por:

Código:

Public Const NPC_BEHAVIOUR_GUARD As Byte = 4

Abaixo adicione:

Código:

Public Const NPC_BEHAVIOUR_PET As Byte = 5

Procure por:

Código:

Public Const SPELL_TYPE_WARP As Byte = 4

Abaixo coloque:

Código:

Public Const SPELL_TYPE_PET As Byte = 5

Procure por:

Código:

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

Abaixo adicione:

Código:

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

Procure por:

Código:

Public Sub logoutGame()

Abaixo de:

Código:

frmMain.picParty.Visible = False

Coloque:

Código:

frmMain.PetBox.Visible = False

Procure por:

Código:

Public Sub cacheButtons()

Depois de:

Código:

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

Coloque:

Código:

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

Procure por:

Código:

.scrlRange.Value = Spell(EditorIndex).Range

Abaixo adicione:

Código:

.scrlPetNpc.Value = Spell(EditorIndex).PetNum
If Spell(EditorIndex).PetNum > 0 Then
        .lblPetNpc = "Pet Npc: " & Trim(Npc(Spell(EditorIndex).PetNum).Name)
        Else
        .lblPetNpc = "Pet Npc: None"
        End If

Procure por:

Código:

' Make sure SMSG_COUNT is below everything else

Acima adicione:

Código:

SPetWindow

Depois procure por:

Código:

' Make sure CMSG_COUNT is below everything else

Acima adicione:

Código:

CPetFollowOwner
    CPetAttackTarget
    CPetWander
    CPetWindow
    CPetDisband

Procure por:

Código:

HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)

Depois adicione:

Código:

HandleDataSub(SPetWindow) = GetAddress(AddressOf HandlePetWindow)

Agora no final da modhandledata adicione:

Código:

Private Sub HandlePetWindow(ByVal Index As Long, ByRef Data() As Byte, ByVal EditorIndex As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

Dim Buffer As clsBuffer
Dim IsOut As Long
Dim Name As String
Dim Level As Long
Dim HP As Long
Dim MaxHP As Long
Dim Exp As Long
Dim NextExp As Long
Dim Damage As Long

 Set Buffer = New clsBuffer
 Buffer.WriteBytes Data()
 
 IsOut = Buffer.ReadLong
 Name = Buffer.ReadString
 Level = Buffer.ReadLong
 HP = Buffer.ReadLong
 MaxHP = Buffer.ReadLong
 Exp = Buffer.ReadLong
 NextExp = Buffer.ReadLong
 Damage = Buffer.ReadLong
 
 If HP <= 0 Then
 frmMain.PetBox.Visible = False
 frmMain.lblPetName.Caption = Trim(Name)
 frmMain.lblPetLv.Caption = "Level: " & Level
 frmMain.lblPetHP.Caption = "HP: " & MaxHP & " / " & MaxHP
 frmMain.lblPetDamage.Caption = "Força: " & Damage
 frmMain.lblPetExp.Caption = "Exp: " & Exp & " / " & NextExp
 Exit Sub
 End If
 
 frmMain.lblPetName.Caption = Trim(Name)
 frmMain.lblPetLv.Caption = "Level: " & Level
 frmMain.lblPetHP.Caption = "HP: " & HP & " / " & MaxHP
 frmMain.lblPetDamage.Caption = "Força: " & Damage
 frmMain.lblPetExp.Caption = "Exp: " & Exp & " / " & NextExp

            Set Buffer = Nothing
             End Sub


Agora Vá na main e crie um novo imgbutton (no mesmo estilo do da party e talz)

e altere o index dele para 7

Após isso baixe os Arquivos <ao lado,e coloque na main do seu game.

Agora juntamente com os arquivos que eu pedi para vocês baixarem vocês verão algo parecido com frmPet.

Após isso cliquem na picturebox desse frmPet,chamada de PetBox apertem ctrl+c nela e depois apertem ctrl+v no seu projeto

Fim pessoal espero que tenham gostado.
Creditos:
Robin
Guifs
Ricardo

Obrigado por postar o sistema, +1.

   Bem ainda não tive a oportunidade de testa-lo, mas se realmente estiver 100% , realmente é um sistema incrivel , se foi você que criou, meus parabéns meu caro ! Você está mais 1 passo a frente em se tornar melhor do que era ontem !

      Meus Creditos para você =+1

Bom não fui eu que criei,a base desse sistema é da EO 2.6,eu corrigi algumas partes ripei acrescentei o exp por .ini que eu peguei base no sistema do ricardo e fiz esse aew

Caraca deve ter tido muito trabalho. +1 por Compartilhar.

No Meu server tah dando erro aqui

Erro Aqui:

Steel, procura por:

Código:

Sub ClearParty(ByVal partyNum As Long)

E embaixo dessa mesma sub, adicione:

Código:

Sub ClearSingleMapNpc(ByVal index As Long, ByVal mapnum As Long)
    Call ZeroMemory(ByVal VarPtr(MapNpc(mapnum).NPC(index)), LenB(MapNpc(mapnum).NPC(index)))
    Map(mapnum).NPC(index) = 0
    MapNpc(mapnum).NPC(index).Num = 0
    MapCache_Create (mapnum)
End Sub

Boa resolveu Obrigado

Parabéns pelo tutorial