Fix TM GameMode Item crashes

This commit is contained in:
JappaWakka 2023-06-01 12:40:58 +02:00
parent 771540a4a0
commit 098feb8e0d
5 changed files with 74 additions and 26 deletions

Binary file not shown.

View File

@ -57,14 +57,6 @@ Public Class GameModeItemLoader
Select Case key.ToLower()
Case "id"
item.gmID = "gm" & CInt(value).ToString
Dim itemX As Integer = CInt(value)
Dim itemY As Integer = 0
Dim sheetWidth As Integer = CInt(TextureManager.GetTexture(item.gmTextureSource).Width / 24)
While itemX > sheetWidth - 1
itemX -= sheetWidth
itemY += 1
End While
item.gmTextureRectangle = New Rectangle(CInt(itemX * 24), CInt(itemY * 24), 24, 24)
setID = True
Case "name"
item.gmName = value
@ -92,6 +84,16 @@ Public Class GameModeItemLoader
Case "battleitems", "7"
item.gmItemType = ItemTypes.BattleItems
End Select
Case "textureindex"
Dim itemX As Integer = CInt(value)
Dim itemY As Integer = 0
Dim sheetWidth As Integer = CInt(TextureManager.GetTexture(item.gmTextureSource).Width / 24)
While itemX > sheetWidth - 1
itemX -= sheetWidth
itemY += 1
End While
item.gmTextureRectangle = New Rectangle(CInt(itemX * 24), CInt(itemY * 24), 24, 24)
Case "canbeused"
item.gmCanBeUsed = CBool(value)
Case "canbeusedinbattle"
@ -136,7 +138,7 @@ Public Class GameModeItemLoader
item.gmIsEvolutionItem = CBool(value)
Case "evolutionpokemon"
Dim PokemonList As New List(Of Integer)
Dim valueSplit As String() = value.Split(",")
Dim valueSplit As String() = value.Split(CChar(","))
For i = 0 To valueSplit.Count - 1
If Pokemon.PokemonDataExists(CInt(valueSplit(i))) Then
PokemonList.Add(CInt(valueSplit(i)))
@ -188,6 +190,17 @@ Public Class GameModeItemLoader
item.SetTeachMoveTextureRectangle()
End If
If item.gmTextureRectangle = Nothing Then
Dim itemX As Integer = CInt(item.gmID.Remove(0, 2))
Dim itemY As Integer = 0
Dim sheetWidth As Integer = CInt(TextureManager.GetTexture(item.gmTextureSource).Width / 24)
While itemX > sheetWidth - 1
itemX -= sheetWidth
itemY += 1
End While
item.gmTextureRectangle = New Rectangle(CInt(itemX * 24), CInt(itemY * 24), 24, 24)
End If
LoadedItems.Add(item) 'Add the item.
Else
Logger.Log(Logger.LogTypes.ErrorMessage, "GameModeItemLoader.vb: User defined Items must set their ID through the ""ID"" property and their Name through the ""Name"" property, however the item loaded from """ & file & """ has no ID or Name set so it will be ignored.")

View File

@ -202,7 +202,7 @@ Public Class NewInventoryScreen
End Sub
Public Sub New(ByVal currentScreen As Screen, Optional ByVal AllowedItems As List(Of String) = Nothing, Optional ByVal DoReturnItem As Boolean = False)
Me.New(currentScreen, {}, Player.Temp.BagIndex, Nothing, AllowedItems, DoReturnItem)
Me.New(currentScreen, {0, 1, 2, 3, 4, 5, 6, 7}, Player.Temp.BagIndex, Nothing, AllowedItems, DoReturnItem)
End Sub
Public Overrides Sub Draw()
@ -415,7 +415,12 @@ Public Class NewInventoryScreen
End If
If _tabIndex = 4 Then
Dim AttackName As String = CType(cItem, Items.TechMachine).Attack.Name
Dim AttackName As String
If cItem.IsGameModeItem = False Then
AttackName = CType(cItem, Items.TechMachine).Attack.Name
Else
AttackName = CType(cItem, GameModeItem).gmTeachMove.Name
End If
Dim TMfontWidth As Integer = CInt(FontManager.MiniFont.MeasureString(AttackName).X)
itemBatch.DrawString(FontManager.MiniFont, AttackName, itemLoc + New Vector2(48 - TMfontWidth / 2.0F, 51 + 16), New Color(255, 255, 255, itemPanelAlpha))
End If
@ -484,6 +489,22 @@ Public Class NewInventoryScreen
Select Case cItem.ItemType
Case Items.ItemTypes.Machines
If cItem.IsGameModeItem = True Then
itemTitle = CType(cItem, GameModeItem).gmTeachMove.Name
If CType(cItem, GameModeItem).gmIsTM Then
'JSON stuff
'itemSubTitle = _translation.TECH_MACHINE_TITLE(cItem.ItemType.ToString())
itemSubTitle = "Technical Machine"
Else
'JSON stuff
'itemSubTitle = _translation.HIDDEN_MACHINE_TITLE(cItem.ItemType.ToString())
itemSubTitle = "Hidden Machine"
End If
itemDescription &= Environment.NewLine & CType(cItem, GameModeItem).gmTeachMove.Description
Else
Dim techMachine = CType(cItem, Items.TechMachine)
itemTitle = techMachine.Attack.Name
@ -499,6 +520,7 @@ Public Class NewInventoryScreen
End If
itemDescription &= Environment.NewLine & techMachine.Attack.Description
End If
Case Items.ItemTypes.Standard
'JSON stuff
'itemSubTitle = _translation.STANDARD_ITEM_TITLE(cItem.ItemType.ToString())

View File

@ -266,12 +266,19 @@
If CBool(GameModeManager.GetGameRuleValue("SingleUseTM", "0")) = True Then
Dim TechMachine As Item = Item.GetItemByID(Me.MachineItemID)
If TechMachine.ItemType = Items.ItemTypes.Machines Then
If TechMachine.IsGameModeItem = True Then
If CType(TechMachine, GameModeItem).gmIsTM = True Then
Core.Player.Inventory.RemoveItem(Me.MachineItemID, 1)
End If
Else
If CType(TechMachine, Items.TechMachine).IsTM = True Then
Core.Player.Inventory.RemoveItem(Me.MachineItemID, 1)
End If
End If
End If
End If
End If
PlayerStatistics.Track("Moves learned", 1)
TextBox.FollowUp = AddressOf FollowUpText
End If

View File

@ -391,9 +391,15 @@ Public Class PartyScreen
AttackLabel = "Unable!"
Select Case LearnType
Case 1 ' Technical/Hidden Machine
If CType(moveLearnArg, Item).IsGameModeItem = True Then
If CType(moveLearnArg, GameModeItem).CanTeach(p) = "" Then
AttackLabel = "Able!"
End If
Else
If CType(moveLearnArg, Items.TechMachine).CanTeach(p) = "" Then
AttackLabel = "Able!"
End If
End If
End Select
End If
GetFontRenderer().DrawString(FontManager.MainFont, AttackLabel, New Vector2(position.X + 216, position.Y + 28), New Color(255, 255, 255, CInt(255 * _interfaceFade)))