tom's bakery

[lotto_tom75]

tom's bakery ovvero la pasticceria di tom

Qui chi vorrà potrà provare a richiedere uno script per una sua esigenza particolare e se riuscirò a trovarlo tra i miei migliaia di script salvati, modificati, potenziati, creati e/o a realizzarlo x novo da zero sarò ben lieto di condividerlo in questo spazio dedicato senza alcuna pretesa nè di qualità, nè di funzionalità nè soprattutto di resa in termini di output vincenti.

Ogni tanto forse, tipo una sorta di backup online, condividerò comunque qualche script a caso anche senza rispettiva eventuale richiesta e in ogni caso proverò ad aggiungervi per ognuno una descrizione abbastanza dettagliata su cosa fa e una breve legenda riguardo le righe di codice necessarie a personalizzarlo secondo le proprie eventuali esigenze elaborazionali. Ove sarà possibile capirlo ovviamente metterò anche il nick del relativo scripter che lo ha creato e ognuno comunque potrà verificare se si tratta di una sua creazione o meno e aggiungervi tale nota e/o richiederne la rimozione. Talvolta la spiegazione di come si utilizza e/o modifica un determinato script potrebbe essere data anche a voce da uno dei miei molti avatar 2d e 3d multi language

Un saluto a tutti e good luck da tom con un vecchio pc oggi potenziato a 6 gb di ram e sistema operativo 64bit super "frizzante"

Fino ad ora infatti elaboravo tutto molto + lentamente con un 32 bit e 3 gb di ram scarsi...

​

 

[lotto_tom75]

Grazie per i like e gli smiles friends

script n. 1 : filtro random per superenalotto by me

Breve spiegazione: così settato lo script estrapola e visualizza in output la formazione che nel range di estrazioni superenalotto volute ha rispettato il filtro x differenza (RS-RA=0) e incmax=0 e nel contempo filtra anche quella con ra maggiore indicando se vi sono o meno altre risultanze con ra massimi del tutto uguali.

Sub Main
   Dim QuantitaNumeriScelti
   Dim sorte
   Dim ritardo,ritardomax,Incrritmax,frequenza,Inizio,fine
   Dim diff
   Dim valoreInizioelaborazione
   Dim valorefineelaborazione
   ReDim anum(0)
   Dim Classe
   ReDim aRetCol(0)
   Dim numerorisultanze
   numerorisultanze = 0
   Dim estr,Ini,fin,Tot
   Classe = CInt(InputBox("classe",,20))
   sorte = CInt(InputBox("sorte",,2))
   estr = InputBox("Quante estrazioni Analizzo",,9)
   fin = EstrazioniArchivioSE
   Ini = fin - estr
   Tot = fin - Ini '+ 1
   Dim ramaggiore
   ramaggiore = 0
   Dim FormazioneSErispettanteilfiltroeconramaggiore
   Dim dettagliparametriciformazioneSEeconramaggiore
   Dim numerorisultanzeconramaxidentico
   numerorisultanzeconramaxidentico = 0
   'by tom's bakery :)
   Scrivi "Filtro Random per Punti Voluti x Superenalotto in Periodi Temporali Prestabiliti"
   Scrivi
   Scrivi "Range Inizio  : " & DataEstrazioneSE(Ini)
   Scrivi "Range Fine    : " & DataEstrazioneSE(fin)
   Scrivi "Totali Estraz.: " & Tot
   Scrivi
   Scrivi "Classe esaminata: " & Classe
   Scrivi "Punti ricercati: " & sorte
   Call Scrivi("                                                             ")
   Call Scrivi("Id estrazione inizio analisi per superenalotto" & " " & Ini)
   Call Scrivi("Id estrazione fine analisi per superenalotto" & " " & fin)
   Call Scrivi("                                                             ")
   Call Scrivi("                                                             ")
   QuantitaNumeriScelti = ScegliNumeri(anum)
   valoreInizioelaborazione = 1
   valorefineelaborazione = 100000
   For k = valoreInizioelaborazione To valorefineelaborazione
      Call GetColonnaCasuale(Classe,aRetCol,anum)
      'Call Scrivi(StringaNumeri(aRetCol,,True))
      'sorte = 1
      Call StatisticaFormazioneSE(aRetCol,sorte,ritardo,ritardomax,Incrritmax,frequenza,Ini,fin)
      diff = ritardomax - ritardo
      'If(ritardo = 0 And ritardomax = 0) Then 'And diff=0) Then
      'If(ritardo >= 0) Then
      If diff = 0 And Incrritmax = 0 Then
         Call Scrivi(" Colonna: " & k & " " & StringaNumeri(aRetCol,,True) & " RA " & ritardo & " RS " & ritardomax & " INCMAX " & Incrritmax & " FQ " & frequenza & " diff " & diff & " risultanza n. " & numerorisultanze)
         numerorisultanze = numerorisultanze + 1
         If ritardo > ramaggiore Then
            ramaggiore = ritardo
            FormazioneSErispettanteilfiltroeconramaggiore = StringaNumeri(aRetCol)
            dettagliparametriciformazioneSEeconramaggiore = " RA " & ritardo & " RS " & ritardomax & " INCMAX " & Incrritmax & " FQ " & frequenza & " diff " & diff
            numerorisultanzeconramaxidentico = 0
         End If
         ' End If
         'Else
         If ritardo = ramaggiore Then
            numerorisultanzeconramaxidentico = numerorisultanzeconramaxidentico + 1
         End If
      End If
      Call AvanzamentoElab(valoreInizioelaborazione,valorefineelaborazione,k)
      Call Messaggio("numero risultanze trovate: " & numerorisultanze & " num. ra max identici: " & numerorisultanzeconramaxidentico)
      If ScriptInterrotto Then Exit For
   Next
   If numerorisultanze = 0 Then
      Scrivi "nessuna risultanza trovata :("
   End If
   Scrivi
   Scrivi "Formazione SE Top rispettante il filtro e con ra maggiore " & FormazioneSErispettanteilfiltroeconramaggiore
   Scrivi "Dettagli parametrici della formazione scelta ed estrapolata " & dettagliparametriciformazioneSEeconramaggiore
   Scrivi "Numero ra max identici " & numerorisultanzeconramaxidentico
End Sub

Ovviamente anche la riga filtro

      If diff = 0 And Incrritmax = 0 Then

è customizzabile come uno preferisce...

Relativa spiegazione a voce by avatar 2d/3d In base al pubblico è possibile volendo anche tradurla in run time in quasi tutte le lingue

 

[honeybee]

bravo lotto tom grazie
piccolo contributo di pasticceria virtuale

 

[*blacklotto*]

