Novità

Per dirla alla "Austin Powers" sarebbe...

non mi fare pensare alla pensione ..mancano almeno 25 anni... e chissa se la prenderemo ...
 
Ciao a tutti;)
Ecco il Codice
Non ho file txt quindi non so se funzionano correttamente
Archivi virtuali(magari 10-15 minuti) sembra funzionare ma per i dati mi farebbe piacere avere conferma da Silop
per tutto il resto credo che tom mi possa dire se è tutto implementato
Per Luigi ora ti occa tornare afare il prof:)
Codice: 
Option Explicit
Class clsLunghetta
    Private aNumeri ' contiene i numeri della lunghetta
    Private mInizio,mFine,aRuote,mSorte ' parametri per il range analisi
    Private mClasse ' contine la classe della lunghetta
    Private aElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aIdEstrElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aElencoIncrRitMax ' contiene l'elnco degli incrementi del ritardo max
    Private aIdEstrIncrRitMax ' conterra l'elenco degli id estrazione in
    ' cui si è registrato l'incremento del ritmax conosciuto
    Private aRitardiAllIncremento ' contiene il valore del ritardo all'idestrazione in cui
    ' si è verificato l'incremento
    Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza ' valori statistici
    Private mIncrRitardoMaxSto,mStrIncRitSto
    Public Property Get sArrayNumeri
        sArrayNumeri = StringaNumeri(aNumeri)
    End Property
    Public Property Get iNumIncrementi
        iNumIncrementi = UBound(aElencoIncrRitMax)
    End Property
    Public Property Get IncrRitMaxSto
        IncrRitMaxSto = mIncrRitardoMaxSto
    End Property
    Public Property Get strIncRitMaxSto
        strIncRitMaxSto = mStrIncRitSto
    End Property
    Public Property Get Ritardo
        Ritardo = mRitardo
    End Property
    Public Property Get RitardoMax
        RitardoMax = mRitardoMax
    End Property
    Public Property Get IncrRitMax
        IncrRitMax = mIncrRitMax
    End Property
    Public Property Get Frequenza
        Frequenza = mFrequenza
    End Property
    Public Property Get LunghettaString
        LunghettaString = StringaNumeri(aNumeri)
    End Property
    ' inizializza le proprietà dell'oggetto
    Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco)
        ' acquisisco i parametri per l'analisi
        mInizio = RangeInizio
        mFine = RangeFine
        aRuote = vetRuote
        mSorte = SorteInGioco
        ' alimento il vettore con i numeri della lunghetta
        Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        ' calcolo l'elenco dei ritardi
        Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
        ' alimento il vettore che contien l'elenco degli incrementi rit max
        Call AlimentaVettoreIncrRitMax
    End Sub
    ' esegue il calcolo dei valori statistici della lunghetta
    Sub EseguiStatistica
        Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
    End Sub
    Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        Dim k
        If IsArray(sLunghetta) Then
            ' se la lunghetta è gia un array lo copio nel vettore locale dei numeri
            ReDim aNumeri(UBound(sLunghetta))
            For k = 1 To UBound(sLunghetta)
                aNumeri(k) = sLunghetta(k)
            Next
        Else
            ' antepongo un carattere separatore per fare in modo che
            ' aNumeri si valorizzi dall'indice 1 (senno si sarebeb valorizzato dall'indice 0)
            Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
        End If
        ' valorizzo la classe della lunghetta
        mClasse = UBound(aNumeri)
    End Sub
    Private Sub AlimentaVettoreIncrRitMax
        Dim nRitMax,nIncr,nId,k
        nId = 0
        ' inizializzo il vettore a 0 elementi
        ReDim aElencoIncrRitMax(0)
        ReDim aIdEstrIncrRitMax(0)
        ReDim aRitardiAllIncremento(0)
        ' ciclo sul vettore dei ritardi
        For k = 1 To UBound(aElencoRit)
            ' se il ritardo corrente supera il ritmax attuale..
            If aElencoRit(k) > nRitMax Then
                If nRitMax > 0 Then
                    ' se il ritmax attuale è >0 (ivvero ne esiste uno)
                    ' calcolo di quanto si è incrementato
                    nIncr = aElencoRit(k) - nRitMax
                    ' incremento il contatore dei valori trovati
                    nId = nId + 1
                    ' ridimensiono il vettore mantenendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aElencoIncrRitMax(nId)
                    ' memorizzo il valore
                    aElencoIncrRitMax(nId) = nIncr
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aIdEstrIncrRitMax(nId)
                    ' memorizzo l'id dell'estrazione dove si è avuto l'incremento
                    aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aRitardiAllIncremento(nId)
                    ' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento
                    aRitardiAllIncremento(nId) = aElencoRit(k)
                End If
                nRitMax = aElencoRit(k)
            End If
        Next
        mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
    End Sub
    Function IsCondizioneRispettata(nIdFiltro,nQIncr)
        ' verifica che l'incremento dell'ultimo ritmax sia uguale al massimo incr rit max conosciuto.
        Dim nUpper
        nUpper = UBound(aElencoIncrRitMax)
        mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
        If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine And nUpper >= nQIncr Then
            Select Case nIdFiltro
            Case 0
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto)
            Case 1
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto)
            Case 2
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto)
            End Select
        Else
            IsCondizioneRispettata = False
        End If
    End Function
    Sub DisegnaGraficoIncrRitMax
        Dim x,y,k
        Dim nValoreMaxX,nValoreMaxY,nValoreMinX
        Dim nStepX,nStepY
        Dim nUpperVetIncrRit
        nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
        nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
        nValoreMaxY = MassimoV(aElencoRit,1)
        nStepX =(nValoreMaxX -(mInizio - 1)) \10
        nStepY = nValoreMaxY \10
        Call PreparaGrafico("Formaziione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
        nUpperVetIncrRit = UBound(aElencoIncrRitMax)
        ' linea dell'incremento rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aElencoIncrRitMax(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
        ' linea dell' rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aRitardiAllIncremento(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
        ' scrive grafico nell'output
        Call InserisciGrafico
    End Sub
End Class
Sub Main
    Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
    Dim bOk,idFiltro,qIncr
    sDir = GetDirectoryAppData & "ArchiviVirtuali\"
    sFile = ScegliFileArchivioVirt(sDir)
    If sFile <> "" Then
        sFileCompleto = sDir & sFile & ".dat"
        bOk = ApriFileBaseDati(sFileCompleto)
    Else
        bOk = True ' archivio normale
    End If
    If bOk Then
        If ScegliRange(Inizio,Fine) Then
            Sorte = ScegliEsito
            Call ScegliRuote(aRuote,Nothing)
            ' decido il filtro in base al valore degli incrementi
            idFiltro = GetIdFiltro
            ' decido di filtrare in base al numero degli incrementi
            qIncr = GetQuantiIncrementi
            If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 And idFiltro > - 1 Then
                Call Scrivi("Archivio : " & Iif(sFile <> "",sFile,"Archivio lotto"))
                Select Case ScegliTipoSviluppo
                Case 1
                    Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
                Case 2
                    Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
                Case 3
                    Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
                End Select
            End If
        End If
    End If
End Sub
Function ScegliFileArchivioVirt(sDir)
    Dim i
    ReDim aFile(0)
    Call ElencoFileInDirectory(sDir,aFile,".dat")
    aFile(0) = "Archivio reale"
    i = ScegliOpzioneMenu(aFile,0,"Scegli archivio virtuale")
    If i > 0 Then
        ScegliFileArchivioVirt = aFile(i)
    Else
        ScegliFileArchivioVirt = ""
    End If
End Function
Function ScegliTipoSviluppo
    ReDim aVoci(3)
    aVoci(1) = "Da file txt con lunghette"
    aVoci(2) = "Da sviluppo casuale"
    aVoci(3) = "Da sviluppo tabellare"
    ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1)
End Function
Function GetChrSepFromRiga(sRiga)
    Dim k,schr
    schr = ""
    For k = 1 To Len(sRiga)
        schr = Mid(sRiga,k,1)
        If IsNumeric(schr) = False Then
            Exit For
        End If
    Next
    GetChrSepFromRiga = schr
End Function
Function GetIdFiltro
    Dim aFiltro
    aFiltro = Array("IncrRitMaxSto=UltimoIncrRitMax","IncrRitMaxSto<=UltimoIncrRitMax","IncrRitMaxSto>=UltimoIncrRitMax")
    GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
End Function
Function GetQuantiIncrementi
    GetQuantiIncrementi = CInt(InputBox("qIncr>=(NumeroIncrementiRitMaxFormazione)","Filtro Quantitaà Incrementi",5))
End Function
Sub AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
    Dim sFile,aLunghette,nTotLunghette
    Dim k,sChrSep
    Dim clsL,collLunghette
    Set collLunghette = GetNewCollection
    sFile = ScegliFile(GetDirectoryAppData,".txt")
    If FileEsistente(sFile) Then
        Call LeggiRigheFileDiTesto(sFile,aLunghette)
        nTotLunghette = UBound(aLunghette)
        If nTotLunghette > 0 Then
            sChrSep = GetChrSepFromRiga(aLunghette(1))
            For k = 0 To nTotLunghette
                Set clsL = New clsLunghetta
                Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte)
                If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                    Call clsL.EseguiStatistica
                    collLunghette.Add clsL
                End If
                If k Mod 50 = 0 Then
                    Call Messaggio("Righe esaminate : " & k)
                    Call AvanzamentoElab(1,nTotLunghette,k)
                    If ScriptInterrotto Then Exit For
                End If
            Next
            Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
            Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
            Scrivi "Sorte                 : " & NomeSorte(Sorte)
            Scrivi "Ruote                 : " & StringaRuote(aRuote)
            Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
            Scrivi
            Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
            Call Scrivi
            If collLunghette.count > 0 Then
                Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
                For Each clsL In collLunghette
                    Call Scrivi("Numeri Formazione     : " & clsL.sArrayNumeri)
                    Call Scrivi("Ritardo               : " & clsL.Ritardo)
                    Call Scrivi("RitMax                : " & clsL.RitardoMax)
                    Call Scrivi("Freq                  : " & clsL.Frequenza)
                    Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                    Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                    Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                    Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                    Call clsL.DisegnaGraficoIncrRitMax
                Next
            Else
                Scrivi "Nessuna lunghetta rispetta le condizioni"
                Scrivi "Lunghette esaminate " & nTotLunghette + 1
            End If
        End If
    End If
End Sub
Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
    Dim sFile,aLunghette,nTotLunghette,nClasse
    Dim nTrov,nProdotte
    Dim clsL,collLunghette
    ReDim aSelNum(0)
    Set collLunghette = GetNewCollection
    nTotLunghette = Int(InputBox("Quante lunghette devono essere trovate ?",,10))
    ScegliNumeri(aSelNum)
    nClasse = Int(InputBox("Quanti numeri nella lunghetta",,Sorte))
    If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then
        nTrov = 0
        nProdotte = 0
        Do While nTrov < nTotLunghette
            Set clsL = New clsLunghetta
            ReDim aNum(nClasse)
            Call GetColonnaCasuale(nClasse,aNum,aSelNum)
            nProdotte = nProdotte + 1
            Call clsL.Init(aNum,"",Inizio,Fine,aRuote,Sorte)
            If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                Call clsL.EseguiStatistica
                collLunghette.Add clsL
                nTrov = nTrov + 1
            End If
            If nProdotte Mod 50 = 0 Then
                Call Messaggio("combinazioni esaminate " & nProdotte & " valide " & nTrov)
                Call DoEventsEx
                If ScriptInterrotto Then Exit Do
            End If
        Loop
        Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
        Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
        Scrivi "Sorte                 : " & NomeSorte(Sorte)
        Scrivi "Ruote                 : " & StringaRuote(aRuote)
        Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
        Scrivi
        Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
        Call Scrivi
        If collLunghette.count > 0 Then
            Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
            For Each clsL In collLunghette
                Call Scrivi("Numeri Formazione     : " & clsL.sArrayNumeri)
                Call Scrivi("Ritardo               : " & clsL.Ritardo)
                Call Scrivi("RitMax                : " & clsL.RitardoMax)
                Call Scrivi("Freq                  : " & clsL.Frequenza)
                Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                Call clsL.DisegnaGraficoIncrRitMax
            Next
        Else
            Scrivi "Nessuna lunghetta rispetta le condizioni"
            Scrivi "Lunghette esaminate " & nTotLunghette
        End If
    End If
End Sub
Sub AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
    Dim nTotLunghette
    Dim k,sChrSep,nClasse
    ReDim aLunghette(0)
    Dim clsL,collLunghette
    Set collLunghette = GetNewCollection
    sChrSep = " "
    ScegliNumeri(aLunghette)
    nClasse = CInt(InputBox(" classe sviluppo ",,2))
    nTotLunghette = InitSviluppoIntegrale(aLunghette,nClasse)
    k = 0
    Do While GetCombSviluppo(aLunghette)
        k = k + 1
        Set clsL = New clsLunghetta
        Call clsL.Init(aLunghette,sChrSep,Inizio,Fine,aRuote,Sorte)
        If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
            Call clsL.EseguiStatistica
            collLunghette.Add clsL
        End If
        If k Mod 50 = 0 Then
            Call Messaggio("Righe esaminate " & k & "  valide " & collLunghette. count)
            DoEventsEx
            Call AvanzamentoElab(1,nTotLunghette,k)
            If ScriptInterrotto Then Exit Do
        End If
    Loop
    Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
    Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
    Scrivi "Sorte                 : " & NomeSorte(Sorte)
    Scrivi "Ruote                 : " & StringaRuote(aRuote)
    Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
    Scrivi
    Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
    Call Scrivi
    If collLunghette.count > 0 Then
        Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
        For Each clsL In collLunghette
            Call Scrivi("Numeri Formazione     : " & clsL.sArrayNumeri)
            Call Scrivi("Ritardo               : " & clsL.Ritardo)
            Call Scrivi("RitMax                : " & clsL.RitardoMax)
            Call Scrivi("Freq                  : " & clsL.Frequenza)
            Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
            Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
            Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
            Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
            Call clsL.DisegnaGraficoIncrRitMax
        Next
    Else
        Scrivi "Nessuna lunghetta rispetta le condizioni"
        Scrivi "Lunghette esaminate " & nTotLunghette
    End If
End Sub
Pensa a scriverlo con il cellulare;)
 
