[EO] Basic Pet System V.1.2

[Helladen]

This is a very basic pet system. Using items will show them and using them again will hide them.

**Lightning's Pet System is better, be warned!**

**Credits:** Helladen and Robin for the base code from BltPlayer.

**EO V2 Beta Basic Pet System V.1.2**

**V.1.0:** - Initial Release.

**V.1.1:** - Fixed rendering order and added the requirements check to Case Select on Server, mine uses HandleUseItem instead of reusing the same code for each Case Select, so I added for you guys so you could restrict pets with specific requirements. Fixed InvNum being dimmed as Byte in Change Pet to Long, this was because mine uses Byte for it.

**V.1.2** - Fixed a misuse of MyIndex when checking directions in GameLoop, it now uses I. Added where you can't drop the pet if your using it.

**Client:**

>! In modConstants find:
```
Public Const ITEM_TYPE_TELEPORT As Byte = 9
```
Below it add:
```
Public Const ITEM_TYPE_PET As Byte = 10
```
In modTypes inside PlayerRec add:
```
    ' Pet
    Pet As Integer
```
In frmEditor_Item look for cmbType, click on it and look in properties for list.
Click on it and click on the arrow to the right, go to the bottom of the list and type Pet.
>! In frmEditor_Item find cmbType_Click and below this:
```
    If (cmbType.ListIndex = ITEM_TYPE_TELEPORT) Then
        fraTele.Visible = True
    Else
        fraTele.Visible = False
    End If
```
Add:
```
    If (cmbType.ListIndex = ITEM_TYPE_PET) Then
        fraPet.Visible = True
    Else
        fraPet.Visible = False
    End If
```
Copy a frame from the bottom of frmEditor_Item and paste it out of the current area.
Drag the frame down to where you copied it from, make sure the visibility it set to false.
Set the name for it as fraPet, set the caption for it to Pet Data.
>! Add a scroll bar and label. Set the name to scrlPetSprite.
Set the caption to Sprite: 1.
Make sure the minimum for the scrlPetSprite is 1.
Place the label above or next to the scroll bar.
>! Double click scrlPetSprite and paste this into the sub:
```
    If EditorIndex < 1 Or EditorIndex > MAX_ITEMS Then Exit Sub
>!     ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler

    lblPetSprite.Caption = "Sprite: " & scrlPetSprite.Value
    Item(EditorIndex).Data1 = scrlPetSprite.Value
    Exit Sub

' Error handler
errorhandler:
    HandleError "scrlPetSprite_Change", "frmEditor_Item", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
```
In frmEditor_Item inside form_load place this into the sub:
```
    frmEditor_Item.scrlPetSprite.max = NumCharacters
```
In modGameEditors inside ItemEditorInit find With Item(EditorIndex) and add:
```
        If .Data1 > 0 Then
            If .Data1 > frmEditor_Item.scrlPetSprite.max Then
                frmEditor_Item.scrlPetSprite.Value = frmEditor_Item.scrlPetSprite.max
            Else
                frmEditor_Item.scrlPetSprite.Value = .Data1
            End If
        Else
            frmEditor_Item.scrlPetSprite.Value = 1
        End If
```
In modDirectDraw7 find Y-based render, find:
```
Call BltPlayer(I)
```
Below it add:
```
                        If GetPlayerDir(I) = DIR_DOWN Then
                            Call BltPet(I)
                            Call BltPlayer(I)
                        Else
                            Call BltPlayer(I)
                            Call BltPet(I)
                        End If
```
Add this to the bottom of modDirectDraw7:
```
Public Sub BltPet(ByVal Index As Long)
    Dim Anim As Byte, I As Long, X As Long, Y As Long
    Dim Sprite As Long, SpriteTop As Long
    Dim rec As DxVBLib.RECT

    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler
>!     If Player(Index).Pet = 0 Then Exit Sub
>!     Sprite = Item(Player(Index).Pet).Data1
>!     If Sprite < 1 Or Sprite > NumCharacters Then Exit Sub

    CharacterTimer(Sprite) = GetTickCount + SurfaceTimerMax
>!     If DDS_Character(Sprite) Is Nothing Then
        Call InitDDSurf("characters\" & Sprite, DDSD_Character(Sprite), DDS_Character(Sprite))
    End If
>!     ' Reset frame
    If Player(Index).Step = 3 Then
        Anim = 0
    ElseIf Player(Index).Step = 1 Then
        Anim = 2
    End If

    ' If not attacking, walk normally
    Select Case GetPlayerDir(Index)
        Case DIR_UP
            If (Player(Index).YOffset > 8) Then Anim = Player(Index).Step
        Case DIR_DOWN
            If (Player(Index).YOffset < -8) Then Anim = Player(Index).Step
        Case DIR_LEFT
            If (Player(Index).XOffset > 8) Then Anim = Player(Index).Step
        Case DIR_RIGHT
            If (Player(Index).XOffset < -8) Then Anim = Player(Index).Step
    End Select
>!     ' Set the left
    Select Case GetPlayerDir(Index)
        Case DIR_UP
            SpriteTop = 3
        Case DIR_RIGHT
            SpriteTop = 2
        Case DIR_DOWN
            SpriteTop = 0
        Case DIR_LEFT
            SpriteTop = 1
    End Select
>!     With rec
        .Top = SpriteTop * (DDSD_Character(Sprite).lHeight / 4)
        .Bottom = .Top + (DDSD_Character(Sprite).lHeight / 4)
        .Left = Anim * (DDSD_Character(Sprite).lWidth / 4)
        .Right = .Left + (DDSD_Character(Sprite).lWidth / 4)
    End With
>!     ' Calculate the X
    If GetPlayerDir(Index) = DIR_RIGHT Then
        X = (GetPlayerX(Index) - 1) * PIC_X + Player(Index).XOffset - ((DDSD_Character(Sprite).lWidth / 4 - 32) / 2)
    ElseIf GetPlayerDir(Index) = DIR_LEFT Then
        X = (GetPlayerX(Index) + 1) * PIC_X + Player(Index).XOffset - ((DDSD_Character(Sprite).lWidth / 4 - 32) / 2)
    Else
        X = GetPlayerX(Index) * PIC_X + Player(Index).XOffset - ((DDSD_Character(Sprite).lWidth / 4 - 32) / 2)
    End If
>!     ' Is the player's height more than 32?
    If (DDSD_Character(Sprite).lHeight) > 32 Then
        ' Create a 32 pixel offset for larger sprites
        Y = GetPlayerY(Index) * PIC_Y + Player(Index).YOffset - ((DDSD_Character(Sprite).lHeight / 4) - 32)
    Else
        ' Proceed as normal
        Y = GetPlayerY(Index) * PIC_Y + Player(Index).YOffset
    End If

    ' Adjust Y based on direction
    If GetPlayerDir(Index) = DIR_DOWN Then
        Y = Y - 32
    ElseIf GetPlayerDir(Index) = DIR_UP Then
        Y = Y + 32
    End If

    ' Render the actual sprite
    Call BltSprite(Sprite, X, Y, rec)
    Exit Sub

' Error handler
errorhandler:
    HandleError "BltPet", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
End Sub
```
In modEnumerations, find SPlayerStats and add this below it:
```
    SPlayerPet
```
In modHandleData, find HandleDataSub(SPlayerStats) = GetAddress(AddressOf HandlePlayerStats) below it add:
```
    HandleDataSub(SPlayerPet) = GetAddress(AddressOf HandlePlayerPet)
```
At the bottom of modHandleData add:
```
Private Sub HandlePlayerPet(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()
    Index = Buffer.ReadLong
    Player(Index).Pet = Buffer.ReadInteger
    Set Buffer = Nothing
End Sub
```
In modHandleData in HandlePlayerData above ' Check if the player is the client player add:
```
    ' Pet
    Player(I).Pet = Buffer.ReadInteger
```
In modClientTCP in sub SendDropItem above:
```
Set Buffer = New clsBuffer
```
Add this:
```
    If GetPlayerInvItemNum(MyIndex, InvNum) = Player(MyIndex).Pet Then
        Call AddText("You can't drop an item that is currently in use!", BrightRed)
        Exit Sub
    End If
```

