Figure utente esempi utilizzo.

genios · 16 Ottobre 2015

Grazie .

LuigiB · 17 Ottobre 2015

questo ultimo script disegna anche i legami tra i numeri , disponendo della versioen 1.5.62 (al monento non ancora disponibile ) si potranno analizzare tutte le estrazion del range contemporaneamente senza gestire l'archivio a pezzetti. Per farsi che ciò avvenga bisogna mettere il rem su due righe e levarlo da altre due coem descritto nello script setesso.

nel frattempo si puo usare con le versioni inferiori di spazioometria copiando lo script cosi com'è

hostare immagini

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\Rubino4Chiusure.dat"
    
    
    
    ' solo da spaziometria 1.5.62 si puo gestire l'intero archivio in un colpo solo
    'nRigheMax = nEnd -(nStart - 1) ' analizza tutte le estrazioni in una volta sola
    'nRidondanzaEstr = 0 ' in ogni quadro mostra le ultime 10 del quadro precedete
    
    
    'se si ha la versione 1.5.62 o superiore remmare le seguenti 2 righe
    nRigheMax = 30 ' analizza tutte le estrazioni in una volta sola
    nRidondanzaEstr = 10 ' in ogni quadro mostra le ultime 10 del quadro precedete
        
        
    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, nPrimaColonna
    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)
    nPrimaColonna = 10000
    
    For Each clsV In clsFig.CollCoord
    
        aIdRighe(i) = clsV.Riga
        If clsV.Colonna < nPrimaColonna Then nPrimaColonna = clsV.Colonna
        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 ,nPrimaRiga ,nPrimaColonna )
    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,  nPrimaRiga ,nPrimaColonna )
    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 , clsLeg
    Dim nX,nY,nXX,nYY
    Dim k,r,e,N,NTipo
    Dim nRigaTmp , nColonnaTmp
    
    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
    
     ' legami celle
        
       
    ' 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
    
     For Each clsLeg In clsFig.CollLegami
            'Debug.Print clsLeg.v1riga & "." & clsLeg.v1colonna
            ' Debug.Print clsLeg.v1riga - nPrimaRiga & "." & clsLeg.v1colonna
           nRigaTmp = (clsLeg.v1riga - nPrimaRiga)+1
         'nColonnaTmp = (clsLeg.V1Colonna - nPrimaColonna) + 1
           nColonnaTmp = GetIdColGrigliaFromColStrutt (clsLeg.V1Colonna ,aRuote ,nPrimaColonna  )

              
         nX =nBordo + nWDataEstr + (nWCella *(nColonnaTmp -1))+ nWCella\2
         nY =nBordo + nHCella + (nHCella *(nRigaTmp -1))+ nHCella\2
         
         nRigaTmp = (clsLeg.v2riga - nPrimaRiga)+1
         nColonnaTmp = GetIdColGrigliaFromColStrutt (clsLeg.V2Colonna ,aRuote ,nPrimaColonna  )

 
        
         nXX =nBordo + nWDataEstr + (nWCella *(nColonnaTmp -1))+ nWCella\2
         nYY =nBordo + nHCella + (nHCella *(nRigaTmp -1))+ nHCella\2
    
         Call PicLinea (nX , nY ,nXX , nYY  ,vbRed ,3)    

      
        Next
    
    Call PicEsegui
End Sub

Function GetIdColGrigliaFromColStrutt (nColonna   , aRuote , nPrimaColonna)
    Dim Ruota
    Dim k
    Dim nPrimaColRuota
    Dim nColTmp
    
    If nColonna Mod 5 =0 Then
        nColTmp =  5
    Else
        nColTmp =  nColonna Mod 5
        
    End If    
    Ruota = GetRuotaFromColonna(nColonna)
    For k = 1 To UBound(aRuote)
        If aRuote(k) = Ruota Then
            nPrimaColRuota  = ((k-1)*5)+1
            Exit For
        End If
    Next
    GetIdColGrigliaFromColStrutt  =  (nPrimaColRuota  -1) + nColTmp

End Function

i legend · 17 Ottobre 2015

Ciao luigi trovato tempo e voglio pet finire lo script vedo

È già in linea questo ultima versione?
Se dovessi fare l aggiornamento e presente anche il plug in dei sistemi virtuali?
Ciao e grazie mille

