Novità

Figure utente esempi utilizzo.

i legend

Premium Member
Ciao ho disegnato una figura e l ho salvata .dat
Ora vorrei utilizzarla in spazio script
gli esempi che ci sono non funzionano.
In pratica vorrei che lo script restituisca. le figure trovate i vertici data inizio e data Fine .la figura èirregolare non parallelepipedo.le funzioni già esistono ma non lè so utilizzare.
Ciao e grazie
A chiunque possa aiutarmi :)
 
L

LuigiB

Guest
ciao legend questo esempio funziona

Codice:
Sub Main
    Dim idEstr
    Dim CollP
    Dim PPL ' As clsParallelepipedo
    Dim CRD ' As clsVertice
    
    ReDim aRuote(1)
    ReDim aPoste(10)
    Dim sFileFigura
    
    aRuote(1) = 11
    aPoste(2) = 1
    
    sFileFigura = GetDirectoryAppData  &  "Strutture\Varie\test_consecutiviUnodoppioDellaltro.dat"
    
    
    
    For idEstr =8500 To EstrazioniArchivio - 10
        ' ottengo i parallelepipedi presenti nell'estrazione
        Call GetCollFiguraUtente(idEstr,sFileFigura,CollP)
    
        ' per ogni parallelepipedo trovato nella tale estrazione faccio il disegno
        For Each PPL In CollP
            
            ReDim aNumeri(8)
            
            
            
                ReDim aNumeri(0)
                Call GetArrayNumeriFromFiguraSpaziometrica(PPL,aNumeri)
                
                Call DisegnaFiguraSpaziometrica(idEstr,PPL)
                Call ImpostaGiocata(1,aNumeri,aRuote,aPoste,10,2)
                Call Gioca(idEstr)
                
            
        Next
    
        
    Next
    Call ScriviResoconto
End Sub
 

i legend

Premium Member
Ok adesso funziona
Era uno degli script che avevo tè stato.
Per rendere più agevole la ricerca
Ho utilizzato la tua mitica
ScegliFile (GetDirectoryAppData,".dat")
Questo così non sbaglio a selezionare.
Domanda
Funziona solo su un concorso?
Non fa le ricerche come il modulo Edit strutture in più estrazioni?
Sarebbe chiedere l impossibile vero?
Ci vorrebbe troppo tempo per le ricerche.
Domanda due
Ci fermiamo a -10 per poter utilizzare il gioca?
Grazie mille come sempre:)
Notte
 
L

LuigiB

Guest
probabilmente non ti funzionava proprio perche il percorso era sbagliato
quello che dici gia si puo fare anche se in un modo un po' diverso , è chiaro che
la velocita ne soffre quindi fai un range di analisi contenuto



Codice:
Option Explicit
Sub Main
    Dim sFile
    Dim collFig
    Dim CollPar
    Dim clsFig
    Dim nFatte
    Dim sFilefigura
    Dim nRigheMax,nColonneMax
    Dim Inizio
    Dim nRidondanzaEstr
    
    sFilefigura = GetDirectoryAppData & "Strutture\varie\cubo3test.dat"
    nRigheMax = 30
    nColonneMax = 55
    nRidondanzaEstr = 10 ' in ogni quadro mostra le ultime 10 del quadro precedete
    For Inizio = EstrazioneIni To EstrazioneFin Step 50
        ReDim aQuadro(nRigheMax,nColonneMax)
        Call AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr)
        'Call ScriviQuadro(aQuadro)
        Call GetCollFiguraUtenteQN(aQuadro,sFilefigura,collFig)
        'Call GetCollParallelepipediQN(aQuadro,CollPar)
        For Each clsFig In collFig
            Call DisegnaFiguraSpaziometricaQN(aQuadro,clsFig)
            If ScriptInterrotto Then Exit For

            DoEventsEx
            
        Next
        
        If ScriptInterrotto Then Exit For
        
    Next
    

End Sub
Sub ScriviQuadro(aQuadro)
    Dim k
    Dim s
    For k = 1 To UBound(aQuadro)
        s = ""
        For e = 1 To UBound(aQuadro,2)
            s = s & Format2(aQuadro(k,e)) & " "
        Next
        Call Scrivi(s)
    Next
