Evidenziare estratti Come fare

[Zetrix]

Luigi ma che siamo su scherzi a parte ma che forum e questo non ti da nemmeno il tempo
di scrivere e modificare i messaggi
non scrivo piu niente in questo forum non mi piacciono queste regole

 

[LuigiB]

credo sia una misura dovuta ai tanti polemiconi che ci sono che in seguito ai flame che si creano vanno a cambiare il testo dei propri messaggi .. sicche lottoced avrapensato .. daccordo se ti sbaglia scrivere lo corregi subito quindi entro 5 minuti ....

ecco il nuovo aggiornamento

LottoOpen

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

 

[Zetrix]

Luigi però non mi piacciono queste regole assurde se uno deve spiegare un disegno e
ci puo mettere un po di tempo per spiegare le cose e se sbaglia a scrivere a tutti i diritti
di modificare il messaggio e non esiste che il tempo e scaduto e non si puo modificare
piu il mesaggio
grazie per l'aggiornamento

 

[Xeroxs]

Ciao, LuigiB,

altra chicca molto valida,
Volevo capire una cosa su evidenzia combinazioni, anche se la scelgo dal suo menù poi il tasto abilita on/off non "funziona" mentre si attivano on/off sia le combinazioni che le combinazioni con il tasto evidenzia numeri,
se sbaglio a capire dimmi Tu come devo agire.

Ho visto che il colore che usi per evidenziare i numeri ripetuti all'ultima estrazione è il giallo ma i numeri evidenziati sono poco leggibili, magari sono sulla strada di un invecchiamento precoce della vista, portando gli occhiali... è posibile far si che i numeri siano più scuri, spero di non esagerare nella mia osservazione, ma prendendo a cuore questo nuovo progetto preferisco testarlo fin dall'inizio in ogni sua funzione.

Grazie come sempre

 

[palas]

Luigi vedo che a menu c'è "Elenco Disegni",

solo disegni di nuova creazione o

c'è la possibilità di importare STRUTTURE già fatte con spaziometria?

avevano estensione .dat

 

[i legend]

ciao luigi Ho provato a fare un piccolo script per chi vuole evidenziare i numeri ripetuti =2 (no >= ) per costruirsi delle strutture spaziometriche
si possono scegliere il numero di estrazioni da controllare,
vediamo se funzia,
P.S
forse l ho fatta troppa complicata , sicuramente ci sono dei comandi per trovare l ultima estrazione in archivio
al momento Righe conteggia anche le righevuote credo
Ciao
P.P.S
sono troppo arrugginito
ecco lo script di test

Option Explicit
Sub Main
Dim qEstr
   Dim R,C,Fin,Ini
   Dim E
   Dim Ruota
   Dim IniCol,FinCol
   ReDim aN(11,90)
   For R = righe To 1 Step - 1
      If GetValueInt(R,C) > 0 Then ' as Long [Ottiene il valore di una cella espresso come numero intero]
         Fin = R
         Exit For
      End If
   Next
   qEstr=CInt(InputBox(" Inserisci quante estrazioni vuoi visualizzare","Estrazioni esaminate",9))-1
   Ini = Fin - qEstr
   For Ruota = 1 To 11
      FinCol = Ruota*5
      IniCol = FinCol - 4
      For R = Ini To Fin
         For C = IniCol To FinCol
            E = GetValueInt(R,C)' As String  [Ottiene il valore di una cella eventualmente formattato a 2 cifre con 0 ]
            aN(Ruota,E) = aN(Ruota,E) + 1
            'Call setrettangolo(R,C)
         Next
      Next
   Next
   For Ruota = 1 To 11
      FinCol = Ruota*5
      IniCol = FinCol - 4
      For R = Ini To Fin
         For C = IniCol To FinCol
            E = GetValueint(R,C)' As String  [Ottiene il valore di una cella eventualmente formattato a 2 cifre con 0 ]
            If aN(Ruota,E) = 2 Then '
               Call setrettangolo(R,C)
            End If
         Next
      Next
   Next