Buon week end
A dopo

LuigiB · 17 Ottobre 2015

si legend .. ti consiglio di farlo ..

fillotto · 23 Agosto 2017

LuigiB;n1927058 ha scritto:

questo ultimo script disegna anche i legami tra i numeri , disponendo della versioen 1.5.62 (al monento non ancora disponibile ) si potranno analizzare tutte le estrazion del range contemporaneamente senza gestire l'archivio a pezzetti. Per farsi che ciò avvenga bisogna mettere il rem su due righe e levarlo da altre due coem descritto nello script setesso.

nel frattempo si puo usare con le versioni inferiori di spazioometria copiando lo script cosi com'è

hostare immagini

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\Rubino4Chiusure.dat"



' solo da spaziometria 1.5.62 si puo gestire l'intero archivio in un colpo solo
'nRigheMax = nEnd -(nStart - 1) ' analizza tutte le estrazioni in una volta sola
'nRidondanzaEstr = 0 ' in ogni quadro mostra le ultime 10 del quadro precedete


'se si ha la versione 1.5.62 o superiore remmare le seguenti 2 righe
nRigheMax = 30 ' analizza tutte le estrazioni in una volta sola
nRidondanzaEstr = 10 ' in ogni quadro mostra le ultime 10 del quadro precedete


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, nPrimaColonna
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)
nPrimaColonna = 10000

For Each clsV In clsFig.CollCoord

aIdRighe(i) = clsV.Riga
If clsV.Colonna < nPrimaColonna Then nPrimaColonna = clsV.Colonna
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 ,nPrimaRiga ,nPrimaColonna )
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, nPrimaRiga ,nPrimaColonna )
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 , clsLeg
Dim nX,nY,nXX,nYY
Dim k,r,e,N,NTipo
Dim nRigaTmp , nColonnaTmp

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

' legami celle


' 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

For Each clsLeg In clsFig.CollLegami
'Debug.Print clsLeg.v1riga & "." & clsLeg.v1colonna
' Debug.Print clsLeg.v1riga - nPrimaRiga & "." & clsLeg.v1colonna
nRigaTmp = (clsLeg.v1riga - nPrimaRiga)+1
'nColonnaTmp = (clsLeg.V1Colonna - nPrimaColonna) + 1
nColonnaTmp = GetIdColGrigliaFromColStrutt (clsLeg.V1Colonna ,aRuote ,nPrimaColonna )


nX =nBordo + nWDataEstr + (nWCella *(nColonnaTmp -1))+ nWCella\2
nY =nBordo + nHCella + (nHCella *(nRigaTmp -1))+ nHCella\2

nRigaTmp = (clsLeg.v2riga - nPrimaRiga)+1
nColonnaTmp = GetIdColGrigliaFromColStrutt (clsLeg.V2Colonna ,aRuote ,nPrimaColonna )



nXX =nBordo + nWDataEstr + (nWCella *(nColonnaTmp -1))+ nWCella\2
nYY =nBordo + nHCella + (nHCella *(nRigaTmp -1))+ nHCella\2

Call PicLinea (nX , nY ,nXX , nYY ,vbRed ,3)


Next

Call PicEsegui
End Sub

Function GetIdColGrigliaFromColStrutt (nColonna , aRuote , nPrimaColonna)
Dim Ruota
Dim k
Dim nPrimaColRuota
Dim nColTmp

If nColonna Mod 5 =0 Then
nColTmp = 5
Else
nColTmp = nColonna Mod 5

End If
Ruota = GetRuotaFromColonna(nColonna)
For k = 1 To UBound(aRuote)
If aRuote(k) = Ruota Then
nPrimaColRuota = ((k-1)*5)+1
Exit For
End If
Next
GetIdColGrigliaFromColStrutt = (nPrimaColRuota -1) + nColTmp

End Function

