Option Explicit
Class clsColonna
Dim aNumeriOrig ' numeri della colonna matrice
Dim NumeriSostituiti(10) ' numeri della colonna con le sostituzioni prese dal pronostico
Sub SetNumeri(sNum)
Dim av,k,e
ReDim aNumeriOrig(10)
av = Split(sNum,";")
For k = 0 To UBound(av)
If isNumeroValidoLotto(Int(av(k))) Then
e = e + 1
aNumeriOrig(e) = Int(av(k))
End If
Next
End Sub
Sub ConvertiColonna(aLunghetta,aRetCol)
Dim k
ReDim aRetCol(UBound(aNumeriOrig))
For k = 1 To UBound(aRetCol)
aRetCol(k) = aLunghetta(aNumeriOrig(k))
Next
End Sub
End Class
Class clsRuota
Private m_CollFormazioni
Private m_Ruota
Sub Class_Initialize
Set m_CollFormazioni = GetNewCollection
End Sub
Public Property Let Ruota(v)
m_Ruota = v
End Property
Public Property Get Ruota
Ruota = m_Ruota
End Property
Public Property Get CollFormazioni
Set CollFormazioni = m_CollFormazioni
End Property
Public Property Set CollFormazioni(NewValue)
m_CollFormazioni = NewValue
End Property
Sub AddFormazione(cFrz)
m_CollFormazioni.Add cFrz
End Sub
End Class
Class clsFormazione
Private aNum
Private mRitardo
Sub SetNumeri(sNum)
Dim av,k,e
ReDim aNum(90)
av = Split(sNum,";")
For k = 0 To UBound(av)
If isNumeroValidoLotto(Int(av(k))) Then
e = e + 1
aNum(e) = Int(av(k))
End If
Next
ReDim Preserve aNum(e)
End Sub
Sub CalcRitardi(Ruota,idEstr,nSorte)
ReDim aR(1)
aR(1) = Ruota
mRitardo = RitardoCombinazioneTurbo(aR,aNum,nSorte,idEstr)
End Sub
Sub PrendiNumeriPiuRecenti(nQuantita,aRetNum,idPrimoElem,idEstr,Ruota,bDettagli)
Dim k
ReDim aE(10,2)
For k = 1 To 10
aE(k,1) = aNum(k)
aE(k,2) = RitardoEstrattoTurbo(aNum(k),idEstr,Ruota)
Next
Call OrdinaMatrice(aE,1,2)
If bDettagli Then
For k = 1 To 10
If k <= nQuantita Then
Scrivi Format2(aE(k,1)) & " Rit : " & aE(k,2),True
Else
Scrivi Format2(aE(k,1)) & " Rit : " & aE(k,2),False
End If
Next
End If
For k = 1 To nQuantita
aRetNum((idPrimoElem - 1) + k) = aE(k,1)
Next
End Sub
Sub ScriviNumeri
Call Scrivi(StringaNumeri(aNum) & " Rit : " & mRitardo)
End Sub
Public Property Get Ritardo
Ritardo = mRitardo
End Property
End Class
Sub Main
Dim CollRuote
Dim CollSistema
Dim idEstr,RitMin,RitMax
Dim cFrz1,cFrz2
Dim nSorte
Dim RuotaDiGioco
Dim aRegistro
Dim nTotCasi,nTotVincenti
Dim nUltima
Dim bDettagli
Dim nColpiUsati
Dim aPosteProg
Dim aLunghetta
Dim bGioca
ReDim aQPerEsito(5)
If MsgBox("MOSTRARE I DETTAGLI DELLE LUNGHETTE GIOCATE CON LE FORMAZONI SCELTE E GLI ESITI ?",vbQuestion + vbYesNo) = vbYes Then
bDettagli = True
End If
If MsgBox("SIMULARE LE GIOCATE CON LA PROGRESSIONE ?",vbQuestion + vbYesNo) = vbYes Then
bGioca = True
End If
nSorte = 2
RitMin = 27
RitMax = 36
ReDim aProgressioni(15)
' la progressione prevede di vincere minimo 10 euro entro 15 colpi giocati per ambo
aProgressioni(1) = 3.00
aProgressioni(2) = 5.00
aProgressioni(3) = 7.50
aProgressioni(4) = 12.00
aProgressioni(5) = 18.50
aProgressioni(6) = 28.50
aProgressioni(7) = 44.00
aProgressioni(8) = 68.50
aProgressioni(9) = 106.00
aProgressioni(10) = 164.50
aProgressioni(11) = 255.00
aProgressioni(12) = 395.50
aProgressioni(13) = 613.50
aProgressioni(14) = 951.00
aProgressioni(15) = 1475.00
Call AlimentaCollRuote(CollRuote)
Call AlimentaRegistro(aRegistro)
Call AlimentaColonneSistema(CollSistema)
For idEstr = EstrazioneIni To EstrazioneFin
Call CalcolaRitardi(CollRuote,idEstr,nSorte)
If TrovaFormazioniDaGiocare(CollRuote,cFrz1,cFrz2,RitMin,RitMax,RuotaDiGioco) Then
Call VerificaLunghetta(cFrz1,cFrz2,RuotaDiGioco,idEstr,RuotaDiGioco,nSorte,aRegistro,nTotCasi,nTotVincenti,aQPerEsito,bDettagli,nColpiUsati,aLunghetta)
If bGioca Then Call GiocaLunghetta(CollSistema,aLunghetta,nColpiUsati,RuotaDiGioco,nSorte,aProgressioni,idEstr)
End If
Call AvanzamentoElab(EstrazioneIni,EstrazioneFin,idEstr)
nUltima = idEstr
If ScriptInterrotto Then Exit For
Next
Call ScriviRegistro(aQPerEsito,aRegistro,nTotCasi,nTotVincenti,EstrazioneIni,nUltima)
ScriviResoconto
End Sub
Sub AlimentaRegistro(aRegistro)
ReDim aRegistro(6,3)
aRegistro(1,1) = 1 :aRegistro(1,2) = 3
aRegistro(2,1) = 4 :aRegistro(2,2) = 5
aRegistro(3,1) = 6 :aRegistro(3,2) = 7
aRegistro(4,1) = 8 :aRegistro(4,2) = 10
aRegistro(5,1) = 11 :aRegistro(5,2) = 13
aRegistro(6,1) = 14 :aRegistro(6,2) = 10000000
End Sub
Sub AlimentaCollRuote(CollRuote)
Dim r
Dim cFrz,cRuota
Set CollRuote = GetNewCollection
For r = 1 To 12
If r <> 11 Then
Set cRuota = New clsRuota
cRuota.Ruota = r
Set cFrz = New clsFormazione
cFrz.SetNumeri("1;2;3;4;5;6;7;8;9;10")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("11;12;13;14;15;16;17;18;19;20")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("21;22;23;24;25;26;27;28;29;30")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("31;32;33;34;35;36;37;38;39;40")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("41;42;43;44;45;46;47;48;49;50")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("51;52;53;54;55;56;57;58;59;60")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("61;62;63;64;65;66;67;68;69;70")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("71;72;73;74;75;76;77;78;79;80")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("81;82;83;84;85;86;87;88;89;90")
Call cRuota.AddFormazione(cFrz)
CollRuote.Add cRuota
End If
Next
End Sub
Sub CalcolaRitardi(collRuote,idEstr,nSorte)
Dim cRuota,cFrz
For Each cRuota In collRuote
For Each cFrz In cRuota.CollFormazioni
Call cFrz.CalcRitardi(cRuota.Ruota,idEstr,nSorte)
Next
Next
End Sub
Function TrovaFormazioniDaGiocare(CollRuote,cFrz1,cFrz2,RitMin,RitMax,RuotaDiGioco)
Dim cRuota,cFrz
Dim nTrovate
For Each cRuota In CollRuote
nTrovate = 0
For Each cFrz In cRuota.CollFormazioni
If cFrz.Ritardo >= RitMin And cFrz.Ritardo <= RitMax Then
nTrovate = nTrovate + 1
Select Case nTrovate
Case 1
Set cFrz1 = cFrz
Case 2
Set cFrz2 = cFrz
Case Else
Exit For
End Select
End If
Next
If nTrovate = 2 Then
RuotaDiGioco = cRuota.ruota
TrovaFormazioniDaGiocare = True
Exit Function
End If
Next
TrovaFormazioniDaGiocare = False
End Function
Sub VerificaLunghetta(cFrz1,cFrz2,RuotaDiGioco,idEstr,Ruota,nSorte,aRegistro,nTotCasi,nTotVincenti,aQPerEsito,bDettagli,nRetColpiDiGioco,aNumLunghetta)
Dim sEsito,nRetColpi,sRetEstratti
ReDim aNumLunghetta(13)
nTotCasi = nTotCasi + 1
If bDettagli Then
Call Scrivi("Numeri ricavati all'estrazione " & GetInfoEstrazione(idEstr) & " per " & NomeRuota (RuotaDiGioco) ,True,,vbYellow,,4)
Scrivi
End If
If cFrz1.ritardo >= cFrz2.ritardo Then
If bDettagli Then cFrz1.ScriviNumeri
Call cFrz1.PrendiNumeriPiuRecenti(7,aNumLunghetta,1,idEstr,Ruota,bDettagli)
If bDettagli Then cFrz2.ScriviNumeri
Call cFrz2.PrendiNumeriPiuRecenti(6,aNumLunghetta,8,idEstr,Ruota,bDettagli)
Else
If bDettagli Then cFrz2.ScriviNumeri
Call cFrz2.PrendiNumeriPiuRecenti(7,aNumLunghetta,1,idEstr,Ruota,bDettagli)
If bDettagli Then cFrz1.ScriviNumeri
Call cFrz1.PrendiNumeriPiuRecenti(6,aNumLunghetta,8,idEstr,Ruota,bDettagli)
End If
If bDettagli Then Call Scrivi("Lunghetta : " & StringaNumeri(aNumLunghetta))
ReDim aRuoteG(1)
aRuoteG(1) = Ruota
If VerificaEsito(aNumLunghetta,aRuoteG,idEstr + 1,nSorte,,,sEsito,nRetColpi,sRetEstratti) Then
Call RegistraVincita(aRegistro,nRetColpi,sEsito,aQPerEsito)
If bDettagli Then Scrivi sEsito & " colpi : " & nRetColpi & " Numeri : " & sRetEstratti
nTotVincenti = nTotVincenti + 1
Else
If bDettagli Then Scrivi "Senza esito" & " colpi : " & nRetColpi
End If
nRetColpiDiGioco = nRetColpi
If bDettagli Then
Scrivi
Scrivi
End If
End Sub
Sub RegistraVincita(aRegistro,nColpi,sEsito,aQPerEsito)
Dim k
Select Case sEsito
Case "Estratto"
aQPerEsito(1) = aQPerEsito(1) + 1
Case "Ambo"
aQPerEsito(2) = aQPerEsito(2) + 1
Case "Terno"
aQPerEsito(3) = aQPerEsito(3) + 1
Case "Quaterna"
aQPerEsito(4) = aQPerEsito(4) + 1
Case "Cinquina"
aQPerEsito(5) = aQPerEsito(5) + 1
End Select
For k = 1 To UBound(aRegistro)
If nColpi >= aRegistro(k,1) And nColpi <= aRegistro(k,2) Then
aRegistro(k,3) = aRegistro(k,3) + 1
End If
Next
End Sub
Sub ScriviRegistro(aQPerEsito,aRegistro,nTotCasi,nTotVincenti,Inizio,fine)
Dim k
Scrivi
Scrivi "Resoconto del metodo"
Scrivi "Estrazione inizio : " & GetInfoEstrazione(Inizio)
Scrivi "Estrazione fine : " & GetInfoEstrazione(fine)
Scrivi "Casi totali : " & nTotCasi
Scrivi "Casi vincenti : " & nTotVincenti & " (" & Round(ProporzioneX(nTotVincenti,nTotCasi,100),3) & "%" & ")"
Scrivi
Dim aD
aD = Array("","Colpi Min","Colpi Max","Vincenti","Perc")
Call InitTabella(aD,vbBlue,,,vbWhite)
For k = 1 To UBound(aRegistro)
aD(1) = aRegistro(k,1)
aD(2) = aRegistro(k,2)
aD(3) = aRegistro(k,3)
aD(4) = Round(ProporzioneX(aRegistro(k,3),nTotVincenti,100),3)
Call AddRigaTabella(aD)
Next
Call CreaTabella
Scrivi
aD = Array("","Sorte","Quantita","Perc")
Call InitTabella(aD,vbBlue,,,vbWhite)
For k = 1 To 5
aD(1) = NomeSorte(k)
aD(2) = aQPerEsito(k)
aD(3) = Round(ProporzioneX(aD(2),nTotVincenti,100),3)
Call AddRigaTabella(aD)
Next
Call CreaTabella
End Sub
Sub AlimentaColonneSistema(coll)
Set coll = GetNewCollection
Call AddColonna(coll,"2;3;5;11")
Call AddColonna(coll,"3;4;6;12")
Call AddColonna(coll,"4;5;7;13")
Call AddColonna(coll,"1;5;6;8")
Call AddColonna(coll,"2;6;7;9")
Call AddColonna(coll,"3;7;8;10")
Call AddColonna(coll,"4;8;9;11")
Call AddColonna(coll,"5;9;10;12")
Call AddColonna(coll,"6;10;11;13")
Call AddColonna(coll,"1;7;11;12")
Call AddColonna(coll,"2;8;12;13")
Call AddColonna(coll,"1;3;9;13")
Call AddColonna(coll,"1;2;4;10")
End Sub
Sub AddColonna(coll,sNumeri)
Dim clsCol
Set clsCol = New clsColonna
clsCol.SetNumeri(sNumeri)
coll.Add clsCol
End Sub
Sub GiocaLunghetta(CollSistema,aLunghetta,nColpiUsati,RuotaDiGioco,nSorte,aPosteProg,idEstr)
Dim idG,k
Dim cCol
Dim aN
ReDim aP(10)
ReDim aRt(1)
aRt(1) = RuotaDiGioco
For k = 1 To UBound(aPosteProg)
idG = 0
If k <= nColpiUsati Then
Scrivi "Colpo : " & k,True,,,,4
aP(nSorte) = aPosteProg(k)
For Each cCol In CollSistema
idG = idG + 1
Call cCol.ConvertiColonna(aLunghetta,aN)
Call ImpostaGiocata(idG,aN,aRt,aP,1)
Next
Gioca(idEstr - 1) + k
End If
Next
End Sub
www.lopinionista.it
www.superenalotto.com
www.fanpage.it
3534122320