End Sub

 

[i legend]

Ciao questo si puo scegliere anche la frequenza desiderata

Option Explicit
Sub Main
Dim qEstr
Dim Freq
   Dim R,C,Fin,Ini
   Dim E
   Dim Ruota
   Dim IniCol,FinCol
   ReDim aN(11,90)
   For R = righe To 1 Step - 1
      If GetValueInt(R,C) > 0 Then ' as Long [Ottiene il valore di una cella espresso come numero intero]
         Fin = R
         Exit For
      End If
   Next
   qEstr=CInt(InputBox(" Inserisci quante estrazioni vuoi visualizzare","Estrazioni esaminate",9))-1
   Freq=CInt(InputBox(" Inserisci quale frequenza visualizzare","Frequenze",2))

   Ini = Fin - qEstr
   For Ruota = 1 To 11
      FinCol = Ruota*5
      IniCol = FinCol - 4
      For R = Ini To Fin
         For C = IniCol To FinCol
            E = GetValueInt(R,C)' As String  [Ottiene il valore di una cella eventualmente formattato a 2 cifre con 0 ]
            aN(Ruota,E) = aN(Ruota,E) + 1
            'Call setrettangolo(R,C)
         Next
      Next
   Next
   For Ruota = 1 To 11
      FinCol = Ruota*5
      IniCol = FinCol - 4
      For R = Ini To Fin
         For C = IniCol To FinCol
            E = GetValueint(R,C)' As String  [Ottiene il valore di una cella eventualmente formattato a 2 cifre con 0 ]
            If aN(Ruota,E) = Freq Then '
               Call setrettangolo(R,C)
            End If
         Next
      Next
   Next
End Sub

 

[i legend]

E' una figata unica poter interagire con la videata delle estrazioni
Luigi non ti smentisci mai , sei un mito
la pagina degli script è fissa bisogna minimizzarla per poter accedere ad altri form di spaziometria

 

[Xeroxs]

Ciao, I Legend

Concordo con Te

"E' una figata unica poter interagire con la videata delle estrazioni"

Grazie per aver postato qualche Script, Voglio cercare di capirli questi e provare a proporre qualcosa.

 

[Xeroxs]

Non Sei Arrugginito, Wow ottimi Script

 

[i legend]

Ciao xerox gli script sono identici, nel secondo si possono scegliere le frequenze da evidenziare non solo il fisso 2
Dai aspettiamo qualche tuo script.
Ciao

 

[i legend]

Esempio di utility
senza nessuna pretesa
in verde sono evidenziate le frequenze a tre in rosso a 2 e in nero a freq singola

salta agli occhi la semplicissima struttura
non è detto che paghi , infatti serve solo esempio per aiutare gli occhi a trovare qualcosina
nel disegno le spiegazioni


da verificare in 9 estrazioni gli estratti 56.71 in 2.3.4. posizione sulla nazionale
ambo secco Nazionale e anche a tutte
56 estratto primario 71 recupero
lunghetta 56.64.71.90
NESSUNA GARANZIA DI VINCITA
ciao

 

[LuigiB]

LottoOpen

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

 

[fillotto]

ciao luigi Ho provato a fare un piccolo script per chi vuole evidenziare i numeri ripetuti =2 (no >= ) per costruirsi delle strutture spaziometriche
si possono scegliere il numero di estrazioni da controllare,
vediamo se funzia,
P.S
forse l ho fatta troppa complicata , sicuramente ci sono dei comandi per trovare l ultima estrazione in archivio
al momento Righe conteggia anche le righevuote credo
Ciao
P.P.S
sono troppo arrugginito
ecco lo script di test