End Sub
Sub AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr)
    Dim k,e,r,riga
    Dim nStart, nEnd,Col
    nStart = Inizio - nRidondanzaEstr
    If nStart <= 0 Then nStart = Inizio
    nEnd = nStart + (UBound(aQuadro) -1)
    For k = nStart To nEnd
        riga = riga + 1
        Col = 0
        For r = 1 To 12
            If r <> 11 Then
                For e = 1 To 5
                    Col = Col + 1
                    aQuadro(riga,Col) = Estratto(k,r,e)
                Next
            End If
        Next
    Next
End Sub
 

i legend

Premium Member
Buona giornata; )
Apro lottoced e vedo questo programma :)
Luigi oggi non è il mio compleanno ,ma vedo che ti sei preso avanti:)
Grazie mille.
Ricoperto riga per riga .
Ti ho mai detto che sei grande?
Grazie mille. Ora sono fuori nel pomeriggio faccio le prove.
Grazzzzzziiiiiiiiiiiiiiieeeeeeeeerr:)
 

i legend

Premium Member
Funziona:)
Ovviamente non avevo dubbi.
Grazie mille
Se riesco faccio una sorpresa a tutti altrimenti ci sbatto la testa.
Ciao; )
Grazie davvero è uno script fantastico
 

i legend

Premium Member
Luigi per me non è importante disegnare le figure quanto trovare la data in cui si trova il primo vertice la data inizio struttura . Ci sbatto un po la testa altridente ti chiederò qualche indizio.
Ciao e grazie ;)
 
L

LuigiB

Guest
Ciao , vedi se funziona , la logica comunque è questa

Option Explicit

Codice:
Option Explicit
Sub Main
    Dim sFile
    Dim collFig
    Dim CollPar
    Dim clsFig
    Dim nFatte
    Dim sFilefigura
    Dim nRigheMax,nColonneMax
    Dim Inizio
    Dim nRidondanzaEstr
    Dim bDisegnaFig
    Dim nInizioReale
    
    bDisegnaFig = True
    
    
    sFilefigura = GetDirectoryAppData & "Strutture\varie\cubo3test.dat"
    nRigheMax = 30
    nColonneMax = 55
    nRidondanzaEstr = 10 ' in ogni quadro mostra le ultime 10 del quadro precedete
    For Inizio = EstrazioneIni To EstrazioneFin Step 50
        ReDim aQuadro(nRigheMax,nColonneMax)
        Call AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr ,nInizioReale)
        'Call ScriviQuadro(aQuadro)
        Call GetCollFiguraUtenteQN(aQuadro,sFilefigura,collFig)
        'Call GetCollParallelepipediQN(aQuadro,CollPar)
        For Each clsFig In collFig
            If bDisegnaFig Then
                Call DisegnaFiguraSpaziometricaQN(aQuadro,clsFig)
            End If
            Call ScriviInfoFigTrov(clsFig,nInizioReale)
            
            Call Scrivi
            Call Scrivi(String(50,"="))
            Call Scrivi
            
            If ScriptInterrotto Then Exit For
            DoEventsEx
        Next
        If ScriptInterrotto Then Exit For
    Next
End Sub
Sub ScriviQuadro(aQuadro)
    Dim k
    Dim s
    For k = 1 To UBound(aQuadro)
        s = ""
        For e = 1 To UBound(aQuadro,2)
            s = s & Format2(aQuadro(k,e)) & " "
        Next
        Call Scrivi(s)
    Next
End Sub
Sub AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr ,nRetStart )
    Dim k,e,r,riga
    Dim nStart,nEnd,Col
    nStart = Inizio - nRidondanzaEstr
    If nStart <= 0 Then nStart = Inizio
    nRetStart = nStart
    
    nEnd = nStart +(UBound(aQuadro) - 1)
    For k = nStart To nEnd
        riga = riga + 1
        Col = 0
        For r = 1 To 12
            If r <> 11 Then
                For e = 1 To 5
                    Col = Col + 1
                    aQuadro(riga,Col) = Estratto(k,r,e)
                Next
            End If
        Next
    Next