Interessante la tua disponibilità, e se mi permetti una richiesta l'avrei.

Mi sarebbe d'aiuto un listato che possa inserire le estrazioni, in modo che possa mettere a video i numeri delle cadenze, oppure delle decine da me richieste, magari in rosso, mentre dove ci sarebbero stati gli altri numeri ci fosse soltanto dei trattini neri.
Però, questi numeri ricercati, delle decine o cadenze, dovranno appartenere solo alle ruote richieste.

Grazie !

 

[lotto_tom75]

Interessante la tua disponibilità, e se mi permetti una richiesta l'avrei.

Mi sarebbe d'aiuto un listato che possa inserire le estrazioni, in modo che possa mettere a video i numeri delle cadenze, oppure delle decine da me richieste, magari in rosso, mentre dove ci sarebbero stati gli altri numeri ci fosse soltanto dei trattini neri.
Però, questi numeri ricercati, delle decine o cadenze, dovranno appartenere solo alle ruote richieste.

Grazie !

Non so se può esserti utile ma questo del grande joe... credo abbia le carte giuste per essere un'ottima base di inizio per avere quello che cerchi..

Con l'occasione aggiungo che quando, come in questo caso, gli script si trovano direttamente sul forum vi sarà un semplice link a quello più corrispondente alla richiesta fatta.

 

[*blacklotto*]

Grazie per la tua risposta, molto gentile e celere !
Però ..., pur sia un buon listato, mi servirebbe che nell'estrazione non si veda solo la cadenza, ma il numero per intero.
Se per esempio cerco la cadenza 0, compare solo lo 0 e non l'intero numero, e quindi dovrei andare a cercare nell'intera estrazione, stessa cosa per le ruote, nel listato di Joe comprende tutte le ruote, ma per sceglierle ?
Se per esempio vorrei vedere la cadenza solo di bari, milano, roma e nazionale ???
Non so, se troverai il tempo per questo listato, benissimo !!
Buona serata

 

[lotto_tom75]

Grazie per la tua risposta, molto gentile e celere !
Però ..., pur sia un buon listato, mi servirebbe che nell'estrazione non si veda solo la cadenza, ma il numero per intero.
Se per esempio cerco la cadenza 0, compare solo lo 0 e non l'intero numero, e quindi dovrei andare a cercare nell'intera estrazione, stessa cosa per le ruote, nel listato di Joe comprende tutte le ruote, ma per sceglierle ?
Se per esempio vorrei vedere la cadenza solo di bari, milano, roma e nazionale ???
Non so, se troverai il tempo per questo listato, benissimo !!
Buona serata

Ciao blacklotto,
per adesso forse ti ho risolto il banale problema della selezione ruote...

Option Explicit
Sub Main
   'T_A_D_C_  Script By Joe V.2.0del 21/04/2020
   Dim Ini,Fin,Es,I,F,Ex,R,P,C,D,Q,N
   Scrivi Space(4) & "Data" & Space(12),True,False
   ColoreTesto 2 : Scrivi "Decine" & Space(16),True,False
   ColoreTesto 1 : Scrivi "Cadenze",True,False
   ColoreTesto 0 : Scrivi
   Dim Ruotascelta
   ReDim aruote(0)
   ScegliRuote(aruote)
   Dim Rdp
   For Rdp = 1 To UBound(aruote)
      Ruotascelta = aruote(Rdp)
      Ini = EstrazioneFin : Fin = EstrazioneFin : Q = 3
      For Es = Ini To Fin : I = Es - Q + 1 : F = Es
         Dim Numeriestratti
         For R = Ruotascelta To Ruotascelta : AvanzamentoElab 1,10,R
            ReDim Dec(9),Cad(9)
            For Ex = I To F
               For P = 1 To 5
                  D = DecinaNaturale(Estratto(Ex,R,P))
                  C = Cadenza(Estratto(Ex,R,P))
                  Dec(D) = True : Cad(C) = True
               Next
            Next
            Scrivi DataEstrazione(Es) & Space(1),0,0
            Scrivi SiglaRuota(R) & Space(1),True,False
            ColoreTesto 2
            For N = 0 To 8
               If Dec(N) = False Then
                  Scrivi N & Space(1),True,False
               Else
                  Scrivi "." & Space(1),False,False
               End If
            Next
            Scrivi Space(4),False,False
            ColoreTesto 1
            For N = 0 To 9
               If Cad(N) = False Then
                  'Call GetArrayNumeriRuota(Es,R,Numeriestratti)
                  'Scrivi
                  'Scrivi StringaNumeri(Numeriestratti)
                  'Scrivi
                  Scrivi N & Space(1),True,False
               Else
                  Scrivi "." & Space(1),False,False
               End If
            Next
            ColoreTesto 0
            Scrivi
         Next
      Next
   Next ' x aruote
End Sub

Se, mentre cerchiamo di risolvere anche l'altra questione..., qualcuno, incluso ovviamente il creatore dello script joe, volesse aiutarti... ben venga!

Con questa ulteriore aggiunta dovresti visualizzare anche la corrispondente estrazione... per il range temporale desiderato...

Option Explicit
Sub Main
   'T_A_D_C_  Script By Joe V.2.0del 21/04/2020
   Dim Ini,Fin,Es,I,F,Ex,R,P,C,D,Q,N
   Scrivi Space(4) & "Data" & Space(12),True,False
   ColoreTesto 2 : Scrivi "Decine" & Space(16),True,False
   ColoreTesto 1 : Scrivi "Cadenze",True,False
   ColoreTesto 0 : Scrivi
   Dim Ruotascelta
   ReDim aruote(0)
   ScegliRuote(aruote)
   Dim Rdp
   Dim Estrattos
   Estrattos = ""
   Dim Quantestrazionianalizzare
   Quantestrazionianalizzare = CInt(InputBox("quante estrazioni analizzare",,9))
   For Rdp = 1 To UBound(aruote)
      Ruotascelta = aruote(Rdp)
      Ini =(EstrazioneFin - Quantestrazionianalizzare) + 1 : Fin = EstrazioneFin : Q = 3
      For Es = Ini To Fin : I = Es - Q + 1 : F = Es
         Dim Numeriestratti
         For R = Ruotascelta To Ruotascelta : AvanzamentoElab 1,10,R
            ReDim Dec(9),Cad(9)
            For Ex = I To F
               For P = 1 To 5
                  D = DecinaNaturale(Estratto(Ex,R,P))
                  C = Cadenza(Estratto(Ex,R,P))
                  Dec(D) = True : Cad(C) = True
               Next
            Next
            Scrivi DataEstrazione(Es) & Space(1),0,0
            Scrivi SiglaRuota(R) & Space(1),True,False
            ColoreTesto 2
            For N = 0 To 8
               If Dec(N) = False Then
                  Scrivi N & Space(1),True,False
               Else
                  Scrivi "." & Space(1),False,False
               End If
            Next
            Scrivi Space(4),False,False
            ColoreTesto 1
            For N = 0 To 9
               If Cad(N) = False Then
                  Scrivi N & Space(1),True,False
               Else
                  Scrivi "." & Space(1),False,False
               End If
            Next
            For P = 1 To 5
               Estrattos = Estrattos & Estratto(Es,R,P) & "."
            Next
            Scrivi " " & Estrattos
            ColoreTesto 0
            'Scrivi
         Next
         Estrattos = ""
      Next
      Estrattos = ""
   Next ' x aruote