Option Explicit
Sub Main
Dim qEstr
   Dim R,C,Fin,Ini
   Dim E
   Dim Ruota
   Dim IniCol,FinCol
   ReDim aN(11,90)
   For R = righe To 1 Step - 1
      If GetValueInt(R,C) > 0 Then ' as Long [Ottiene il valore di una cella espresso come numero intero]
         Fin = R
         Exit For
      End If
   Next
   qEstr=CInt(InputBox(" Inserisci quante estrazioni vuoi visualizzare","Estrazioni esaminate",9))-1
   Ini = Fin - qEstr
   For Ruota = 1 To 11
      FinCol = Ruota*5
      IniCol = FinCol - 4
      For R = Ini To Fin
         For C = IniCol To FinCol
            E = GetValueInt(R,C)' As String  [Ottiene il valore di una cella eventualmente formattato a 2 cifre con 0 ]
            aN(Ruota,E) = aN(Ruota,E) + 1
            'Call setrettangolo(R,C)
         Next
      Next
   Next
   For Ruota = 1 To 11
      FinCol = Ruota*5
      IniCol = FinCol - 4
      For R = Ini To Fin
         For C = IniCol To FinCol
            E = GetValueint(R,C)' As String  [Ottiene il valore di una cella eventualmente formattato a 2 cifre con 0 ]
            If aN(Ruota,E) = 2 Then '
               Call setrettangolo(R,C)
            End If
         Next
      Next
   Next
End Sub

legend ,per favore, puoi fare un "disegnino" step by step non riesco proprio a cacciare un ragno dal buco come si lanciano ....abbi pazienza-Non riesco ad andare avanti eppure sembra essere più facile di spazio----

 

[i legend]

Ciao filotto, non è più semplice anzi .
Spazioscript è superfacile perché luigi ha scritto tutto lui.
Qui bisogna ingegnarsi un po.

Per luigi
Fatto un altro piccolo script ma ho l inputbox che viene lanciato allo scorrere dello scrollbar .
Anche il precedente.
Le estrazioni sono legate a quello che si vede nella finestra.

 

[Elleuca]

Buongiorno a tutti. Se posso ,una integrazione interessante sarebbe quella di poter vedere nel tabellone analitico evidenziate le sfere che nell'estrazione successiva sono uscite. Ovvero la posizione che occupava nel tabellone prima della loro uscita. E questo deve avvenire in automatico . Per come la vedo io veder evidenziato anche il primo L0 e il secondo partendo dalle parti basse del tabellone renderebbe il programmino molto utile a tutti. (Sempre in automatico).

L0=totale uscita di tutte le 5 sfere/numeri in una cinquina sincrona.

Grazie di avermi letto e buona continuazione .

Grazie Luigi e grazie a tutti coloro che stanno contribuendo con le proprie idee e capacità.
Elleuca

 

[i legend]

Ciao a tutti
ecco un altro piccolo script
se si lancia e si scorrono le estrazioni con lo scrollbar bisogna disattivare il tasto degli script .
non so se questo sia un bug da correggere o sia stato voluto e pensato da Luigi
se ho scritto bene la funzione della distanza ciclometrica
lo script rileva le distanze da 1 A 45 ruota per ruota
ditemi che ne pensate.
ecco lo script.
possono esserci errori

Sub Main
   Dim Ruota,IniCol,FinCol
   Dim Rig,Col,Col1
   Dim a,b,nDist
   nDist=cint(InputBox("Inserisci una distanza da 1 a 45","Ricerca distanza Ciclometrica",45))
  
   For Rig = 1 To righe
      For Ruota = 1 To 11
         FinCol = Ruota*5
         IniCol = FinCol - 4
         ReDim aN(90)
        
         For Col = IniCol To FinCol - 1
            a = GetValueInt(Rig,Col)
            For Col1 = Col + 1 To FinCol
               b = GetValueInt(Rig,Col1) 'as Long [Ottiene il valore di una cella espresso come numero intero]
               If Dist(a,b) = nDist Then aN(a) = 1:aN(b) = 1
            Next
         Next
         For Col = IniCol To FinCol
            a = getValueint(Rig,Col)
            If aN(a) = 1 Then
               Call setCerchio(Rig,Col)
            End If
         Next
      Next
   Next