End Sub
Sub ScriviInfoFigTrov(clsFig,Inizio)
    Dim clsV ' clsVertice
    Dim i,j,jj
    Dim nPrimaRiga,nUltimaRiga

    Dim nidEstrI,nidEstrF,nRuota
    
    ReDim aIdRighe(clsFig.CollCoord.count - 1)
    ReDim aRuoteInt(clsFig.CollCoord.Count)
    ReDim aNumeri(clsFig.CollCoord.Count)
    ReDim aChiusure(clsFig.CollCoord.Count)
    
    For Each clsV In clsFig.CollCoord
        
        aIdRighe(i) = clsV.Riga
        
        i = i + 1
        nRuota = GetRuotaFromColonna(clsV.Colonna)
        aRuoteInt(i) = nRuota
        
        If clsV.bChiusura = False Then
            j = j + 1
            aNumeri(j) = clsV.Numero
        Else
            jj = jj + 1
            
            aChiusure(jj) = clsV.Numero
            

        End If
        
    Next
    
    nPrimaRiga = MinimoV(aIdRighe)
    nUltimaRiga = MassimoV(aIdRighe)


    
    nidEstrI =Inizio + (nPrimaRiga-1)
    nidEstrF =Inizio  + (nUltimaRiga-1)
    
    Call EliminaRipetuti(aRuoteInt,True)
    Call EliminaRipetuti(aNumeri,True)
    Call EliminaRipetuti(aChiusure,True)
    

    
    Call Scrivi("Inizio struttura  : " & GetInfoEstrazione(nidEstrI))
    Call Scrivi("Fine struttura    : " & GetInfoEstrazione(nidEstrF))
    Call Scrivi("Ruote interessate : " & StringaRuote(aRuoteInt))
    Call Scrivi("Numeri            : " & StringaNumeri(aNumeri))
    Call Scrivi("Chiusure          : " & StringaNumeri(aChiusure))
    
    
    
End Sub
Function GetRuotaFromColonna(C)
    
    Dim r
    
    If C Mod 5 = 0 Then
        r = C /5
    Else
        If C > 5 Then
            r =(C\5) + 1
        Else
            r = 1
        End If
    End If
    
    If r = 11 Then r = 12
    GetRuotaFromColonna = r
        
End Function
 
Ultima modifica di un moderatore:

i legend

Premium Member
Provo anche questa meraviglia. Al momento sono via ma non vedo l ora di rientrare per provarlo.
Ciao e grazie mille.
Sto cercando imparare dal migliore; )
Buona domenica e buon pranzo. :)
 
L

LuigiB

Guest
nello script che avevo postato c'era un problema , la logica era corretta ma era sbagliata l'individuazione delle date e riportava i numeri doppi.
Fatte le dovute correzioni lo script l'ho modificato percio ricopialo daccapo vedi come funziona e poi dedicati a quello che volevi fare
ciao
 
L

LuigiB

Guest
ciao Legend , usa questo ultimo script che posto qui.
La differenza è che in questa nuova versione la struttura viene disegnata tramite codice in script

Codice:
Option Explicit
Sub Main
    Dim sFile
    Dim collFig
    Dim CollPar
    Dim clsFig
    Dim nFatte
    Dim sFilefigura
    Dim nRigheMax,nColonneMax
    Dim Inizio
    Dim nRidondanzaEstr
    Dim bDisegnaFig
    Dim nInizioReale
    Dim nStart,nEnd
    
    bDisegnaFig = True
    
    nStart = EstrazioneIni
    nEnd = EstrazioneFin
    
    
    sFilefigura = GetDirectoryAppData & "Strutture\varie\cubo3test.dat"
    nRigheMax = 30
    nColonneMax = 55
    nRidondanzaEstr = 10 ' in ogni quadro mostra le ultime 10 del quadro precedete
    For Inizio = nStart To nEnd Step nRigheMax
        ReDim aQuadro(nRigheMax,nColonneMax)
        Call AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr,nInizioReale)
        'Call ScriviQuadro(aQuadro)
        Call GetCollFiguraUtenteQN(aQuadro,sFilefigura,collFig)
        'Call GetCollParallelepipediQN(aQuadro,CollPar)
        For Each clsFig In collFig
            'If bDisegnaFig Then
            'Call DisegnaFiguraSpaziometricaQN(aQuadro,clsFig)
            'End If
            Call ScriviInfoFigTrov(clsFig,nInizioReale,bDisegnaFig)
            Call Scrivi
            Call Scrivi(String(50,"="))
            Call Scrivi
            If ScriptInterrotto Then Exit For
            DoEventsEx
        Next
        If ScriptInterrotto Then Exit For
        Call AvanzamentoElab(nStart,nEnd,Inizio)
    Next