End Sub

 

[*blacklotto*]

Grazie !! Molto gentile.

 

[lotto_tom75]

script n. 2 : filtro integrale per superenalotto by me

Breve spiegazione: così settato lo script estrapola e visualizza in output la formazione che nel range di estrazioni superenalotto desiderate ha rispettato il filtro impostato x sorte e classe di sviluppo volute. E' possibile analizzarvi qualsiasi gruppo base per sorti da 1 a 6 e classi di sviluppo da 1 a 20.

Option Explicit
Sub Main
   'tom's bakery - script n.2 x superenalotto by tom - analisi di tipo integrale semplice con limite di classe di sviluppo a 20 num
   Dim fine,es,sorte,aretritardi,aretidestr,ritardo,last,frequenza,max
   Dim num(10)
   Call ScegliNumeri(num)
   ''
   Dim Inizio
   Dim estrazionivolute
   estrazionivolute = CInt(InputBox("ultime estrazioni volute",,60))
   fine = EstrazioniArchivioSE
   Inizio = fine - estrazionivolute
   sorte = InputBox("Sorte 1-2-3-4-5-6",,2)
   es = fine
   Dim Classe
   Classe = CInt(InputBox("classe",,1))
   Scrivi
   Scrivi "Situazione SuperEnalotto con archivio aggiornato al " & GetInfoEstrazioneSE(fine)
   Scrivi
   Scrivi "Gruppo base scelto " & StringaNumeri(num) & " di classe " & UBound(num)
   Scrivi "Classe di svilupo " & Classe
   Scrivi "Sorte di analisi " & sorte
   Scrivi
   Scrivi "Numero ultime estrazioni analizzate " & estrazionivolute
   Scrivi "Range temporale analizzato " & GetInfoEstrazioneSE(Inizio) & " - " & GetInfoEstrazioneSE(fine)
   Scrivi
   Dim coltot
   Dim acol
   coltot = InitSviluppoIntegrale(num,Classe)
   If coltot > 0 Then
      Do While GetCombSviluppo(acol) = True
         Call ElencoRitardiSE(acol,sorte,Inizio,fine,aretritardi,aretidestr)
         last = UBound(aretritardi)
         ritardo = aretritardi(last)
         frequenza = last - 1
         max = MassimoV(aretritardi,1)
         Scrivi "Nr. " & StringaNumeri(acol,".") & " Ritardo " & ritardo & " Rit.Max " & max & " Frequenza " & frequenza
         If ScriptInterrotto Then Exit Do
      Loop
   End If
End Sub

 

[i legend]

Ciao Tom , scusa se mi intrometto nel tuo 3D
X black lotto
, potresti postare un immagine di come andrebbero raccolti i dati e colorati?
insomma come tabella , lista , non saprei

questo sarebbe il modo migliore per capire cosa deve fare lo script e come.
ovviamente usando un foglio di calcolo o notepad non con spaziometria
ciao

 

[lotto_tom75]

Ciao Tom , scusa se mi intrometto nel tuo 3D
...

Ma scherzi?
Entra... e scrivi... quando vuoi ilegend.
Le chiavi... sono sotto il tappetino... maestro scripter

 

[joe]

Ciao Tom.

Ci sono normalmente 2 Componenti fondamentali che sono la richiesta e la soluzione.

Nel primo messaggio (cioè nella richiesta) normalmente è contenuto l'oggetto di quanto si desidera.

Poi ... è vero che spesso, diventa difficile comprenderlo, mancano gli esempi, non è completamente descritto ... ecc. ecc.

La seconda parte può riguardare gli esempi o gli script (da modificare)

ed anche l'algoritmo che viene proposto come soluzione e/o a corredo della richiesta.

In casi, come questo e secondo me sarebbe molto-molto meglio redigere una soluzione, NUOVA,

specifica perché essa risulterà più aderente alla richiesta, meno complicata, più veloce ed in sintesi migliore.

Un esempio per tutti ... tu scrivi giustamente che lo script è mio.

Dopo (ed anche prima della tua modifica) ho difficoltà a leggerlo per capire "cosa fa".

A seguito della tua modifica e ad uno sguardo veloce lo direi persino sbagliato.

Dunque ... se non intendo metterci mano è perché modifiche su modifiche, anche a più mani,

spesso complicano i problemi invece di risolverli.

I più delle volte portano anche a soluzioni che si riveleranno poi piuttosto "sbagliate" e difficile da interpretare.

In sintesi ho scritto questo ... e non so se sia una interpretazione corretta della richiesta.

Sub Main
'Visualizzazione Decine e Cadenze in Ruote a scelta Script V.1.0. By Joe
   ReDim aRuote(11)
   Dim k,Ini,Fin,Es,E,P,C,D,T
   Ini = EstrazioneFin - 53 : Fin = EstrazioneFin
   D = CInt(InputBox("scegli","DECINA",5)) : C = CInt(InputBox("scegli","CADENZA",4))
   If ScegliRuote(aRuote) > 0 Then
   Titoli(aRuote)
      For Es = Ini To Fin
         Scrivi DataEstrazione(Es) & Space(2),1,0,RGB(208,208,208),0
         For k = 1 To UBound(aRuote)
            If aRuote(k) > 0 And aRuote(k) <> 11 Then
               For P = 1 To 5
                  T = 5
                  E = Estratto(Es,aRuote(k),P)
                  If Decina(E) = D Then T = 1
                  If Cadenza(E) = C Then T = 2
                  If Decina(E) = D And Cadenza(E) = C Then T = 0
                  Call Scrivi(Format2(E) & Space(1),0,0,RGB(208,208,208),T)
               Next
               Scrivi Space(1),0,0
            End If
         Next
         Scrivi
      Next
      Titoli(aRuote)
   End If
   Scrivi
   Scrivi "LEGENDA : ",1,0,RGB(208,208,208),0
   Scrivi "DECINA " & D & Space(2),1,0,RGB(208,208,208),1
   Scrivi "CADENZA " & C & Space(2),1,0,RGB(208,208,208),2
   Scrivi "DEC & CAD " & D & C,1,0,RGB(208,208,208),0
