Listato metodo Onerom

[Roby]

Gentilmente offerto dal nostro DANIEL tutta testa e ambi a ruota [][8D]ekkovi il listato del metodo di Onerom
N.b.

Sub main()
Dim num(2)
Dim num1(2)
Dim num2(2)
Dim num3(2)
Dim num4(2)
Dim num5(2)
Dim num6(2)
Dim num7(2)
Dim num8(6)
Dim ruote(10)
Dim poste(2)
Dim posta(5)
poste(2)=1
posta(2)=1
posta(3)=1
posta(4)=1
posta(5)=1
tmp=InputBox("Quante estrazioni controllo?",,20) fin=EstrazioneFin ini=fin-tmp For es=ini To fin Messaggio CStr (EstrazioneFin - es) For r=1 To 9
r1=r+1
For p=1 To 5
a=Estratto (es,r,p)
b=Estratto (es,r1,p)
b1=Figura(a)
b2=Figura(b)
b3=Posizione(es,r,a)
b4=Posizione(es,r1,b)
If b2=b1+1 Or b2=b1-1 Then
Scrivi DataEstrazione(es),True
Scrivi Left(NomeRuota(r),2)&" "& StringaEstratti(es,r)&" ["&Format2(a)&"]"&_ " Figura "&b1&" Posizione "&b3 Scrivi Left(NomeRuota(r1),2)&" "& StringaEstratti(es,r1)&" ["&Format2(b)&"]"&_ " Figura "&b2&" Posizione "&b4 a1=Fuori90(a+b)'Primo capogioco a2=Diametrale(a1)'Secondo capogioco
a3=Trasposizione(a,b)
a4=Trasposizione(b,a)
ruote(1)=r
ruote(2)=r1
num(1)=a1
num(2)=a
ImpostaGiocata 1,num,ruote,poste,10,2
num1(1)=a1
num1(2)=b
ImpostaGiocata 2,num1,ruote,poste,10,2
num2(1)=a2
num2(2)=a
ImpostaGiocata 3,num2,ruote,poste,10,2
num3(1)=a2
num3(2)=b
ImpostaGiocata 4,num3,ruote,poste,10,2
num4(1)=a1
num4(2)=a3
ImpostaGiocata 5,num4,ruote,poste,10,2
num5(1)=a1
num5(2)=a4
ImpostaGiocata 6,num5,ruote,poste,10,2
num6(1)=a2
num6(2)=a3
ImpostaGiocata 7,num6,ruote,poste,10,2
num7(1)=a2
num7(2)=a4
ImpostaGiocata 8,num7,ruote,poste,10,2
num8(1)=a1
num8(2)=a2
num8(3)=a3
num8(4)=a4
num8(5)=a
num8(6)=b
ImpostaGiocata 9,num8,ruote,posta,10,3
Gioca es
Scrivi"**************************************************"
End If
Next
Next
Next
ScriviResoconto
End Sub

ankora Dan!![]

CiAo cIaO

....muoio ogni attimo, io, e rinasco nuovo e senza ricordi: vivo e intero, non più me, ma in ogni cosa fuori....

 

[rossofragola]

Cry nn sapevo avessi fatto corso di arabo.

Grazie amica.
Grazie anche a Daniel

 

[imported_n/a]

Ma sei sicura che fruzzica??????
Che hai combinato??