Ciao luigi ora che sono aggiornato vorrei cominciare ad utilizzare la class
ClsHSS
Quali sono i metodi?
Dove li trovo?
Grazie mille:)
 
i legend;n1941483 ha scritto:
Ciao a tutti;)
Ecco il Codice
Non ho file txt quindi non so se funzionano correttamente
Archivi virtuali(magari 10-15 minuti) sembra funzionare ma per i dati mi farebbe piacere avere conferma da Silop
per tutto il resto credo che tom mi possa dire se è tutto implementato
Per Luigi ora ti occa tornare afare il prof:)
Codice: 
Option Explicit
Class clsLunghetta
Private aNumeri ' contiene i numeri della lunghetta
Private mInizio,mFine,aRuote,mSorte ' parametri per il range analisi
Private mClasse ' contine la classe della lunghetta
Private aElencoRit ' conterra l'elenco dei ritardi per la lunghetta
Private aIdEstrElencoRit ' conterra l'elenco dei ritardi per la lunghetta
Private aElencoIncrRitMax ' contiene l'elnco degli incrementi del ritardo max
Private aIdEstrIncrRitMax ' conterra l'elenco degli id estrazione in
' cui si è registrato l'incremento del ritmax conosciuto
Private aRitardiAllIncremento ' contiene il valore del ritardo all'idestrazione in cui
' si è verificato l'incremento
Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza ' valori statistici
Private mIncrRitardoMaxSto,mStrIncRitSto
Public Property Get sArrayNumeri
sArrayNumeri = StringaNumeri(aNumeri)
End Property
Public Property Get iNumIncrementi
iNumIncrementi = UBound(aElencoIncrRitMax)
End Property
Public Property Get IncrRitMaxSto
IncrRitMaxSto = mIncrRitardoMaxSto
End Property
Public Property Get strIncRitMaxSto
strIncRitMaxSto = mStrIncRitSto
End Property
Public Property Get Ritardo
Ritardo = mRitardo
End Property
Public Property Get RitardoMax
RitardoMax = mRitardoMax
End Property
Public Property Get IncrRitMax
IncrRitMax = mIncrRitMax
End Property
Public Property Get Frequenza
Frequenza = mFrequenza
End Property
Public Property Get LunghettaString
LunghettaString = StringaNumeri(aNumeri)
End Property
' inizializza le proprietà dell'oggetto
Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco)
' acquisisco i parametri per l'analisi
mInizio = RangeInizio
mFine = RangeFine
aRuote = vetRuote
mSorte = SorteInGioco
' alimento il vettore con i numeri della lunghetta
Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
' calcolo l'elenco dei ritardi
Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
' alimento il vettore che contien l'elenco degli incrementi rit max
Call AlimentaVettoreIncrRitMax
End Sub
' esegue il calcolo dei valori statistici della lunghetta
Sub EseguiStatistica
Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
End Sub
Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
Dim k
If IsArray(sLunghetta) Then
' se la lunghetta è gia un array lo copio nel vettore locale dei numeri
ReDim aNumeri(UBound(sLunghetta))
For k = 1 To UBound(sLunghetta)
aNumeri(k) = sLunghetta(k)
Next
Else
' antepongo un carattere separatore per fare in modo che
' aNumeri si valorizzi dall'indice 1 (senno si sarebeb valorizzato dall'indice 0)
Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
End If
' valorizzo la classe della lunghetta
mClasse = UBound(aNumeri)
End Sub
Private Sub AlimentaVettoreIncrRitMax
Dim nRitMax,nIncr,nId,k
nId = 0
' inizializzo il vettore a 0 elementi
ReDim aElencoIncrRitMax(0)
ReDim aIdEstrIncrRitMax(0)
ReDim aRitardiAllIncremento(0)
' ciclo sul vettore dei ritardi
For k = 1 To UBound(aElencoRit)
' se il ritardo corrente supera il ritmax attuale..
If aElencoRit(k) > nRitMax Then
If nRitMax > 0 Then
' se il ritmax attuale è >0 (ivvero ne esiste uno)
' calcolo di quanto si è incrementato
nIncr = aElencoRit(k) - nRitMax
' incremento il contatore dei valori trovati
nId = nId + 1
' ridimensiono il vettore mantenendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aElencoIncrRitMax(nId)
' memorizzo il valore
aElencoIncrRitMax(nId) = nIncr
' ridimensiono il vettore mantnendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aIdEstrIncrRitMax(nId)
' memorizzo l'id dell'estrazione dove si è avuto l'incremento
aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
' ridimensiono il vettore mantnendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aRitardiAllIncremento(nId)
' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento
aRitardiAllIncremento(nId) = aElencoRit(k)
End If
nRitMax = aElencoRit(k)
End If
Next
mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
End Sub
Function IsCondizioneRispettata(nIdFiltro,nQIncr)
' verifica che l'incremento dell'ultimo ritmax sia uguale al massimo incr rit max conosciuto.
Dim nUpper
nUpper = UBound(aElencoIncrRitMax)
mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine And nUpper >= nQIncr Then
Select Case nIdFiltro
Case 0
IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto)
Case 1
IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto)
Case 2
IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto)
End Select
Else
IsCondizioneRispettata = False
End If
End Function
Sub DisegnaGraficoIncrRitMax
Dim x,y,k
Dim nValoreMaxX,nValoreMaxY,nValoreMinX
Dim nStepX,nStepY
Dim nUpperVetIncrRit
nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
nValoreMaxY = MassimoV(aElencoRit,1)
nStepX =(nValoreMaxX -(mInizio - 1)) \10
nStepY = nValoreMaxY \10
Call PreparaGrafico("Formaziione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
nUpperVetIncrRit = UBound(aElencoIncrRitMax)
' linea dell'incremento rit max
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aElencoIncrRitMax(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
' linea dell' rit max
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aRitardiAllIncremento(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
' scrive grafico nell'output
Call InserisciGrafico
End Sub
End Class
Sub Main
Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
Dim bOk,idFiltro,qIncr
sDir = GetDirectoryAppData & "ArchiviVirtuali\"
sFile = ScegliFileArchivioVirt(sDir)
If sFile <> "" Then
sFileCompleto = sDir & sFile & ".dat"
bOk = ApriFileBaseDati(sFileCompleto)
Else
bOk = True ' archivio normale
End If
If bOk Then
If ScegliRange(Inizio,Fine) Then
Sorte = ScegliEsito
Call ScegliRuote(aRuote,Nothing)
' decido il filtro in base al valore degli incrementi
idFiltro = GetIdFiltro
' decido di filtrare in base al numero degli incrementi
qIncr = GetQuantiIncrementi
If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 And idFiltro > - 1 Then
Call Scrivi("Archivio : " & Iif(sFile <> "",sFile,"Archivio lotto"))
Select Case ScegliTipoSviluppo
Case 1
Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
Case 2
Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
Case 3
Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
End Select
End If
End If
End If
End Sub
Function ScegliFileArchivioVirt(sDir)
Dim i
ReDim aFile(0)
Call ElencoFileInDirectory(sDir,aFile,".dat")
aFile(0) = "Archivio reale"
i = ScegliOpzioneMenu(aFile,0,"Scegli archivio virtuale")
If i > 0 Then
ScegliFileArchivioVirt = aFile(i)
Else
ScegliFileArchivioVirt = ""
End If
End Function
Function ScegliTipoSviluppo
ReDim aVoci(3)
aVoci(1) = "Da file txt con lunghette"
aVoci(2) = "Da sviluppo casuale"
aVoci(3) = "Da sviluppo tabellare"
ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1)
End Function
Function GetChrSepFromRiga(sRiga)
Dim k,schr
schr = ""
For k = 1 To Len(sRiga)
schr = Mid(sRiga,k,1)
If IsNumeric(schr) = False Then
Exit For
End If
Next
GetChrSepFromRiga = schr
End Function
Function GetIdFiltro
Dim aFiltro
aFiltro = Array("IncrRitMaxSto=UltimoIncrRitMax","IncrRitMaxSto<=UltimoIncrRitMax","IncrRitMaxSto>=UltimoIncrRitMax")
GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
End Function
Function GetQuantiIncrementi
GetQuantiIncrementi = CInt(InputBox("qIncr>=(NumeroIncrementiRitMaxFormazione)","Filtro Quantitaà Incrementi",5))
End Function
Sub AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
Dim sFile,aLunghette,nTotLunghette
Dim k,sChrSep
Dim clsL,collLunghette
Set collLunghette = GetNewCollection
sFile = ScegliFile(GetDirectoryAppData,".txt")
If FileEsistente(sFile) Then
Call LeggiRigheFileDiTesto(sFile,aLunghette)
nTotLunghette = UBound(aLunghette)
If nTotLunghette > 0 Then
sChrSep = GetChrSepFromRiga(aLunghette(1))
For k = 0 To nTotLunghette
Set clsL = New clsLunghetta
Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte)
If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
Call clsL.EseguiStatistica
collLunghette.Add clsL
End If
If k Mod 50 = 0 Then
Call Messaggio("Righe esaminate : " & k)
Call AvanzamentoElab(1,nTotLunghette,k)
If ScriptInterrotto Then Exit For
End If
Next
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
Call Scrivi("Numeri Formazione : " & clsL.sArrayNumeri)
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("strIncrementi : " & clsL.strIncRitMaxSto)
Call Scrivi("Numero Incrementi : " & clsL.iNumIncrementi)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette + 1
End If
End If
End If
End Sub
Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
Dim sFile,aLunghette,nTotLunghette,nClasse
Dim nTrov,nProdotte
Dim clsL,collLunghette
ReDim aSelNum(0)
Set collLunghette = GetNewCollection
nTotLunghette = Int(InputBox("Quante lunghette devono essere trovate ?",,10))
ScegliNumeri(aSelNum)
nClasse = Int(InputBox("Quanti numeri nella lunghetta",,Sorte))
If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then
nTrov = 0
nProdotte = 0
Do While nTrov < nTotLunghette
Set clsL = New clsLunghetta
ReDim aNum(nClasse)
Call GetColonnaCasuale(nClasse,aNum,aSelNum)
nProdotte = nProdotte + 1
Call clsL.Init(aNum,"",Inizio,Fine,aRuote,Sorte)
If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
Call clsL.EseguiStatistica
collLunghette.Add clsL
nTrov = nTrov + 1
End If
If nProdotte Mod 50 = 0 Then
Call Messaggio("combinazioni esaminate " & nProdotte & " valide " & nTrov)
Call DoEventsEx
If ScriptInterrotto Then Exit Do
End If
Loop
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
Call Scrivi("Numeri Formazione : " & clsL.sArrayNumeri)
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("strIncrementi : " & clsL.strIncRitMaxSto)
Call Scrivi("Numero Incrementi : " & clsL.iNumIncrementi)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette
End If
End If
End Sub
Sub AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
Dim nTotLunghette
Dim k,sChrSep,nClasse
ReDim aLunghette(0)
Dim clsL,collLunghette
Set collLunghette = GetNewCollection
sChrSep = " "
ScegliNumeri(aLunghette)
nClasse = CInt(InputBox(" classe sviluppo ",,2))
nTotLunghette = InitSviluppoIntegrale(aLunghette,nClasse)
k = 0
Do While GetCombSviluppo(aLunghette)
k = k + 1
Set clsL = New clsLunghetta
Call clsL.Init(aLunghette,sChrSep,Inizio,Fine,aRuote,Sorte)
If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
Call clsL.EseguiStatistica
collLunghette.Add clsL
End If
If k Mod 50 = 0 Then
Call Messaggio("Righe esaminate " & k & " valide " & collLunghette. count)
DoEventsEx
Call AvanzamentoElab(1,nTotLunghette,k)
If ScriptInterrotto Then Exit Do
End If
Loop
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
Call Scrivi("Numeri Formazione : " & clsL.sArrayNumeri)
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("strIncrementi : " & clsL.strIncRitMaxSto)
Call Scrivi("Numero Incrementi : " & clsL.iNumIncrementi)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette
End If
End Sub
Pensa a scriverlo con il cellulare;)
Clicca per espandere...