End Sub
Function Dist(a,b)
   Dim nDist
   nDist = Abs(a - b)
   Do While nDist > 45
      nDist = 90 - nDist
   Loop
   Dist = nDist
End Function

 

[LuigiB]

ciao Legend , lo script viene eseguito ad ogni nuova modifica della grigflia , percio se fa tanti calcoli rallenta l'esecuzione


in questo aggiornamento se lo script da errore si puo correggere ... perodevi deselezionare i ltaso abilita script

LottoOpen

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

inoltre pure io metto un piccolo script

Option explicit
dim aGriglia 

Sub Main
    
    dim r , c , lato 
    
    call GetGriglia(aGriglia ) 
    
    for lato = 4 to 8 
        for  r = 1 to Righe - lato 
            for c = 1 to colonne -lato
                call DisegnaQuadrato ( r , c , lato)  
            next
        next
    next

End sub

function DisegnaQuadrato ( r , c , lato)
    
    on error resume next

    dim b     , k ,RetNum

     
    b = true 

    redim aVertici (4 ,2)

    aVertici (1,1) = r
    aVertici (1,2) = c

    aVertici (2,1) = r
    aVertici (2,2) = c + (lato -1)

    aVertici (3,1) = r + (lato -1)
    aVertici (3,2) = aVertici (2,2)

    aVertici (4,1) = r + (lato -1)
    aVertici (4,2) = c

    for k = 1 to 4 
        if aVertici (k,1) > ubound (aGriglia ,1 ) then 
            b = false
            exit for
        end if 
        if aVertici (k,2) >   ubound (aGriglia ,2 ) then 
            b = false
            exit for
        end if 
         aVertici (k,0) =  int(aGriglia (aVertici (k,1) ,aVertici (k,2)))        
         
         
    next
 
    if b then 
        
        if contaNumeriUguali ( aVertici  ,RetNum ) >= 3 then 

            call DisegnaRettangolo(aVertici (1,1),aVertici (1,2),aVertici (3,1), aVertici (3,2),2) 
            for k = 1 to ubound(aVertici)
                if  aVertici(k,0) = RetNum  then 
                    call setCerchio (aVertici(k,1) ,aVertici(k,2))
                end if 
            next
        end if 

    end if     

    
end function 
function ContaNumeriUguali  (aVertici , nRetNum ) 
    dim k , n ,   nMax 
    nMax = 0  

     

 
    redim aN(90)
    for k = 1 to ubound(aVertici  ) 
         
        if   aVertici (k ,0)   > 0 then 
            aN( aVertici (k ,0)) = aN( aVertici (k ,0)) +1
        end if         
    next
    
    for k = 1 to 90 
        if aN(k) > nMax then 
            nMax = aN(k)
            nRetNum  = k 
        end if  
    next 

    ContaNumeriUguali   = nMax 
        

end function

 

[Xeroxs]

Buongiorno a Tutti,
Un Ulteriore Aggiornamento, Sembra + Veloce
Grazie LuigiB e I-legend per gli Script, Come detto Ci sto provando a creare qualcosa.
Il Programma sembra davvero indirizzato Sulla Giusta Direzione proponendo Cose mai Viste in altri programmi è Tutte in un unico contenitore "LottoOpen", Che Completa Spaziometria e lo affianca in ogni argomento sul lotto.

 

[Xeroxs]

Nel Continuare a Testare le varie Versioni del programma Elenco alcune osservazioni:

- Browser Estrazioni ( o Mini Browser)
Sarebbe Sbagliato aprirlo all'ultima estrazione o è una scelta Tecnica

- Tabellone Analitico
Si Potrebbe applicare quanto avviene o come Avviene per la Scelta Ruote
nell'Elenco Estrazioni, Immediato nel Togliere e aggiungere le Ruote Selezionate
visto che sembra usare lo stesso Criterio

- Seleziona Combinazioni da Evidenziare
Nella Scelta delle Combinazioni se csgli la combinazione con + di 5 numeri da errore