End Sub
Function Titoli(aRuote)
   Dim K
   Scrivi Space(2) & "DATA" & Space(2),1,0,RGB(208,208,208),0
   For K = 1 To UBound(aRuote)
      Scrivi Space(5) & FormatSpace(UCase(NomeRuota(aRuote(K))),12),1,0
   Next
   Scrivi
End Function

 

[lotto_tom75]

Ciao Tom.

Ci sono normalmente 2 Componenti fondamentali che sono la richiesta e la soluzione.

Nel primo messaggio (cioè nella richiesta) normalmente è contenuto l'oggetto di quanto si desidera.

Poi ... è vero che spesso, diventa difficile comprenderlo, mancano gli esempi, non è completamente descritto ... ecc. ecc.

La seconda parte può riguardare gli esempi o gli script (da modificare)

ed anche l'algoritmo che viene proposto come soluzione e/o a corredo della richiesta.

In casi, come questo e secondo me sarebbe molto-molto meglio redigere una soluzione, NUOVA,

specifica perché essa risulterà più aderente alla richiesta, meno complicata, più veloce ed in sintesi migliore.

Un esempio per tutti ... tu scrivi giustamente che lo script è mio.

Dopo (ed anche prima della tua modifica) ho difficoltà a leggerlo per capire "cosa fa".

A seguito della tua modifica e ad uno sguardo veloce lo direi persino sbagliato.

Dunque ... se non intendo metterci mano è perché modifiche su modifiche, anche a più mani,

spesso complicano i problemi invece di risolverli.

I più delle volte portano anche a soluzioni che si riveleranno poi piuttosto "sbagliate" e difficile da interpretare.

In sintesi ho scritto questo ... e non so se sia una interpretazione corretta della richiesta.

Sub Main
'Visualizzazione di cadenze e decine in ruote a scelta Script V.1.0. By Joe
   ReDim aRuote(11)
   Dim k,Ini,Fin,Es,E,P,C,D,T
   Ini = EstrazioneFin - 53 : Fin = EstrazioneFin
   D = CInt(InputBox("scegli","DECINA",5)) : C = CInt(InputBox("scegli","CADENZA",4))
   If ScegliRuote(aRuote) > 0 Then
   Titoli(aRuote)
      For Es = Ini To Fin
         Scrivi DataEstrazione(Es) & Space(2),1,0,RGB(208,208,208),0
         For k = 1 To UBound(aRuote)
            If aRuote(k) > 0 And aRuote(k) <> 11 Then
               For P = 1 To 5
                  T = 5
                  E = Estratto(Es,aRuote(k),P)
                  If Decina(E) = D Then T = 1
                  If Cadenza(E) = C Then T = 2
                  If Decina(E) = D And Cadenza(E) = C Then T = 0
                  Call Scrivi(Format2(E) & Space(1),0,0,RGB(208,208,208),T)
               Next
               Scrivi Space(1),0,0
            End If
         Next
         Scrivi
      Next
      Titoli(aRuote)
   End If
   Scrivi
   Scrivi "LEGENDA : ",1,0,RGB(208,208,208),0
   Scrivi "DECINA " & D & Space(2),1,0,RGB(208,208,208),1
   Scrivi "CADENZA " & C & Space(2),1,0,RGB(208,208,208),2
   Scrivi "DEC & CAD " & D & C,1,0,RGB(208,208,208),0
End Sub
Function Titoli(aRuote)
   Dim K
   Scrivi Space(2) & "DATA" & Space(2),1,0,RGB(208,208,208),0
   For K = 1 To UBound(aRuote)
      Scrivi Space(5) & FormatSpace(UCase(NomeRuota(aRuote(K))),12),1,0
   Next
   Scrivi
End Function

Grazie joe, d'accordo al 100% con quello che hai scritto e complimenti per l'ennesima chicca di code che hai realizzato. Anche e sopratutto il richiedente blacklotto ne sarà entusiasta .


script n.3

implementazione in sviluppo integrale x lotto del motore di sviluppo senza limite di classe del grande Edoardo_95 (Edoardo), autore insieme al Gran Maestro LuigiB anche del programma i Spazio Light ovvero della versione leggera dell'incommensurabile Spaziometria di LuigiB e che purtroppo sembra non solo essere sparito dal forum ma che anche si sia cancellato . Con il suo nick non riesco + a trovarlo... Se ci leggi o ci vedi un mega saluto e spero di nuovo a presto caro e bravissimo Edo

Breve spiegazione: lo script supera l'iniziale limite dello sviluppo integrale di spaziometria che consente di per sè di analizzare in questa modalità di analisi senza salti solo formazioni di classe (numero di elementi) <= 20. Con questo script-tool è infatti possibile analizzare in modo integrale formazioni di classe da 1 a 90. Piccola chicca tecnica al riguardo... superando i 3 punti riduzionali i tempi di elaborazione diventano piuttosto lunghi. Ottimo è infatti, nel caso si vogliano analizzare classi ampie superiori a 20 in questa modalità integrale, considerare salti riduzionali di non più di 3 punti massimo.

 

[lotto_tom75]

Script n.4 x lotto rileva situazione incmax per formazione scelta. Inizialmente creato da ilegend e LuigiB su mia richiesta, successivamente Edoardo_95 lo ha perfezionato.