Pensare che prima lo facevi! :eek: . Di programmare con il cellulare intendo.. :) A me sembra impossibile ma tu ci riuscivi.... :eek: :D Bravissimo i legend! Comunque tornando al tuo ultimo gioiellino devo dire che è davvero eccezionale e fa davvero quasi tutto! :p ;) Il quasi è relativo solo a questa piccola differenza (tra l'altro da me non specificata chiaramente e data erroneamente e per distrazione come sottintesa) tra quanto da te magistralmente implementato e quanto io sono abituato a usare con la modalità random. Vengo a spiegarti a cosa mi riferisco:

Al momento se si sceglie modo casuale -> tabella -> ci viene chiesto quante colonne "valide" vogliamo che lo script trovi prima di fermarsi...

Mentre io nella modalità random ti chiederei di aggiungere se è possibile l'opzione cui sono più abituato che risponderebbe invece a quest altro tipo di domanda:

Quante colonne random vuoi che vengano elaborate?

Spero di essere stato un pò più chiaro e comunque se non lo sono stato non ti peritare nel farmi tutte le domande che vuoi e che ti necessitano ;)

GRAZIE ANCORA STUDENTE* PROGRAMMATORE "MAGO" i legend! :cool:
* Dell'Insuperabile LuigiB.
 
