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() Select Case key.ToLower()
Case "id" Case "id"
item.gmID = "gm" & CInt(value).ToString 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 setID = True
Case "name" Case "name"
item.gmName = value item.gmName = value
@ -92,6 +84,16 @@ Public Class GameModeItemLoader
Case "battleitems", "7" Case "battleitems", "7"
item.gmItemType = ItemTypes.BattleItems item.gmItemType = ItemTypes.BattleItems
End Select 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" Case "canbeused"
item.gmCanBeUsed = CBool(value) item.gmCanBeUsed = CBool(value)
Case "canbeusedinbattle" Case "canbeusedinbattle"
@ -136,7 +138,7 @@ Public Class GameModeItemLoader
item.gmIsEvolutionItem = CBool(value) item.gmIsEvolutionItem = CBool(value)
Case "evolutionpokemon" Case "evolutionpokemon"
Dim PokemonList As New List(Of Integer) 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 For i = 0 To valueSplit.Count - 1
If Pokemon.PokemonDataExists(CInt(valueSplit(i))) Then If Pokemon.PokemonDataExists(CInt(valueSplit(i))) Then
PokemonList.Add(CInt(valueSplit(i))) PokemonList.Add(CInt(valueSplit(i)))
@ -188,6 +190,17 @@ Public Class GameModeItemLoader
item.SetTeachMoveTextureRectangle() item.SetTeachMoveTextureRectangle()
End If 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. LoadedItems.Add(item) 'Add the item.
Else 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.") 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 End Sub
Public Sub New(ByVal currentScreen As Screen, Optional ByVal AllowedItems As List(Of String) = Nothing, Optional ByVal DoReturnItem As Boolean = False) 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 End Sub
Public Overrides Sub Draw() Public Overrides Sub Draw()
@ -415,7 +415,12 @@ Public Class NewInventoryScreen
End If End If
If _tabIndex = 4 Then 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) 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)) itemBatch.DrawString(FontManager.MiniFont, AttackName, itemLoc + New Vector2(48 - TMfontWidth / 2.0F, 51 + 16), New Color(255, 255, 255, itemPanelAlpha))
End If End If
@ -484,6 +489,22 @@ Public Class NewInventoryScreen
Select Case cItem.ItemType Select Case cItem.ItemType
Case Items.ItemTypes.Machines 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) Dim techMachine = CType(cItem, Items.TechMachine)
itemTitle = techMachine.Attack.Name itemTitle = techMachine.Attack.Name
@ -499,6 +520,7 @@ Public Class NewInventoryScreen
End If End If
itemDescription &= Environment.NewLine & techMachine.Attack.Description itemDescription &= Environment.NewLine & techMachine.Attack.Description
End If
Case Items.ItemTypes.Standard Case Items.ItemTypes.Standard
'JSON stuff 'JSON stuff
'itemSubTitle = _translation.STANDARD_ITEM_TITLE(cItem.ItemType.ToString()) 'itemSubTitle = _translation.STANDARD_ITEM_TITLE(cItem.ItemType.ToString())

View File

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

View File

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