Forse è questo?
Sub main()
Dim num(2)
Dim num1(2)
Dim num2(2)
Dim num3(2)
Dim num4(2)
Dim num5(2)
Dim num6(2)
Dim num7(2)
Dim num8(6)
Dim ruote(10)
Dim poste(2)
Dim posta(5)
poste(2)=1
posta(2)=1
posta(3)=1
posta(4)=1
posta(5)=1
tmp=InputBox("Quante estrazioni controllo?",,20)
fin=EstrazioneFin
ini=fin-tmp
For es=ini To fin
Messaggio CStr (EstrazioneFin - es)
For r=1 To 9
r1=r+1
For p=1 To 5
a=Estratto (es,r,p)
b=Estratto (es,r1,p)
b1=Figura(a)
b2=Figura(b)
b3=Posizione(es,r,a)
b4=Posizione(es,r1,b)
If b2=b1+1 Or b2=b1-1 Then
Scrivi DataEstrazione(es),True
Scrivi Left(NomeRuota(r),2)&" "& StringaEstratti(es,r)&" ["&Format2(a)&"]"&_ " Figura "&b1&" Posizione "&b3 Scrivi Left(NomeRuota(r1),2)&" "& StringaEstratti(es,r1)&" ["&Format2(b)&"]"&_ " Figura "&b2&" Posizione "&b4 a1=Fuori90(a+b)'Primo capogioco a2=Diametrale(a1)'Secondo capogioco
a3=Trasposizione(a,b)
a4=Trasposizione(b,a)
ruote(1)=r
ruote(2)=r1
num(1)=a1
num(2)=a
ImpostaGiocata 1,num,ruote,poste,10,2
num1(1)=a1
num1(2)=b
ImpostaGiocata 2,num1,ruote,poste,10,2
num2(1)=a2
num2(2)=a
ImpostaGiocata 3,num2,ruote,poste,10,2
num3(1)=a2
num3(2)=b
ImpostaGiocata 4,num3,ruote,poste,10,2
num4(1)=a1
num4(2)=a3
ImpostaGiocata 5,num4,ruote,poste,10,2
num5(1)=a1
num5(2)=a4
ImpostaGiocata 6,num5,ruote,poste,10,2
num6(1)=a2
num6(2)=a3
ImpostaGiocata 7,num6,ruote,poste,10,2
num7(1)=a2
num7(2)=a4
ImpostaGiocata 8,num7,ruote,poste,10,2
num8(1)=a1
num8(2)=a2
num8(3)=a3
num8(4)=a4
num8(5)=a
num8(6)=b
ImpostaGiocata 9,num8,ruote,posta,10,3
Gioca es
Scrivi"**************************************************"
End If
Next
Next
Next
ScriviResoconto
End Sub

Daniel
"I numeri non hanno memoria......e il banco lo sa!!!

 

[franca46]

posso??

i due listati mi danno errore.

ciao a tutti

 

[Navigator]

Scusate,

ho provato anch'io i due listati: ottengo errore in entrambi i casi.


Ciao
Navigator

 

[Roby]

Navigator, prova questo.

ciao

Sub main()
Dim num(2)
Dim num1(2)
Dim num2(2)
Dim num3(2)
Dim num4(2)
Dim num5(2)
Dim num6(2)
Dim num7(2)
Dim num8(6)
Dim ruote(10)
Dim poste(2)
Dim posta(5)
TabellaGiocate
poste(2)=1
posta(2)=1
posta(3)=1
posta(4)=1
posta(5)=1
tmp=InputBox("Quante estrazioni controllo?",,20)
fin=EstrazioneFin
ini=fin-tmp
For es=ini To fin
Messaggio CStr (EstrazioneFin - es)
For r=1 To 9
r1=r+1
For p=1 To 5
a=Estratto (es,r,p)
b=Estratto (es,r1,p)
b1=Figura(a)
b2=Figura(b)
b3=Posizione(es,r,a)
b4=Posizione(es,r1,b)
If b2=b1+1 Or b2=b1-1 Then
Scrivi DataEstrazione(es),True
a3=Trasposizione(a,b)
a4=Trasposizione(b,a)
ruote(1)=r
ruote(2)=r1
num(1)=a1
num(2)=a
ImpostaGiocata 1,num,ruote,poste,10,2
num1(1)=a1
num1(2)=b
ImpostaGiocata 2,num1,ruote,poste,10,2
num2(1)=a2
num2(2)=a
ImpostaGiocata 3,num2,ruote,poste,10,2
num3(1)=a2
num3(2)=b
ImpostaGiocata 4,num3,ruote,poste,10,2
num4(1)=a1
num4(2)=a3
ImpostaGiocata 5,num4,ruote,poste,10,2
num5(1)=a1
num5(2)=a4
ImpostaGiocata 6,num5,ruote,poste,10,2
num6(1)=a2
num6(2)=a3
ImpostaGiocata 7,num6,ruote,poste,10,2
num7(1)=a2
num7(2)=a4
ImpostaGiocata 8,num7,ruote,poste,10,2
num8(1)=a1
num8(2)=a2
num8(3)=a3
num8(4)=a4
num8(5)=a
num8(6)=b
ImpostaGiocata 9,num8,ruote,posta,10,3
Gioca es
Scrivi"**************************************************"
End If
Next
Next
Next
ScriviResoconto
End Sub

 

