Option Explicit
Class ClsCombinazione
Private aNumeri
Private aRuote
Private m_ritardo
Private m_frequenza
Private m_ritardoMax
Private m_sorte
Private m_EstrIni
Private m_EstrFin
Public Property Get Ruote
Ruote = aRuote
End Property
Public Property Get Sorte
Sorte = m_sorte
End Property
Public Property Get EstrIni
EstrIni = m_EstrIni
End Property
Public Property Get EstrFin
EstrFin = m_EstrFin
End Property
Public Property Get Ritardo
Ritardo = m_ritardo
End Property
Public Property Get Frequenza
Frequenza = m_frequenza
End Property
Public Property Get RitardoMax
RitardoMax = m_ritardoMax
End Property
Sub EseguiStat(vNumeri,vRuote,Sorte,Inizio,Fine)
Dim nColTot,r
ReDim aR(1)
aNumeri = vNumeri
aRuote = vRuote
m_sorte = Sorte
m_EstrIni = Inizio
m_EstrFin = Fine
m_ritardo = 0
m_frequenza = 0
m_ritardoMax = 0
Call StatisticaFormazioneTurbo(aNumeri,aRuote,m_sorte,m_ritardo,m_ritardoMax,0,m_frequenza,m_EstrIni,m_EstrFin)
End Sub
Function StringaNum
StringaNum = StringaNumeri(aNumeri)
End Function
End Class
Sub Main
Dim nQNum,nSorte,Inizio,Fine,nFisso,idMese,nEstrAna
Dim Coll,clsCmb
Dim R,j
Dim idTipoRic
ReDim aNumeri(0)
ReDim aVTable(11)
ReDim abMesi(12)
ReDim aColoreRip (5)
Dim aVTipoRic
Call CreaArrayColori(aColoreRip)
'aColoreRip = Array ("Black" , "Cyan" , ")
aVTipoRic = Array("Frequenza","Ritardo","RitardoMax")
idMese = ScegliMese
abMesi(idMese) = True
nFisso = Sceglifisso
aVTable(1) = "Ruota"
For R = 2 To 11
aVTable(R) = "A" & R - 1
Next
Call InitTabella(aVTable)
Inizio = EstrazioneIni
Fine = EstrazioneFin
nQNum = ScegliNumeri(aNumeri)
nSorte = ScegliEsito(2)
idTipoRic = ScegliTipoRicerca
nEstrAna = AttivaEstrazioni(Inizio,Fine,abMesi)
For R = 1 To 12
If R <> 11 Then
aVTable(1) = NomeRuota(R)
Call Messaggio(aVTable(1))
Set Coll = GetNewCollection
Call EseguiStatistica(nFisso,aNumeri,R,nSorte,nSorte,Inizio,Fine,Coll)
Call OrdinaItemCollection(Coll,aVTipoRic(idTipoRic))
ReDim aNumRip (90)
Call ContaNumeriRipetuti(Coll ,aNumRip )
'For j = 2 To 11
For j = 2 To Coll.count + 1
If j > 11 Then Exit For
Set clsCmb = Coll(j - 1)
If aVTipoRic(idTipoRic) = "Frequenza" Then
aVTable(j) = ColoraNumeri(clsCmb.StringaNum ,aNumRip ,aColoreRip) & " (" & "<font color='RED'>" & clsCmb.Frequenza & "</font>)"
ElseIf aVTipoRic(idTipoRic) = "Ritardo" Then
aVTable(j) = ColoraNumeri(clsCmb.StringaNum ,aNumRip ,aColoreRip) & " (" & "<font color='RED'>" & clsCmb.Ritardo & "</font>)"
ElseIf aVTipoRic(idTipoRic) = "RitardoMax" Then
aVTable(j) = ColoraNumeri(clsCmb.StringaNum ,aNumRip ,aColoreRip) & " (" & "<font color='RED'>" & clsCmb.RitardoMax & "</font>)"
End If
Next
Call AddRigaTabella(aVTable)
End If
Call AvanzamentoElab(1,12,R)
Next
SetTableWidth("100%")
Call Scrivi("Range analizzato : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
Call Scrivi("Numero fisso ; " & Iif(nFisso = 0,"Nessuno",nFisso))
Call Scrivi("Mese analizzato : " & Iif(idMese = 0,"Tutti",MeseNome(idMese)))
Call Scrivi("Estrazioni tot, : " & nEstrAna)
Call Scrivi(String(100,"-"))
Call CreaTabella
Call CreaLegendaColori (aColoreRip )
End Sub
Sub EseguiStatistica(nFisso,vNumeri,nRuota,Classe,Sorte,Inizio,Fine,CollDest)
Dim nColTot
Dim cComb
ReDim aFissi(1)
aFissi(1) = nFisso
ReDim aR(1)
aR(1) = nRuota
If aFissi(1) > 0 Then
nColTot = InitSviluppoIntegrale(vNumeri,Classe,aFissi)
Else
nColTot = InitSviluppoIntegrale(vNumeri,Classe)
End If
ReDim aCol(0)
Do While GetCombSviluppo(aCol)
Set cComb = New ClsCombinazione
Call cComb.EseguiStat(aCol,aR,Sorte,Inizio,Fine)
CollDest.Add cComb
Loop
End Sub
Private Function MeseValido(idEstr,aMesi)
If aMesi(0) Then
MeseValido = True
Else
MeseValido = aMesi(Mese(idEstr))
End If
End Function
Private Function AttivaEstrazioni(Inizio,fine,aMesi)
Dim k
Dim nValide,b
nValide = 0
For k = Inizio To fine
b = MeseValido(k,aMesi)
Call ImpostaEstrazione(k,CBool(b))
If b Then
nValide = nValide + 1
End If
Next
AttivaEstrazioni = nValide
End Function
Function ScegliMese
Dim aV
aV = Array("Tutti","Gen","Feb","Mar","Apr","Mag","Giu","Lug","Ago","Set","Ott","Nov","Dic")
ScegliMese = ScegliOpzioneMenu(aV,0)
End Function
Function Sceglifisso
ReDim aV(90)
Dim k
aV(0) = "Nessun fisso"
For k = 1 To 90
aV(k) = k
Next
Sceglifisso = ScegliOpzioneMenu(aV,0)
End Function
Function ScegliTipoRicerca
Dim aV
aV = Array("Frequenza","Ritardo","RitardoMax")
ScegliTipoRicerca = ScegliOpzioneMenu(aV,0)
End Function
Sub ContaNumeriRipetuti(Coll , aNumRip )
Dim clsCmb , j , y , n
ReDim aNumRip(90)
For j = 1 To Coll.count
If j > 10 Then Exit For
Set clsCmb = Coll(j)
ReDim aV(0)
Call SplitByChar(clsCmb.StringaNum ,"." ,aV)
For y =0 To UBound(aV)
n = Int(aV(y))
aNumRip (n) = aNumRip (n) +1
Next
Next
End Sub
Function ColoraNumeri(sNumeri ,aQNumRip ,aColoreRip)
Dim k , n , sRet
ReDim aV(0)
Call SplitByChar( sNumeri , "." ,aV)
sRet = ""
For k = 0 To UBound(aV)
n = Int(aV(k))
If aQNumRip (n) = 1 Then
sRet = sRet & Format2( n) & "."
ElseIf aQNumRip (n) >= 2 And aQNumRip (n) <= 4 Then
sRet = sRet & GetStringaColorata (Format2( n), aColoreRip(aQNumRip (n)) ) & "."
Else
sRet = sRet & GetStringaColorata (Format2( n), aColoreRip(5) ) & "."
End If
Next
ColoraNumeri = RimuoviLastChr( sRet , ".")
End Function
Function GetStringaColorata (s , Colore)
GetStringaColorata = "<font color ='" & GetColoreHtml(Colore) & "'><b>" & s & "</b></font>"
End Function
Sub CreaArrayColori (aC)
ReDim aC(5)
aC(1) = 0
aC(2) = RGB(0,128,0)
aC(3) = RGB(255,0,128)
aC(4) = RGB(255,128,64)
aC(5) = RGB(0,128,255)
End Sub
Sub CreaLegendaColori ( aColori)
Dim k
ReDim av(2)
av(1) = "Colore"
av(2) = "Quantita ripetizioni per ruota"
Call InitTabella(av )
For k = 1 To UBound(aColori) -1
av(1) = ""
av(2) = k
Call AddRigaTabella ( av)
Call SetColoreCella( 1,(aColori(k)))
Next
av(1) = " "
av(2) = ">=" & k
Call AddRigaTabella ( av )
Call SetColoreCella(1,(aColori(k)))
Scrivi
Call SetTableWidth ("30%")
Call CreaTabella
End Sub