Ho ripreso questa discussione e questo script in quanto ,in questi ultimi tempi, si è un po trascurato una parte delle potenzialità di "spaziometria"ovvero quella di testare le figure spaziometriche in particolare quelle definite dall'utente.
Ho fatto una figura utente con l'editor quindi ho visto quante volte si è presentata fino ad oggi , successivamente l'ho provata (la figura) su questo script ,ovviamente modificando il percorso remmando e "sremmando" quanto raccomandato all'inizio da Luigi e ho trovato la stessa quantità di figure ,solo che questa volta tutte belle disegnate con l'indicazione del principio e fine figura!!!!!
Tutto molto bello.....però mi sarebbe piaciuto che una volta impostate il numero di estrazioni desiderate e la sorte desiderata mi si mostrasse anche mostrasse anche il resoconto è possibile? qualcuno è in grado di darmi un'aiuto?

fillotto · 23 Agosto 2017

LuigiB;n1927058 ha scritto:

questo ultimo script disegna anche i legami tra i numeri , disponendo della versioen 1.5.62 (al monento non ancora disponibile ) si potranno analizzare tutte le estrazion del range contemporaneamente senza gestire l'archivio a pezzetti. Per farsi che ciò avvenga bisogna mettere il rem su due righe e levarlo da altre due coem descritto nello script setesso.

nel frattempo si puo usare con le versioni inferiori di spazioometria copiando lo script cosi com'è

[IMG2=JSON]{"data-align":"none","data-size":"full","src":"http:\/\/s8.postimg.org\/id6oxi2id\/image.jpg"}[/IMG2]
hostare immagini

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\Rubino4Chiusure.dat"



' solo da spaziometria 1.5.62 si puo gestire l'intero archivio in un colpo solo
'nRigheMax = nEnd -(nStart - 1) ' analizza tutte le estrazioni in una volta sola
'nRidondanzaEstr = 0 ' in ogni quadro mostra le ultime 10 del quadro precedete


'se si ha la versione 1.5.62 o superiore remmare le seguenti 2 righe
nRigheMax = 30 ' analizza tutte le estrazioni in una volta sola
nRidondanzaEstr = 10 ' in ogni quadro mostra le ultime 10 del quadro precedete


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, nPrimaColonna
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)
nPrimaColonna = 10000

For Each clsV In clsFig.CollCoord

aIdRighe(i) = clsV.Riga
If clsV.Colonna < nPrimaColonna Then nPrimaColonna = clsV.Colonna
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 ,nPrimaRiga ,nPrimaColonna )
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, nPrimaRiga ,nPrimaColonna )
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 , clsLeg
Dim nX,nY,nXX,nYY
Dim k,r,e,N,NTipo
Dim nRigaTmp , nColonnaTmp

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

' legami celle


' 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

For Each clsLeg In clsFig.CollLegami
'Debug.Print clsLeg.v1riga & "." & clsLeg.v1colonna
' Debug.Print clsLeg.v1riga - nPrimaRiga & "." & clsLeg.v1colonna
nRigaTmp = (clsLeg.v1riga - nPrimaRiga)+1
'nColonnaTmp = (clsLeg.V1Colonna - nPrimaColonna) + 1
nColonnaTmp = GetIdColGrigliaFromColStrutt (clsLeg.V1Colonna ,aRuote ,nPrimaColonna )


nX =nBordo + nWDataEstr + (nWCella *(nColonnaTmp -1))+ nWCella\2
nY =nBordo + nHCella + (nHCella *(nRigaTmp -1))+ nHCella\2

nRigaTmp = (clsLeg.v2riga - nPrimaRiga)+1
nColonnaTmp = GetIdColGrigliaFromColStrutt (clsLeg.V2Colonna ,aRuote ,nPrimaColonna )



nXX =nBordo + nWDataEstr + (nWCella *(nColonnaTmp -1))+ nWCella\2
nYY =nBordo + nHCella + (nHCella *(nRigaTmp -1))+ nHCella\2

Call PicLinea (nX , nY ,nXX , nYY ,vbRed ,3)


Next

Call PicEsegui
End Sub

Function GetIdColGrigliaFromColStrutt (nColonna , aRuote , nPrimaColonna)
Dim Ruota
Dim k
Dim nPrimaColRuota
Dim nColTmp

If nColonna Mod 5 =0 Then
nColTmp = 5
Else
nColTmp = nColonna Mod 5