Ultima modifica:
Ciao tom deduco che il resto funzioni.
Allora secondo me colonna casuale se non metti l uscita va avanti .infatti con 90 numeri sviluppa più di 4005 ambi.
La cosa dura da digerire e devo vedere dove correggere i risultati ripetuti.
Voglio sviluppare i sistemi condizionati e ridotti.
Mi cimentero domenica :)aspettando il prof :)
 
Archivi virtuali(magari 10-15 minuti) sembra funzionare ma per i dati mi farebbe piacere avere conferma da Silop
=============================== [TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 832"]
[TR]
[TD]
LOGOSILOP.gif
[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD]Ciao i legend ,[/TD]
[/TR]
[TR]
[TD]ho avviato il tuo script va bene tutto, la lettura del range, degli archivi virtuali[/TD]
[/TR]
[TR]
[TD]ma manca l'aggiunta che avevo chiesto a LuigiB cioè di mettere vicino[/TD]
[/TR]
[TR]
[TD]ai numeri elaborati anche i futuri numeri da mettere in gioco[/TD]
[/TR]
[TR]
[TD]all'estrazione successiva quando si analizzano i 24 archivi virtuali.[/TD]
[/TR]
[TR]
[TD]======================== [/TD]
[/TR]
[TR]
[TD]In rosso ho messo l'aggiunta da fare con dati reali a quella estrazione.[/TD]
[/TR]
[TR]
[TD]Con inizio dalla 3950 del 14/09/1946 fino alla 9088 del 28/11/2015 totale estrazioni 5.139[/TD]
[/TR]
[TR]
[TD]ho elaborato sui sistemi D(90), D(01) e D(11) le 117.480 terzine x la sorte dell'ambo su TUTTE[/TD]
[/TR]
[TR]
[TD]di ogni sistema, per il momento la sola PRIMA CONDIZIONE ecco i report:[/TD]
[/TR]
[TR]
[TD]
stickman.gif
[/TD]
[/TR]
[TR]
[TD]i legend[/TD]
[/TR]
[TR]
[TD]1^opzione[/TD]
[/TR]
[TR]
[TD]Archivio : SVP D(90) ConFissi [3950]_P1[/TD]
[/TR]
[TR]
[TD]Range analisi : [00001] [ 37] 14.09.1946 - [05139] [143] 28.11.2015[/TD]
[/TR]
[TR]
[TD]Lunghette esaminate : 117479 Valide : 1[/TD]
[/TR]
[TR]
[TD]Sorte : Ambo[/TD]
[/TR]
[TR]
[TD]Ruote : TT[/TD]
[/TR]
[TR]
[TD]Numero Minimo IncrRit : 10[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD]Lunghette ordinate per incremento ritardo max[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD]Numeri Formazione : .17.24.27[/TD]
[/TR]
[TR]
[TD]Ritardo : 82[/TD]
[/TR]
[TR]
[TD]RitMax : 82[/TD]
[/TR]
[TR]
[TD]Freq : 354[/TD]
[/TR]
[TR]
[TD]IncrRitMx : 14[/TD]
[/TR]
[TR]
[TD]IncrRitMaxSto : 14[/TD]
[/TR]
[TR]
[TD]strIncrementi : 05.01.01.14.06.08.04.01.06.14[/TD]
[/TR]
[TR]
[TD]Numero Incrementi : 10[/TD]
[/TR]
[TR]
[TD]
stickman.gif
[/TD]
[/TR]
[TR]
[TD]i legend[/TD]
[/TR]
[TR]
[TD]1^opzione[/TD]
[/TR]
[TR]
[TD]Archivio : SVP D(1) ConFissi [3950]_P1[/TD]
[/TR]
[TR]
[TD]Range analisi : [00001] [ 37] 14.09.1946 - [05139] [143] 28.11.2015[/TD]
[/TR]
[TR]
[TD]Lunghette esaminate : 117479 Valide : 4[/TD]
[/TR]
[TR]
[TD]Sorte : Ambo[/TD]
[/TR]
[TR]
[TD]Ruote : TT[/TD]
[/TR]
[TR]
[TD]Numero Minimo IncrRit : 05[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD]Lunghette ordinate per incremento ritardo max[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD]NumeriV Formazione : .29.47.88 ______NumInGioco : 38.56.7[/TD]
[/TR]
[TR]
[TD]Ritardo : 113[/TD]
[/TR]
[TR]
[TD]RitMax : 113[/TD]
[/TR]
[TR]
[TD]Freq : 422[/TD]
[/TR]
[TR]
[TD]IncrRitMx : 38[/TD]
[/TR]
[TR]
[TD]IncrRitMaxSto : 38[/TD]
[/TR]
[TR]
[TD]strIncrementi : 08.38.07.18.38[/TD]
[/TR]
[TR]
[TD]Numero Incrementi : 5[/TD]
[/TR]
[TR]
[TD]NumeriV Formazione : .01.16.19_______NumInGioco : 10.25.28[/TD]
[/TR]
[TR]
[TD]Ritardo : 102[/TD]
[/TR]
[TR]
[TD]RitMax : 102[/TD]
[/TR]
[TR]
[TD]Freq : 364[/TD]
[/TR]
[TR]
[TD]IncrRitMx : 28[/TD]
[/TR]
[TR]
[TD]IncrRitMaxSto : 28[/TD]
[/TR]
[TR]
[TD]strIncrementi : 28.03.15.04.28[/TD]
[/TR]
[TR]
[TD]Numero Incrementi : 5[/TD]
[/TR]
[TR]
[TD]NumeriV Formazione : .18.28.35_____NumInGioco : 27.37.44[/TD]
[/TR]
[TR]
[TD]Ritardo : 82[/TD]
[/TR]
[TR]
[TD]RitMax : 82[/TD]
[/TR]
[TR]
[TD]Freq : 388[/TD]
[/TR]
[TR]
[TD]IncrRitMx : 18[/TD]
[/TR]
[TR]
[TD]IncrRitMaxSto : 18[/TD]
[/TR]
[TR]
[TD]strIncrementi : 04.01.18.05.03.18[/TD]
[/TR]
[TR]
[TD]Numero Incrementi : 6[/TD]
[/TR]
[TR]
[TD]NumeriV Formazione : .15.37.54____NumInGioco : 24.46.63[/TD]
[/TR]
[TR]
[TD]Ritardo : 78[/TD]
[/TR]
[TR]
[TD]RitMax : 78[/TD]
[/TR]
[TR]
[TD]Freq : 411[/TD]
[/TR]
[TR]
[TD]IncrRitMx : 17[/TD]
[/TR]
[TR]
[TD]IncrRitMaxSto : 17[/TD]
[/TR]
[TR]
[TD]strIncrementi : 17.13.02.04.17[/TD]
[/TR]
[TR]
[TD]Numero Incrementi : 5[/TD]
[/TR]
[TR]
[TD]
stickman.gif
[/TD]
[/TR]
[TR]
[TD]i legend[/TD]
[/TR]
[TR]
[TD]1^opzione[/TD]
[/TR]
[TR]
[TD]Archivio : SVP D(11) ConFissi [3950]_P1[/TD]
[/TR]
[TR]
[TD]Range analisi : [00001] [ 37] 14.09.1946 - [05139] [143] 28.11.2015[/TD]
[/TR]
[TR]
[TD]Lunghette esaminate : 117479 Valide : 4[/TD]
[/TR]
[TR]
[TD]Sorte : Ambo[/TD]
[/TR]
[TR]
[TD]Ruote : TT[/TD]
[/TR]
[TR]
[TD]Numero Minimo IncrRit : 05[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD]Lunghette ordinate per incremento ritardo max[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD]NumeriV Formazione : .36.60.70_____NumInGioco : 45.69.79[/TD]
[/TR]
[TR]
[TD]Ritardo : 128[/TD]
[/TR]
[TR]
[TD]RitMax : 128[/TD]
[/TR]
[TR]
[TD]Freq : 422[/TD]
[/TR]
[TR]
[TD]IncrRitMx : 25[/TD]
[/TR]
[TR]
[TD]IncrRitMaxSto : 25[/TD]
[/TR]
[TR]
[TD]strIncrementi : 24.05.14.25.18.25[/TD]
[/TR]
[TR]
[TD]Numero Incrementi : 6[/TD]
[/TR]
[TR]
[TD]NumeriV Formazione : .03.36.49_____NumInGioco : 12.45.58[/TD]
[/TR]
[TR]
[TD]Ritardo : 104[/TD]
[/TR]
[TR]
[TD]RitMax : 104[/TD]
[/TR]
[TR]
[TD]Freq : 370[/TD]
[/TR]
[TR]
[TD]IncrRitMx : 18[/TD]
[/TR]
[TR]
[TD]IncrRitMaxSto : 18[/TD]
[/TR]
[TR]
[TD]strIncrementi : 14.03.07.18.07.18[/TD]
[/TR]
[TR]
[TD]Numero Incrementi : 6[/TD]
[/TR]
[TR]
[TD]NumeriV Formazione : .17.38.48_____NumInGioco : 26.47.57[/TD]
[/TR]
[TR]
[TD]Ritardo : 82[/TD]
[/TR]
[TR]
[TD]RitMax : 82[/TD]
[/TR]
[TR]
[TD]Freq : 391[/TD]
[/TR]
[TR]
[TD]IncrRitMx : 13[/TD]
[/TR]
[TR]
[TD]IncrRitMaxSto : 13[/TD]
[/TR]
[TR]
[TD]strIncrementi : 07.04.03.01.01.08.13.05.06.05.12.13[/TD]
[/TR]
[TR]
[TD]Numero Incrementi : 12[/TD]
[/TR]
[TR]
[TD]NumeriV Formazione : .16.36.70_____NumInGioco : 25.26.38[/TD]
[/TR]
[TR]
[TD]Ritardo : 58[/TD]
[/TR]
[TR]
[TD]RitMax : 58[/TD]
[/TR]
[TR]
[TD]Freq : 451[/TD]
[/TR]
[TR]
[TD]IncrRitMx : 7[/TD]
[/TR]
[TR]
[TD]IncrRitMaxSto : 7[/TD]
[/TR]
[TR]
[TD]strIncrementi : 04.03.02.07.05.07[/TD]
[/TR]
[TR]
[TD]Numero Incrementi : 6[/TD]
[/TR]
[TR]
[TD]
stickman.gif
[/TD]
[/TR]
[TR]
[TD]In questa riga per il sistema D(11) :[/TD]
[/TR]
[TR]
[TD]Lunghette esaminate : 117479 Valide : 4[/TD]
[/TR]
[TR]
[TD]dovrebbe riportare il totale delle combinazioni esaminate (117.480) e no 117479[/TD]
[/TR]
[TR]
[TD]combinazioni presenti (59)[/TD]
[/TR]
[TR]
[TD]combinazioni valide (4)[/TD]
[/TR]
[TR]
[TD]======================== [/TD]
[/TR]
[TR]
[TD]le medesime devono essere aggiunte anche per tutti gli altri sistemi, grazie.[/TD]
[/TR]
[TR]
[TD]======================== [/TD]
[/TR]
[TR]
[TD]Ringrazio i legend per l'impegno e per i bellissimi script che ci sta "regalando" insieme a LuigiB.[/TD]
[/TR]
[TR]
[TD]======================== [/TD]
[/TR]
[TR]
[TD]
stickman.gif
[/TD]
[/TR]
[TR]
[TD]Buona notte a tutti.[/TD]
[/TR]
[TR]
[TD]A presto [/TD]
[/TR]
[TR]
[TD]Silop ;) ;) ;)[/TD]
[/TR]
[/TABLE]
 