**Server:**

>! In modConstants find:
```
Public Const ITEM_TYPE_TELEPORT As Byte = 9
```
Below it add:
```
Public Const ITEM_TYPE_PET As Byte = 10
```
In modTypes inside PlayerRec add:
```
    ' Pet
    Pet As Integer
```
In sub UseItem place this at the very bottom before End Select:
```
        Case ITEM_TYPE_PET
            ' stat requirements
            For I = 1 To Stats.Stat_Count - 1
                If GetPlayerRawStat(Index, I) < Item(ItemNum).Stat_Req(I) Then
                    PlayerMsg Index, "You do not meet the stat requirements to equip this item.", BrightRed
                    Exit Sub
                End If
            Next

            ' level requirement
            If GetPlayerLevel(Index) < Item(ItemNum).LevelReq Then
                PlayerMsg Index, "You do not meet the level requirement to equip this item.", BrightRed
                Exit Sub
            End If

            ' class requirement
            If Item(ItemNum).ClassReq > 0 Then
                If Not GetPlayerClass(Index) = Item(ItemNum).ClassReq Then
                    PlayerMsg Index, "You do not meet the class requirement to equip this item.", BrightRed
                    Exit Sub
                End If
            End If

            ' access requirement
            If Not GetPlayerAccess(Index) >= Item(ItemNum).AccessReq Then
                PlayerMsg Index, "You do not meet the access requirement to equip this item.", BrightRed
                Exit Sub
            End If

            Call SendAnimation(GetPlayerMap(Index), Item(GetPlayerInvItemNum(Index, InvNum)).Animation, 0, 0, TARGET_TYPE_PLAYER, Index)
            Call ChangePet(Index, InvNum)
            ' Send the sound
            SendPlayerSound Index, GetPlayerX(Index), GetPlayerY(Index), SoundEntity.seItem, GetPlayerInvItemNum(Index, InvNum)
```
At the bottom of modPlayer paste this:
```
Public Sub ChangePet(ByVal Index As Long, Optional InvNum As Long)
    If Player(Index).Pet > 0 Then
        Player(Index).Pet = 0
    Else
        If Item(GetPlayerInvItemNum(Index, InvNum)).Data1 > 0 Then
            Player(Index).Pet = GetPlayerInvItemNum(Index, InvNum)
        Else
            Call PlayerMsg(Index, "This pet does not have a sprite, report this to a staff member!", BrightRed)
            Exit Sub
        End If
        Player(Index).Pet = GetPlayerInvItemNum(Index, InvNum)
    End If
    Call SendPlayerPet(Index)
End Sub
```
At the bottom of modServerTCP add this to the bottom:
```
Sub SendPlayerPet(ByVal Index As Long)
    Dim Packet As String
    Dim Buffer As clsBuffer

    Set Buffer = New clsBuffer

    Buffer.WriteLong SPlayerPet
    Buffer.WriteLong Index

    ' Send pet item number to client
    Buffer.WriteInteger Player(Index).Pet

    SendDataToMap GetPlayerMap(Index), Buffer.ToArray()
    Set Buffer = Nothing
End Sub
```
>! In modEnumerations, find SPlayerStats and add this below it:
```
    SPlayerPet
```
In modServerTCP in SendLeftGame above SetBuffer = Nothing add:
```
    Buffer.WriteInteger 0
```
Still in modServerTCP find Sub PlayerData at the bottom of the sub above PlayerData = Buffer.ToArray() add:
```
    ' Send pet item number to client
    Buffer.WriteInteger Player(Index).Pet
```
In modHandleData in sub HandleMapDropItem find:
```
    ' Everything worked out fine
    Call PlayerMapDropItem(Index, InvNum, Amount)
```
Above it add:
```
    ' Make sure there not using it
    If GetPlayerInvItemNum(Index, InvNum) = Player(Index).Pet Then Exit Sub
```