Option Explicit
Class clsLunghetta
   Private aNumeri
   Private mInizio,mFine,aRuote,mSorte
   Private mClasse
   Private aElencoRit
   Private aIdEstrElencoRit
   Private aElencoIncrRitMax
   Private aIdEstrIncrRitMax
   Private aRitardiAllIncremento
   Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza
   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
   Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco)
      mInizio = RangeInizio
      mFine = RangeFine
      aRuote = vetRuote
      mSorte = SorteInGioco
      Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
      Call ElencoRitardi(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
      Call AlimentaVettoreIncrRitMax
   End Sub
   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
         ReDim aNumeri(UBound(sLunghetta))
         For k = 1 To UBound(sLunghetta)
            aNumeri(k) = sLunghetta(k)
         Next
      Else
         Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
      End If
      mClasse = UBound(aNumeri)
   End Sub
   Private Sub AlimentaVettoreIncrRitMax
      Dim nRitMax,nIncr,nId,k
      Dim nUpper
      nId = 0
      ReDim aElencoIncrRitMax(0)
      ReDim aIdEstrIncrRitMax(0)
      ReDim aRitardiAllIncremento(0)
      aElencoIncrRitMax(0) = aElencoRit(1)
      For k = 1 To UBound(aElencoRit)
         If aElencoRit(k) > nRitMax Then
            If nRitMax > 0 Then
               nIncr = aElencoRit(k) - nRitMax
               nId = nId + 1
               ReDim Preserve aElencoIncrRitMax(nId)
               aElencoIncrRitMax(nId) = nIncr
               ReDim Preserve aIdEstrIncrRitMax(nId)
               aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
               ReDim Preserve aRitardiAllIncremento(nId)
               aRitardiAllIncremento(nId) = aElencoRit(k)
            End If
            nRitMax = aElencoRit(k)
         End If
      Next
      mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
      nUpper = UBound(aElencoIncrRitMax)
      mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
   End Sub
   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("Formazione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
      nUpperVetIncrRit = UBound(aElencoIncrRitMax)
      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")
      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")
      Call InserisciGrafico
   End Sub
End Class
Sub Main
   Dim Inizio,Fine,Sorte,aRuote,clsL,aN,sChrSep,k,sFrz
   sChrSep = " "
   Inizio = EstrazioneIni
   Fine = EstrazioneFin
   Set clsL = New clsLunghetta
   ReDim aN(90)
   If ScegliFormazione(aN) Then
      For k = 1 To 90
         If aN(k) Then
            sFrz = sFrz & Format2(k) & ","
         End If
      Next
      sFrz = RimuoviLastChr(sFrz,",")
      aN = Array(0)
      aN = array_push(aN,sFrz)
      Sorte = SelEsito
      Call ScegliRuote(aRuote,Nothing)
      Call clsL.Init(aN,sChrSep,Inizio,Fine,aRuote,Sorte)
      Call clsL.EseguiStatistica
      Call AvanzamentoElab(0,1,1)
      Call Scrivi("Analisi incremento ritardo massimo per la sorte di " & NomeSorte(Sorte),True,,vbRed,vbWhite,4)
      Call Scrivi
      Call Scrivi("Sulla ruota di        : " & StringaRuote(aRuote) & " ",True,,vbBlue,vbWhite,3)
      Call Scrivi("Da Estrazione         : " & GetInfoEstrazione(Inizio),True,,vbBlue,vbWhite,3)
      Call Scrivi("A  Estrazione         : " & GetInfoEstrazione(Fine),True,,vbBlue,vbWhite,3)
      Call Scrivi
      Call Scrivi("Numeri Formazione                               : " & clsL.LunghettaString,True,,,,2)
      Call Scrivi("Ritardo attuale                                 : " & clsL.Ritardo,True,,,,2)
      Call Scrivi("Ritardo Massimo storico                         : " & clsL.RitardoMax,True,,,,2)
      Call Scrivi("Frequenza                                       : " & clsL.Frequenza,True,,,,2)
      Call Scrivi("Incremento del ritardo massimo attuale          : " & clsL.IncrRitMax,True,,,,2)
      Call Scrivi("Incremento del ritardo massimo storico più alto : " & clsL.IncrRitMaxSto,True,,,,2)
      Call Scrivi("Stringa degli incrementi                        : " & clsL.strIncRitMaxSto,True,,,,2)
      Call Scrivi
      If clsL.RitardoMax > 0 Then
         Call clsL.DisegnaGraficoIncrRitMax
      End If
   End If
End Sub
Function SelEsito
   Dim ret
   Dim aVoci
   ' gli array partono sempre da 0
   aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
   ret = ScegliOpzioneMenu(aVoci,2," Analesi per Sorte di : ")
   SelEsito = ret
End Function
Function ScegliFormazione(aN)
   Dim sFormazione
   Dim k,i
   sFormazione = InputBox("Inserire la formazione da analizzare separando i numeri che la compongono con il punto",,"1.10.20")
   ReDim aV(0)
   Call SplitByChar(sFormazione,".",aV)
   For k = 0 To UBound(aV)
      If Int(aV(k)) > 0 And Int(aV(k)) <= 90 Then
         aN(Int(aV(k))) = True
         i = i + 1
      End If
   Next
   If i > 0 Then ScegliFormazione = True
End Function
Function array_push(arr,vars)
   Dim k,newelem,newarrsize,elem
   If IsArray(arr) Then
      If Len(vars) > 0 Then
         If InStr(vars,",") = False Then
            newarrsize = CInt(UBound(arr) + 1)
            ReDim Preserve arr(newarrsize)
            arr(newarrsize) = vars
         Else
            k =(UBound(arr) + 1)
            newelem = Split(vars,",")
            newarrsize = CInt(UBound(arr) + UBound(newelem) + 1)
            ReDim Preserve arr(newarrsize)
            For Each elem In newelem
               arr(k) = Trim(elem)
               k = k + 1
            Next
         End If
      End If
      array_push = arr
   Else
      array_push = False
   End If
End Function

Breve spiegazione: lo script serve a evidenziare per qualsivoglia ruota e formazione numerica intervallata nei suoi elementi dal carattere punto (.) la relativa situazione dal punto di vista di incremento massimo di ritardo (incmax). Infatti una volta raggiunta la diff=0 ovvero quando il ritardo attuale eguaglia quello storico per la sorte e ruota di ricerca spesso e volentieri purtroppo invece di assistere allo sfaldamento della sorte monitorata si assiste all'incremento di un altro valore. Appunto dell'incremento massimo di ritardo. Thread con + info al riguardo.

 

[lotto_tom75]

Script n.5 x lotto "ironbot" x rilevare da gruppo base iniziale deisderato la lunghetta con classe di soglia minima voluta rispettante il filtro impostato. Di default il filtro rileva condizioni ABS ovvero con RA=RS=INCMAX=0 per la sorte di ricerca voluta. Anche in questo caso è possibile volendo abilitare la voce che avverte se si è trovato o meno una classe minima rispetto alla precedente rilevata...

Option Explicit
Sub Main
   'tom's bakery script n.5 x lotto ironbot progressivo x rilevare in modo random a step riduzionale progressivo la lunghetta con classe di soglia minima desiderata
   Dim k
   Dim Classe
   Dim aCol
   ReDim aNum(90)
   Dim i,i2
   Dim nSorte,Fine,RetRit1,QuantitaNumeriScelti,aRuoteSel,RuoteSelezionate,RetRitMax,RetIncrRitMax,RetFreq,Inizio
   Dim ColTot,aRetcol
   Dim valoreInizioelaborazione,valorefineelaborazione
   Dim Valoresogliaraggiunto
   Valoresogliaraggiunto = EstrazioneFin
   Dim ruota
   Dim ff
   Dim numerocolonne
   Dim multiplocolonne
   Dim numerocolonnerandomtotale
   Dim ramassimotop
   Dim ramassimostandard
   Dim raminimostandard
   Dim Incmaxdeciso
   Dim puntidipartenzadasottrarre
   Dim puntiriduzioneadognipassaggio
   Dim grupponumericobaseiniziale
   Call ScegliNumeri(grupponumericobaseiniziale)
   Dim diffdecisa
   Dim quantestrazionidallafine
   Dim filexanalisicollimanze
   filexanalisicollimanze = ".\filexanalisicollimanze.txt"
   Dim Iniziorange
   Iniziorange = EstrazioneIni
   Fine = EstrazioneFin
   quantestrazionidallafine = Fine - Iniziorange
   Dim counter
   counter = 0
   Dim casiesaminati
   casiesaminati = 0
   Dim casipositivi
   Dim casinegativi
   Dim casiattivi
   casipositivi = 0
   casinegativi = 0
   casiattivi = 0
   Dim estrazionidaanalizzare
   estrazionidaanalizzare = EstrazioneFin
   Dim quanteiterazioni
   quanteiterazioni = CInt(InputBox("Quante iterazioni vuoi effettuare per questa analisi?",,10)) '1  ' 100))
   Inizio = CInt(InputBox("Da quale estrazione vuoi partire per l'analisi?",,Iniziorange))
   Fine = CInt(InputBox("Quale estrazione vuoi impostare come ultima di studio?",,Fine))
   Classe = CInt(InputBox("QUALE GRUPPO NUMERICO ASSOLUTO O SEMI ASSOLUTO DI SVILUPPO",,UBound(grupponumericobaseiniziale) - 1)) '78)) 'provo a velocizzare ricerca facendola partire da una classe molto + ridotta rispetto la 73ina...
   Classefinale = CInt(InputBox("QUALE CLASSE FINALE DI SVILUPPO",,40))
   puntidipartenzadasottrarre = CInt(InputBox("DA QUANTI PUNTI PARTIRE IN MENO RISPETTO LA CLASSE DEL GRUPPO NUMERICO SCELTO",,1))
   puntiriduzioneadognipassaggio = CInt(InputBox("QUANTI PUNTI RIDUZIONALI SOTTRARRE AD OGNI PASSAGGIO",,1))
   nSorte = CInt(InputBox("QUALE SORTE DI RICERCA","sorte di ricerca",1))
   ff = CInt(InputBox("QUANTE ESTRAZIONI DALLA FINE",,estrazionidaanalizzare)) 'quantestrazionidallafine + 1))
   numerocolonne = CInt(InputBox("QUANTE COLONNE RANDOM ANALIZZARE (max 10000)",,500))
   multiplocolonne = CInt(InputBox("FATTORE DI MOLTIPLICAZIONE COLONNE RANDOM (max 10000)",,1))
   ramassimotop = CInt(InputBox("RITARDO MASSIMO TOP",,0)) ' 9000))
   raminimostandard = CInt(InputBox("RITARDO MINIMO STANDARD",,0))
   ramassimostandard = CInt(InputBox("RITARDO MASSIMO STANDARD",,ramassimotop))
   Incmaxdeciso = CInt(InputBox("INCMAX DA CUI PARTIRE",,0))
   Dim classemaxperoutput
   classemaxperoutput = CInt(InputBox("CLASSE MAX X OUTPUT",,55))
   Dim ruotascelta
   ruotascelta = ScegliRuota
   Inizio = EstrazioneFin - ff
   If FileEsistente(filexanalisicollimanze) Then
      Call EliminaFile(filexanalisicollimanze)
   End If
   filexanalisicollimanze = ".\filexanalisicollimanze.txt"
   Dim contaiterazioni
   For contaiterazioni = 1 To quanteiterazioni
      Dim sfilereportdinamico,Classedinamicaprogressiva
      sfilereportdinamico = ".\risultanzadinamica.txt"
      Dim filenumericoiniziale
      filenumericoiniziale = ".\risultanzadinamica.txt"
      If FileEsistente(filenumericoiniziale) Then
         Call EliminaFile(filenumericoiniziale)
      End If
      filenumericoiniziale = ".\risultanzadinamica.txt"
      Dim n
      sfileclassedinamica = ".\classedinamica" & n & ".txt"
      For n = 1 To 90
         If FileEsistente(".\classedinamica" & n & ".txt") Then
            Call EliminaFile(".\classedinamica" & n & ".txt")
         End If
         If ScriptInterrotto Then Exit For
      Next
      Call ScriviFile(filenumericoiniziale,StringaNumeri(grupponumericobaseiniziale))
      Call CloseFileHandle(filenumericoiniziale)
      Dim aRuoteTmp
      Dim sfile
      Dim sFiles
      Dim aLunghette
      Dim sFiletxt
      Dim contatore
      Dim c,alunghetta
      numerocolonnerandomtotale = numerocolonne * multiplocolonne
      valoreInizioelaborazione = 1
      valorefineelaborazione = numerocolonnerandomtotale '...
      ReDim aRuote(0)
      ReDim aRuote(1) ' si considerano due ruote unite
      aRuote(1) = ruotascelta 'PA_
      Call Messaggio("Lettura file di testo")
      ReDim aRighe(0)
      sFiletxt = ".\risultanzadinamica.txt"
      LeggiRigheFileDiTesto sFiletxt,aRighe
      For k = 0 To UBound(aRighe)
         If aRighe(k) <> "" Then
            ReDim aSelNum(0)
            Call SplitByChar("." & aRighe(k),".",aNum)
         End If
      Next
      sFiletxt = ".\risultanzadinamica.txt"
      Dim partida
      Dim Classefinale
      partida = Classe - puntidipartenzadasottrarre
      Scrivi "Analizzatore lunghette desiderate di gruppo numerico desiderato",1,1,1,5,3
      Scrivi "per sorte desiderata in quantità di colonne Random desiderate (max 100 mln)",1,1,1,5,3
      Scrivi
      Scrivi
      Scrivi "By Lotto_tom75 - of NLT ",1,1,1,4,2
      Scrivi
      Call Scrivi("Sviluppo Combinazioni del gruppo numerico assoluto o semi assoluto di classe " & Classe & " a partire dalla Classe ridotta " & partida)
      Call Scrivi(" per la sorte di... " & NomeSorte(nSorte),1,1,2,4,4) ' size 5
      Scrivi
      Scrivi "Totale colonne elaborate: " & numerocolonnerandomtotale,0,0,1,4,5
      Scrivi
      Scrivi "Totale estrazioni elaborate: " & ff,0,0,1,4,5
      Scrivi
      Scrivi
      Scrivi "Estrazione inizio... " & GetInfoEstrazione(Iniziorange) & "  Estrazione fine... " & GetInfoEstrazione(EstrazioneFin) '& " estrazione intermedia di analisi " & idestrazione
      Scrivi
      For k = 1 To RuoteSelezionate
         Call Scrivi("Scelta ruota " & NomeRuota(aRuote(k)) & " - " & SiglaRuota(aRuote(k)))
      Next
      Scrivi
      Scrivi
      Scrivi "RA massimo impostato con scrittura su file e alert... RA= " & ramassimotop
      Scrivi
      Scrivi "RA medio impostato con scrittura su file e output... RA= " & ramassimostandard
      Scrivi
      Scrivi "Incmax da cui partire... Incmax= " & Incmaxdeciso
      Scrivi
      Call Scrivi
      Call Scrivi("Elaborazione con archivio aggiornato al: " & giorno(EstrazioneFin) & "-" & Mese(EstrazioneFin) & "-" & Anno(EstrazioneFin))
      Call Scrivi
      Dim idestrazione
      For idestrazione = Inizio To Fine
         For i2 = partida To Classefinale Step - puntiriduzioneadognipassaggio
            ReDim aNum(0)
            Call Messaggio("Lettura file di testo")
            ReDim aRighe(0)
            sFiletxt = ".\risultanzadinamica.txt"
            LeggiRigheFileDiTesto sFiletxt,aRighe
            For k = 0 To UBound(aRighe)
               If aRighe(k) <> "" Then
                  ReDim aSelNum(0)
                  Call SplitByChar("." & aRighe(k),".",aNum)
               End If
            Next
            For i = valoreInizioelaborazione To valorefineelaborazione
               Dim NomeRuotaNome
               If RuoteSelezionate > 1 Then
                  NomeRuotaNome = "ruote decise unite"
               Else
                  NomeRuotaNome = SiglaRuota(aRuote(1)) '& SiglaRuota(aRuote(2))
               End If
               Call Messaggio("c" & i2 & " " & StringaNumeri(aRuote) & " s" & nSorte & " v " & counter & " " & Iniziorange & "-" & idestrazione & " rm " & raminimostandard & " es " & Fine - Inizio & " it " & contaiterazioni & " crt " & crt & " csi " & casiesaminati & " cs+ " & casipositivi & " cs- " & casinegativi & " csa " & casiattivi)
               Call GetColonnaCasuale(i2,aRetcol,aNum)
               Call StatisticaFormazioneTurbo(aRetcol,aRuote,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,Iniziorange,idestrazione)
               Call AvanzamentoElab(1,valorefineelaborazione,i)
               Dim Diff
               Diff = RetRitMax - RetRit1
               If RetRit1 > 0 And RetRitMax > 0 Then
                  Dim datoabasul
                  datoabasul =(RetRit1/RetRitMax) * 100
               End If
               If(RetRit1 >= raminimostandard And RetRit1 <= ramassimotop And RetRitMax <= ramassimotop And Diff = 0 And RetIncrRitMax = 0) Then
                  If i2 < Valoresogliaraggiunto And i2 <= classemaxperoutput Then
                     Valoresogliaraggiunto = i2
                     'Call PlayWav("C:\silenzio.wav",1,"trovata classe doc minore e pari a " & i2 & " elementi ")
                  End If
                  Call Scrivi("N.r: " & StringaNumeri(aRuote) & " Colonna: " & i & " " & StringaNumeri(aRetcol,,True) & " RA " & RetRit1 & " RS " & RetRitMax & " INCMAX " & RetIncrRitMax & " FQ " & RetFreq & " Diff " & Diff & " classe " & i2 & " sorte " & nSorte & " riga " & counter)
                  counter = counter + 1
                  Dim reportlunghettadoc
                  sfilereportdinamico = ".\risultanzadinamica.txt"
                  Dim sfileclassedinamica
                  sfileclassedinamica = ".\classedinamica" '& i2 & ".txt"
                  reportlunghettadoc = StringaNumeri(aRetcol,,True)
                  If FileEsistente(sfilereportdinamico) Then
                     Call EliminaFile(sfilereportdinamico)
                  End If
                  sfilereportdinamico = ".\risultanzadinamica.txt"
                  If FileEsistente(sfileclassedinamica) Then
                     Call EliminaFile(sfileclassedinamica)
                  End If
                  sfileclassedinamica = ".\classedinamica" & i2 & ".txt"
                  Call ScriviFile(sfilereportdinamico,reportlunghettadoc,False,True)
                  Call ScriviFile(sfileclassedinamica,reportlunghettadoc,False,True)
                  Call CloseFileHandle(sfilereportdinamico)
                  Call CloseFileHandle(sfileclassedinamica)
                  If i2 = Classefinale Or i2 = Classefinale + 1 Or i2 = Classefinale + 2 Or i2 = Classefinale + 3 Or i2 = Classefinale + 4 Or i2 = Classefinale + 5 Then
                     Call ScriviFile(filexanalisicollimanze,reportlunghettadoc,False,True)
                     Call CloseFileHandle(filexanalisicollimanze)
                     Dim sortediverifica
                     Dim esito
                     Dim entrocolpi
                     Dim alcolponumero
                     Dim estratti
                     Dim estrazionediuscita
                     Dim vettorediverifica
                     sortediverifica = 2
                     entrocolpi = 296 '270
                     Dim crt ' colpi restanti teorici
                     crt = entrocolpi -(EstrazioneFin - idestrazione)
                     Dim numerodicrtmaxvoluti
                     numerodicrtmaxvoluti = estrazionidaanalizzare - entrocolpi
                     Call SplitByChar(reportlunghettadoc,".",vettorediverifica)
                     Call VerificaEsito(vettorediverifica,aRuote,idestrazione + 1,sortediverifica,entrocolpi,,esito,alcolponumero,estratti,estrazionediuscita)
                     If esito <> "" Then
                        casipositivi = casipositivi + 1
                     Else
                        Call Scrivi("N.r: " & StringaNumeri(aRuote) & " Colonna: " & i & " " & StringaNumeri(aRetcol,,True) & " RA " & RetRit1 & " RS " & RetRitMax & " INCMAX " & RetIncrRitMax & " FQ " & RetFreq & " Diff " & Diff & " classe " & i2 & " sorte " & nSorte & " riga " & counter)
                        Scrivi "<font color=red><strong>NO non si è avuto alcun sfaldamento per adesso...</strong></font>"
                        If crt > 0 Then
                           casiattivi = casiattivi + 1
                        Else
                           casinegativi = casinegativi + 1
                        End If
                        Scrivi
                        Call Scrivi("<font color=green><strong>Colpi restanti teorici (CRT) : " & crt & "</strong></font>")
                        Scrivi
                        Call Scrivi("Tempo trascorso: " & TempoTrascorso)
                        Exit For
                     End If
                  End If
                  Call Messaggio("T R O V A T A! alla riga " & i)
                  Exit For
               End If
               If ScriptInterrotto Then Exit For
            Next
            If ScriptInterrotto Then Exit For
            If ScriptInterrotto Then Exit For
         Next ' x i2
         sfilereportdinamico = ".\risultanzadinamica.txt"
         If FileEsistente(sfilereportdinamico) Then
            Call EliminaFile(sfilereportdinamico)
         End If
         sfilereportdinamico = ".\risultanzadinamica.txt"
         Call ScriviFile(sfilereportdinamico,StringaNumeri(grupponumericobaseiniziale))
         Call CloseFileHandle(sfilereportdinamico)
         casiesaminati = casiesaminati + 1
         If ScriptInterrotto Or crt >= numerodicrtmaxvoluti Then Exit For
      Next ' x idestrazione
      If ScriptInterrotto Or crt < 0 Then Exit For : Scrivi "<font color=red>necessario aumento dei colpi di ricerca o la rivisitazione della stessa</font>"
   Next ' x iterazioni
   Scrivi
   Scrivi
   Scrivi "<font size=5 color=red>Valore soglia raggiunto " & Valoresogliaraggiunto & "</font>"
   Scrivi