allora Legend visto che oggi lavori tutto il giorno coglierò l'occasione per lasciarti gli input che t i consentiranno di continuare a lavaroare anche quando tornerai questa sera ..eheh come vedi siamo molto umani .-)
A parte gli scherzi ..

Problema 1
avere solo colonne univoche nello sviluppo casuale

Per risolvere questo problema sfrutteremo una caratteristica delle collection,
Le collection possono contenere (eventualmente) solo valori univoci

abbiamo visto che le collection sono come delle scatole che possono contenere oggetti
infatti nello script nella collLunghette noi aggiungiamo un 'istanza della nostra clsLunghetta
e alla fine ci ritroviamo con la collection che contiene tutte le lunghette che rispetttavano le condizioni che volevamo

ad ognuno di questi oggetti presenti nella collection è anche possibile assegnare una chiave (nel nostro caso non lo abbiamo fatto) , tale chiave si passa durante il metodo Add
se ad ogni oggetto si assegna una chiave affinche il metodo Add vada bene è necessario che tale chiave sia univoca senno il metoto add andra in errore.
E' proprio gestendo questo errore che possiamo ottenere quanto voluto.

come vedi quando usiamo il metodo Add facciamo cosi




per passare una chiave che identifichi l'oggetto la sintassi sarebeb questa

Codice: 
collLunghette.Add clsL , sKey