**V.1.0 -> V.1.1 Fixes:**

**Client:**

>! Change Pet(I) to:
```
                        If GetPlayerDir(MyIndex) = DIR_DOWN Then
                            Call BltPet(I)
                            Call BltPlayer(I)
                        Else
                            Call BltPlayer(I)
                            Call BltPet(I)
                        End If
```

**Server:**

>! Change Public Sub ChangePet(ByVal Index As Long, Optional InvNum As Byte = 0) to:
>! ```
Public Sub ChangePet(ByVal Index As Long, Optional InvNum As Long)
```
Replace:
```
        Case ITEM_TYPE_PET

            Call SendAnimation(GetPlayerMap(Index), Item(GetPlayerInvItemNum(Index, InvNum)).Animation, 0, 0, TARGET_TYPE_PLAYER, Index)
            Call ChangePet(Index, InvNum)
            ' Send the sound
            SendPlayerSound Index, GetPlayerX(Index), GetPlayerY(Index), SoundEntity.seItem, GetPlayerInvItemNum(Index, InvNum)
```
With:
```
        Case ITEM_TYPE_PET
            ' stat requirements
            For I = 1 To Stats.Stat_Count - 1
                If GetPlayerRawStat(Index, I) < Item(ItemNum).Stat_Req(I) Then
                    PlayerMsg Index, "You do not meet the stat requirements to equip this item.", BrightRed
                    Exit Sub
                End If
            Next

            ' level requirement
            If GetPlayerLevel(Index) < Item(ItemNum).LevelReq Then
                PlayerMsg Index, "You do not meet the level requirement to equip this item.", BrightRed
                Exit Sub
            End If

            ' class requirement
            If Item(ItemNum).ClassReq > 0 Then
                If Not GetPlayerClass(Index) = Item(ItemNum).ClassReq Then
                    PlayerMsg Index, "You do not meet the class requirement to equip this item.", BrightRed
                    Exit Sub
                End If
            End If

            ' access requirement
            If Not GetPlayerAccess(Index) >= Item(ItemNum).AccessReq Then
                PlayerMsg Index, "You do not meet the access requirement to equip this item.", BrightRed
                Exit Sub
            End If

            Call SendAnimation(GetPlayerMap(Index), Item(GetPlayerInvItemNum(Index, InvNum)).Animation, 0, 0, TARGET_TYPE_PLAYER, Index)
            Call ChangePet(Index, InvNum)
            ' Send the sound
            SendPlayerSound Index, GetPlayerX(Index), GetPlayerY(Index), SoundEntity.seItem, GetPlayerInvItemNum(Index, InvNum)
```