End Sub
Function ScegliFiletxt(sDir)
   sDir = ".\"
   ReDim aV(0)
   Call ElencoFileInDirectory(sDir,aV,".txt")
   i = ScegliOpzioneMenu(aV,,"Scegli il file txt desiderato")
   ScegliFiletxt = ".\risultanzadinamica.txt"
   Call Scrivi("file" & i)
End Function
Sub PlayWav(sFile,nRepeat,sTesto)
   Dim oVoice,oSpFileStream
   Dim k
   Set oVoice = CreateObject("SAPI.SpVoice")
   Set oSpFileStream = CreateObject("SAPI.SpFileStream")
   For k = 1 To nRepeat
      oSpFileStream.Open sFile
      oVoice.SpeakStream oSpFileStream
      oSpFileStream.Close
   Next
   oVoice.Speak sTesto
End Sub

nota riguardo attivazione voce: come nell'altro caso..., se si vuole attivare la voce decommentando la relativa riga di codice con il "call play..." bisogna mettere come file audio iniziale (anche muto) un file .wav . La funzione non accetta altri formati...

 

[lotto_tom75]

Script n.6 x ripulire dai commenti qualsiasi script si voglia... by Edoardo_95 (Edoardo)

Sub Main
   Dim k,y,z
   Dim sfile
   Dim aLunghette
   Dim sfiletxt,sfiletxtok
   Dim c
   Call EliminaFileRipulito
   sfile = ".\"'==========> modificare inserendo il percorso file txt lunghette
   sfiletxtok = ".\FileRipulito.ls"
   sfiletxt = ScegliFiletxt(sfile)
   Call Messaggio("Lettura file di testo")
   ReDim aRighe(0)
   y = 0
   z = 0
   LeggiRigheFileDiTesto sfiletxt,aRighe
   For k = 0 To UBound(aRighe)
      y = y + 1
      Call AvanzamentoElab(0,UBound(aRighe),y)
      If aRighe(k) <> "" Then
         Call RemPresente(aRighe(k))
         If RemPresente(aRighe(k)) = False Then
            Call ScriviFile(sfiletxtok,"" & aRighe(k) & "",False,True)
            CloseFileHandle(sfiletxtok)
         End If
      End If
   Next
   Call Scrivi("File ripulito con successo",True,,vbGreen,vbBlack,30)
