' Copyright (c) 2016 imacat. ' ' Licensed under the Apache License, Version 2.0 (the "License"); ' you may not use this file except in compliance with the License. ' You may obtain a copy of the License at ' ' http://www.apache.org/licenses/LICENSE-2.0 ' ' Unless required by applicable law or agreed to in writing, software ' distributed under the License is distributed on an "AS IS" BASIS, ' WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ' See the License for the specific language governing permissions and ' limitations under the License. ' 0Main: The main module for the Pokémon GO IV calculator ' by imacat <imacat@mail.imacat.idv.tw>, 2016-11-27 Option Explicit ' The stats of a Pokémon. Type aStats sNo As String sPokemon As String fLevel As Double nStamina As Integer nAttack As Integer nDefense As Integer nTotal As Integer nMaxCP As Integer maEvolvedForms () As aEvolveForm End Type ' The amount of star dust to power-up. Type aStarDust fLevel As Double nStarDust As Integer End Type ' The parameters to find the individual values. Type aFindIVParam sPokemon As String nCP As Integer nHP As Integer nStarDust As Integer nPlayerLevel As Integer bIsNew As Boolean nAppraisal1 As Integer sBest As String nAppraisal2 As Integer bIsCancelled As Boolean End Type Type aEvolveForm sPokemon As String nCP As Integer nMaxCP As Integer End Type Private maBaseStats () As New aStats Private mCPM () As Double, mStarDust () As Integer ' subMain: The main program Sub subMain Dim maIVs As Variant, nI As Integer Dim aQuery As New aFindIVParam, aBaseStats As New aStats aQuery = fnAskParam If aQuery.bIsCancelled Then Exit Sub End If maIVs = fnFindIV (aQuery) If UBound (maIVs) = -1 Then MsgBox fnGetResString ("ErrorNotFound") Else subSaveIV (aQuery, maIVs) End If End Sub ' fnAskParam: Asks the users for the parameters for the Pokémon. Function fnAskParam As aFindIVParam Dim oDialog As Object, oDialogModel As Object Dim bIsBestAttack As Boolean, bIsBestDefense As Boolean Dim bIsBestHP As Boolean Dim aQuery As New aFindIVParam DialogLibraries.loadLibrary "PokemonGoIV" oDialog = CreateUnoDialog (DialogLibraries.PokemonGoIV.DlgMain) oDialog.getControl ("lstAppraisal1").setVisible (False) oDialog.getControl ("txtBestBefore").setVisible (False) oDialog.getControl ("lstBest").setVisible (False) oDialog.getControl ("txtBestAfter").setVisible (False) oDialog.getControl ("cbxBest2").setVisible (False) oDialog.getControl ("cbxBest3").setVisible (False) oDialog.getControl ("lstAppraisal2").setVisible (False) oDialog.getControl ("imgPokemon").getModel.setPropertyValue ( _ "ImageURL", fnGetImageUrl ("Unknown")) oDialog.getControl ("imgTeamLogo").getModel.setPropertyValue ( _ "ImageURL", fnGetImageUrl ("Unknown")) If oDialog.execute = 0 Then aQuery.bIsCancelled = True fnAskParam = aQuery Exit Function End If With aQuery .sPokemon = oDialog.getControl ("lstPokemon").getSelectedItem .nCP = oDialog.getControl ("numCP").getValue .nHP = oDialog.getControl ("numHP").getValue .nStarDust = CInt (oDialog.getControl ("lstStarDust").getSelectedItem) .nPlayerLevel = CInt (oDialog.getControl ("lstPlayerLevel").getSelectedItem) .nAppraisal1 = oDialog.getControl ("lstAppraisal1").getSelectedItemPos + 1 .nAppraisal2 = oDialog.getControl ("lstAppraisal2").getSelectedItemPos + 1 .bIsCancelled = False End With If oDialog.getControl ("cbxIsNew").getState = 1 Then aQuery.bIsNew = True Else aQuery.bIsNew = False End If ' The best stats bIsBestAttack = False bIsBestDefense = False bIsBestHP = False If oDialog.getControl ("lstBest").getSelectedItem = "Attack" Then bIsBestAttack = True If oDialog.getControl ("cbxBest2").getState = 1 Then bIsBestDefense = True End If If oDialog.getControl ("cbxBest3").getState = 1 Then bIsBestHP = True End If End If If oDialog.getControl ("lstBest").getSelectedItem = "Defense" Then bIsBestDefense = True If oDialog.getControl ("cbxBest2").getState = 1 Then bIsBestAttack = True End If If oDialog.getControl ("cbxBest3").getState = 1 Then bIsBestHP = True End If End If If oDialog.getControl ("lstBest").getSelectedItem = "HP" Then bIsBestHP = True If oDialog.getControl ("cbxBest2").getState = 1 Then bIsBestAttack = True End If If oDialog.getControl ("cbxBest3").getState = 1 Then bIsBestDefense = True End If End If aQuery.sBest = "" If bIsBestAttack Then aQuery.sBest = aQuery.sBest & "Atk " End If If bIsBestDefense Then aQuery.sBest = aQuery.sBest & "Def " End If If bIsBestHP Then aQuery.sBest = aQuery.sBest & "Sta " End If fnAskParam = aQuery End Function ' subBtnOKCheck: Checks whether the required columns are filled. Sub subBtnOKCheck (oEvent As object) Dim oDialog As Object Dim oPokemon As Object, oCP As Object Dim oHP As Object, oStarDust As Object, oOK As Object oDialog = oEvent.Source.getContext oPokemon = oDialog.getControl ("lstPokemon") oCP = oDialog.getControl ("numCP") oHP = oDialog.getControl ("numHP") oStarDust = oDialog.getControl ("lstStarDust") oOK = oDialog.getControl ("btnOK") If oPokemon.getSelectedItemPos <> -1 _ And oCP.getText <> "" _ And oHP.getText <> "" _ And oStarDust.getSelectedItemPos <> -1 Then oOK.setEnable (True) Else oOK.setEnable (False) End If End Sub ' subLstPokemonSelected: When the Pokémon is selected. Sub subLstPokemonSelected (oEvent As object) Dim oDialog As Object, sPokemon As String Dim oImageModel As Object, sImageId As String oDialog = oEvent.Source.getContext ' Updates the Pokémon image. sPokemon = oDialog.getControl ("lstPokemon").getSelectedItem sImageId = "" If sPokemon = "Farfetch'd" Then sImageId = "PokemonFarfetchd" End If If sPokemon = "Nidoran♀" Then sImageId = "PokemonNidoranFemale" End If If sPokemon = "Nidoran♂" Then sImageId = "PokemonNidoranMale" End If If sPokemon = "Mr. Mime" Then sImageId = "PokemonMrMime" End If If sImageId = "" Then sImageId = "Pokemon" & sPokemon End If oImageModel = oDialog.getControl ("imgPokemon").getModel oImageModel.setPropertyValue ("ImageURL", _ fnGetImageUrl (sImageId)) ' Updates the text of the first appraisal. subUpdateAppraisal1 (oDialog, True) ' Checks if the required columns are filled. subBtnOKCheck (oEvent) End Sub ' subRdoTeamValorItemChanged: When Team Valor is selected. Sub subRdoTeamValorItemChanged (oEvent As object) Dim oDialog As Object, oList As Object, oText As Object Dim oImageModel As Object Dim mItems () As String oDialog = oEvent.Source.getContext oImageModel = oDialog.getControl ("imgTeamLogo").getModel oImageModel.setPropertyValue ("ImageURL", _ fnGetImageUrl ("TeamLogoValor")) oImageModel = oDialog.getControl ("imgTeamLeader").getModel oImageModel.setPropertyValue ("ImageURL", _ fnGetImageUrl ("TeamLeaderCandela")) oText = oDialog.getControl ("txtLeaderAppraise") oText.setVisible (True) oText.setText (fnGetResString ("AppraiseFromCandela")) ' Updates the text of the first appraisal. subUpdateAppraisal1 (oDialog, False) ' Updates the text of the best stat appraisal. subUpdateBestStatAppraisal (oDialog, _ "Its", 8, "is its strongest feature.", 65) mItems = Array ( _ "I'm blown away by its stats. WOW!", _ "It's got excellent stats! How exciting!", _ "Its stats indicate that in battle, it'll get the job done.", _ "Its stats don't point to greatness in battle.") oList = oDialog.getControl ("lstAppraisal2") oList.removeItems (0, oList.getItemCount()) oList.addItems (mItems, 0) oList.setVisible (True) End Sub ' subRdoTeamMysticItemChanged: When Team Mystic is selected. Sub subRdoTeamMysticItemChanged (oEvent As object) Dim oDialog As Object, oList As Object, oText As Object Dim oImageModel As Object Dim mItems () As String oDialog = oEvent.Source.getContext oImageModel = oDialog.getControl ("imgTeamLogo").getModel oImageModel.setPropertyValue ("ImageURL", _ fnGetImageUrl ("TeamLogoMystic")) oImageModel = oDialog.getControl ("imgTeamLeader").getModel oImageModel.setPropertyValue ("ImageURL", _ fnGetImageUrl ("TeamLeaderBlanche")) oText = oDialog.getControl ("txtLeaderAppraise") oText.setVisible (True) oText.setText (fnGetResString ("AppraiseFromBlanche")) ' Updates the text of the first appraisal. subUpdateAppraisal1 (oDialog, False) ' Updates the text of the best stat appraisal. subUpdateBestStatAppraisal (oDialog, _ "I see that its best attribute is its", 85, ".", 5) mItems = Array ( _ "Its stats exceed my calculations. It's incredible!", _ "I am certainly impressed by its stats, I must say.", _ "Its stats are noticeably trending to the positive.", _ "Its stats are not out of the norm, in my opinion.") oList = oDialog.getControl ("lstAppraisal2") oList.removeItems (0, oList.getItemCount()) oList.addItems (mItems, 0) oList.setVisible (True) End Sub ' subRdoTeamInstinctItemChanged: When Team Instinct is selected. Sub subRdoTeamInstinctItemChanged (oEvent As object) Dim oDialog As Object, oList As Object, oText As Object Dim oImageModel As Object Dim mItems () As String oDialog = oEvent.Source.getContext oImageModel = oDialog.getControl ("imgTeamLogo").getModel oImageModel.setPropertyValue ("ImageURL", _ fnGetImageUrl ("TeamLogoInstinct")) oImageModel = oDialog.getControl ("imgTeamLeader").getModel oImageModel.setPropertyValue ("ImageURL", _ fnGetImageUrl ("TeamLeaderSpark")) oText = oDialog.getControl ("txtLeaderAppraise") oText.setVisible (True) oText.setText (fnGetResString ("AppraiseFromSpark")) ' Updates the text of the first appraisal. subUpdateAppraisal1 (oDialog, False) ' Updates the text of the best stat appraisal. subUpdateBestStatAppraisal (oDialog, _ "Its best quality is", 45, ".", 5) mItems = Array ( _ "Its stats are the best I've ever seen! No doubt about it!", _ "Its stats are really strong! Impressive.", _ "It's definitely got some good stats. Definitely!", _ "Its stats are all right, but kinda basic, as far as I can see.") oList = oDialog.getControl ("lstAppraisal2") oList.removeItems (0, oList.getItemCount()) oList.addItems (mItems, 0) oList.setVisible (True) End Sub ' subUpdateBestStatAppraisal: Updates the text of the best stat appraisal. Sub subUpdateBestStatAppraisal (oDialog As Object, _ sBefore As String, nBeforeWidth As Integer, _ sAfter As String, nAfterWidth As Integer) Dim oText As Object, oList As Object, nX As Integer Dim mItems () As String oText = oDialog.getControl ("txtBestBefore") oText.getModel.setPropertyValue ("Width", nBeforeWidth) oText.setVisible (True) oText.setText (sBefore) nX = oText.getModel.getPropertyValue ("PositionX") + nBeforeWidth mItems = Array ("Attack", "Defense", "HP") oList = oDialog.getControl ("lstBest") oList.removeItems (0, oList.getItemCount()) oList.addItems (mItems, 0) oList.getModel.setPropertyValue ("PositionX", nX) oList.setVisible (True) nX = nX + oList.getModel.getPropertyValue ("Width") + 2 oText = oDialog.getControl ("txtBestAfter") oText.getModel.setPropertyValue ("PositionX", nX) oText.getModel.setPropertyValue ("Width", nAfterWidth) oText.setVisible (True) oText.setText (sAfter) oList = oDialog.getControl ("cbxBest2") oList.setVisible (False) oList = oDialog.getControl ("cbxBest3") oList.setVisible (False) End Sub ' subLstBestItemChanged: When the best stat is selected. Sub subLstBestItemChanged (oEvent As object) Dim oDialog As Object, oCheckBox As Object oDialog = oEvent.Source.getContext If oDialog.getControl ("rdoTeamValor").getState Then If oDialog.getControl ("lstBest").getSelectedItem = "Attack" Then oCheckBox = oDialog.getControl ("cbxBest2") oCheckBox.setLabel ("I'm just as impressed with its Defense.") oCheckBox.setVisible (True) oCheckBox.setState (0) oCheckBox = oDialog.getControl ("cbxBest3") oCheckBox.setLabel ("I'm just as impressed with its HP.") oCheckBox.setVisible (True) oCheckBox.setState (0) End If If oDialog.getControl ("lstBest").getSelectedItem = "Defense" Then oCheckBox = oDialog.getControl ("cbxBest2") oCheckBox.setLabel ("I'm just as impressed with its Attack.") oCheckBox.setVisible (True) oCheckBox.setState (0) oCheckBox = oDialog.getControl ("cbxBest3") oCheckBox.setLabel ("I'm just as impressed with its HP.") oCheckBox.setVisible (True) oCheckBox.setState (0) End If If oDialog.getControl ("lstBest").getSelectedItem = "HP" Then oCheckBox = oDialog.getControl ("cbxBest2") oCheckBox.setLabel ("I'm just as impressed with its Attack.") oCheckBox.setVisible (True) oCheckBox.setState (0) oCheckBox = oDialog.getControl ("cbxBest3") oCheckBox.setLabel ("I'm just as impressed with its Defense.") oCheckBox.setVisible (True) oCheckBox.setState (0) End If End If If oDialog.getControl ("rdoTeamMystic").getState Then If oDialog.getControl ("lstBest").getSelectedItem = "Attack" Then oCheckBox = oDialog.getControl ("cbxBest2") oCheckBox.setLabel ("It is matched equally by its Defense.") oCheckBox.setVisible (True) oCheckBox.setState (0) oCheckBox = oDialog.getControl ("cbxBest3") oCheckBox.setLabel ("It is matched equally by its HP.") oCheckBox.setVisible (True) oCheckBox.setState (0) End If If oDialog.getControl ("lstBest").getSelectedItem = "Defense" Then oCheckBox = oDialog.getControl ("cbxBest2") oCheckBox.setLabel ("It is matched equally by its Attack.") oCheckBox.setVisible (True) oCheckBox.setState (0) oCheckBox = oDialog.getControl ("cbxBest3") oCheckBox.setLabel ("It is matched equally by its HP.") oCheckBox.setVisible (True) oCheckBox.setState (0) End If If oDialog.getControl ("lstBest").getSelectedItem = "HP" Then oCheckBox = oDialog.getControl ("cbxBest2") oCheckBox.setLabel ("It is matched equally by its Attack.") oCheckBox.setVisible (True) oCheckBox.setState (0) oCheckBox = oDialog.getControl ("cbxBest3") oCheckBox.setLabel ("It is matched equally by its Defense.") oCheckBox.setVisible (True) oCheckBox.setState (0) End If End If If oDialog.getControl ("rdoTeamInstinct").getState Then If oDialog.getControl ("lstBest").getSelectedItem = "Attack" Then oCheckBox = oDialog.getControl ("cbxBest2") oCheckBox.setLabel ("Its Defense is great, too!") oCheckBox.setVisible (True) oCheckBox = oDialog.getControl ("cbxBest3") oCheckBox.setLabel ("Its HP is great, too!") oCheckBox.setVisible (True) End If If oDialog.getControl ("lstBest").getSelectedItem = "Defense" Then oCheckBox = oDialog.getControl ("cbxBest2") oCheckBox.setLabel ("Its Attack is great, too!") oCheckBox.setVisible (True) oCheckBox.setState (0) oCheckBox = oDialog.getControl ("cbxBest3") oCheckBox.setLabel ("Its HP is great, too!") oCheckBox.setVisible (True) oCheckBox.setState (0) End If If oDialog.getControl ("lstBest").getSelectedItem = "HP" Then oCheckBox = oDialog.getControl ("cbxBest2") oCheckBox.setLabel ("Its Attack is great, too!") oCheckBox.setVisible (True) oCheckBox.setState (0) oCheckBox = oDialog.getControl ("cbxBest3") oCheckBox.setLabel ("Its Defense is great, too!") oCheckBox.setVisible (True) oCheckBox.setState (0) End If End If End Sub ' subUpdateAppraisal1: Updates the text of the first appraisal. Sub subUpdateAppraisal1 (oDialog As Object, bIsKeepSelected As Boolean) Dim sPokemon As String, oList As Object, nSelected As Integer Dim mItems () As String, nI As Integer If oDialog.getControl ("rdoTeamValor").getState Then mItems = Array ( _ "Overall, your [Pokémon] simply amazes me. It can accomplish anything!", _ "Overall, your [Pokémon] is a strong Pokémon. You should be proud!", _ "Overall, your [Pokémon] is a decent Pokémon.", _ "Overall, your [Pokémon] may not be great in battle, but I still like it!") End If If oDialog.getControl ("rdoTeamMystic").getState Then mItems = Array ( _ "Overall, your [Pokémon] is a wonder! What a breathtaking Pokémon!", _ "Overall, your [Pokémon] has certainly caught my attention.", _ "Overall, your [Pokémon] is above average.", _ "Overall, your [Pokémon] is not likely to make much headway in battle.") End If If oDialog.getControl ("rdoTeamInstinct").getState Then mItems = Array ( _ "Overall, your [Pokémon] looks like it can really battle with the best of them!", _ "Overall, your [Pokémon] is really strong!", _ "Overall, your [Pokémon] is pretty decent!", _ "Overall, your [Pokémon] has room for improvement as far as battling goes.") End If ' The team was not selected yet. If UBound (mItems) = -1 Then Exit sub End If sPokemon = oDialog.getControl ("lstPokemon").getSelectedItem If sPokemon <> "" Then For nI = 0 To UBound (mItems) mItems (nI) = fnReplace (mItems (nI), _ "[Pokémon]", sPokemon) Next nI End If oList = oDialog.getControl ("lstAppraisal1") If bIsKeepSelected Then nSelected = oList.getSelectedItemPos End If oList.removeItems (0, oList.getItemCount()) oList.addItems (mItems, 0) If bIsKeepSelected Then oList.selectItemPos (nSelected, True) End If oList.setVisible (True) End Sub ' fnFindIV: Finds the possible individual values of the Pokémon Function fnFindIV (aQuery As aFindIVParam) As Variant Dim aBaseStats As New aStats, maIV () As New aStats Dim fLevel As Double, nStamina As Integer Dim nAttack As Integer, nDefense As integer Dim nI As Integer, nJ As Integer Dim fStep As Double, nCount As Integer Dim aEvBaseStats As new aStats, aTempIV As New aStats Dim maEvolvedForms () As New aEvolveForm If aQuery.sPokemon = "" Then fnFindIV = maIV Exit Function End If If aQuery.bIsNew Then fStep = 1 Else fStep = 0.5 End If aBaseStats = fnGetBaseStats (aQuery.sPokemon) subReadStarDust nCount = -1 For fLevel = 1 To UBound (mStarDust) Step fStep If mStarDust (CInt (fLevel - 0.5)) = aQuery.nStarDust Then For nStamina = 0 To 15 If fnCalcHP (aBaseStats, fLevel, nStamina) = aQuery.nHP Then For nAttack = 0 To 15 For nDefense = 0 To 15 If fnCalcCP (aBaseStats, fLevel, nAttack, nDefense, nStamina) = aQuery.nCP _ And Not (fnFilterAppraisals (aQuery, nAttack, nDefense, nStamina)) Then nCount = nCount + 1 ReDim Preserve maIV (nCount) As New aStats With maIV (nCount) .sNo = aBaseStats.sNo .sPokemon = aQuery.sPokemon .fLevel = fLevel .nAttack = nAttack .nDefense = nDefense .nStamina = nStamina .nTotal = nAttack + nDefense + nStamina End With If aQuery.nPlayerLevel <> 0 Then maIV (nCount).nMaxCP = fnCalcCP (aBaseStats, aQuery.nPlayerLevel + 1.5, nAttack, nDefense, nStamina) Else maIV (nCount).nMaxCP = -1 End If maIV (nCount).maEvolvedForms = fnGetEvolvedFormArray (UBound (aBaseStats.maEvolvedForms)) For nI = 0 To UBound (aBaseStats.maEvolvedForms) maIV (nCount).maEvolvedForms (nI).sPokemon = aBaseStats.maEvolvedForms (nI).sPokemon aEvBaseStats = fnGetBaseStats (aBaseStats.maEvolvedForms (nI).sPokemon) maIV (nCount).maEvolvedForms (nI).nCP = fnCalcCP (aEvBaseStats, fLevel, nAttack, nDefense, nStamina) If aQuery.nPlayerLevel <> 0 Then maIV (nCount).maEvolvedForms (nI).nMaxCP = fnCalcCP (aEvBaseStats, aQuery.nPlayerLevel + 1.5, nAttack, nDefense, nStamina) Else maIV (nCount).maEvolvedForms (nI).nMaxCP = -1 End If Next nI End If Next nDefense Next nAttack End If Next nStamina End If Next fLevel ' Sorts the IVs For nI = 0 To UBound (maIV) - 1 For nJ = nI + 1 To UBound (maIV) If fnCompareIV (maIV (nI), maIV (nJ)) > 0 Then subCopyIV (maIV (nI), aTempIV) subCopyIV (maIV (nJ), maIV (nI)) subCopyIV (aTempIV, maIV (nJ)) End If Next nJ Next nI fnFindIV = maIV End Function ' fnCompareIV: Compare two IVs for sorting Function fnCompareIV (aIVa As aStats, aIVb As aStats) As Double Dim nCPa As Integer, nCPb As Integer, nI As Integer nCPa = aIVa.nMaxCP For nI = 0 To UBound (aIVa.maEvolvedForms) If nCPa < aIVa.maEvolvedForms (nI).nMaxCP Then nCPa = aIVa.maEvolvedForms (nI).nMaxCP End If Next nI nCPb = aIVb.nMaxCP For nI = 0 To UBound (aIVb.maEvolvedForms) If nCPb < aIVb.maEvolvedForms (nI).nMaxCP Then nCPb = aIVb.maEvolvedForms (nI).nMaxCP End If Next nI fnCompareIV = nCPb - nCPa If fnCompareIV <> 0 Then Exit Function End If nCPa = 0 For nI = 0 To UBound (aIVa.maEvolvedForms) If nCPa < aIVa.maEvolvedForms (nI).nCP Then nCPa = aIVa.maEvolvedForms (nI).nCP End If Next nI nCPb = 0 For nI = 0 To UBound (aIVb.maEvolvedForms) If nCPb < aIVb.maEvolvedForms (nI).nCP Then nCPb = aIVb.maEvolvedForms (nI).nCP End If Next nI fnCompareIV = nCPb - nCPa If fnCompareIV <> 0 Then Exit Function End If fnCompareIV = aIVb.nTotal - aIVa.nTotal If fnCompareIV <> 0 Then Exit Function End If fnCompareIV = aIVb.fLevel - aIVa.fLevel If fnCompareIV <> 0 Then Exit Function End If fnCompareIV = aIVb.nStamina - aIVa.nStamina If fnCompareIV <> 0 Then Exit Function End If fnCompareIV = aIVb.nAttack - aIVa.nAttack If fnCompareIV <> 0 Then Exit Function End If fnCompareIV = aIVb.nDefense - aIVa.nDefense If fnCompareIV <> 0 Then Exit Function End If End Function ' subCopyIV: Copies one IV to another Function subCopyIV (aFrom As aStats, aTo As aStats) As Double Dim nI As Integer, maEvolvedForms () As New aEvolveForm With aTo .sNo = aFrom.sNo .sPokemon = aFrom.sPokemon .fLevel = aFrom.fLevel .nAttack = aFrom.nAttack .nDefense = aFrom.nDefense .nStamina = aFrom.nStamina .nTotal = aFrom.nTotal .nMaxCP = aFrom.nMaxCP End With aTo.maEvolvedForms = fnGetEvolvedFormArray (UBound (aFrom.maEvolvedForms)) For nI = 0 To UBound (aFrom.maEvolvedForms) With aTo.maEvolvedForms (nI) .sPokemon = aFrom.maEvolvedForms (nI).sPokemon .nCP = aFrom.maEvolvedForms (nI).nCP .nMaxCP = aFrom.maEvolvedForms (nI).nMaxCP End With Next nI End Function ' subSaveIV: Saves the found IV Sub subSaveIV (aQuery As aFindIVParam, maIVs () As aStats) Dim oDoc As Object, oSheet As Object Dim oRange As Object, oColumns As Object, oRows As Object Dim nI As Integer, nJ As Integer, nFrontCols As Integer Dim mData (Ubound (maIVs) + 1) As Variant, mRow () As Variant Dim mProps () As New com.sun.star.beans.PropertyValue oDoc = StarDesktop.loadComponentFromURL ( _ "private:factory/scalc", "_default", 0, mProps) oSheet = oDoc.getSheets.getByIndex (0) mRow = Array ( _ "No", "Pokemon", "CP", "HP", "Star dust", _ "Lv", "Atk", "Def", "Sta", "IV") nFrontCols = UBound (mRow) If aQuery.sPokemon = "Eevee" Then If aQuery.nPlayerLevel <> 0 Then ReDim Preserve mRow (nFrontCols + 6) As Variant mRow (nFrontCols + 1) = "CP as " & maIVs (0).maEvolvedForms (0).sPokemon mRow (nFrontCols + 2) = "Powered-up as " & maIVs (0).maEvolvedForms (0).sPokemon mRow (nFrontCols + 3) = "CP as " & maIVs (0).maEvolvedForms (1).sPokemon mRow (nFrontCols + 4) = "Powered-up as " & maIVs (0).maEvolvedForms (1).sPokemon mRow (nFrontCols + 5) = "CP as " & maIVs (0).maEvolvedForms (2).sPokemon mRow (nFrontCols + 6) = "Powered-up as " & maIVs (0).maEvolvedForms (2).sPokemon Else ReDim Preserve mRow (nFrontCols + 3) As Variant mRow (nFrontCols + 1) = "CP as " & maIVs (0).maEvolvedForms (0).sPokemon mRow (nFrontCols + 2) = "CP as " & maIVs (0).maEvolvedForms (1).sPokemon mRow (nFrontCols + 3) = "CP as " & maIVs (0).maEvolvedForms (2).sPokemon End If Else If UBound (maIVs (0).maEvolvedForms) = -1 Then If aQuery.nPlayerLevel <> 0 Then ReDim Preserve mRow (nFrontCols + 1) As Variant mRow (nFrontCols + 1) = "Powered-up" End If Else If aQuery.nPlayerLevel <> 0 Then ReDim Preserve mRow (nFrontCols + UBound (maIVs (0).maEvolvedForms) + 2) As Variant For nJ = 0 To UBound (maIVs (0).maEvolvedForms) mRow (nFrontCols + nJ + 1) = "CP as " & maIVs (0).maEvolvedForms (nJ).sPokemon Next nJ mRow (UBound (mRow)) = "Powered-up as " & maIVs (0).maEvolvedForms (UBound (maIVs (0).maEvolvedForms)).sPokemon Else ReDim Preserve mRow (nFrontCols + UBound (maIVs (0).maEvolvedForms) + 1) As Variant For nJ = 0 To UBound (maIVs (0).maEvolvedForms) mRow (nFrontCols + nJ + 1) = "CP as " & maIVs (0).maEvolvedForms (nJ).sPokemon Next nJ End If End If End If mData (0) = mRow For nI = 0 To UBound (maIVs) mRow = Array ( _ "", "", "", "", "", _ maIVs (nI).fLevel, maIVs (nI).nAttack, maIVs (nI).nDefense, _ maIVs (nI).nStamina, maIVs (nI).nTotal / 45) If aQuery.sPokemon = "Eevee" Then If aQuery.nPlayerLevel <> 0 Then ReDim Preserve mRow (nFrontCols + 6) As Variant mRow (nFrontCols + 1) = maIVs (nI).maEvolvedForms (0).nCP mRow (nFrontCols + 2) = maIVs (nI).maEvolvedForms (0).nMaxCP mRow (nFrontCols + 3) = maIVs (nI).maEvolvedForms (1).nCP mRow (nFrontCols + 4) = maIVs (nI).maEvolvedForms (1).nMaxCP mRow (nFrontCols + 5) = maIVs (nI).maEvolvedForms (2).nCP mRow (nFrontCols + 6) = maIVs (nI).maEvolvedForms (2).nMaxCP Else ReDim Preserve mRow (nFrontCols + 3) As Variant mRow (nFrontCols + 1) = maIVs (nI).maEvolvedForms (0).nCP mRow (nFrontCols + 2) = maIVs (nI).maEvolvedForms (1).nCP mRow (nFrontCols + 3) = maIVs (nI).maEvolvedForms (2).nCP End If Else If UBound (maIVs (nI).maEvolvedForms) = -1 Then If aQuery.nPlayerLevel <> 0 Then ReDim Preserve mRow (nFrontCols + 1) As Variant mRow (nFrontCols + 1) = maIVs (nI).nMaxCP End If Else If aQuery.nPlayerLevel <> 0 Then ReDim Preserve mRow (nFrontCols + UBound (maIVs (nI).maEvolvedForms) + 2) As Variant For nJ = 0 To UBound (maIVs (nI).maEvolvedForms) mRow (nFrontCols + nJ + 1) = maIVs (nI).maEvolvedForms (nJ).nCP Next nJ mRow (UBound (mRow)) = maIVs (nI).maEvolvedForms (UBound (maIVs (nI).maEvolvedForms)).nMaxCP Else ReDim Preserve mRow (nFrontCols + UBound (maIVs (nI).maEvolvedForms) + 1) As Variant For nJ = 0 To UBound (maIVs (nI).maEvolvedForms) mRow (nFrontCols + nJ + 1) = maIVs (nI).maEvolvedForms (nJ).nCP Next nJ End If End If End If mData (nI + 1) = mRow Next nI ' Fills the query information at the first row mData (1) (0) = maIVs (0).sNo mData (1) (1) = aQuery.sPokemon mData (1) (2) = aQuery.nCP mData (1) (3) = aQuery.nHP mData (1) (4) = aQuery.nStarDust oRange = oSheet.getCellRangeByPosition ( _ 0, 0, UBound (mData (0)), UBound (mData)) oRange.setDataArray (mData) oRange.setPropertyValue ("VertJustify", _ com.sun.star.table.CellVertJustify.TOP) oRange = oSheet.getCellRangeByPosition ( _ 0, 1, 0, UBound (mData)) oRange.merge (True) oRange = oSheet.getCellRangeByPosition ( _ 1, 1, 1, UBound (mData)) oRange.merge (True) oRange = oSheet.getCellRangeByPosition ( _ 2, 1, 2, UBound (mData)) oRange.merge (True) oRange = oSheet.getCellRangeByPosition ( _ 3, 1, 3, UBound (mData)) oRange.merge (True) oRange = oSheet.getCellRangeByPosition ( _ 4, 1, 4, UBound (mData)) oRange.merge (True) oRange = oSheet.getCellRangeByPosition ( _ 9, 1, 9, UBound (mData)) oRange.setPropertyValue ("NumberFormat", 10) If aQuery.sPokemon = "Eevee" Then oRange = oSheet.getCellRangeByPosition ( _ 10, 0, 15, 0) Else If UBound (maIVs (0).maEvolvedForms) = -1 Then oRange = oSheet.getCellRangeByPosition ( _ 10, 0, 10, 0) Else oRange = oSheet.getCellRangeByPosition ( _ 10, 0, 10 + UBound (maIVs (0).maEvolvedForms) + 2, 0) End If End If oRange.setPropertyValue ("IsTextWrapped", True) oRows = oSheet.getRows oRows.getByIndex (0).setPropertyValue ("Height", 840) oColumns = oSheet.getColumns oColumns.getByIndex (0).setPropertyValue ("Width", 890) oColumns.getByIndex (1).setPropertyValue ("Width", 2310) oColumns.getByIndex (2).setPropertyValue ("Width", 890) oColumns.getByIndex (3).setPropertyValue ("Width", 890) oColumns.getByIndex (4).setPropertyValue ("Width", 1780) oColumns.getByIndex (5).setPropertyValue ("Width", 860) oColumns.getByIndex (6).setPropertyValue ("Width", 860) oColumns.getByIndex (7).setPropertyValue ("Width", 860) oColumns.getByIndex (8).setPropertyValue ("Width", 860) oColumns.getByIndex (9).setPropertyValue ("Width", 1030) If aQuery.sPokemon = "Eevee" Then If aQuery.nPlayerLevel <> 0 Then For nI = 0 To 5 Step 2 oColumns.getByIndex (10 + nI).setPropertyValue ("Width", 2310) oColumns.getByIndex (10 + nI + 1).setPropertyValue ("Width", 2810) Next nI Else For nI = 0 To 2 oColumns.getByIndex (10 + nI).setPropertyValue ("Width", 2310) Next nI End If Else If UBound (maIVs (0).maEvolvedForms) = -1 Then If aQuery.nPlayerLevel <> 0 Then oColumns.getByIndex (10).setPropertyValue ("Width", 2200) End If Else For nI = 0 To UBound (maIVs (0).maEvolvedForms) oColumns.getByIndex (10 + nI).setPropertyValue ("Width", 2310) Next nI If aQuery.nPlayerLevel <> 0 Then oColumns.getByIndex (10 + UBound (maIVs (0).maEvolvedForms) + 1).setPropertyValue ("Width", 2810) End If End If End If End Sub ' fnFilterAppraisals: Filters the IV by the appraisals. Function fnFilterAppraisals (aQuery As aFindIVParam, nAttack As Integer, nDefense As Integer, nStamina As Integer) As Boolean Dim nTotal As Integer, nMax As Integer, sBest As String ' The first appraisal. nTotal = nAttack + nDefense + nStamina If aQuery.nAppraisal1 = 1 And Not (nTotal >= 37) Then fnFilterAppraisals = True Exit Function End If If aQuery.nAppraisal1 = 2 And Not (nTotal >= 30 And nTotal <= 36) Then fnFilterAppraisals = True Exit Function End If If aQuery.nAppraisal1 = 3 And Not (nTotal >= 23 And nTotal <= 29) Then fnFilterAppraisals = True Exit Function End If If aQuery.nAppraisal1 = 4 And Not (nTotal <= 22) Then fnFilterAppraisals = True Exit Function End If ' The best stats. nMax = nAttack If nDefense > nMax Then nMax = nDefense End If If nStamina > nMax Then nMax = nStamina End If If aQuery.sBest <> "" Then sBest = "" If nAttack = nMax Then sBest = sBest & "Atk " End If If nDefense = nMax Then sBest = sBest & "Def " End If If nStamina = nMax Then sBest = sBest & "Sta " End If If aQuery.sBest <> sBest Then fnFilterAppraisals = True Exit Function End If End If ' The second appraisal. If aQuery.nAppraisal2 = 1 And Not (nMax = 15) Then fnFilterAppraisals = True Exit Function End If If aQuery.nAppraisal2 = 2 And Not (nMax = 13 Or nMax = 14) Then fnFilterAppraisals = True Exit Function End If If aQuery.nAppraisal2 = 3 And Not (nMax >= 8 And nMax <= 12) Then fnFilterAppraisals = True Exit Function End If If aQuery.nAppraisal2 = 4 And Not (nMax <= 7) Then fnFilterAppraisals = True Exit Function End If fnFilterAppraisals = False End Function ' fnCalcCP: Calculates the combat power of the Pokémon Function fnCalcCP (aBaseStats As aStats, fLevel As Double, nAttack As Integer, nDefense As Integer, nStamina As Integer) As Integer Dim nCP As Integer nCP = fnFloor ((aBaseStats.nAttack + nAttack) _ * ((aBaseStats.nDefense + nDefense) ^ 0.5) _ * ((aBaseStats.nStamina + nStamina) ^ 0.5) _ * (fnGetCPM (fLevel) ^ 2) / 10) If nCP < 10 Then nCP = 10 End If fnCalcCP = nCP End Function ' fnCalcHP: Calculates the hit points of the Pokémon Function fnCalcHP (aBaseStats As aStats, fLevel As Double, nStamina As Integer) As Integer fnCalcHP = fnFloor ((aBaseStats.nStamina + nStamina) _ * fnGetCPM (fLevel)) End Function ' fnGetBaseStats: Returns the base stats of the Pokémon. Function fnGetBaseStats (sPokemon As String) As aStats Dim nI As Integer subReadBaseStats For nI = 0 To UBound (maBaseStats) If maBaseStats (nI).sPokemon = sPokemon Then fnGetBaseStats = maBaseStats (nI) Exit Function End If Next nI End Function ' fnGetCPM: Returns the combat power multiplier. Function fnGetCPM (fLevel As Double) As Double Dim nI As Integer subReadCPM If CInt (fLevel) = fLevel Then fnGetCPM = mCPM (fLevel) Else fnGetCPM = ((mCpm (fLevel - 0.5) ^ 2 _ + mCpm (fLevel + 0.5) ^ 2) / 2) ^ 0.5 End If End Function ' fnFloor: Returns the floor of the number Function fnFloor (fNumber As Double) As Integer fnFloor = CInt (fNumber - 0.5) End Function ' subReadBaseStats: Reads the base stats table. Sub subReadBaseStats Dim mData As Variant, nI As Integer, nJ As Integer If UBound (maBaseStats) = -1 Then mData = fnGetBaseStatsData ReDim Preserve maBaseStats (UBound (mData)) As New aStats For nI = 0 To UBound (mData) With maBaseStats (nI) .sNo = mData (nI) (1) .sPokemon = mData (nI) (0) .nStamina = mData (nI) (2) .nAttack = mData (nI) (3) .nDefense = mData (nI) (4) End With maBaseStats (nI).maEvolvedForms = fnGetEvolvedFormArray (UBound (mData (nI) (5))) For nJ = 0 To UBound (maBaseStats (nI).maEvolvedForms) With maBaseStats (nI).maEvolvedForms (nJ) .sPokemon = mData (nI) (5) (nJ) .nCP = -1 .nMaxCP = -1 End With Next nJ Next nI End If End Sub ' fnGetEvolvedFormArray: Obtains a blank aEvolveForm array Function fnGetEvolvedFormArray (nUBound As Integer) As Variant If nUBound = -1 Then fnGetEvolvedFormArray = fnGetEmptyEvolvedFormArray Else fnGetEvolvedFormArray = fnGetNumberedEvolvedFormArray (nUBound) End If End Function ' fnGetNumberedEvolvedFormArray: Obtains a numbered aEvolveForm array Function fnGetNumberedEvolvedFormArray (nUBound As Integer) As Variant Dim mData (nUBound) As New aEvolveForm fnGetNumberedEvolvedFormArray = mData End Function ' fnGetEmptyEvolvedFormArray: Obtains an empty aEvolveForm array Function fnGetEmptyEvolvedFormArray () As Variant Dim mData () As New aEvolveForm fnGetEmptyEvolvedFormArray = mData End Function ' fnReplace: Replaces all occurrances of a term to another. Function fnReplace (sText As String, sFrom As String, sTo As String) As String Dim nPos As Integer nPos = InStr (sText, sFrom) Do While nPos <> 0 sText = Left (sText, nPos - 1) & sTo _ & Right (sText, Len (sText) - nPos - Len (sFrom) + 1) nPos = InStr (nPos + Len (sTo), sText, sFrom) Loop fnReplace = sText End Function ' subReadCPM: Reads the CPM table. Sub subReadCPM If UBound (mCPM) = -1 Then mCPM = fnGetCPMData End If End Sub ' subReadStarDust: Reads the star dust table. Sub subReadStarDust If UBound (mStarDust) = -1 Then mStarDust = fnGetStarDustData End If End Sub