End Sub
Sub ScriviQuadro(aQuadro)
    Dim k
    Dim s
    For k = 1 To UBound(aQuadro)
        s = ""
        For e = 1 To UBound(aQuadro,2)
            s = s & Format2(aQuadro(k,e)) & " "
        Next
        Call Scrivi(s)
    Next
End Sub
Sub AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr,nRetStart)
    Dim k,e,r,riga
    Dim nStart,nEnd,Col
    nStart = Inizio - nRidondanzaEstr
    If nStart <= 0 Then nStart = Inizio
    nRetStart = nStart
    nEnd = nStart +(UBound(aQuadro) - 1)
    For k = nStart To nEnd
        riga = riga + 1
        Col = 0
        For r = 1 To 12
            If r <> 11 Then
                For e = 1 To 5
                    Col = Col + 1
                    aQuadro(riga,Col) = Estratto(k,r,e)
                Next
            End If
        Next
    Next
End Sub
Sub ScriviInfoFigTrov(clsFig,Inizio,bDisegna)
    Dim clsV ' clsVertice
    Dim i,j,jj
    Dim nPrimaRiga,nUltimaRiga
    Dim nidEstrI,nidEstrF,nRuota
    ReDim aIdRighe(clsFig.CollCoord.count - 1)
    ReDim aRuoteInt(clsFig.CollCoord.Count)
    ReDim aNumeri(clsFig.CollCoord.Count)
    ReDim aChiusure(clsFig.CollCoord.Count)
    For Each clsV In clsFig.CollCoord
        aIdRighe(i) = clsV.Riga
        i = i + 1
        nRuota = GetRuotaFromColonna(clsV.Colonna)
        aRuoteInt(i) = nRuota
        If clsV.bChiusura = False Then
            j = j + 1
            aNumeri(j) = clsV.Numero
        Else
            jj = jj + 1
            aChiusure(jj) = clsV.Numero
        End If
    Next
    nPrimaRiga = MinimoV(aIdRighe)
    nUltimaRiga = MassimoV(aIdRighe)
    nidEstrI = Inizio +(nPrimaRiga - 1)
    nidEstrF = Inizio +(nUltimaRiga - 1)
    Call EliminaRipetuti(aRuoteInt,True)
    Call EliminaRipetuti(aNumeri,True)
    Call EliminaRipetuti(aChiusure,True)
    If bDisegna Then
        Call OrdinaMatrice(aRuoteInt,1)
        Call DisegnaStruttura(clsFig,aRuoteInt,nidEstrI,nidEstrF,Inizio)
    End If
    Call Scrivi("Inizio struttura  : " & GetInfoEstrazione(nidEstrI))
    Call Scrivi("Fine struttura    : " & GetInfoEstrazione(nidEstrF))
    Call Scrivi("Ruote interessate : " & StringaRuote(aRuoteInt))
    Call Scrivi("Numeri            : " & StringaNumeri(aNumeri))
    Call Scrivi("Chiusure          : " & StringaNumeri(aChiusure))
End Sub
Function GetRuotaFromColonna(C)
    Dim r
    If C Mod 5 = 0 Then
        r = C /5
    Else
        If C > 5 Then
            r =(C\5) + 1
        Else
            r = 1
        End If
    End If
    If r = 11 Then r = 12
    GetRuotaFromColonna = r
