' Copyright (c) 2016-2017 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 , 2016-11-27 Option Explicit ' The base stats of a Pokémon. Type aStats sNo As String sPokemonId As String nStamina As Integer nAttack As Integer nDefense As Integer mEvolved () As String bIsLastForm As Boolean End Type ' The individual values of a Pokémon. Type aIV fLevel As Double nStamina As Integer nAttack As Integer nDefense As Integer ' For sorting nTotal As Integer nMaxCP As Integer nMaxMaxCP As Integer End Type ' The parameters to find the individual values. Type aFindIVParam sPokemonId As String sPokemonName As String nCP As Integer nHP As Integer nStardust As Integer nTrainerLevel As Integer bIsNew As Boolean nTotal As Integer sBest As String nMax As Integer bIsCancelled As Boolean End Type Private maBaseStats () As New aStats Private mCPM () As Double, mStardust () As Integer ' subMain: The main program Sub subMain Dim aBaseStats As New aStats, maIVs As Variant, nI As Integer Dim aQuery As New aFindIVParam aQuery = fnAskParam If aQuery.bIsCancelled Then Exit Sub End If aBaseStats = fnGetBaseStats (aQuery.sPokemonId) maIVs = fnFindIV (aBaseStats, aQuery) If UBound (maIVs) = -1 Then MsgBox fnGetResString ("ErrorNotFound") Else subCreateReport (aBaseStats, aQuery, maIVs) End If End Sub ' fnFindIV: Finds the possible individual values of the Pokémon Function fnFindIV ( _ aBaseStats As aStats, aQuery As aFindIVParam) As Variant Dim maIV () As New aIV, nN As Integer Dim fLevel As Double, nStamina As Integer Dim nAttack As Integer, nDefense As integer Dim nI As Integer, nJ As Integer, fLevelStep As Double If aQuery.sPokemonId = "" Then fnFindIV = maIV Exit Function End If If aQuery.bIsNew Then fLevelStep = 1 Else fLevelStep = 0.5 End If subReadStardust nN = -1 For fLevel = 1 To UBound (mStardust) Step fLevelStep 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 nN = nN + 1 ReDim Preserve maIV (nN) As New aIV With maIV (nN) .fLevel = fLevel .nAttack = nAttack .nDefense = nDefense .nStamina = nStamina End With End If Next nDefense Next nAttack End If Next nStamina End If Next fLevel fnFindIV = maIV End Function ' 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 stats total. nTotal = nAttack + nDefense + nStamina If aQuery.nTotal = 1 And Not (nTotal >= 37) Then fnFilterAppraisals = True Exit Function End If If aQuery.nTotal = 2 And Not (nTotal >= 30 And nTotal <= 36) Then fnFilterAppraisals = True Exit Function End If If aQuery.nTotal = 3 And Not (nTotal >= 23 And nTotal <= 29) Then fnFilterAppraisals = True Exit Function End If If aQuery.nTotal = 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 max stat value. If aQuery.nMax = 1 And Not (nMax = 15) Then fnFilterAppraisals = True Exit Function End If If aQuery.nMax = 2 And Not (nMax = 13 Or nMax = 14) Then fnFilterAppraisals = True Exit Function End If If aQuery.nMax = 3 And Not (nMax >= 8 And nMax <= 12) Then fnFilterAppraisals = True Exit Function End If If aQuery.nMax = 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 Dim nHP As Integer nHP = fnFloor ((aBaseStats.nStamina + nStamina) _ * fnGetCPM (fLevel)) If nHP < 10 Then nHP = 10 End If fnCalcHP = nHP End Function ' fnGetBaseStats: Returns the base stats of the Pokémon. Function fnGetBaseStats (sPokemonId As String) As aStats Dim nI As Integer subReadBaseStats For nI = 0 To UBound (maBaseStats) If maBaseStats (nI).sPokemonId = sPokemonId 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 ' fnReplace: Replaces all occurrances of a term to another. Function fnReplace ( _ sText As String, sFrom As String, sTo As String) As String Dim sResult As String, nPos As Integer sResult = sText nPos = InStr (sResult, sFrom) Do While nPos <> 0 sResult = Left (sResult, nPos - 1) & sTo _ & Right (sResult, Len (sResult) - nPos - Len (sFrom) + 1) nPos = InStr (nPos + Len (sTo), sResult, sFrom) Loop fnReplace = sResult End Function ' subReadBaseStats: Reads the base stats table. Sub subReadBaseStats Dim mData As Variant, nI As Integer, nJ As Integer, nK As Integer Dim nEvolved As Integer, mEvolved () As Variant 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) .sPokemonId = mData (nI) (0) .nStamina = mData (nI) (2) .nAttack = mData (nI) (3) .nDefense = mData (nI) (4) End With nEvolved = UBound (mData (nI) (5)) + 1 mEvolved = Array () maBaseStats (nI).bIsLastForm = True If nEvolved > 0 Then ReDim mEvolved (nEvolved - 1) As Variant For nJ = 0 To nEvolved - 1 mEvolved (nJ) = mData (nI) (5) (nJ) Next nJ maBaseStats (nI).mEvolved = mEvolved maBaseStats (nI).bIsLastForm = False End If Next nI End If End Sub ' subReadCPM: Reads the CPM table. Sub subReadCPM If UBound (mCPM) = -1 Then mCPM = fnGetCPMData End If End Sub ' subReadStardust: Reads the stardust table. Sub subReadStardust If UBound (mStardust) = -1 Then mStardust = fnGetStardustData End If End Sub