Option Explicit
Dim clsHSS
Sub Main
'http://forum.lottoced.com/forum/lottoced/area-download/1928444-sub-combconcapogioco?_=1445891195815
'Sub combConCapogioco di i legend vers.10ELotto mod.01 disaronno
Dim sFileBd
Dim Tipoarchivio
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
'-----------------------------------------------------------------------------------------------------
Dim Ini,fin,Tot,EstrRic
Dim idcg,IdClasse
Dim nStart,nEnd
Dim j,num,sNum
Dim aComb
Dim sorte
Dim Rit,RitMax,Incr,Freq
Dim aNumProno ,aCol , nCombTot
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
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 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
'Call Getcombconcapogioco(idcg,IdClasse,aComb)
If GetArrayNumeriProno(idcg,aNumProno ,IdClasse) Then
nCombTot = InitSviluppoIntegrale (aNumProno ,IdClasse -1)
j =0
Do While GetCombSviluppo(aCol )
j = j +1
ReDim Preserve aCol(IdClasse)
aCol(IdClasse) = idcg
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(05),I
For I = 01 To 05
aVoci(I) = NomeSorte(I)
Next
getClasse = ScegliOpzioneMenu(aVoci,03,"CombInazioni = Combinazione + 01" )
End Function
Sub getTitoli
Dim aTitoli
aTitoli = Array(" "," ID "," FORMAZIONE "," FREQUENZA "," RITARDO "," RITARDO MAX. "," INC.RIT.MAX ")
Call InitTabella(aTitoli)
End Sub
Sub Getcombconcapogioco(idCG,IdClasse,aComb)
Dim anumeri(89)
Dim I,j
Dim k,e,s
Dim aColonne
I = 00
For j = 01 To 90
If j <> idCG Then
I = I + 01
anumeri(I) = j
End If
Next
aColonne = SviluppoIntegrale(anumeri,IdClasse)
ReDim aComb(UBound(aColonne))
For k = 01 To UBound(aColonne)
s = " "
For e = 01 To IdClasse
s = s & ". " & Format2(aColonne(k,e))
Next
aComb(k) = Format2(idCG) & s
Next
End Sub
Function GetArrayNumeriProno(NumCapoG,aNumProno , Classe)
ReDim aNum(0)
ReDim aNumProno(90)
Dim k,i
Call ScegliNumeri(aNum)
For k = 1 To UBound(aNum)
If aNum(k) <> NumCapoG Then
i = i + 1
aNumProno(i) = aNum(k)
End If
Next
ReDim Preserve aNumProno(i)
If i >= (Classe-1) Then
GetArrayNumeriProno = True
End If
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