**V.1.1 -> V.1.2**

**Client:**

>! In modClientTCP in sub SendDropItem above:
```
Set Buffer = New clsBuffer
```
Add this:
```
    If GetPlayerInvItemNum(MyIndex, InvNum) = Player(MyIndex).Pet Then
        Call AddText("You can't drop an item that is currently in use!", BrightRed)
        Exit Sub
    End If
```
Find:
```
Call BltPet(I)
```
Change:
```
If GetPlayerDir(MyIndex) = DIR_DOWN Then
```
To:
```
If GetPlayerDir(I) = DIR_DOWN Then
```

**Server:**

>! In modHandleData in sub HandleMapDropItem find:
```
    ' Everything worked out fine
    Call PlayerMapDropItem(Index, InvNum, Amount)
```
Above it add:
```
    ' Make sure there not using it
    If GetPlayerInvItemNum(Index, InvNum) = Player(Index).Pet Then Exit Sub
```

Regards,
**Helladen**

[hammer]

some screens ? look good

[Helladen]

There's not much to show. The pets are just a sprite rendered behind or beside the player with a difference of 32 pixels. They have their own packet when sending the data, mostly because all my packets are separate anyway cause of players syncing with there they don't need to. And they also are in the PlayerData packet which clears out when you log out so it disappears/reappears when logging in.

This hasn't been heavily tested but I spot bugs/errors very easily so it should be very stable.

[hammer]

is just like papperdoll in front of you? or do something? like walk or atack?

[Helladen]

It does nothing. It just walks behind you, such as a Pokemon game. It walks and moves as you do, it's very basic…

[hammer]

ummm thats good to. maybe a base for other sistem. ty

[Helladen]

Also I forgot to mention this does not have the requirements code, because my source has them in HandleUseItem so you will have to add those if you want them.

[The New World]

I might actually tweak this a bit, it is a nice start. :) Giving an NPC the same path-finding logic as combative NPC's might help a bit. It's quite humorous how it's full of random movement to get to the damned player. Great work Helladen. :)

