secondo il mio modesto parere devono rispettare certe disposizioni che consentono di tracciare figure anche fantsiose ma comunque regolari (tipo frattali o come questo listato che si puo repire
sul forum di Ramco)
Sub main()
'rif. 0903_40a Ro Omaggio sul quadro
' prelevato da Rosanna dicembre 2008 - forum Ramcolotto.it
'figura statica di 8 elementi
'-> numero di chiusure (elementi non ripetuti) a scelta
'-> prova per un cubo
Dim nu(8,2),num(5),ru(5),poste(2),tt(1),post(1),col(8,2),ruote(5)
tt(1)=11
post(1)=1
poste(2)=1
colpi=40
Scrivi
Scrivi " cubo sul quadro esteso Standard "&chr(10),1
ch= 2 '< ---NOTA impostare qui il n° di chiusure desiderato
ch=ch+1
'----------------------------------------------
'----------------------------------------------
For es=EstrazioneFin-200 To EstrazioneFin
Messaggio "Elaboro "& es
For p = 1 To 50
Erase ru : Erase nu : Erase num : co= 0 : Erase col
'-------------------------------------------------------------------
If p < 41 Then 'limite destro
p1=p+3 : p2=p1+2 : p3=p2+3
nu(1,1)=Estratto(es,ricavaruota(p), ricavaposizione(p)) 'col(1,2)=nu(1,1)
nu(2,1)=Estratto(es,ricavaruota(p2),ricavaposizione(p2))
nu(3,1)=Estratto(es-3,ricavaruota(p1),ricavaposizione(p1))
nu(4,1)=Estratto(es-3,ricavaruota(p3),ricavaposizione(p3))
nu(5,1)=Estratto(es-5,ricavaruota(p),ricavaposizione(p))
nu(6,1)=Estratto(es-5,ricavaruota(p2),ricavaposizione(p2))
nu(7,1)=Estratto(es-8,ricavaruota(p1),ricavaposizione(p1))
nu(8,1)=Estratto(es-8,ricavaruota(p3),ricavaposizione(p3))
For x= 1 To 7 'creo tutte le coppie (ambi) coi nu
For y = x+1 To 8
If nu(x,2)< 3 Then ' se il 1° elemento è ancora da valutare o ancora senza assegnazioni positive
If nu(x,1)=nu(y,1) Then nu(x,2)=(nu(x,2))+1 'se il num è uguale all'altro, gli aggiungo valore 1
End If
If nu(y,2)< 3 Then 'faccio la stessa cosa col 2° elemento
If nu(x,1)=nu(y,1) Then nu(y,2)=(nu(y,2))+1 'se il num è uguale all'altro, gli aggiungo valore 1
End If
Next
Next
For i= 1 To 8 'terminata l'analisi di ciascun numero
If nu(i,2)=0 Then co= co+1 'verifico quali nu non sono doppi, cioè conto le chiusure spaziometriche
If nu(i,2)>1 Then cot= cot+1 'verifico quali nu hanno più di una ripetizioni
Next
c=0
If co < ch And cot>0 Then 'se le chiusure sono quelle volute allora le carico su un vettore per le giocate
For i= 1 To 8
If nu(i,2)=0 Then c= c+1 : num(c)=nu(i,1)
Next
ru(1)=ricavaruota(p)
ru(2)=ricavaruota(p1)
ru(3)=ricavaruota(p2)
ru(4)=ricavaruota(p3)
ru(5)=ricavaruota(p4)
'--------- blocco per il grassetto
Erase ruote : cr=0 'cr=contatore delle ruote
For i= 1 To 8
For y= 1 To c
If nu(i,1)=num
Then col(i,1)=1
Next
Next
For i= 1 To 5 '
If col(i,1)=1 Then cr=cr+1 : ruote(cr)=col(i,2)
Next
Scrivi String(67,"-")
Scrivi "cubo " & DataEstrazione(es-8)& " al " & DataEstrazione(es)&chr(10),1
ColoreTesto 1
Scrivi Space(2)& Space(2),0,0: Scrivi Space(8)& Format2(nu(7,1)),col(7,1),0 : Scrivi Space(8)& Format2(nu(8,1)),col(8,1)
Scrivi Space(2) & Space(2),0,0: Scrivi Space(2)& Format2(nu(5,1)),col(5,1),0 : Scrivi Space(8)& Format2(nu(6,1)),col(6,1)
Scrivi Space(2)& Space(2),0,0: Scrivi Space(8)& Format2(nu(3,1)),col(3,1),0 : Scrivi Space(8)& Format2(nu(4,1)),col(4,1)
Scrivi Space(2) & Space(2),0,0: Scrivi Space(2)& Format2(nu(1,1)),col(1,1),0 : Scrivi Space(8)& Format2(nu(2,1)),col(2,1)
ColoreTesto 0
Scrivi Space(9)&SiglaRuota(ricavaruota(p))&"" & SiglaRuota(ricavaruota(p1))&" " & SiglaRuota(ricavaruota(p2))&"" & SiglaRuota(ricavaruota(p3))
Scrivi Space(9)& ricavaposizione(p)& Space(2) & ricavaposizione(p1)& Space(2)& ricavaposizione(p2) &space(2) & ricavaposizione(p3)
ColoreTesto(2)
Rit=SerieRitardo(1,es,num,tt,2)
ColoreTesto(2)
Scrivi "Chiusure : "& StringaNumeri(num),1,0 : Scrivi "[ rit x ambo TT => "& rit&"]"
ColoreTesto(0)
ImpostaGiocata 1,num,ru,post,9
ImpostaGiocata 2,num,tt,poste,colpi,2
Gioca es
End If