End If
Ruota = GetRuotaFromColonna(nColonna)
For k = 1 To UBound(aRuote)
If aRuote(k) = Ruota Then
nPrimaColRuota = ((k-1)*5)+1
Exit For
End If
Next
GetIdColGrigliaFromColStrutt = (nPrimaColRuota -1) + nColTmp

End Function

Ho ripreso questa discussione e questo script in quanto ,in questi ultimi tempi, si è un po trascurato una parte delle potenzialità di "spaziometria"ovvero quella di testare le figure spaziometriche in particolare quelle definite dall'utente.
Ho fatto una figura utente con l'editor quindi ho visto quante volte si è presentata fino ad oggi , successivamente l'ho provata (la figura) su questo script ,ovviamente modificando il percorso remmando e "sremmando" quanto raccomandato all'inizio da Luigi e ho trovato la stessa quantità di figure ,solo che questa volta tutte belle disegnate con l'indicazione del principio e fine figura!!!!!
Tutto molto bello.....però mi sarebbe piaciuto che una volta impostate il numero di estrazioni desiderate e la sorte desiderata mi si mostrasse anche il resoconto è possibile? qualcuno è in grado di darmi un'aiuto?

fillotto · 25 Agosto 2017

Più di 200 visualizzazioni in neanche 2 giorni, evidendemente l'argomento interessa !! qualcuno mi può aiutare?

gian332 · 4 Ottobre 2017

Ciao filolotto.... non vorrei peccare di ingenuità data la mia poca esperienza

,...credo che per avere un resoconto serva estrapolare i numeri da mettere in gioco
eseguire le giocate e alla fine è possibile avere il resoconto

fillotto · 5 Ottobre 2017

gian332;n2081055 ha scritto:
Ciao filolotto.... non vorrei peccare di ingenuità data la mia poca esperienza ,...credo che per avere un resoconto serva estrapolare i numeri da mettere in gioco
eseguire le giocate e alla fine è possibile avere il resoconto

Sicuramente è come dici tu gian332,solo che io non sono capace di "incastonare" in questo script (di Luigi) i comandi necessari affinchè nell'output mi dia anche il resoconto è questo che chiedevo ....

Rubino · 5 Ottobre 2017

ciao

prova a sostituire tutta questa routine con queste modifiche
tieni conto che le poste in gioco, ho messo ambo-terno-quaterna 1euro simbolico

devi correggerlo come vuoi
redim ps(5) e relative sorti
se vuoi anche le ambate devi mettere ps(1) = 1

inserire anche i numeri di chiusura.come impostagiocata 2

Sub ScriviInfoFigTrov(clsFig,Inizio,bDisegna)
Dim clsV ' clsVertice
Dim i,j,jj
Dim nPrimaRiga,nUltimaRiga,nPrimaColonna
Dim nidEstrI,nidEstrF,nRuota,c,es
ReDim aIdRighe(clsFig.CollCoord.count - 1)
ReDim aRuoteInt(clsFig.CollCoord.Count)
ReDim aNumeri(clsFig.CollCoord.Count)
ReDim aChiusure(clsFig.CollCoord.Count)
nPrimaColonna = 10000
For Each clsV In clsFig.CollCoord
aIdRighe(i) = clsV.Riga
If clsV.Colonna < nPrimaColonna Then nPrimaColonna = clsV.Colonna
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,nidEstr F,Inizio,nPrimaRiga,nPrimaColonna)
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))
'''''''''''''''''
ReDim ps(5)
ps(2) = 1
ps(3) = 1
ps(4) = 1
c=9
es = nidEstrF
ImpostaGiocata 1,aNumeri,aRuoteInt,ps,c,2
Gioca es
'''' ScriviResoconto(True)

in seguito poi riattiva il resoconto se vedi che va bene
naturalmente è solo una bozza buttata li senza pensare

ciao

fillotto · 5 Ottobre 2017

Grazie Rubino vado a fare mente locale a quello che più di un mese fa avevo pensato per utilizzare le strutture utente

fillotto · 6 Ottobre 2017

Rubino;n2081147 ha scritto:
ciao

prova a sostituire tutta questa routine con queste modifiche
tieni conto che le poste in gioco, ho messo ambo-terno-quaterna 1euro simbolico

devi correggerlo come vuoi
redim ps(5) e relative sorti
se vuoi anche le ambate devi mettere ps(1) = 1