End Sub
Function EliminaFileRipulito
   Dim sfiletxtok
   sfiletxtok = ".\FileRipulito.ls"
   If FileEsistente(sfiletxtok) Then
      Call EliminaFile(sfiletxtok)
   End If
End Function
Function RemPresente(ByVal sRiga)
   sRiga = Replace(sriga,vbTab,"")
   sRiga = LTrim(sriga)
   sRiga = LCase(sriga)
   If Left(sriga,1) = "'" Or Left(sriga,4) = "rem " Then
      RemPresente = True
   Else
      RemPresente = False
   End If
End Function
Function ScegliFiletxt(sDir)
   Dim i
   ReDim aV(0)
   Call ElencoFileInDirectory(sDir,aV,".ls")
   i = ScegliOpzioneMenu(aV,,"Scegli file daripulire")
   ScegliFiletxt = sDir & aV(i) & ".ls"
End Function

Il nuovo script pulito dai commenti, ovvero dalle righe del codice con l'apice all'inizio delle stesse e di colore verde, sarà creato come copia "pulita" dello script voluto e nominato di default come FileRipulito.ls e si troverà nella stessa directory della sua versione commentata.

 

[lotto_tom75]

Script n.7 x lotto rilevatore semi automatico di condizioni incmax "standard" teoricamente ottimali by LuigiB e Ilegend su mia richiesta di molti anni fa - Si potrebbe intitolare anche "agli albori di Jarvis..." In questo caso posto il link al relativo thread in cui si costruì la prima volta... Lo script è verso la fine... dello stesso...

 

