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