Option Explicit
Dim clsHSS
Sub Main
Dim sFileBd
Dim Tipoarchivio
Dim nCapogiochi
Dim Ini,fin,Tot,EstrRic
Dim idcg,IdClasse
Dim nStart,nEnd
Dim j,num,sNum,k
Dim aComb
Dim sorte
Dim Rit,RitMax,Incr,Freq
Dim aNumProno,aCol,nCombTot
Dim nClasseSvil
Tipoarchivio = ScegliArchivioDL
If Tipoarchivio > 00 Then
If Tipoarchivio = 02 Then
If MsgBox("Vuoi aggiornare le estrazioni prima di eseguire il listato",vbQuestion + vbYesNo) = vbYes Then
Call AggiornaArchivioDL
End If
End If
' imposto il percorso per il file della base dati da usare
'---------------------------------------------------------------------------------
If Tipoarchivio = 01 Then sFileBd = GetDirectoryAppData & "BaseDati10Elotto.Dat"
If Tipoarchivio = 02 Then sFileBd = GetDirectoryAppData & "BaseDati10Elotto5M.Dat"
'---------------------------------------------------------------------------------
Call ImpostaArchivio10ELotto(Tipoarchivio)
' istanzio l'oggetto HSS
Set clsHSS = CreateObject("HSS.ClsHighSpeedStat")
' inizializzo l'archivio.N.B. E' la prima cosa da fare
'-----------------------------------------------------------------------------------------------------
Call clsHSS.Init(sFileBd,02) ' parametro 2 indica file 10 e lotto norm e 5M del programma spaziometria
'-----------------------------------------------------------------------------------------------------
nStart = Timer
EstrRic = CInt(InputBox("Estrazioni di Controllo",,12))
Ini = EstrazioniArchivioDL - EstrRic
fin = EstrazioniArchivioDL
Tot = fin - Ini + 01
'idcg = CInt(InputBox(" inserisci un numero tra 1 & 90","CapoGioco",25))
'If Not isNumeroValidoLotto(idcg) Then Exit Sub
IdClasse = getClasse
nCapogiochi = GetQCapoGiochi(IdClasse)
ReDim aCapogiochi(nCapogiochi)
nClasseSvil = IdClasse - nCapogiochi
sorte = CInt(InputBox(" inserisci un numero tra 1 e " & IdClasse,"esito ",IdClasse))
If Tipoarchivio = 01 Then Call Scrivi(" Tabella Statistiche con Capogioco di i legend al 10eLotto Serale ",1,- 1,3)
If Tipoarchivio = 02 Then Call Scrivi(" Tabella Statistiche con Capogioco di i legend al 10eLotto 5 minuti ",1,- 1,3)
'Call Getcombconcapogioco(idcg,IdClasse,aComb)
If GetArrayNumeriProno(aNumProno,IdClasse,aCapogiochi) And nClasseSvil > 0 Then
Call Scrivi
nStart = Timer
Call Scrivi(" Dalla Data di inizio " & GetInfoEstrazioneDL(Ini) & " alla data finale di " & GetInfoEstrazioneDL(fin) & " Estrazioni esaminate... " & Format2(Tot),1)
Call Scrivi
Call getTitoli
nCombTot = InitSviluppoIntegrale(aNumProno,nClasseSvil)
j = 0
Do While GetCombSviluppo(aCol)
j = j + 1
ReDim Preserve aCol(IdClasse)
For k = 1 To nCapogiochi
aCol(nClasseSvil + k) = aCapogiochi(k)
Next
sNum = StringaNumeri(aCol,".",True)
Call clsHSS.StatisticaFormazioneDL(aCol,sorte,Rit,RitMax,Incr,Freq,Ini,fin)
ReDim aTab(06)
Call getTabella(aTab,j,sNum,Freq,Rit,RitMax,Incr)
Call AddRigaTabella(aTab)
If j Mod 100 = 0 Then
Call Messaggio("combinazione : " & sNum)
Call AvanzamentoElab(1,nCombTot,j)
If ScriptInterrotto Then Exit Do
End If
Loop
Call scegliTabella
Set clsHSS = Nothing
nEnd = Timer
Call Scrivi("Tempo di elaborazione : " & FormattaSecondi((nEnd + 01) - nStart))
End If
End If
End Sub
Function ScegliArchivioDL()
ReDim aVoci(01)
aVoci(00) = "10eLotto Serale"
aVoci(01) = "10eLotto 5minuti"
ScegliArchivioDL = ScegliOpzioneMenu(aVoci,00," Secegli archivio ") + 01
End Function
Function getClasse
Dim aVoci(9),I
For I = 0 To 9
aVoci(I) = NomeSorte(I + 1)
Next
getClasse = ScegliOpzioneMenu(aVoci,03,"Classe di sviluppo compresi capigiochi") + 1
End Function
Sub getTitoli
Dim aTitoli
aTitoli = Array(" "," ID "," FORMAZIONE "," FREQUENZA "," RITARDO "," RITARDO MAX. "," INC.RIT.MAX ")
Call InitTabella(aTitoli)
End Sub
Function GetArrayNumeriProno(aNumProno,Classe,aCapiGioco)
ReDim aNum(0)
ReDim aNumProno(90)
Dim k,i,n
Dim bAnnullato
bAnnullato = False
Call ScegliNumeri(aNum)
For k = 1 To UBound(aNum)
i = i + 1
aNumProno(i) = aNum(k)
Next
ReDim Preserve aNumProno(i)
If i >=(Classe) Then
k = 0
Do While k < UBound(aCapiGioco)
n = Int(InputBox("Inserire il capogioco Numero " & k + 1))
If isNumeroValidoLotto(n) Then
If NumeroPresenteInArray(aNumProno,n) = False And NumeroPresenteInArray(aCapiGioco,n) = False Then
k = k + 1
aCapiGioco(k) = n
Else
If MsgBox("Il numero " & n & " è gia usato. Annullare",vbQuestion + vbYesNo) = vbYes Then
bAnnullato = True
Exit Do
End If
End If
Else
Exit Do
End If
Loop
If bAnnullato = False And k = UBound(aCapiGioco) Then
GetArrayNumeriProno = True
End If
End If
End Function
Function NumeroPresenteInArray(aV,n)
Dim k
For k = 0 To UBound(aV)
If Int(aV(k)) = Int(n) Then
NumeroPresenteInArray = True
Exit For
End If
Next
End Function
Sub getTabella(atab,id,sNum,Frequenza,Ritardo,RitardoMax,IncrRitMax)
atab(01) = id
atab(02) = sNum
atab(03) = Frequenza
atab(04) = Ritardo
atab(05) = RitardoMax
atab(06) = IncrRitMax
End Sub
Function FormattaSecondi(s)
'Questa Function trasforma il numero di secondi passato come parametro in una stringa
' passando i secondi si ottengono ore minuti e secondi in formato hh:mm:ss
' s ---> Numero di secondi da formattare
' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
Dim hh
Dim Mm
Dim Ss
Dim TimeStr
hh = s \ 3600
Mm =(s Mod 3600) \ 60
Ss = s -((hh * 3600) +(Mm * 60))
TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
FormattaSecondi = TimeStr
End Function
Function scegliTabella()
ReDim Voci(01)
Voci(00) = "Tabella Normale"
Voci(01) = "tabella Ordinabile"
scegliTabella = ScegliOpzioneMenu(Voci,01,"Seleziona tabella")
If scegliTabella = 00 Then Call CreaTabella(03)
If scegliTabella = 01 Then Call CreaTabellaOrdinabile(03,- 1,,151)
End Function
Function GetQCapoGiochi(nclasse)
Dim k
ReDim aV(nclasse - 1)
For k = 0 To UBound(aV)
aV(k) = k
Next
GetQCapoGiochi = ScegliOpzioneMenu(aV,0,"Seleziona quantita capogiochi")
End Function