inserire anche i numeri di chiusura.come impostagiocata 2

Sub ScriviInfoFigTrov(clsFig,Inizio,bDisegna)
.......
........
ImpostaGiocata 1,aNumeri,aRuoteInt,ps,c,2
Gioca es
'''' ScriviResoconto(True)
in seguito poi riattiva il resoconto se vedi che va bene
naturalmente è solo una bozza buttata li senza pensare

ciao

Scusa Rubino ma quando dici"prova a sostituire tutta questa routine con queste modifiche"
a cosa ti riferisci?? queta inviata da te è una sub e come tale non gira da sola ma va all'interno di una main , e dove e a che posto di quale Sub la metto??Io ho adattato lo script di Luigi(vedi sotto) e funziona,nel senso che mi da tutte le figure di una struttura utente ma io volevo come già detto vedere la possibilità che mi desse anche i risultati con il resoconto,perdonami ma non ho capito

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\MieFigure\selv1.dat"



' solo da spaziometria 1.5.62 si puo gestire l'intero archivio in un colpo solo
nRigheMax = nEnd -(nStart - 1) ' analizza tutte le estrazioni in una volta sola
nRidondanzaEstr = 0 ' in ogni quadro mostra le ultime 10 del quadro precedete


'se si ha la versione 1.5.62 o superiore remmare le seguenti 2 righe
' nRigheMax = 30 ' analizza tutte le estrazioni in una volta sola
'nRidondanzaEstr = 10 ' in ogni quadro mostra le ultime 10 del quadro precedete


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,nPrimaColonna
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)
nPrimaColonna = 10000

For Each clsV In clsFig.CollCoord

aIdRighe(i) = clsV.Riga
If clsV.Colonna < nPrimaColonna Then nPrimaColonna = clsV.Colonna
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,nPrimaRiga,nPrimaColonna)
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,nPrimaRiga,nPrimaColonna)
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,clsLeg
Dim nX,nY,nXX,nYY
Dim k,r,e,N,NTipo
Dim nRigaTmp,nColonnaTmp

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

' legami celle


' 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

For Each clsLeg In clsFig.CollLegami
'Debug.Print clsLeg.v1riga & "." & clsLeg.v1colonna
' Debug.Print clsLeg.v1riga - nPrimaRiga & "." & clsLeg.v1colonna
nRigaTmp =(clsLeg.v1riga - nPrimaRiga) + 1
'nColonnaTmp = (clsLeg.V1Colonna - nPrimaColonna) + 1
nColonnaTmp = GetIdColGrigliaFromColStrutt(clsLeg.V1Colonna,aRuote,nPrimaColonna)


nX = nBordo + nWDataEstr +(nWCella *(nColonnaTmp - 1)) + nWCella\2
nY = nBordo + nHCella +(nHCella *(nRigaTmp - 1)) + nHCella\2

nRigaTmp =(clsLeg.v2riga - nPrimaRiga) + 1
nColonnaTmp = GetIdColGrigliaFromColStrutt(clsLeg.V2Colonna,aRuote,nPrimaColonna)



nXX = nBordo + nWDataEstr +(nWCella *(nColonnaTmp - 1)) + nWCella\2
nYY = nBordo + nHCella +(nHCella *(nRigaTmp - 1)) + nHCella\2

Call PicLinea(nX,nY,nXX,nYY,vbRed,3)


Next

Call PicEsegui
End Sub

Function GetIdColGrigliaFromColStrutt(nColonna,aRuote,nPrimaColonna)
Dim Ruota
Dim k
Dim nPrimaColRuota
Dim nColTmp

If nColonna Mod 5 = 0 Then
nColTmp = 5
Else
nColTmp = nColonna Mod 5

End If
Ruota = GetRuotaFromColonna(nColonna)
For k = 1 To UBound(aRuote)
If aRuote(k) = Ruota Then
nPrimaColRuota =((k - 1)*5) + 1
Exit For
End If
Next
GetIdColGrigliaFromColStrutt =(nPrimaColRuota - 1) + nColTmp

End Function

Rubino · 6 Ottobre 2017

ciao Fillotto
probabilmente non ci siamo capiti.

la routine è quella nel tuo script originario o di LuigiB,
non c'è nulla da cambiare, c'è solo da aggiungere qualche istruzione nel punto giusto per avere il dettaglio degli esiti.

la routine che va modificata è questa con questo nome
Sub ScriviInfoFigTrov(clsFig,Inizio,bDisegna)

dopo queste istruzioni specificate nel tuo script

Call OrdinaMatrice(aRuoteInt,1)
Call DisegnaStruttura(clsFig,aRuoteInt,nidEstrI,nidEstr F,Inizio,nPrimaRiga,nPrimaColonna)
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))
''''''''''''''''
qui puoi inserire queste istruzioni