[imported_n/a]

Questo è quello postato ieri.

Sub main()
Dim num(2)
Dim num1(2)
Dim num2(2)
Dim num3(2)
Dim num4(2)
Dim num5(2)
Dim num6(2)
Dim num7(2)
Dim num8(6)
Dim ruote(10)
Dim poste(2)
Dim posta(5)
poste(2)=1
posta(2)=1
posta(3)=1
posta(4)=1
posta(5)=1
tmp=InputBox("Quante estrazioni controllo?",,60)
fin=EstrazioneFin
ini=fin-tmp
For es=ini To fin
Messaggio CStr (EstrazioneFin - es)
For r=1 To 9
r1=r+1
For p=1 To 5
a=Estratto (es,r,p)
b=Estratto (es,r1,p)
b1=Figura(a)
b2=Figura(b)
b3=Posizione(es,r,a)
b4=Posizione(es,r1,b)
If b2=b1+1 Or b2=b1-1 Then
Scrivi DataEstrazione(es),True
Scrivi Left(NomeRuota(r),2)&" "& StringaEstratti(es,r)&" ["&Format2(a)&"]"&_
" Figura "&b1&" Posizione "&b3
Scrivi Left(NomeRuota(r1),2)&" "& StringaEstratti(es,r1)&" ["&Format2(b)&"]"&_
" Figura "&b2&" Posizione "&b4
a1=Fuori90(a+b)'Primo capogioco
a2=Diametrale(a1)'Secondo capogioco
a3=Trasposizione(a,b)
a4=Trasposizione(b,a)
ruote(1)=r
ruote(2)=r1
num(1)=a1
num(2)=a
ImpostaGiocata 1,num,ruote,poste,10,2
num1(1)=a1
num1(2)=b
ImpostaGiocata 2,num1,ruote,poste,10,2
num2(1)=a2
num2(2)=a
ImpostaGiocata 3,num2,ruote,poste,10,2
num3(1)=a2
num3(2)=b
ImpostaGiocata 4,num3,ruote,poste,10,2
num4(1)=a1
num4(2)=a3
ImpostaGiocata 5,num4,ruote,poste,10,2
num5(1)=a1
num5(2)=a4
ImpostaGiocata 6,num5,ruote,poste,10,2
num6(1)=a2
num6(2)=a3
ImpostaGiocata 7,num6,ruote,poste,10,2
num7(1)=a2
num7(2)=a4
ImpostaGiocata 8,num7,ruote,poste,10,2
num8(1)=a1
num8(2)=a2
num8(3)=a3
num8(4)=a4
num8(5)=a
num8(6)=b
ImpostaGiocata 9,num8,ruote,posta,10,3
'per avere risultati solo positivi e annullare gli altri sostituire
'Gioca es con Gioca es,True
Gioca es
Scrivi"**************************************************"
End If
Next
Next
Next
ScriviResoconto
End Sub

Daniel
"I numeri non hanno memoria......e il banco lo sa!!!

 

[Roby]

Daniel, mettici anche nel mezzo: TabellaGiocate si ha così una visione + semplice delle giocate.

ciao

 

[Navigator]

Grazie Parmando e grazie Daniel,

i due listati funzionano egregiamente, bel lavoro!

Per curiosità ho riprovato i due listati all'inizio del post e proprio non vanno, danno errore.
Ho fatto questa verifica solo per essere sicuro di non aver sbagliato io qualche passaggio.

Ancora grazie per la disponibilità

Ciao
Navigator