dove sKey è la famosa chiave che noi pero non abbiamo .. ma la possiamo creare , dato che ci interessa creare una chiave univoca dobbiamo costruire la chiave con i numeri della lunghetta
a tali numeri corrisponderà automaticamente la stessa chiave sicche due chiavi uguali non potranno esistere in quanto come detto il metodo Add andrebbe in errore.
Per avere la chiave potremmo usare la proprietà sArrayNumeri che hai creato tu (forse non ti eri accorto che gia esisteva fatta da me e si chiamava LunghettaString fanno la stessa cosa una delle due va levata n.d.p. ) dato che le chiavi devono iniziare con una lettera per passare la chiave
durante il metodo add potremmo fare cosi

Codice: 
collLunghette.Add clsL , "k" &  clsL.LunghettaString

in pratica mettiamo sempre un k davanti (potevamo mettere qaulsiasi lettera)

ora facendo questa modifica è sicuro che la collection non accetterà due oggetti con la stessa chiave e ahime quando capita questa circostanza ti andrà in errore facendo bloccare lo script ..
come fare ? lo vedremo nella prossima puntata... tu intanto fai questa piccola modifica lancia lo script e vedi se l'errore capita , (lo scriopt non lo pubblicare serve solo a te per vedere)


Problema 2
avere i numeri reali chiesti da silop

C'è una funzione apposita che converte i numeri virtuali degli archivi paralleli nel rispettivo numero reale quindi va creata una nuova funzione o proprietà nella classe che ci faccia tornare la stringa dei numeri reali convertendo in modo opportuno i numeri presenti nell'array della lunghetta aNumeri.
la funzione da usare è NumVirtToNumReale , ti scorri l'array dei numeri e ad ogni numero usi questa funzione costruendo cosi la stringa dei numeri reali che serve


ciao
 
Ciao a tutti :)
Piccola pausa, vi leggo con piacere.
Ok a tutto:)
Questa sera appena arrivo a casa; subito dopo la doccia, la cena , almeno una mezz'ora di pisolino, uno zapping veloce , magari fanno qualcosa di interessante:), proprio subitissimo mi metto a fare le nuove funxioni:)
Scherzo se riesco dopo cena mi cimento .....
A stasera Buon week end a tutti :)
 
Ciao
Allora fatto il punto 1 si blocca lo script
Il punto 2 non ho trovato esempi.
Il mio cruccio è l ultimo parametro come faccio a prenderlo senza incasinare lo script.
Nella cartella archivi virtuali ho ordinato i file per .dat ho sbagliato?
Cmq stasera sono a pezzi!
Io direi di risolvere un problema alla volta.
Decidi tu quale vuoi implementare.
Partiamo dalla colonna casuale o dai sistemi virtuali?
Adomani notte a tutti:)
 
ciao legend .. buona notte .. il giusto riposo ... vedrai sono problemi banali ..
 
Ultima modifica di un moderatore:
Buon giorno legend .. sei pronto per la lezione domenicale ? Spero di si :-)
iniziamo col problemino delle colonne univoche.
Mi hai detto che hai fatto l'implementazione c he ti avevo suggerito e quindi ora ti capita proprio l'errore che avevamo anticipato e cioè quando si tenta di inserire un oggetto con la stessa chiave in una collection il metodo Add da errore.
Avevamo anticipato che prroprio gestendo questo errore potevamo ottenere il nostro scopo.
Benissimo !
In vb scrip la gestionedegli errori di runtime è davvero molto scarna c'è ben poco da ricordarsi e c'è una sola istruzione che serve per intercettare l'errore e non far bloccare il codice.
Tale istruzione è la seguente

Codice: 
on error resume next


nella routine dove è presente questa istruzione appena l'interprete che esegue il codice si rende conto di un errore di runtime invece di far bloccare il programma fa una bella cosa : passa all'istruzione successiva a quella che ha causato l'errore coem dice la parola stessa "resume next"

quello che dobbiamo fare noi è isolare il possibile errore intercettarlo e far proseguire lo script.
come si fa per isolarlo ? semplice si crea una routine apposta che esegua solo l'istruzione di ADD
e in questa routine la prima istuzione sarà proprio on error resume next.

quindi attualmente noi abbiamo

Codice: 
collLunghette.add clsLunghetta , sKey

dobbiamo invece fare cosi

Codice: 
call AddLunghetta (collLunghette , clsL)

quindi a te tocca scrivere questa breve routine AddLunghetta nella quale per prima cosa ci sarà l'istruzione per intercettare l'errore e poi il normale codice che attraverso il metodo add aggiunge l'oggetto nella collection.

molto semplice ci vuole piu a spegarlo che a farlo ... vai ...
 
