Option Explicit
Class clsAmbo
Private aAmbi
Private IdEstrazione
Private IdRuota
Sub GeneraAmbi(idEstr,Ruota)
IdEstrazione = idEstr
IdRuota = Ruota
ReDim aN(0)
Call GetArrayNumeriRuota(IdEstrazione,IdRuota,aN)
'Call OrdinaMatrice ( aN ,1)
If aN(1) > 0 Then
aAmbi = SviluppoIntegrale(aN,2)
Else
ReDim aAmbi(0)
End If
End Sub
Function GetQuantitaAmbi
GetQuantitaAmbi = UBound(aAmbi)
End Function
Function GetAmbo(idAmbo)
ReDim aN(2)
aN(1) = aAmbi(idAmbo,1)
aN(2) = aAmbi(idAmbo,2)
GetAmbo = aN
End Function
Function GetRuota
GetRuota = IdRuota
End Function
End Class
Class clsQuartinaAmboTrasposto
Private aNum(4)
Public Ruota1
Public Ruota2
Public IdEstrazione
Sub SetNumeri(aNumAmboR1 , aNumAmboR2)
Dim k
For k = 1 To 4
If k <=2 Then
aNum(k) = aNumAmboR1 (k)
Else
aNum(k) = aNumAmboR2 (k-2)
End If
Next
End Sub
Function GetNumeri()
GetNumeri = aNum
End Function
Function GetRuote()
ReDim aRuote(2)
aRuote(1) = Ruota1
aRuote(2) = Ruota2
GetRuote = aRuote
End Function
End Class
Sub Main
Dim idEstr,Ruota
Dim Inizio,Fine
Dim r,rr,i,ii
Dim aNumAmbo,aNumAmboT
Dim nDiff,nSomma
ReDim acAmbiRuota(11)
Dim nCasi
Dim bQualsiasiDisp
Dim nCasiParz
Dim bEseguiGiocate
Dim bEseguiStatistica
Dim CollCasiRilevati
Dim clsQuartina
Inizio = EstrazioneIni
Fine = EstrazioneFin
bQualsiasiDisp = False
bEseguiGiocate = True
bEseguiStatistica = True
nCasi = 0
Set CollCasiRilevati = GetNewCollection
If MsgBox ("Considerare gli ambi trasposti a prescindere dalla disposizione fisica dei numeri usciti ?" , vbQuestion + vbYesNo) = vbYes Then
bQualsiasiDisp = True
End If
If MsgBox ("Eseguire la simulazione delle giocate sui casi rilevati ?" , vbQuestion + vbYesNo) = vbNo Then
bEseguiGiocate = False
End If
If MsgBox ("Eseguire la statistica sui casi degli ambi trasposti rilevati ?" , vbQuestion + vbYesNo) = vbNo Then
bEseguiStatistica = False
End If
For idEstr = Inizio To Fine
i = 0
nCasiParz = 0
' prima genero per ogni ruota tutti gli ambi costituiti dai nuemeri estratti
For r = 1 To 12
If r <> 11 Then
i = i + 1
Set acAmbiRuota(i) = New clsAmbo
Call acAmbiRuota(i).GeneraAmbi(idEstr,r)
End If
Next
' poi ricerco gli ambi trasposti tra 2 ruote
For r = 1 To 10
For rr = r + 1 To 11
Call Messaggio("Estrazione : " & idEstr & " confronto ruote : " & SiglaRuota(acAmbiRuota(r).GetRuota) & " --> " & SiglaRuota(acAmbiRuota(rr).GetRuota))
For i = 1 To acAmbiRuota(r).GetQuantitaAmbi
aNumAmbo = acAmbiRuota(r).Getambo(i)
For ii = 1 To acAmbiRuota(rr).GetQuantitaAmbi
aNumAmboT = acAmbiRuota(rr).Getambo(ii)
If IsAmboTrasposto(aNumAmbo,aNumAmboT,bQualsiasiDisp) Then
nDiff = Differenza(aNumAmbo(1),aNumAmbo(2))
nSomma = Fuori90(aNumAmbo(1) + aNumAmbo(2))
ReDim aNum(4)
aNum(1) = nDiff
aNum(2) = nSomma
aNum(3) = Vert(nDiff)
aNum(4) = Vert(nSomma)
ReDim aRuote(2)
aRuote(1) = acAmbiRuota(r).GetRuota
aRuote(2) = acAmbiRuota(rr).GetRuota
ReDim aPoste(2)
aPoste(2) = 1
nCasi = nCasi + 1
nCasiParz = nCasiParz + 1
If bEseguiGiocate Then
Call Scrivi(String(50,"=") & " Caso " & FormatSpace(nCasi,5,True))
Call Scrivi("Estrazione : " & GetInfoEstrazione(idEstr))
Call Scrivi("Condizione : " & SiglaRuota(aRuote(1)) & " " & StringaNumeri(aNumAmbo) & " - " & SiglaRuota(aRuote(2)) & " " & StringaNumeri(aNumAmboT))
Call ImpostaGiocata(nCasi,aNum,aRuote,aPoste,13,2)
Call Gioca(idEstr)
End If
If bEseguiStatistica Then
Set clsQuartina = New clsQuartinaAmboTrasposto
clsQuartina.Ruota1 = aRuote(1)
clsQuartina.Ruota2 = aRuote(2)
clsQuartina.IdEstrazione = idEstr
Call clsQuartina.SetNumeri(aNumAmbo ,aNumAmboT )
CollCasiRilevati.add clsQuartina
End If
End If
Next
Next
Next
Next
'If nCasiParz > 0 And bEseguiGiocate Then
' Call Gioca(idEstr)
'End If
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
If bEseguiGiocate Then Call ScriviResoconto
If bEseguiStatistica Then
Call StatisticaCasiRilevati(CollCasiRilevati)
End If
End Sub
Function IsAmboTrasposto(aNumAmbo,aNumAmboT,bQualsiasiDisp)
Dim b
b = False
If aNumAmboT(1) > 0 And aNumAmboT(2) > 0 Then
If aNumAmboT(1) = Trasposizione(aNumAmbo(1),aNumAmbo(2)) Then
If aNumAmboT(2) = Trasposizione(aNumAmbo(2),aNumAmbo(1)) Then
b = True
End If
ElseIf aNumAmboT(1) = Trasposizione(aNumAmbo(2),aNumAmbo(1)) Then
If bQualsiasiDisp Then
If aNumAmboT(2) = Trasposizione(aNumAmbo(1),aNumAmbo(2)) Then
b = True
End If
End If
End If
End If
IsAmboTrasposto = b
End Function
Sub StatisticaCasiRilevati(CollCasiRilevati)
Dim clsQuartina
Dim k
Dim nEstrTot
nEstrTot = EstrazioniArchivio
ReDim aTitoli(14)
ReDim aColSpan(14)
ReDim aColori(14)
For k = 1 To 14
If k >= 1 And k <= 5 Then
aColori(k) = RGB(255,255,221)
ElseIf k >= 6 And k <= 8 Then
aColori(k) = RGB(255,225,255)
ElseIf k >= 9 And k <= 11 Then
aColori(k) = RGB(255,191,255)
ElseIf k >= 12 And k <= 14 Then
aColori(k) = RGB(255,159,255)
End If
Next
aTitoli(1) = ""
aTitoli(2) = ""
aTitoli(3) = ""
aTitoli(4) = ""
aTitoli(5) = ""
aTitoli(6) = "Ruota 1"
aTitoli(7) = "Ruota 2"
aTitoli(8) = "Tutte"
For k = 1 To 5
aColSpan(k) = 1
Next
aColSpan(6) = 3
aColSpan(7) = 3
aColSpan(8) = 3
Call InitTabella(aTitoli,vbBlue,,3,vbWhite,"Courier New",aColSpan)
aTitoli(1) = "Quartina rilevata"
aTitoli(2) = "Estrazione di Rilevamento"
aTitoli(3) = "Ruote Di Rilev."
aTitoli(4) = "Numeri Estratti Ruota 1"
aTitoli(5) = "Numeri Estratti Ruota 2"
aTitoli(6) = "Ritardo"
aTitoli(7) = "RitardoMax"
aTitoli(8) = "Frequenza"
aTitoli(9) = "Ritardo"
aTitoli(10) = "RitardoMax"
aTitoli(11) = "Frequenza"
aTitoli(12) = "Ritardo"
aTitoli(13) = "RitardoMax"
aTitoli(14) = "Frequenza"
Call AddRigaTabella(aTitoli,vbYellow,,,,"Courier New")
For Each clsQuartina In CollCasiRilevati
ReDim aValori(14)
ReDim aEstratti(0)
aValori(1) = StringaNumeri(clsQuartina.GetNumeri ,,True)
aValori(2) = GetInfoEstrazione(clsQuartina.IdEstrazione)
aValori(3) = SiglaRuota(clsQuartina.Ruota1) & " - " & SiglaRuota(clsQuartina.Ruota2)
Call GetArrayNumeriRuota(clsQuartina.IdEstrazione,clsQuartina.Ruota1,aEstratti)
aValori(4) = StringaNumeri(aEstratti,,True)
Call GetArrayNumeriRuota(clsQuartina.IdEstrazione,clsQuartina.Ruota2,aEstratti)
aValori(5) = StringaNumeri(aEstratti,,True)
ReDim aRuote(1)
aRuote(1) = clsQuartina.Ruota1
Call StatisticaFormazioneTurbo(clsQuartina.GetNumeri,aRuote,2,aValori(6),aValori(7),0,aValori(8),1,nEstrTot)
aRuote(1) = clsQuartina.Ruota2
Call StatisticaFormazioneTurbo(clsQuartina.GetNumeri,aRuote,2,aValori(9),aValori(10),0,aValori(11),1,nEstrTot)
aRuote(1) = TU_
Call StatisticaFormazioneTurbo(clsQuartina.GetNumeri,aRuote,2,aValori(12),aValori(13),0,aValori(14),1,nEstrTot)
Call AddRigaTabella(aValori,aColori,,,,"Courier New")
Next
Call Scrivi("Statistica nel range di tutte le estrazioni disponibili in archivio da " & GetInfoEstrazione(1) & " a " & GetInfoEstrazione(EstrazioniArchivio))
Call CreaTabella
End Sub
. Spero tutto bene. A presto! 