ReDim ps(5)
ps(1) = 1
ps(2) = 1
ps(3) = 1
ps(4) = 1
c=9
es = nidEstrF
ImpostaGiocata 1,aNumeri,aRuoteInt,ps,c
ImpostaGiocata 2,aChiusure,aRuoteint,ps,c
Gioca es

tieni conto che la dim ps deve contenere la posta simbolica per la sorte di ambata,ambo,terno,quaterna (1,2,3,4)

il campo c sta per ncolpi , io ho abbozzato 9 colpi, ma tu puoi mettere quelle che vuoi

nell'istruzione Gioca es devono essere listati gli esiti avuti nelle 2 arrays
una aNumeri e una aChiusure

ricordati di assegnare se vuoi i campi che non sono stati definiti nel tuo script perché nuovi

a questo punto rimane il ScriviResoconto(true)

che va messo dopo nel punto giusto, per ottenere l'andamento generale del metodo .

fillotto · 7 Ottobre 2017

Grazie Rubino adesso va bene, ho aggiunto solo Dim es e Dm c in questa maniera CODE]
Dim es

im c
ReDim ps1(5)
ps1(1) = 1
ReDim ps2(5)
ps2(2) = 1
ps2(3) = 0.5

c=9
es = nidEstrF
ImpostaGiocata 1,aNumeri,aRuoteInt,ps1,c,1
ImpostaGiocata 2,aChiusure,aRuoteInt,ps2,c,2
Gioca es
ScriviResoconto(True)

[/CODE]
e funziona . Per la cronaca si tratta di una semplice figura utente composta da 6 num 2 di base ripetuti (4) e quattro singoli figura trovata 69 volte e alla fine della giostra sono andato sostanzialmente pari grazie ad un terno questo è il rendiconto finale , a proposito ma l'8% è andato in vigore o meno ? nel rendiconto il netto è ancora al 6%P.S. ma come si manda un'immagine?

Codice:

