PENTAMBO

[sax71]

Ho trovato questo script in giro per la rete,ho letto le opinioni di questo programma e sembrano buone. Lo provato su spaziometria purtroppo mi dà errore. C'è qualcuno di voi che può metterlo apposto? Ringrazio anticipatamente!!!


Sub main()
Dim ruote(2),nr(5),amb(3),n(4),amb1(8)
Dim posta(2),ruota(2)
Dim e1,e2,e3
posta(1)=1 ' Ambate
posta(2)=1 ' Amb0

'TabellaGiocate
'considero le ultime 100 estrazioni
rs=InputBox("Quante estrazioni vuoi controllare?",,30)
ini=EstrazioneFin -rs
fin=EstrazioneFin
t=0
For es=ini To fin
Messaggio "Estrazione esaminata: " & CStr(es)
For rt= 1 To 10
For p1= 1 To 5
For p2=p1+1 To 5
For y=0 To 4
ex=es-y
e1=Estratto(ex,rt,p1) : e2=Estratto(ex,rt,p2)
do1=Distanza (e1,e2)
If do1=18 Or do1=36 Then

For rr=rt+1 To 12
If rr=11 Then rr=12

For q1=1 To 4
For q2=q1+1 To 5
e3=Estratto(es,rr,q1): e4=Estratto (es,rr,q2)
If e3<>e1 And e3<>e2 And e4<>e1 And e4<>e2 Then
do2=Distanza (e3,e4)
If do2=18 Or do2=36 Then
dv1=Distanza (e1,e3):dv2=Distanza (e2,e4)
If dv1=18 Or dv1=36 And dv2=18 Or dv2=36 Then
nr(1)=Fuori90(e1):nr(2)=Fuori90(e1+18):nr(3)=Fuori90(e1+36):nr(4)=Fuori90(e1+54):nr(5)=Fuori90(e1+72)
OrdinaMatrice nr
n(1)=e1:n(2)=e2:n(3)=e3:n(4)=e4
OrdinaMatrice n
For i=1 To 5
k=0
For j=1 To 4
If nr(i)<>n(j) Then k=k+1
Next
If k=4 Then amb(1)=nr(i)
Next
t=t+1
ruote(1)=rt:ruote(2)=rr:ruota(2)=11

amb(2)=Fuori90(amb(1)*2)
amb(3)=Diametrale(amb(2))

amb1(1)=amb(1)
amb1(2)=Fuori90(amb(1)*2)
amb1(3)=Diametrale(amb(2))

Scrivi
Scrivi "--------------------------------------------------------------------------------------------------"
Scrivi DataEstrazione(ex) &" "& NomeRuota (rt) & " " & Format2 (e1) &" "& Format2 (e2)&""
Scrivi DataEstrazione(es) &" "& NomeRuota (rr) &" "& Format2 (e3) &" "& Format2 (e4)&""
Scrivi "** Cinquine Pentagonali : " & StringaNumeri (nr)&" [Num. mancante = "& Format2 (amb(1)) &"]",1
Scrivi "-------------------------------------------------------------"& "Giocata n° "& Format2(t)
ImpostaGiocata 1,amb,ruote,posta,12
'ImpostaGiocata 2,amb,ruota,posta,12
ImpostaGiocata 3,amb1,ruote,posta,12

Gioca es

End If
End If
End If
Next
Next
Next
End If
Next

Next
Next
Next
Next
ScriviResoconto
ColoreTesto 1
Scrivi String(70,"=")&"listato da franco florindi",1
ColoreTesto 0
End Sub

 

[gamberorosso]

Ciao questo listato e di franco florindi che saluto....

Sub Main()
Dim ruote(2),nr(5),amb(3),n(4),amb1(8)
Dim posta(2),ruota(2)
Dim e1,e2,e3
posta(1)=1 ' Ambate
posta(2)=1 ' Amb0

'TabellaGiocate
'considero le ultime 100 estrazioni
rs=InputBox("Quante estrazioni vuoi controllare?",,30)
ini=EstrazioneFin -rs
fin=EstrazioneFin
t=0
For es=ini To fin
Messaggio "Estrazione esaminata: " & CStr(es)
For rt= 1 To 10
For p1= 1 To 5
For p2=p1+1 To 5
For y=0 To 4
ex=es-y
e1=Estratto(ex,rt,p1) : e2=Estratto(ex,rt,p2)
do1=Distanza (e1,e2)
If do1=18 Or do1=36 Then

For rr=rt+1 To 12
If rr=11 Then rr=12

For q1=1 To 4
For q2=q1+1 To 5
e3=Estratto(es,rr,q1): e4=Estratto (es,rr,q2)
If e3<>e1 And e3<>e2 And e4<>e1 And e4<>e2 Then
do2=Distanza (e3,e4)
If do2=18 Or do2=36 Then
dv1=Distanza (e1,e3):dv2=Distanza (e2,e4)
If dv1=18 Or dv1=36 And dv2=18 Or dv2=36 Then
nr(1)=Fuori90(e1):nr(2)=Fuori90(e1+18):nr(3)=Fuori90(e1+36):nr(4)=Fuori90(e1+54):nr(5)=Fuori90(e1+72 )
OrdinaMatrice nr,1
n(1)=e1:n(2)=e2:n(3)=e3:n(4)=e4
OrdinaMatrice n,1
For i=1 To 5
k=0
For j=1 To 4
If nr(i)<>n(j) Then k=k+1
Next
If k=4 Then amb(1)=nr(i)
Next
t=t+1
ruote(1)=rt:ruote(2)=rr:ruota(2)=11

amb(2)=Fuori90(amb(1)*2)
amb(3)=Diametrale(amb(2))

amb1(1)=amb(1)
amb1(2)=Fuori90(amb(1)*2)
amb1(3)=Diametrale(amb(2))

Scrivi
Scrivi "--------------------------------------------------------------------------------------------------"
Scrivi DataEstrazione(ex) &" "& NomeRuota (rt) & " " & Format2 (e1) &" "& Format2 (e2)&""
Scrivi DataEstrazione(es) &" "& NomeRuota (rr) &" "& Format2 (e3) &" "& Format2 (e4)&""
Scrivi "** Cinquine Pentagonali : " & StringaNumeri (nr)&" [Num. mancante = "& Format2 (amb(1)) &"]",1
Scrivi "-------------------------------------------------------------"& "Giocata n° "& Format2(t)
ImpostaGiocata 1,amb,ruote,posta,12
'ImpostaGiocata 2,amb,ruota,posta,12
ImpostaGiocata 3,amb1,ruote,posta,12

Gioca es

End If
End If
End If
Next
Next
Next
End If
Next

Next
Next
Next
Next
ScriviResoconto
ColoreTesto 1
Scrivi String(70,"=")&"listato da franco florindi",1
ColoreTesto 0
End Sub

 

[sax71]

Grazie Gamberorosso!