Option Explicit
Class clsNumero
Dim N
Dim nUscite
Dim nUsciteRip
Private nDelta
Public Property Get Delta()
Delta = nDelta
End Property
Sub CalcolaDelta
nDelta = Round(Dividi(nUsciteRip,nUscite),3)
nDelta = Replace(nDelta,",",".")
End Sub
End Class
Class clsPosClassifica
Private collNumeri
Dim nDelta
Sub Class_Initialize
Set collNumeri = GetNewCollection
End Sub
Sub AddItemColl(clsN)
collNumeri.add clsN
End Sub
Function GetNumeri
Dim clsN
Dim s
For Each clsN In collNumeri
s = s & Format2(clsN.n) & "."
Next
If Right(s,1) = "." Then s = Left(s,Len(s) - 1)
GetNumeri = s
End Function
Function QuantitaNumeri (aNumInGioco )
Dim clsN
Dim i
i =0
For Each clsN In collNumeri
i = i +1
ReDim Preserve aNumInGioco(i)
aNumInGioco(i) = clsN.N
Next
QuantitaNumeri = i
End Function
End Class
Sub Main
Dim idEstr,Ruota
Dim Inizio,Fine
Dim nSpia,nPosSpia,nColpiSucc
Dim CollNumeri,CollClassifica
Dim clsN,clsNTmp
Dim clsPosCla
Dim k,kk
Dim iEstrAna,EstrazioneInizioTest
Dim nColpiGioco
Dim nLimitePrimePos
Dim f
Dim nGiocata
Dim aRuote(1)
Dim aPoste(2)
Inizio = EstrazioneIni
Fine = EstrazioneFin
Ruota = ScegliRuota
nSpia = Int(InputBox("Inserire numero spia","Numero spia","1"))
nPosSpia = Int(InputBox("Inserire posizione sortita spia","Posizione sortita spia","1"))
nColpiSucc = Int(InputBox("Inserire colpi successivi per verifica","Colpi successivi","9"))
EstrazioneInizioTest = Int(InputBox("Inserire id estrazione inizio test giocate","inizio test giocate",Fine - 100))
nColpiGioco = Int(InputBox("Inserire colpi di gioco","Colpi di gioco","9"))
nLimitePrimePos = Int(InputBox("Inserire il limite per individuare le prime posizioni della classifica nelle" & _
" quali ricercare la condizione di gioco (due o piu numeri con stesso delta)","Colpi di gioco","9"))
aRuote(1) = Ruota
aPoste(1) =1
aPoste(2) =1
If Ruota > 0 And nSpia > 0 And nSpia <= 90 And nPosSpia > 0 And nPosSpia <= 5 And EstrazioneInizioTest > 0 And nColpiSucc > 0 Then
For iEstrAna = EstrazioneInizioTest To Fine
Call InitCollNumeri(CollNumeri)
Call Messaggio ("Analisi giocate su estrazione " & iEstrAna & " mancanti " & Fine - iEstrAna)
For idEstr = Inizio To iEstrAna
If Estratto(idEstr,Ruota,nPosSpia) = nSpia Then
For Each clsN In CollNumeri
f = EstrattoFrequenza(Ruota,clsN.n,idEstr + 1,idEstr + nColpiSucc)
If f > 0 Then
clsN.nUscite = clsN.nUscite + 1
clsN.nUsciteRip = clsN.nUsciteRip + f
End If
Next
End If
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
For Each clsN In CollNumeri
Call clsN.CalcolaDelta
Next
Call OrdinaItemCollection(CollNumeri,"Delta",,,0)
Set CollClassifica = GetNewCollection
For k = 1 To 90
Set clsN = CollNumeri(k)
Set clsPosCla = New clsPosClassifica
clsPosCla.nDelta = clsN.Delta
For kk = k To 90
k = kk
Set clsNTmp = CollNumeri(kk)
If clsNTmp.Delta = clsPosCla.nDelta Then
Call clsPosCla.AddItemColl(clsNTmp)
Else
k = kk - 1
Exit For
End If
Next
If k <= 90 Then Call AddItemCollClassifica(CollClassifica,clsPosCla)
Next
ReDim aNumInGioco (0)
If VerificaCondizioneDiGioco( CollClassifica ,nLimitePrimePos , aNumInGioco) Then
Call Scrivi ("Condizione di gioco verificata , esiste almeno una formazione di 2 o più numeri " & _
"nelle prime " & nLimitePrimePos & " posizioni della classifica")
Call Scrivi ("Estrazione d i rilevamento : " & GetInfoEstrazione(iEstrAna))
ReDim aV(2)
aV(1) = "Delta"
aV(2) = "Numeri"
Call InitTabella(aV)
For k = 1 To nLimitePrimePos
If k <= CollClassifica.count Then
Set clsPosCla = CollClassifica(k)
aV(1) = clsPosCla.nDelta
aV(2) = clsPosCla.GetNumeri
Call AddRigaTabella(aV)
End If
Next
Call CreaTabella
nGiocata = nGiocata +1
Call ImpostaGiocata ( nGiocata ,aNumInGioco ,aRuote,aPoste ,nColpiGioco , 1 )
Call Gioca (iEstrAna )
End If
If ScriptInterrotto Then Exit For
Next
Call ScriviResoconto
ReDim aV(2)
aV(1) = "Delta"
aV(2) = "Numeri"
Call InitTabella(aV)
For Each clsPosCla In CollClassifica
aV(1) = clsPosCla.nDelta
aV(2) = clsPosCla.GetNumeri
Call AddRigaTabella(aV)
Next
Call Scrivi ("Tabella dei delta all'ultima estrazione analizzata " & GetInfoEstrazione(Fine))
Call CreaTabella
Else
MsgBox "Parametri di ricerca non validi",vbExclamation
End If
End Sub
Function VerificaCondizioneDiGioco( CollClassifica, nLimitePrimePos ,aNumInGioco )
Dim clsP
Dim i
For Each clsP In CollClassifica
i = i +1
If clsP.QuantitaNumeri (aNumInGioco ) > 1 Then
VerificaCondizioneDiGioco = True
Exit For
End If
If i > nLimitePrimePos Then Exit For
Next
End Function
Sub AddItemCollClassifica(CollClassifica,clsPosCla)
On Error Resume Next
Call CollClassifica.add(clsPosCla,"k" & clsPosCla.nDelta)
End Sub
Sub InitCollNumeri(collNumeri)
Dim k
Dim clsN
Set collNumeri = GetNewCollection
For k = 1 To 90
Set clsN = New clsNumero
clsN.n = k
collNumeri.add clsN
Next
End Sub
