Option Explicit
Class ClsAmboPres
Dim strAmbo
Dim nPres
Sub IncrementaPres
nPres = nPres + 1
End Sub
End Class
Class ClsTernoPres
Dim StrTerno
Dim nPres
Sub IncrementaPres
nPres = nPres + 1
End Sub
End Class
Sub Main
Dim Mess,Ini,iAnnoFin
Dim iIdM,sIdMese,IdEstr
Dim Ruota,sRuota,iRuIni,iRuFin
Dim bEstr,p,E,p1,E1,p2,E2
Dim iEstrFiltr,IdPriEstrUti,idUltEstrUti
Dim MaxFreqA,MaxFreqT
Dim sAmbo,sTerno
Dim Coll,CollT
Dim ClsAmbo,ClsTerno
ReDim aEstratti(90,2)
If Not ImpostaParametri(Ini,iAnnoFin,iIdM,sIdMese,sRuota,iRuIni,iRuFin) Then Exit Sub
' Scrivi Ini & " , " & iAnnoFin & " , " & iIdM & " , " & sIdMese & " , " & sRuota & " , " & iRuIni & " , " & iRuFin
Call ResetTimer
For E = 1 To UBound(aEstratti)
aEstratti(E,1) = E
aEstratti(E,2) = 0
Next
iEstrFiltr = 0
IdPriEstrUti = EstrazioneFin
idUltEstrUti = 0
Set Coll = GetNewCollection
Set CollT = GetNewCollection
For IdEstr = Ini To EstrazioneFin
If GetValidaIndicemensile(IdEstr,iIdM) Then ' funzione che valida l indice mensile voluto
For Ruota = iRuIni To iRuFin
If Estratto(IdEstr,Ruota,1) Then
'Scrivi IdEstr & " " & IndiceMensile(IdEstr) & " " & IndiceAnnuale(IdEstr) & " " & DataEstrazione(IdEstr)
ReDim aEstr(0)
Call GetArrayNumeriRuota(IdEstr,Ruota,aEstr)
Call OrdinaMatriceTurbo(aEstr,1)
bEstr = True
For p = 1 To 5
E = aEstr(p)
aEstratti(E,2) = aEstratti(E,2) + 1
Next
' se rieesco con la classe a mettere tutto in collection
For p = 1 To 4
For p1 = p + 1 To 5
Set ClsAmbo = New ClsAmboPres
E = aEstr(p)
E1 = aEstr(p1)
sAmbo = Format2(E) & " " & Format2(E1)
Call GetIncrementaAmbo(sAmbo,Coll,MaxFreqA)
Next
Next
For p = 1 To 3
For p1 = p + 1 To 4
For p2 = p1 + 1 To 5
Set ClsTerno = New ClsTernoPres
E = aEstr(p)
E1 = aEstr(p1)
E2 = aEstr(p2)
sTerno = Format2(E) & " " & Format2(E1) & " " & Format2(E2)
Call GetIncrementaTerno(sTerno,CollT,MaxFreqT)
Next
Next
Next
End If
Next
If bEstr Then
iEstrFiltr = iEstrFiltr + 1 ' se bret è true allora aumento di uno l estrazione valida
If IdPriEstrUti > IdEstr Then IdPriEstrUti = IdEstr ' trovo la prima estrazione utile
If idUltEstrUti < IdEstr Then idUltEstrUti = IdEstr ' trovo l ultima estrazioneutile
End If
End If
Call AvanzamentoElab(Ini,EstrazioneFin,IdEstr)
Next ' Idestr
' Blocco testo dati input e output
Scrivi " Indice Mensile selezionato: " & sIdMese
Scrivi " Ruota di Ricerca: " & sRuota
Scrivi " Anno Inizio Ricerca: " & GetInfoEstrazione(Ini)
Scrivi " Anno Fine Ricerca: " & GetInfoEstrazione(EstrazioneFin)
Scrivi " Prima Estrazione Utile: " & GetInfoEstrazione(IdPriEstrUti)
Scrivi " Ultima Estrazione Utile: " & GetInfoEstrazione(idUltEstrUti)
Scrivi " Concorsi Filtrati: " & iEstrFiltr
Call GetTabellaEstratti(aEstratti)
Dim iFreqMinA
iFreqMinA = GetFreqMin("la frequenza massima dell ambo riscontrata ","Seleziona la frequenza minima che vuoi visualizzare",MaxFreqA)
Call GetTabellaAmbi(Coll,ClsAmbo,iFreqMinA)
Dim iFreqMinT
iFreqMinT = GetFreqMin("la frequenza massima del terno riscontrata ","Seleziona la frequenza minima che vuoi visualizzare",MaxFreqT)
Call GetTabellaTerno(CollT,ClsTerno,iFreqMinT)
Scrivi "Tempo elaborazione dati: " & TempoTrascorso
End Sub
Function GetMessaggioApertura
Dim Mess
Mess = "Verificare che i dati riportati siano esatti"
Mess = Mess & vbCrLf & "Non se ne garantisce la correttezza"
Mess = Mess & vbCrLf & "NESSUNO E' AUTORIZZATO A VENDERE LO SCRIPT perchè dato gratuitamente per esempio compilazione"
Mess = Mess & vbCrLf & "Vuoi proseguire?"
GetMessaggioApertura = MsgBox(Mess,4 + 64,"Informazioni")
End Function
Function GetPrimaDellAnno(Ini)
GetPrimaDellAnno = False
Dim sAnno
Dim iAnnoFin
iAnnoFin = Anno(EstrazioneFin)
sAnno = CInt(InputBox("Range possibile: " & vbCrLf & " 1871-" & iAnnoFin,"Inserisci Anno Inizio Ricerca",iAnnoFin)) ' inserisco l anno di inizio ricerca
' If sAnno >= 1871 And sAnno <= iAnnoFin Then ' se anno è valido trovo la prima estrazione dell anno di inizio ricerca
Ini = PrimaSuccessiva("01/01/" & sAnno)
If isIdEstrValido(Ini) Then
GetPrimaDellAnno = True
Else
Call MsgBox("il: " & sAnno & " non è in archivio" & vbCrLf & "lo script non verrà eseguito",vbOKOnly,"Errore")
End If
End Function
Function GetIndicemensile(iIdM,sIdMese)
GetIndicemensile = False
Dim aIdMese
aIdMese = Array(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,"IsUltimaDelMese")
iIdM = ScegliOpzioneMenu(aIdMese,0,"Seleziona Indice mensile")
If iIdM >= 0 Then
sIdMese = aIdMese(iIdM)
iIdM = iIdM + 1
GetIndicemensile = True
Else
Call MsgBox("Hai inserito un indicemensile non valido=" & iIdM,vbOKOnly,"Errore inserimento indice mensile")
End If
End Function
Function GetRuotaDiCalcolo(sRuota,iRuIni,iRuFin)
GetRuotaDiCalcolo = False
Dim r
r = ScegliRuota
If isRuotaValidaLotto(r) Then
GetRuotaDiCalcolo = True
sRuota = NomeRuota(r)
If r <> 11 Then
iRuIni = r
iRuFin = r
Else
iRuIni = 1
iRuFin = 10
End If
Else
Call MsgBox("Hai inserito una ruota non valida",vbOKOnly,"Errore inserimento indice Ruota")
End If
End Function
Function ImpostaParametri(Ini,iAnnoFin,iIdM,sIdMese,sRuota,iRuIni,iRuFin)
Dim bRet
bRet = False
If GetMessaggioApertura = 6 Then
If GetPrimaDellAnno(Ini) Then
If GetIndicemensile(iIdM,sIdMese) Then
If GetRuotaDiCalcolo(sRuota,iRuIni,iRuFin) Then
bRet = True
Else
Exit Function
End If
Else
Exit Function
End If
Else
Exit Function
End If
Else
Exit Function
End If
ImpostaParametri = bRet
End Function
Function GetValidaIndicemensile(idEstr,iIdMese)
Dim bRet
bRet = False
If iIdMese < 16 Then
If IndiceMensile(idEstr) = iIdMese Then bRet = True
Else
If IsUltimaDelMese(idEstr) Then bRet = True
End If
GetValidaIndicemensile = bRet
End Function
Sub GetIncrementaAmbo(sForm,coll,maxFreq)
Dim sKey,cNum
sKey = "k"
sKey = sKey & sForm
If GetItemCollection(coll,sKey,cNum) Then
cNum.IncrementaPres
If maxFreq < cNum.nPres Then maxFreq = cNum.nPres
Else
Set cNum = New ClsAmboPres
cNum.strAmbo = sForm
cNum.npres = 1
Coll.Add cNum,sKey
End If
End Sub
Sub GetIncrementaTerno(sForm,coll,MaxFreqT)
Dim sKey,cNum
sKey = "k"
sKey = sKey & sForm
If GetItemCollection(coll,sKey,cNum) Then
cNum.IncrementaPres
If MaxFreqT < cNum.npres Then MaxFreqT = cNum.npres
Else
Set cNum = New ClsTernoPres
cNum.StrTerno = sForm
cNum.npres = 1
Coll.Add cNum,sKey
End If
End Sub
Sub GetTabellaEstratti(aEstr)
Dim aTit,aTab
aTit = Array(0,"Estratti","NumeroNumeri","Presenze")
Call InitTabella(aTit)
Dim maxFreq,iNumNum,s,Id
Call OrdinaMatriceTurbo(aEstr,- 1,2)
maxFreq = aEstr(1,2)
Do While maxFreq >= aEstr(90,2)
s = ""
iNumNum = 0
For Id = 1 To UBound(aEstr)
If Int(aEstr(Id,2)) = maxFreq Then
s = s & Format2(aEstr(Id,1)) & " "
iNumNum = iNumNum + 1
End If
Next
' s = RimuoviLastChr(s," ")
If iNumNum Then
' Scrivi " " & FormatSpace(iNumNum,9,1) & " | " & FormatSpace(maxFreq,3) & " | " & s
aTab = Array(0,s,iNumNum,maxFreq)
Call AddRigaTabella(aTab)
End If
maxFreq = maxFreq - 1
Loop
Call SetTableHeight("40%")
Call SetTableWidth("100%")
Call CreaTabellaOrdinabile()
End Sub
Function GetFreqMin(sTesto1,stesto2,freqMax)
Dim FreqMin
FreqMin = ""
Do While Not IsNumeric(FreqMin)
FreqMin = InputBox(sTesto1 & " =" & freqMax,stesto2,freqMax)
Loop
GetFreqMin = CInt(FreqMin)
End Function
Sub GetTabellaAmbi(coll,ClsAmbo,Fmin)
Call OrdinaItemCollection(coll,"nPres",,,- 1)
Dim aTit,aTab,id
aTit = Array(0,"Ambo","Presenze")
Call InitTabella(aTit)
For Each ClsAmbo In coll
If ClsAmbo.npres < Fmin Then Exit For
id = id + 1
aTab = Array(0,clsambo.Strambo,clsAmbo.npres)
Call AddRigaTabella(aTab)
Call AvanzamentoElab(1,Coll.count,id)
Next
Call SetTableHeight("40%")
Call SetTableWidth("100%")
Call SetTableTitle(" Formazioni trovate: " & coll.count)
Call CreaTabellaOrdinabile()
End Sub
Sub GetTabellaTerno(collt,ClsTerno,fMin)
Call OrdinaItemCollection(collt,"nPres",,,- 1)
Dim aTit,aTab
aTit = Array(0,"Terno","Presenze")
Call InitTabella(aTit)
For Each ClsTerno In collt
If ClsTerno.npres < fMin Then Exit For
aTab = Array(0,clsterno.Strterno,clsTerno.npres)
Call AddRigaTabella(aTab)
Next
Call SetTableHeight("40%")
Call SetTableWidth("100%")
Call SetTableTitle(" Formazioni trovate: " & collt.count)
Call CreaTabellaOrdinabile()
End Sub