Class clsAmbo
Public abNum(90)
Public aNum(2)
Public Capogioco
Public nCicliDaCalc
Public PresPerCicliPratici
Public PresenzeAttuali
Sub InitCicliDaCalc(nCicliDaCalc)
Dim k
PresenzeAttuali = 0
ReDim PresPerCicliPratici(nCicliDaCalc)
For k = 0 To nCicliDaCalc
PresPerCicliPratici(k) = 0
Next
End Sub
Sub SetAmbo(n1,n2)
abNum(n1) = True
abNum(n2) = True
If n1 < n2 Then
aNum(1) = n1
aNum(2) = n2
Else
aNum(1) = n2
aNum(2) = n1
End If
End Sub
Function GetNumeriString
GetNumeriString = Format2(aNum(1)) & "." & Format2(aNum(2))
End Function
Function GetSommaPresenze
Dim t
Dim k
For k = 1 To UBound(PresPerCicliPratici)
t = t + PresPerCicliPratici(k)
Next
GetSommaPresenze = t
End Function
End Class
Sub Main
Dim CollAmbi
Dim clsA
Dim nCapogioco
Dim aRuote,abRuote
Dim nRuoteSel
Dim nInizioRangeAnalisi
Dim nFineRangeAnalisi
Dim nInizioTmp
Dim retInizioCiclo,retFineCiclo
Dim aLimitiCicli
Dim k,j
Dim nCicliTrovati
Dim nNumScelti
' attenzione il range analizzato parte dall'estrazione del 14/9/1946 fino all'estrazione corrrentemente impostata
' come limite superiore nel range del programma
nInizioRangeAnalisi = DataEstrToIdEstr(14,9,1946)
nFineRangeAnalisi = EstrazioneFin
'nCapogioco = InputBox("Inserire un numero per il capogioco","Capogioco",1)
ReDim aNumeri(0)
nNumScelti = ScegliNumeri(aNumeri)
nRuoteSel = ScegliRuote(aRuote,abRuote)
Call GestioneAutomaticaRuotaTutte(aRuote,abRuote,nRuoteSel)
If nCapogioco <> "" Then nCapogioco = CInt(nCapogioco)
If nRuoteSel > 0 And nNumScelti > 0 Then
Call Scrivi("Inizio analisi " & GetInfoEstrazione(nInizioRangeAnalisi))
Call Scrivi("Fine analisi " & GetInfoEstrazione(nFineRangeAnalisi))
Call Scrivi
Set CollAmbi = GetNewCollection
For j = 1 To nNumScelti
nCapogioco = aNumeri(j)
nCicliTrovati = 0
ReDim aLimitiCicliMin(nCicliTrovati)
ReDim aLimitiCicliMax(nCicliTrovati)
Call AlimentaCollAmbi(CollAmbi,nCapogioco)
nInizioTmp = nInizioRangeAnalisi
retInizioCiclo = 0
retFineCiclo = 0
Do While CalcolaCicloPratico(nInizioTmp,retInizioCiclo,retFineCiclo,nCapogioco,abRuote,nFineRangeAnalisi)
nCicliTrovati = nCicliTrovati + 1
ReDim Preserve aLimitiCicliMin(nCicliTrovati)
ReDim Preserve aLimitiCicliMax(nCicliTrovati)
aLimitiCicliMin(nCicliTrovati) = retInizioCiclo
aLimitiCicliMax(nCicliTrovati) = retFineCiclo
nInizioTmp = retFineCiclo + 1
Loop
ReDim abCicliDaCalcolare(nCicliTrovati)
If ScegliCicliDaCalcolare(aLimitiCicliMin,aLimitiCicliMax,abCicliDaCalcolare,nCapogioco) Then
For Each clsA In CollAmbi
Call clsA.InitCicliDaCalc(nCicliTrovati)
Next
For k = 1 To nCicliTrovati
If abCicliDaCalcolare(k) Then
Call Messaggio("Conteggio presenze nel ciclo " & k & _
" estrazioni " & aLimitiCicliMin(k) & "/" & aLimitiCicliMax(k))
Call CalcolaPresenze(k,aLimitiCicliMin(k),aLimitiCicliMax(k),CollAmbi,abRuote)
End If
Next
nInizioTmp = aLimitiCicliMax(nCicliTrovati) + 1
Call Messaggio("Conteggio presenze nel ciclo finale incompleto")
Call CalcolaPresenze(0,nInizioTmp,nFineRangeAnalisi,CollAmbi,abRuote)
Call creaOutputRangeCicli(aLimitiCicliMin,aLimitiCicliMax,nCapogioco,aRuote,nFineRangeAnalisi)
End If
Next
Call CreaOutputPresenzeAmbi(CollAmbi,abCicliDaCalcolare)
End If
End Sub
Function ScegliCicliDaCalcolare(aLimitiCicliMin,aLimitiCicliMax,abCicliDaCalcolare,nCapogioco)
Dim k
ReDim aVoci(UBound(abCicliDaCalcolare) - 1)
ReDim abSelected(UBound(abCicliDaCalcolare) - 1)
For k = 0 To UBound(aVoci)
aVoci(k) = "Ciclo " & FormatSpace(k + 1,4,True) & " da " & FormatSpace(aLimitiCicliMin(k + 1),5,2) & " a " & FormatSpace(aLimitiCicliMax(k + 1),5,2)
Next
If ScegliDaLista(aVoci,abSelected,"Cicli del capogioco " & nCapogioco) > 0 Then
For k = 0 To UBound(abSelected)
abCicliDaCalcolare(k + 1) = abSelected(k)
Next
ScegliCicliDaCalcolare = True
Else
ScegliCicliDaCalcolare = False
End If
End Function
Sub GestioneAutomaticaRuotaTutte(aRuote,aBRuote,nRuoteSel)
Dim k
If aBRuote(11) Then
ReDim aRuote(11)
ReDim aBRuote(11)
For k = 1 To 10
aBRuote(k) = True
aRuote(k) = k
Next
ElseIf aBRuote(12) Then
MsgBox "Lo script non opera sulla nazionale",vbExclamation
nRuoteSel = 0
End If
End Sub
Sub AlimentaCollAmbi(CollAmbi,nCapogioco)
Dim k
Dim clsA
For k = 1 To 90
If k <> nCapogioco Then
Set clsA = New clsAmbo
Call clsA.SetAmbo(nCapogioco,k)
clsA.Capogioco = nCapogioco
CollAmbi.Add clsA
End If
Next
End Sub
Function CalcolaCicloPratico(Inizio,retInizio,retFine,nCapogioco,aBRuote,estrazioniTotali)
Dim clsA
Dim idEstr
Dim r,e,N
ReDim aBNum(90)
Dim nTrovati
idEstr = Inizio
retInizio = Inizio
If idEstr <= estrazioniTotali Then
Do
For r = 1 To 10
If aBRuote(r) Then
If IsNumeroPresenteInEstrazione(idEstr,r,nCapogioco,0) Then
For e = 1 To 5
N = Estratto(idEstr,r,e)
If aBNum(N) = False Then
aBNum(N) = True
nTrovati = nTrovati + 1
End If
Next
End If
End If
Next
Call AvanzamentoElab(1,90,nTrovati)
idEstr = idEstr + 1
If idEstr > estrazioniTotali Then Exit Do
If ScriptInterrotto Then Exit Do
Loop While nTrovati < 90
retFine = idEstr - 1
If nTrovati >= 90 Then
CalcolaCicloPratico = True
Else
CalcolaCicloPratico = False
End If
End If
End Function
Function GetRuote(aRuote)
Dim k
Dim s
For k = 1 To UBound(aRuote)
If aRuote(k) > 0 Then
s = s & NomeRuota(aRuote(k)) & "-"
End If
Next
If Len(s) > 1 Then
GetRuote = Left(s,Len(s) - 1)
Else
GetRuote = s
End If
End Function
Sub creaOutputRangeCicli(aLimitiCicloMin,aLimitiCicloMax,nCapogioco,aRuote,nFineRangeAnalisi)
Dim k
Dim s
Dim nPresenze
ReDim aNum(1)
aNum(1) = nCapogioco
Call Scrivi("Cicli pratici per ambo con capogioco " & nCapogioco)
Call Scrivi("Ruote " & GetRuote(aRuote))
Call Scrivi
For k = 1 To UBound(aLimitiCicloMin)
Call StatisticaFormazione(aNum,aRuote,1,0,0,0,nPresenze,aLimitiCicloMin(k),aLimitiCicloMax(k))
s = "Ciclo " & FormatSpace(k,5,True) & " --> " & _
FormatSpace(aLimitiCicloMin(k),8,True) & " - " & FormatSpace(aLimitiCicloMax(k),8,True) & _
" pres capogioco " & FormatSpace(nPresenze,5,True)
Call Scrivi(s)
Next
Call StatisticaFormazione(aNum,aRuote,1,0,0,0,nPresenze,aLimitiCicloMax(UBound(aLimitiCicloMax)) + 1,nFineRangeAnalisi)
s = "Ciclo incompleto " & FormatSpace(k,5,True) & " --> " & _
FormatSpace(aLimitiCicloMax(UBound(aLimitiCicloMax)) + 1,8,True) & " - " & FormatSpace(nFineRangeAnalisi,8,True) & _
" pres capogioco " & FormatSpace(nPresenze,5,True)
Call Scrivi(s)
Call Scrivi
End Sub
Sub CalcolaPresenze(idCiclo,Inizio,Fine,collAmbi,aBRuote)
Dim clsA
Dim k,r,e,p
Dim nAmbiTot,nLetti
nAmbiTot = collAmbi.count
For Each clsA In collAmbi
For k = Inizio To Fine
For r = 1 To 10
If aBRuote(r) Then
p = 0
For e = 1 To 5
If clsA.abNum(Estratto(k,r,e)) Then
p = p + 1
End If
Next
If p = 2 Then
If idCiclo > 0 Then
clsA.PresPerCicliPratici(idCiclo) = clsA.PresPerCicliPratici(idCiclo) + 1
Else
clsA.PresenzeAttuali = clsA.PresenzeAttuali + 1
End If
End If
End If
Next
Next
nLetti = nLetti + 1
Call AvanzamentoElab(1,nAmbiTot,nLetti)
If ScriptInterrotto Then Exit For
Next
End Sub
Function ContaValoriTrue(aB)
Dim k,n
For k = LBound(aB) To UBound(aB)
If aB(k) Then n = n + 1
Next
ContaValoriTrue = n
End Function
Sub CreaOutputPresenzeAmbi(CollAmbi,aBCicliDaCalcolare)
Dim clsA
Dim nColonne
Dim k,i
Dim nIdColSomma,nIdColPresAtt
Dim nCicliDaCalcolare
Dim nCicliTot
nCicliTot = UBound(aBCicliDaCalcolare)
nCicliDaCalcolare = ContaValoriTrue(aBCicliDaCalcolare)
nColonne = 1 + nCicliDaCalcolare + 1 + 1
nIdColSomma = nColonne
nIdColPresAtt = nIdColSomma - 1
ReDim aTitoli(nColonne)
i = 1
aTitoli(i) = "Ambo"
For k = 1 To nCicliTot
If aBCicliDaCalcolare(k) Then
i = i + 1
aTitoli(i) = "Freq C" & k
End If
Next
aTitoli(nIdColPresAtt) = "Presenze Attuali"
aTitoli(nIdColSomma) = "Somma"
Call InitTabella(aTitoli,vbYellow)
For Each clsA In CollAmbi
ReDim aValori(nColonne)
i = 1
aValori(i) = clsA.GetNumeriString
For k = 1 To nCicliTot
If aBCicliDaCalcolare(k) Then
i = i + 1
aValori(i) = clsA.PresPerCicliPratici(k)
End If
Next
aValori(nIdColPresAtt) = clsA.PresenzeAttuali
aValori(nIdColSomma) = clsA.GetSommaPresenze
Call AddRigaTabella(aValori)
Next
Call CreaTabella(nIdColSomma,1) 'ordina per somma crescente
End Sub