End Function
Sub DisegnaStruttura(clsFig,aRuote,nIdEstrIni,nIdEstrFin,nIdEstrBase)
    Dim nWPic ' larghezza oggetto pic
    Dim nHPic ' Altezza oggetto pic
    Dim nHCella ' altezza cella in mm
    Dim nWCella ' larghezza cella
    Dim nBordo ' bordo esterno all'immagine
    Dim nWDataEstr ' larghezza colonna data
    Dim nRuoteTot ' totale ruote interessate
    Dim nRighe ' quantita estrazioni interessate dalla struttura
    Dim nSpess
    Dim clsV
    Dim nX,nY,nXX,nYY
    Dim k,r,e,N,NTipo
    nBordo = 5
    nHCella = 7
    nWCella = 7
    nWDataEstr = 50
    nRuoteTot = UBound(aRuote)
    nRighe = nIdEstrFin -(nIdEstrIni - 1)
    Scrivi nRighe & "_" & nRuoteTot
    nWPic = nWDataEstr +(nRuoteTot *(nWCella*5))
    nHPic = nHCella +(nHCella * nRighe) ' la riga del titolo + le n righe
    nWPic = nWPic +(nBordo * 2)
    nHPic = nHPic +(nBordo * 2)
    PicClear
    Call PicSetDimensioni(nWPic,nHPic,nWPic,nHPic)
    ' Quadrato bordo esterno
    nSpess = 2
    nX = nBordo : nY = nBordo : nXX = nWPic - nBordo : nYY = nBordo
    Call PicLinea(nX,nY,nXX,nYY,,nSpess)
    nX = nWPic - nBordo : nY = nBordo : nXX = nX : nYY = nHPic - nBordo
    Call PicLinea(nX,nY,nXX,nYY,,nSpess)
    nX = nBordo : nY = nHPic - nBordo : nXX = nWPic - nBordo : nYY = nHPic - nBordo
    Call PicLinea(nX,nY,nXX,nYY,,nSpess)
    nX = nBordo : nY = nBordo : nXX = nX : nYY = nHPic - nBordo
    Call PicLinea(nX,nY,nXX,nYY,,nSpess)
    ' righe orizzontali
    nSpess = 1
    nX = nBordo
    nY = nBordo + nHCella
    nXX = nWPic - nBordo
    For k = 1 To nRighe
        If k = 1 Then
            nSpess = 2
        Else
            nSpess = 1
        End If
        nYY = nY
        Call PicLinea(nX,nY,nXX,nYY,,nSpess)
        nY = nY + nHCella
    Next
    ' righe verticali
    nSpess = 1
    nY = nBordo
    nYY = nHPic - nBordo
    nX = nWDataEstr + nBordo
    For k = 1 To nRuoteTot * 5
        nXX = nX
        If(k - 1) Mod 5 = 0 Then
            nY = nBordo
        Else
            nY = nBordo + nHCella
        End If
        Call PicLinea(nX,nY,nXX,nYY,,nSpess)
        nX = nX + nWCella
    Next
    ' intestazione tabella
    nY = nBordo + 1
    nX = nBordo + 2
    Call PicStampaTesto(nX,nY,"Data",,,,,10)
    ' nomi ruote
    nY = nBordo + 1
    For k = 1 To nRuoteTot
        nX = nBordo + nWDataEstr +((k - 1) *(nWCella *5)) + 2
        Call PicStampaTesto(nX,nY,NomeRuota(aRuote(k)),,,,,10)
    Next
    ' righe dati
    nY = nBordo + nHCella + 1
    For k = nIdEstrIni To nIdEstrFin
        nX = nBordo + 2
        Call PicStampaTesto(nX,nY,GetInfoEstrazione(k),,,,,8)
        nX = nBordo + nWDataEstr + 2
        For r = 1 To UBound(aRuote)
            For e = 1 To 5
                N = Estratto(k,aRuote(r),e)
                NTipo = 0
                For Each clsV In clsFig.CollCoord
                    If clsv.Numero = N Then
                        If clsv.riga +(nIdEstrBase - 1) = k Then
                            If GetRuotaFromColonna(clsV.colonna) = aRuote(r) Then
                                If clsv.bChiusura Then
                                    NTipo = 1
                                Else
                                    NTipo = 2
                                End If
                            End If
                        End If
                    End If
                Next
                If NTipo = 0 Then
                    Call PicStampaTesto(nX,nY,Format2(N),,,,,8)
                ElseIf NTipo = 1 Then
                    Call PicRiempi(nX,nY,vbGreen)
                    Call PicStampaTesto(nX,nY,Format2(N),,True,,,8,vbRed)
                ElseIf NTipo = 2 Then
                    Call PicRiempi(nX,nY,vbYellow)
                    Call PicStampaTesto(nX,nY,Format2(N),,True,,,8,vbBlue)
                End If
                nX = nX + nWCella
            Next
        Next
        nY = nY + nHCella
    Next
    Call PicEsegui
