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)
Dim sNumInGioco,sLastNumInGioco
Dim bMostraDettagli
Dim bNonSovrapporreGiocate
Dim nRetColpi
bMostraDettagli = False
bNonSovrapporreGiocate = False
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","3"))
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
If MsgBox("Mostrare anche i dettagli dell'elaborazione ?",vbQuestion + vbYesNo) = vbYes Then
bMostraDettagli = True
End If
If MsgBox("Aspettare il termine della previsione in corso prima di porne in gioco una nuova ?",vbQuestion + vbYesNo) = vbYes Then
bNonSovrapporreGiocate = True
End If
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
If idEstr + nColpiSucc <= iEstrAna Then
f = EstrattoFrequenza(Ruota,clsN.n,idEstr + 1,idEstr + nColpiSucc)
Else
f = EstrattoFrequenza(Ruota,clsN.n,idEstr + 1,iEstrAna )
End If
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)
Call Scrivi(String(100,"-"))
If VerificaCondizioneDiGioco(CollClassifica,nLimitePrimePos,aNumInGioco) Then
sNumInGioco = StringaNumeri(aNumInGioco)
If sNumInGioco <> sLastNumInGioco Then
sLastNumInGioco = sNumInGioco
Call Scrivi("Condizione di gioco verificata , esiste almeno una formazione di 2 o più numeri " & _
"nelle prime " & nLimitePrimePos & " posizioni della classifica",,,vbGreen,vbRed)
Call Scrivi("Estrazione di 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)
If bNonSovrapporreGiocate Then
If VerificaEsito(aNumInGioco,aRuote,iEstrAna + 1,1,nColpiGioco,,,nRetColpi) Then
iEstrAna =(iEstrAna + nRetColpi) - 1
Else
iEstrAna =(iEstrAna + nColpiGioco) - 1
End If
End If
Else
If bMostraDettagli Then
Call Scrivi("Previsione gia giocata",True,,vbRed,vbWhite)
Call Scrivi("Estrazione di rilevamento : " & GetInfoEstrazione(iEstrAna))
Call Scrivi("Previsione : " & sNumInGioco)
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
End If
End If
Else
If bMostraDettagli Then
Call Scrivi("Condizione di gioco non trovata , non esiste almeno una formazione di 2 o più numeri " & _
"nelle prime " & nLimitePrimePos & " posizioni della classifica",,,vbRed,vbWhite)
Call Scrivi("Estrazione di 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
End If
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