Quick note: You have ITEM_TYPE_TELEPORT, when others won't with their copy. So you might want to tweak that part of the tutorial for spoon fed users. :P

[Dzastin]

Compile Error:

InvNum

"ByRef argument type mismatch"

[Dzastin]

When i click to use pet i get Run Time Error…

[damian666]

im making a pokemon game, this will be cool :)

Thanx mate

Dami

[Dzastin]

Public Sub ChangePet(ByVal Index As Long, Optional InvNum As Byte = 0)
    If Player(Index).Pet > 0 Then
        Player(Index).Pet = 0
    Else
        If Item(GetPlayerInvItemNum(Index, InvNum)).Data1 > 0 Then
Help

[Dzastin]

Public Sub ChangePet(ByVal Index As Long, Optional InvNum As Byte = 0)

change to:

Public Sub ChangePet(ByVal Index As Long, Optional InvNum As Long)

[Markz88]

Little bug (arrow key: down):


how to fix?

[Yxxe]

@Markz88:

> Little bug (arrow key: down):
>
> 
>
> how to fix?

Change the rendering order of the player and pet. What I did when I first started out my Pet System was switch the drawing orders around depending on which way the player is facing.

[Markz88]

@Lightning:

> Change the rendering order of the player and pet. What I did when I first started out my Pet System was switch the drawing orders around depending on which way the player is facing.

Thanks… It works!!  :cheesy:

[NightmareX91]

Thanks for making this Helladen! Your the best :D

[Helladen]

@Dåттêвåyо:

> Public Sub ChangePet(ByVal Index As Long, Optional InvNum As Byte = 0)
>
> change to:
>
> Public Sub ChangePet(ByVal Index As Long, Optional InvNum As Long)

Not really a bug, the byval optional is just saying if the value is not provided it sets it to 0 I'm sorry my game has InvNum as Byte I'll fix it.

Fixes have been added to the main post, if you used the first release you can upgrade by following the instructions. Thanks for reporting the issues. :)

[Markz88]

I used your fix, but when I go to compile my client.exe I get this error:

If GetPlayerInvItemNum(MyIndex, InvNum) = Player(MyIndex).Mount Or GetPlayerInvItemNum(MyIndex, InvNum) = Player(MyIndex).Pet Then
        Call AddText("You can't drop an item that is currently in use!", BrightRed)
        Exit Sub
    End If

**Compile error:

Method or data member not found.**

[Joyce]

```
If GetPlayerInvItemNum(MyIndex, InvNum) = Player(MyIndex).Pet Then
        Call AddText("You can't drop an item that is currently in use!", BrightRed)
        Exit Sub
End If
```That's probably the code you need.. I think the Mount UDT entry is a custom one for his own game.. :)

[Dzastin]

If GetPlayerInvItemNum(MyIndex, InvNum) = Player(MyIndex).Mount Or GetPlayerInvItemNum(MyIndex, InvNum) = Player(MyIndex).Pet Then

Change to :

If GetPlayerInvItemNum(MyIndex, InvNum) = Player(MyIndex).Pet Or GetPlayerInvItemNum(MyIndex, InvNum) = Player(MyIndex).Pet Then

[Joyce]

Datte, I just said that.. Besides the fact you're checking the same thing twice now..

[The New World]

He's just trying to help, but you're right, he is checking the same thing twice now with his "correction", and if he isn't 100% sure of what he's doing then he shouldn't be posting.

The code you meant to change it to would not possess the _Or_ statement, or that which is there after, Datte.

What you're basically doing with that code is the equivalent to, If 2 + 2 = 2 or 2 + 2 = 2 Then, which is blatantly pointless. :)

[Markz88]

@Yami:

> ```
> If GetPlayerInvItemNum(MyIndex, InvNum) = Player(MyIndex).Pet Then
>         Call AddText("You can't drop an item that is currently in use!", BrightRed)
>         Exit Sub
> End If
> ```That's probably the code you need.. I think the Mount UDT entry is a custom one for his own game.. :)

It works :) thx

[Helladen]

I fixed that sorry. I use the same method for my mount system. :P (I removed it on the server forgot to remove it on the client check…) Simply redo the fix or remove the mount check to fix the issue.