[FONT=Courier New][SIZE=10px][COLOR=#000000]Inizio struttura  : [09344] [ 85] 18.07.2017[/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]Fine struttura    : [09347] [ 88] 25.07.2017[/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]Ruote interessate : NA[/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]Numeri            : 31.77[/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]Chiusure          : 17.37.46.73[/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000][B]Estrazione generatrice del pronostico 09347 [ 88 - 25/07/2017][/B][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000][B]G 0001 Numeri in gioco : 31.77 su NA per Estratto[/B][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#ff0000]V N. [31.77                         ] [NA]     [.. .. .. .. 31] C.   1 Estratto   09348 [ 89 - 27/07/2017][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]Interrotta per esito verificato[/COLOR][/SIZE][/FONT]  [FONT=Courier New][SIZE=10px][COLOR=#000000][B]G 0002 Numeri in gioco : 17.37.46.73 su NA per Ambo,Terno[/B][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]  N. [17.37.46.73                   ] [NA]     [.. .. .. .. ..] C.   1            09348 [ 89 - 27/07/2017][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]  N. [17.37.46.73                   ] [NA]     [.. .. .. .. ..] C.   2            09349 [ 90 - 29/07/2017][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]  N. [17.37.46.73                   ] [NA]     [.. .. .. 73 ..] C.   3 Estratto   09350 [ 91 - 01/08/2017][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]  N. [17.37.46.73                   ] [NA]     [.. .. 46 .. ..] C.   4 Estratto   09351 [ 92 - 03/08/2017][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]  N. [17.37.46.73                   ] [NA]     [.. .. .. .. ..] C.   5            09352 [ 93 - 05/08/2017][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]  N. [17.37.46.73                   ] [NA]     [.. .. .. .. ..] C.   6            09353 [ 94 - 08/08/2017][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]  N. [17.37.46.73                   ] [NA]     [.. .. .. .. ..] C.   7            09354 [ 95 - 10/08/2017][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]  N. [17.37.46.73                   ] [NA]     [.. .. .. .. ..] C.   8            09355 [ 96 - 12/08/2017][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]  N. [17.37.46.73                   ] [NA]     [.. .. .. .. ..] C.   9            09356 [ 97 - 16/08/2017][/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]Interrotta per raggiunta durata[/COLOR][/SIZE][/FONT]  [FONT=Courier New][SIZE=10px][COLOR=#000000]+----------------------------------------+ | Prima Giocata      : 9347              | | Ultima Giocata     : 9347              | | Range              : 1                 | | Casi giocab perc.  : %                 |[/COLOR][/SIZE][/FONT] [FONT=Courier New][SIZE=10px][COLOR=#000000]+----------------------------------------+ +----------------------------------+ +----------------------------------+ +----------------------------------+  |               RESOCONTO                | |       DISTRIBUZIONE ESITI        | | DISTRIBUZIONE ESITI PERCENTUALI  | |        DISTRIBUZIONE CASI        |  +----------------------------------------+ +----------------------------------+ +----------------------------------+ +----------------------------------+  | Casi esaminati     :               69  | | RT | Est | Amb | Ter | Qua | Cin | | RT | Est | Amb | Ter | Qua | Cin | | RT |  Q  |                       |  | Casi vincenti      :               56  | +----------------------------------+ +----------------------------------+ +----------------------------------+  | Percentuale pos.   :          81,16 %  | | BA |     |     |     |     |     | | BA |     |     |     |     |     | | BA |     |                       |  | Pronostici totali  :                2  | | CA |     |     |     |     |     | | CA |     |     |     |     |     | | CA |     |                       |  | Pronostici vinc.   :                1  | | FI |     |     |     |     |     | | FI |     |     |     |     |     | | FI |     |                       |  | Percentuale pos.   :             50 %  | | GE |     |     |     |     |     | | GE |     |     |     |     |     | | GE |     |                       |  | Giocate in corso   :                0  | | MI |     |     |     |     |     | | MI |     |     |     |     |     | | MI |     |                       |  | Giocate terminate  :                2  | | NA |    1|     |     |     |     | | NA |  100|     |     |     |     | | NA |    2|                       |  | Bollette giocate   :               10  | | PA |     |     |     |     |     | | PA |     |     |     |     |     | | PA |     |                       |  | Bollette vincenti  :                1  | | RO |     |     |     |     |     | | RO |     |     |     |     |     | | RO |     |                       |  | Attesa media       :                1  | | TO |     |     |     |     |     | | TO |     |     |     |     |     | | TO |     |                       |  | Spesa              :          14,50 €  | | VE |     |     |     |     |     | | VE |     |     |     |     |     | | VE |     |                       |  | Vincita            :           5,28 €  | | NZ |     |     |     |     |     | | NZ |     |     |     |     |     | | NZ |     |                       |  | Guadagno           :          -9,22 €  | | TT |     |     |     |     |     | | TT |     |     |     |     |     | | TT |     |                       |  | Perc. Rendimento   :         -1,364 %  | +----------------------------------+ +----------------------------------+ +----------------------------------+  | Mass. Esposizione  :           0,00 €  |     | Estratto su ruota  :                1  |                                                                                                                 |                                        |                                                                                                                 +----------------------------------------+                                                [/COLOR][/SIZE][/FONT]

Cerca

Cerca

Figure utente esempi utilizzo.

genios

Advanced Member >PLATINUM<

LuigiB

Guest

i legend

Premium Member

LuigiB

Guest

fillotto

Advanced Member >PLATINUM<

fillotto

Advanced Member >PLATINUM<

fillotto

Advanced Member >PLATINUM<

gian332

Banned

fillotto

Advanced Member >PLATINUM<

Rubino

Guest

fillotto

Advanced Member >PLATINUM<

fillotto

Advanced Member >PLATINUM<

Rubino

Guest

fillotto

Advanced Member >PLATINUM<

Ultima estrazione Lotto

Ultimi Messaggi