Ultima modifica di un moderatore:
ho scritto la funzione fuori dalla classe
anche se immagino che sKey andrebbe scritta dentro.
il problema persiste ossia non è risolto.
se faccio lo sviluppo integrale sviluppo 4005 ambi e trovo tutto
se lancio Random sviluppo molti piu combinazioni e non riesco ad estrapolare tutti i dati.
cmq qui il code:
Codice: 
Option Explicit
Class clsLunghetta
    Private aNumeri ' contiene i numeri della lunghetta
    Private mInizio,mFine,aRuote,mSorte ' parametri per il range analisi
    Private mClasse ' contine la classe della lunghetta
    Private aElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aIdEstrElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aElencoIncrRitMax ' contiene l'elnco degli incrementi del ritardo max
    Private aIdEstrIncrRitMax ' conterra l'elenco degli id estrazione in
    ' cui si è registrato l'incremento del ritmax conosciuto
    Private aRitardiAllIncremento ' contiene il valore del ritardo all'idestrazione in cui
    ' si è verificato l'incremento
    Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza ' valori statistici
    Private mIncrRitardoMaxSto,mStrIncRitSto
        Public Property Get iNumIncrementi
        iNumIncrementi = UBound(aElencoIncrRitMax)
    End Property
    Public Property Get IncrRitMaxSto
        IncrRitMaxSto = mIncrRitardoMaxSto
    End Property
    Public Property Get strIncRitMaxSto
        strIncRitMaxSto = mStrIncRitSto
    End Property
    Public Property Get Ritardo
        Ritardo = mRitardo
    End Property
    Public Property Get RitardoMax
        RitardoMax = mRitardoMax
    End Property
    Public Property Get IncrRitMax
        IncrRitMax = mIncrRitMax
    End Property
    Public Property Get Frequenza
        Frequenza = mFrequenza
    End Property
    Public Property Get LunghettaString
        LunghettaString = StringaNumeri(aNumeri)
    End Property
    ' inizializza le proprietà dell'oggetto
    Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco)
        ' acquisisco i parametri per l'analisi
        mInizio = RangeInizio
        mFine = RangeFine
        aRuote = vetRuote
        mSorte = SorteInGioco
        ' alimento il vettore con i numeri della lunghetta
        Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        ' calcolo l'elenco dei ritardi
        Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
        ' alimento il vettore che contien l'elenco degli incrementi rit max
        Call AlimentaVettoreIncrRitMax
    End Sub
    ' esegue il calcolo dei valori statistici della lunghetta
    Sub EseguiStatistica
        Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
    End Sub
    Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        Dim k
        If IsArray(sLunghetta) Then
            ' se la lunghetta è gia un array lo copio nel vettore locale dei numeri
            ReDim aNumeri(UBound(sLunghetta))
            For k = 1 To UBound(sLunghetta)
                aNumeri(k) = sLunghetta(k)
            Next
        Else
            ' antepongo un carattere separatore per fare in modo che
            ' aNumeri si valorizzi dall'indice 1 (senno si sarebeb valorizzato dall'indice 0)
            Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
        End If
        ' valorizzo la classe della lunghetta
        mClasse = UBound(aNumeri)
    End Sub
    Private Sub AlimentaVettoreIncrRitMax
        Dim nRitMax,nIncr,nId,k
        nId = 0
        ' inizializzo il vettore a 0 elementi
        ReDim aElencoIncrRitMax(0)
        ReDim aIdEstrIncrRitMax(0)
        ReDim aRitardiAllIncremento(0)
        ' ciclo sul vettore dei ritardi
        For k = 1 To UBound(aElencoRit)
            ' se il ritardo corrente supera il ritmax attuale..
            If aElencoRit(k) > nRitMax Then
                If nRitMax > 0 Then
                    ' se il ritmax attuale è >0 (ivvero ne esiste uno)
                    ' calcolo di quanto si è incrementato
                    nIncr = aElencoRit(k) - nRitMax
                    ' incremento il contatore dei valori trovati
                    nId = nId + 1
                    ' ridimensiono il vettore mantenendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aElencoIncrRitMax(nId)
                    ' memorizzo il valore
                    aElencoIncrRitMax(nId) = nIncr
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aIdEstrIncrRitMax(nId)
                    ' memorizzo l'id dell'estrazione dove si è avuto l'incremento
                    aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aRitardiAllIncremento(nId)
                    ' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento
                    aRitardiAllIncremento(nId) = aElencoRit(k)
                End If
                nRitMax = aElencoRit(k)
            End If
        Next
        mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
    End Sub
    Function IsCondizioneRispettata(nIdFiltro,nQIncr)
        ' verifica che l'incremento dell'ultimo ritmax sia uguale al massimo incr rit max conosciuto.
        Dim nUpper
        nUpper = UBound(aElencoIncrRitMax)
        mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
        If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine And nUpper >= nQIncr Then
            Select Case nIdFiltro
            Case 0
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto)
            Case 1
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto)
            Case 2
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto)
            End Select
        Else
            IsCondizioneRispettata = False
        End If
    End Function
    Sub DisegnaGraficoIncrRitMax
        Dim x,y,k
        Dim nValoreMaxX,nValoreMaxY,nValoreMinX
        Dim nStepX,nStepY
        Dim nUpperVetIncrRit
        nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
        nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
        nValoreMaxY = MassimoV(aElencoRit,1)
        nStepX =(nValoreMaxX -(mInizio - 1)) \10
        nStepY = nValoreMaxY \10
        Call PreparaGrafico("Formaziione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
        nUpperVetIncrRit = UBound(aElencoIncrRitMax)
        ' linea dell'incremento rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aElencoIncrRitMax(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
        ' linea dell' rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aRitardiAllIncremento(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
        ' scrive grafico nell'output
        Call InserisciGrafico
    End Sub
    
End Class
Sub Main
    Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
    Dim bOk,idFiltro,qIncr
    sDir = GetDirectoryAppData & "ArchiviVirtuali\"
    sFile = ScegliFileArchivioVirt(sDir)
    If sFile <> "" Then
        sFileCompleto = sDir & sFile & ".dat"
        bOk = ApriFileBaseDati(sFileCompleto)
    Else
        bOk = True ' archivio normale
    End If
    If bOk Then
        If ScegliRange(Inizio,Fine) Then
            Sorte = ScegliEsito
            Call ScegliRuote(aRuote,Nothing)
            ' decido il filtro in base al valore degli incrementi
            idFiltro = GetIdFiltro
            ' decido di filtrare in base al numero degli incrementi
            qIncr = GetQuantiIncrementi
            If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 And idFiltro > - 1 Then
                Call Scrivi("Archivio : " & Iif(sFile <> "",sFile,"Archivio lotto"))
                Select Case ScegliTipoSviluppo
                Case 1
                    Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
                Case 2
                    Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
                Case 3
                    Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
                End Select
            End If
        End If
    End If
End Sub
Function ScegliFileArchivioVirt(sDir)
    Dim i
    ReDim aFile(0)
    Call ElencoFileInDirectory(sDir,aFile,".dat")
    aFile(0) = "Archivio reale"
    i = ScegliOpzioneMenu(aFile,0,"Scegli archivio virtuale")
    If i > 0 Then
        ScegliFileArchivioVirt = aFile(i)
    Else
        ScegliFileArchivioVirt = ""
    End If
End Function
Function ScegliTipoSviluppo
    ReDim aVoci(3)
    aVoci(1) = "Da file txt con lunghette"
    aVoci(2) = "Da sviluppo casuale"
    aVoci(3) = "Da sviluppo tabellare"
    ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1)
End Function
Function GetChrSepFromRiga(sRiga)
    Dim k,schr
    schr = ""
    For k = 1 To Len(sRiga)
        schr = Mid(sRiga,k,1)
        If IsNumeric(schr) = False Then
            Exit For
        End If
    Next
    GetChrSepFromRiga = schr
End Function
Function GetIdFiltro
    Dim aFiltro
    aFiltro = Array("IncrRitMaxSto=UltimoIncrRitMax","IncrRitMaxSto<=UltimoIncrRitMax","IncrRitMaxSto>=UltimoIncrRitMax")
    GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
End Function
Function GetQuantiIncrementi
    GetQuantiIncrementi = CInt(InputBox("qIncr>=(NumeroIncrementiRitMaxFormazione)","Filtro Quantitaà Incrementi",5))
End Function
' Questa è la nuova routine che impedisce di scrivere i doppi
' ma non mpedisce di incrementare nTrov
Sub AddLunghetta(collLunghette,clsL)
On Error Resume Next
collLunghette.Add clsL ,"k"&clsL.LunghettaString
End Sub


Sub AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
    Dim sFile,aLunghette,nTotLunghette
    Dim k,sChrSep
    Dim clsL,collLunghette
    Set collLunghette = GetNewCollection
    sFile = ScegliFile(GetDirectoryAppData,".txt")
    If FileEsistente(sFile) Then
        Call LeggiRigheFileDiTesto(sFile,aLunghette)
        nTotLunghette = UBound(aLunghette)
        If nTotLunghette > 0 Then
            sChrSep = GetChrSepFromRiga(aLunghette(1))
            For k = 0 To nTotLunghette
                Set clsL = New clsLunghetta
                Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte)
                If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                    Call clsL.EseguiStatistica
                    collLunghette.Add clsL
                End If
                If k Mod 50 = 0 Then
                    Call Messaggio("Righe esaminate : " & k)
                    Call AvanzamentoElab(1,nTotLunghette,k)
                    If ScriptInterrotto Then Exit For
                End If
            Next
            Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
            Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
            Scrivi "Sorte                 : " & NomeSorte(Sorte)
            Scrivi "Ruote                 : " & StringaRuote(aRuote)
            Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
            Scrivi
            Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
            Call Scrivi
            If collLunghette.count > 0 Then
                Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
                For Each clsL In collLunghette
                    Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                    Call Scrivi("Ritardo               : " & clsL.Ritardo)
                    Call Scrivi("RitMax                : " & clsL.RitardoMax)
                    Call Scrivi("Freq                  : " & clsL.Frequenza)
                    Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                    Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                    Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                    Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                    Call clsL.DisegnaGraficoIncrRitMax
                Next
            Else
                Scrivi "Nessuna lunghetta rispetta le condizioni"
                Scrivi "Lunghette esaminate " & nTotLunghette + 1
            End If
        End If
    End If
End Sub
Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
    Dim sFile,aLunghette,nTotLunghette,nClasse
    Dim nTrov,nProdotte
    Dim clsL,collLunghette
    ReDim aSelNum(0)
    Set collLunghette = GetNewCollection
    nTotLunghette = Int(InputBox("Quante lunghette devono essere trovate ?",,10))
    ScegliNumeri(aSelNum)
    nClasse = Int(InputBox("Quanti numeri nella lunghetta",,Sorte))
    If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then
        nTrov = 0
        nProdotte = 0
        Do While nTrov <= nTotLunghette
            Set clsL = New clsLunghetta
            ReDim aNum(nClasse)
            Call GetColonnaCasuale(nClasse,aNum,aSelNum)
            nProdotte = nProdotte + 1
            Call clsL.Init(aNum,"",Inizio,Fine,aRuote,Sorte)
            If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                Call clsL.EseguiStatistica
                
             Call AddLunghetta(collLunghette,clsL)
                nTrov = nTrov + 1
                
            End If
            If nProdotte Mod 50 = 0 Then
                Call Messaggio("combinazioni esaminate " & nProdotte & " valide " & nTrov)
                Call DoEventsEx
                If ScriptInterrotto Then Exit Do
            End If
        Loop
        Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
        Scrivi "Lunghette esaminate   : " & nProdotte & " Valide : " & collLunghette.count
        Scrivi "Sorte                 : " & NomeSorte(Sorte)
        Scrivi "Ruote                 : " & StringaRuote(aRuote)
        Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
        Scrivi
        Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
        Call Scrivi
        If collLunghette.count > 0 Then
            Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
            For Each clsL In collLunghette
                Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                Call Scrivi("Ritardo               : " & clsL.Ritardo)
                Call Scrivi("RitMax                : " & clsL.RitardoMax)
                Call Scrivi("Freq                  : " & clsL.Frequenza)
                Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                Call clsL.DisegnaGraficoIncrRitMax
            Next
        Else
            Scrivi "Nessuna lunghetta rispetta le condizioni"
            Scrivi "Lunghette esaminate " & nTotLunghette
        End If
    End If
End Sub
Sub AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr)
    Dim nTotLunghette
    Dim k,sChrSep,nClasse
    ReDim aLunghette(0)
    Dim clsL,collLunghette
    Set collLunghette = GetNewCollection
    sChrSep = " "
    ScegliNumeri(aLunghette)
    nClasse = CInt(InputBox(" classe sviluppo ",,2))
    nTotLunghette = InitSviluppoIntegrale(aLunghette,nClasse)
    k = 0
    Do While GetCombSviluppo(aLunghette)
        k = k + 1
        Set clsL = New clsLunghetta
        Call clsL.Init(aLunghette,sChrSep,Inizio,Fine,aRuote,Sorte)
        If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
            Call clsL.EseguiStatistica
            collLunghette.Add clsL
        End If
        If k Mod 50 = 0 Then
            Call Messaggio("Righe esaminate " & k & "  valide " & collLunghette. count)
            DoEventsEx
            Call AvanzamentoElab(1,nTotLunghette,k)
            If ScriptInterrotto Then Exit Do
        End If
    Loop
    Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
    Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
    Scrivi "Sorte                 : " & NomeSorte(Sorte)
    Scrivi "Ruote                 : " & StringaRuote(aRuote)
    Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
    Scrivi
    Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
    Call Scrivi
    If collLunghette.count > 0 Then
        Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
        For Each clsL In collLunghette
            Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
            Call Scrivi("Ritardo               : " & clsL.Ritardo)
            Call Scrivi("RitMax                : " & clsL.RitardoMax)
            Call Scrivi("Freq                  : " & clsL.Frequenza)
            Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
            Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
            Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
            Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
            Call clsL.DisegnaGraficoIncrRitMax
        Next
    Else
        Scrivi "Nessuna lunghetta rispetta le condizioni"
        Scrivi "Lunghette esaminate " & nTotLunghette
    End If