End Sub
 

i legend

Premium Member
Sono appena tornato. Tempo di una cena frugale
E ricopio lo script.
Ps :
Ti sembrerà stupido ma l ho letto almeno 6 volte.
E come quando a natale ricevi il regali che volevi ma non te la senti di chiedere.
Huaooo! !!!!!!!
Nessuno ha mai messo in rete codice di questo livello.
Prima erano pochissimi a fare script.
Da quando ci sei te sicuramente siamo moltissimi di più.
Mi spiace che siano così pochi a dirti grazie.
Per quello che vale
Tu dico grazie a nome di quei molti che non lo fanno.
Ora basta se no ti monti la testa.
Ps:
Se mai dovessi candidarti ti voto:)
P.p.s
Per il tuo bene non farlo;)
Ciao:)
 

i legend

Premium Member
Finito di ricopiare o riga x riga è un capolavoro.
Grazie :)
Appena lanciato.
Ti tengo aggiornato sul lavoro che intendo fare,
Ciao; )
 

i legend

Premium Member
La tabella piccola sembra non funzionare correttamente con i colori ma probabilmente ho sbagliato io nel ricopiare qualcosa.
Domani controllo tutto :)

Grazie mille ;)
Ciao
 
Ultima modifica:
L

LuigiB

Guest
ciao legend .. non so dalle prove che ho fatto i colori li mette bene .. al limite posta un immagine per farmi capire cosa fa a te.
 

i legend

Premium Member
Luigi se faccio tethering Se ho virus nel pc lo passo al cell?
Altrimenti non so come postare le immagini:)
A domani.
Ciao
 

i legend

Premium Member
Non si chiude la riga della tabella della seconda ruota e il colore si distribuisce tutto attorno.
Comunque devo controllare
Dove ho sbagliato a ricopiare.
Lo faccio domani con calma :)
Ciao:)
P.s
Alzi l astice la della conoscenza.
Sio costretti a postare script sempre migliori.
Se continuo così forse fra 15 anni arrivo ai livelli attuali di Joe. O almeno è quello che spero; )
Ciao :)
 

i legend

Premium Member
Ciao luigi ovviamente come pensavo avevo sbagliato a ricopiare il codice;
Cmq il fatto che ho capito dove andare a cercare gli errori vuol dire che ho capito lo script.
Grazie semplicemente perfetto.
Ammiro la tua capacita logica.
Lo ripeto
Lost in ammiration :)
Sei un mito
 

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 28 marzo 2024
    Bari
    49
    73
    67
    86
    19
    Cagliari
    64
    36
    37
    02
    04
    Firenze
    66
    27
    44
    90
    17
    Genova
    09
    44
    78
    85
    19
    Milano
    70
    14
    47
    38
    27
    Napoli
    80
    29
    28
    45
    39
    Palermo
    54
    59
    78
    47
    62
    Roma
    17
    22
    49
    52
    88
    Torino
    71
    35
    75
    74
    60
    Venezia
    40
    84
    02
    63
    29
    Nazionale
    08
    13
    44
    69
    85
    Estrazione Simbolotto
    Firenze
    06
    35
    16
    18
    05

Ultimi Messaggi

Alto