Novità

Per Luigi B

giorgioantonio

Super Member >PLATINUM<
Salve Luigi B, ho tentato di non interpellarti ma al messaggio proposto in ultimo "I Legeng, Disaronno ecc"
non è intervenuto nessuno. Gli scriptisti pare non sono interessati ho hanno da fare con altre richieste.
Chiedo cortesemente un ulteriore tuo intervento al listato che mi hai sistemato in ultimo.
Si tratta di portare a 6 i numeri (non spaventarti) da aggiungere come fisso/capogioco un un altro numero
con la riserva che questo ultimo, ma se il caso di entrambi, che i/o capogiochi possono essere FACOLTATIVI.
Dopo tolgo veramente il disturbo, almeno per questo script.
Spero accoglierai la mia richiesta, tempo permettendo.

Saluti e grazie.

NB. Sto ancora lavorando con la vecchia macchina ma con 40/50 numeri
li esegue in pochi minuti, niente male.

Giorgioantonio
 
Codice:
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
 
Salve Luigi B, ho ricopiato il listato , tutto OK non solo per i capogiochi ma per quanto hai
inserito in più.
A questo punto non posso chiedere più niente: c'è tutto.
Grazie è poco ma dipiù non saprei cosa dire.
Saluti Giorgioantonio
 
Salve, prima di chiudere, vorrei sapere se dopo un elaborato script si
può salvare l'elaborato?

Per chiudere ringrazio:
I Legend per aver avuto la prerogrativa di aver aperto questo thrend;
Disaronno, Magia per aver aiutato a proseguire il thrend;
e infine, "dulcis infundum"per aver implementato tutto quanto cera da
aggiungere. LUIGI B
Per chi è appassionato a questo tipo(statistica) di gioco, considero
completato in ogni sua parte il presente "LISTATO" considerato da me
un programma_capolavoro.
Concludendo: alle succitate persone dico che questo lavoro è un
ANTICIPATO REGALO DI NATALE, perciò VI dico: grazie, grazie, grazie.

Saluti
 
Se clicchi col destro compare un menu dove si puo selezionare esporta in excel senno installa una stampante virtuale che crei pdf cosi facendo stampa avrai un documento pdf con l output salvato ciao
 

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 23 gennaio 2025
    Bari
    86
    50
    83
    38
    78
    Cagliari
    11
    36
    52
    31
    74
    Firenze
    56
    59
    86
    27
    84
    Genova
    03
    61
    53
    11
    38
    Milano
    13
    14
    79
    87
    47
    Napoli
    21
    90
    48
    55
    37
    Palermo
    56
    46
    59
    02
    53
    Roma
    74
    13
    07
    38
    77
    Torino
    27
    54
    62
    36
    81
    Venezia
    09
    14
    69
    28
    62
    Nazionale
    32
    73
    27
    11
    51
    Estrazione Simbolotto
    Bari
    36
    27
    19
    08
    24

Ultimi Messaggi

Indietro
Alto