[i legend]

Tom in teoria i commenti sono importanti, viene spiegato cosa fa quella riga di codice o la routine
A volte viene trovata una soluzione molto particolare, e serve non solo a chi mette mano allo script m anche a chi l ha pensato.
Bel lavorone

 

[lotto_tom75]

Tom in teoria i commenti sono importanti, viene spiegato cosa fa quella riga di codice o la routine
A volte viene trovata una soluzione molto particolare, e serve non solo a chi mette mano allo script m anche a chi l ha pensato.
Bel lavorone

Grazie caro Se ti riferisci allo script ripulitore dei commenti tieni presente che può servire per avere la versione di uno stesso script "pulita" oltre a quella commentata. Io lo trovo molto utile e ringrazio ancora Edoardo_95 per averlo creato.

 

[joe]

Sono spesso in totale sintonia con quanto deduce Ilegend riguardo le richieste e le loro soluzioni.

Lo sono anche in questo caso cioè al riguardo dello script per la pulizia dei file che è presente al messaggio #16.

I commenti sono utili e non rallentano sensibilmente gli script.

Andrebbero usati con parsimonia ma è altro discorso.

Penso che questo script sia nato da una costola di uno

più corposo che fu fatto da Luigi per ripulire il testo dai tag HTML.

Quelli presenti nelle pagine web e che devono essere rimossi, per poter avere solo dei dati utili e puliti.

Comunque sia ... questo script ha una sua esemplarità e scopo.