End Sub
a dopo spero di eseermi spiegato
ho lanciato Archivioreale
tutte le estrazioni
Milano
esito.1
Combinazione 2
IncRitmaxSto<=UltimoIncremento
sia con sviluppocasuale e tabellare
 
in realta le combinazoni sono univoche è il contatore che conta lo stesso anche quando la colonna duplicata non è inserita..

attualmente hai

Call AddLunghetta(collLunghette,clsL)
nTrov = nTrov + 1

invece si puo fare in due modi
il primo semplicissimo

ntrov = colllunghette.count

l'altro prevede di modificare la sub appena scritta in una function che torni true se non è capitato l'errore.
per farlo al termine dopo la chiamata al metodo add si testa la variabile Err che è fornita direttamente dal vbscript , se err è =0 non c'è errore e la funzione torna true se è diverso da 0 oltre a tornare false deve anche pulire l'errore col metodo err.clear
se torna tru allora si incrementa nTrov
 
Ultima modifica di un moderatore:
Ok fatta la prima correzione.
Più semplice meno codice.
Cmq tenterò di implementare anche il codice err.
Intanto proporrei di accontentare il buon silop sempre disponibile con tutti:)
Silop ma a casa hai una biblioteca sul lotto?
Ciao buon pranzo a tutti:)
P.s scritta anche la funzione con err.
Che faccio posto il codice o aspettiamo le ultime implementazioni?
 
Ultima modifica:
Codice: 
Function  AddLunghetta (collLunghette, clsL )
On Error resume Next
CollLunghette. Add clsL, "k" & clsL. LunghettaString 
If Err =0 then 
AddLunghetta = true
Else 
AddLunghetta =False 
End  If 
Err.Clear
End function 

If AddLunghetta  ( collLunghette, clsL ) Then  nTrov = nTrov + 1
Questo il particolare tutto lo script in finale?

Ho visto che molti software per interfaccia usano la ribbon non solo excel e sono bellissimi,
Hai mai costruito un software così?
L aspetto plastico di alcuni software a cosa è dovuto?
Anche excel 2007 sembra diverso dalla ultimo eppure entrambi hanno la ribbon:) e una struttura simile:)
Sono curiiso:(


Scusa luigi secondo un software di pulizia spaziometria pesa 22 mb.
Ho fatto un installazione parziale?
 
Ultima modifica:
si tratta di componenti che non hanno niente a che vedere con gli script o con il vb6 , ci sono software house che creano componenti invece di programmi uno li compra e poi li puo usare nei suoi software in fnzione del suo ambiente di sviluppo..passiamo alla soluzione del problema di silop

ti avevo anticipato che bisogna usare la funzione NumVirtualeToNumReale

Codice: 
NumVirtToNumReale ( NumVirt ,bPrimaEstrFissa  ,idEstr , Dist)

NumVirt è il numero virtuale cioè uno dei numeri presenti in aNumeri
bPrimaEstrFissa puo valere True o False il suo valore dipende dall'archivio selezionato
idEstr ' è lestrazione alla quale si riferisce la statistica
Dist è la distanza del sistema virtuale e dipende dal file selezionato.

ora bisogna vedere come passare i parametri a questa funzione

per i numeri li leggiamo dall'array aNumeri non ci dovrebbero essere problemi

bPrimaEstrFissa ci memorizziamo in una variabile il valore true o false in funzione del file selezionato.
se il file selezionato contiene la stringa ConFissi gli diamo true senno gli diamo false

idEstr ' è lestrazione alla quale si riferiscono i numeri virtuali

dist è la distanza e la leggiamo dal nome del file selezionato ,avrai fatto caso che i nomi dei file degli archivi hanno un particolare formato ognuno di loro contiene D(x) dove x è la distanza quindi ci basta scrivere una funzione che estragga il contenuto di una stringa separata da due caratteri separatori noti.

quindi nella sub main aggiungiamo le seguenti variabili

bPrimaEstrFissa , nDistanza

nel caso in cui sFile sia diverso da "" le valorizziamo con i goiusti valori , infatti per averle bisogna che l'utente abbia selezionato uno degli archivi virtuali e se ne ha selezionato uno che non sia l d90 sFile sarà proprio diverso da "" , al contrario le valorizzeremo con False e 0



Codice: 
 If sFile <> "" Then
        sFileCompleto = sDir & sFile & ".dat"
        bOk = ApriFileBaseDati(sFileCompleto)
    Else
        bOk = True ' archivio normale
    End If

quindi prima di fare queste implementazioni dovrai scrivere una funzione di utility
io ti do questo script

Codice: 
Option Explicit
Sub Main
    Dim sTesto,sValue
    
    sTesto = "SVP D(17) ConFissi [9000].dat"
    
    sValue = GetValoreFraSeparatori(sTesto,"(",")")
    Call Scrivi(sValue)
End Sub

e tu devi scrivere la funzione GetValoreFraSeparatori .. deve scrivere 17 ... vai procedi

si usa instr , e mid .. credo tu le conosca gia
 
Ultima modifica di un moderatore:
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    venerdì 22 novembre 2024
    Bari
    27
    45
    81
    17
    55
    Cagliari
    78
    66
    45
    03
    14
    Firenze
    14
    90
    72
    88
    55
    Genova
    33
    23
    82
    81
    24
    Milano
    25
    79
    13
    42
    15
    Napoli
    39
    35
    65
    01
    14
    Palermo
    25
    83
    69
    50
    36
    Roma
    25
    71
    22
    10
    55
    Torino
    59
    30
    43
    74
    49
    Venezia
    39
    90
    77
    05
    35
    Nazionale
    82
    60
    62
    65
    59
    Estrazione Simbolotto
    Torino
    44
    12
    32
    06
    13
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto