Option Explicit
Class clsUscita
Public Ruota
Public idEstr
Public sData
End Class
Class clsComb
Public sNumeri
Public CollUscite
Sub Class_Terminate
Set CollUscite = Nothing
End Sub
Sub AddUscita(Ruota,idEstr,Data)
Dim cU
Set cU = New clsUscita
cU.Ruota = Ruota
cU.idEstr = idEstr
cU.sData = Data
CollUscite.Add cU
End Sub
End Class
Sub Main
Dim Inizio,Fine,idEstr,r,nClasse
Dim aRuote,nRuoteSel,aNumeri,aComb,sData,aNumScelti,aBNumScelti,nQNumScelti
Dim CollComb
nRuoteSel = ScegliRuote(aRuote)
Inizio = EstrazioneIni
Fine = EstrazioneFin
nClasse = ScegliEsito(3)
nQNumScelti = ScegliNumeri(aNumScelti )
If nQNumScelti >= nClasse Then
ReDim aBNumScelti(90)
aBNumScelti = ArrayNumeriToBool(aNumScelti)
Set CollComb = GetNewCollection
For idEstr = Inizio To Fine
sData = DataEstrazione(idEstr)
For r = 1 To nRuoteSel
If aRuote(r) <> 11 Then
Call GetArrayNumeriRuota(idEstr,aRuote(r),aNumeri)
Call RimuoviNumeriNonVoluti(aNumeri,aBNumScelti,nClasse)
If aNumeri(1) > 0 Then
Call OrdinaMatrice(aNumeri,1)
aComb = SviluppoIntegrale(aNumeri,nClasse)
Call AddCombInCollection(aComb,nClasse,CollComb,idEstr,aRuote(r),sData)
End If
End If
Next
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
Call ScriviOutput(CollComb)
Set CollComb = Nothing
Else
MsgBox "Quantita numeri non valida",vbExclamation
End If
End Sub
Sub RimuoviNumeriNonVoluti(aNumeri,aBNumScelti,nClasse)
Dim k,i,aNTemp
ReDim aNTemp(UBound(aNumeri))
For k = 1 To UBound(aNumeri)
If aBNumScelti(aNumeri(k)) Then
i = i + 1
aNTemp(i) = aNumeri(k)
End If
Next
If i >= nClasse Then
ReDim Preserve aNTemp(i)
aNumeri = aNTemp
Else
ReDim aNumeri(1)
aNumeri(1) = 0
End If
End Sub
Sub AddCombInCollection(aComb,nClasse,CollComb,idEstr,Ruota,sData)
Dim k,j,sNumeri,cComb,sKey
For k = 1 To UBound(aComb)
sNumeri = ""
For j = 1 To nClasse
sNumeri = sNumeri & Format2(aComb(k,j)) & "-"
Next
sNumeri = RimuoviLastChr(sNumeri,"-")
sKey = "k" & sNumeri
If GetItemCollection(CollComb,sKey,cComb) = False Then
Set cComb = New clsComb
Set cComb.CollUscite = GetNewCollection
cComb.sNumeri = sNumeri
Call AddItemColl(CollComb,cComb,sKey)
End If
Call cComb.AddUscita(Ruota,idEstr,sData)
Next
End Sub
Sub ScriviOutput(CollComb)
Dim cComb,cU,i,nColor,j,nRipetizioni,nTrov
Dim aRipetizioni(101)
For Each cComb In CollComb
nRipetizioni = cComb.CollUscite.Count
If nRipetizioni > 1 Then
If nRipetizioni > 100 Then
aRipetizioni(101) = aRipetizioni(101) + 1
Else
aRipetizioni(nRipetizioni) = aRipetizioni(nRipetizioni) + 1
End If
nTrov = nTrov + 1
ReDim aColori(nRipetizioni)
For i = 1 To nRipetizioni - 1
If cComb.colluscite(i).IdEstr = cComb.colluscite(i + 1).IdEstr Then
aColori(i) = vbRed
j = i + 1
Do
aColori(j) = vbRed
j = j + 1
If j > nRipetizioni Then Exit Do
Loop While cComb.colluscite(j).IdEstr = cComb.colluscite(i).IdEstr
i = j - 1
Else
aColori(i) = vbBlack
End If
Next
Scrivi FormatSpace(nTrov,5,True) & ") " & cComb.sNumeri,True
i = 0
For Each cU In cComb.CollUscite
i = i + 1
Scrivi " -> " & FormatSpace(cU.idestr,5) & " " & FormatSpace(cU.sData,5) & " " & NomeRuota(cU.ruota),,,,aColori(i)
Next
End If
Next
Scrivi
Scrivi
Scrivi "Riepilogo",True
For j = 2 To 100
If aRipetizioni(j) > 0 Then
Scrivi "Con " & FormatSpace(j,3) & " ripetizioni : " & FormatSpace(aRipetizioni(j),5,True)
End If
Next
If aRipetizioni(j) > 0 Then
Scrivi ">= " & FormatSpace(j,3) & " ripetizioni : " & FormatSpace(aRipetizioni(j),5,True)
End If
End Sub
