Cerco disperatamente script di Manara

[membro cancellato]

Salve cerco disperatamente script dei metodi di Osvaldo Manara..... chi gentilmente li può favorire???, in particolare il metodo distanza diabolica, somma diabolica , metodo fulmine.....grazie in anticipo

 

[solare]

Ciao margot, io ho questo, "sommadiabolica"

Sub main()
Dim num(1)
Dim numeri(2)
Dim numeri1(2)
Dim numeri2(2)
Dim numeri3(4)
Dim post(1)
Dim poste(2)
Dim posta(4)
Dim ruote(10)
post(1)=1
poste(2)=1
posta(2)=1
posta(3)=1
posta(4)=1
tmp=InputBox("Quante estrazioni controllo?",,50)
x=InputBox("Per quante estrazioni deve durare il gioco?",,9)
fin=EstrazioneFin
ini=fin-tmp
For es=ini To fin
Messaggio CStr (EstrazioneFin - es)
AvanzamentoElab ini,fin,es
For r=1 To 9
For r1=r+1 To 10
For p= 1 To 4
For p1=p+1 To 5
a=Estratto (es,r,p)
b=Estratto (es,r,p1)
c=Estratto (es,r1,p)
d=Estratto (es,r1,p1)
a1=Fuori90(a+b)
a2=Fuori90(c+d)
If a2=a1 Then
If r1=r+1 Or r1=r+5 Then
ColoreTesto 1
Scrivi DataEstrazione(es)&" "&Left(NomeRuota(r),2)&" "&_
StringaEstratti(es,r) &" -> "&Format2(a)&"."&Format2(b)
Scrivi DataEstrazione(es)&" "&Left(NomeRuota(r1),2)&" "&_
StringaEstratti(es,r1) &" -> "&Format2(c)&"."&Format2(d)
b1=Eval(a&b)
b2=Eval(c&d)
b3=Fuori90(b1+b2)
b4=90-b3
b5=Diametrale(b4)
ruote(1)=r
ruote(2)=r1
num(1)=d
ImpostaGiocata 1,num,ruote,post,x
numeri(1)=d
numeri(2)=b3
ImpostaGiocata 2,numeri,ruote,poste,x
numeri1(1)=d
numeri1(2)=b4
ImpostaGiocata 3,numeri1,ruote,poste,x
numeri2(1)=d
numeri2(2)=b5
ImpostaGiocata 4,numeri2,ruote,poste,x
numeri3(1)=d
numeri3(2)=b3
numeri3(3)=b4
numeri3(4)=b5
ImpostaGiocata 5,numeri3,ruote,posta,x
Scrivi
ColoreTesto 0
Gioca es
Scrivi"*******************************************************"
End If
End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub

 

[Oscar]

ColoreTesto 2 :Scrivi String(47,32)&"DISTANZA DIABOLICA di Osvaldo Manara",1
Scrivi
Scrivi String(52,32)&"",1
ColoreTesto 0

Sub Main()
Dim num(1)
Dim numeri(2)
Dim numeri1(2)
Dim numeri2(2)
Dim numeri3(4)
Dim post(1)
Dim poste(2)
Dim posta(4)
Dim ruote(10)
post(1)=1
poste(2)=1
posta(2)=1
posta(3)=1
posta(4)=1
tmp=InputBox("Quante estrazioni controllo?",,50)
x=InputBox("Per quante estrazioni deve durare il gioco?",,9)
fin=EstrazioneFin
ini=fin-tmp
For es=ini To fin
Messaggio CStr (EstrazioneFin - es)
AvanzamentoElab ini,fin,es
For r=1 To 9
For r1=r+1 To 10
For p= 1 To 4
For p1=p+1 To 5
a=Estratto (es,r,p)
b=Estratto (es,r,p1)
c=Estratto (es,r1,p)
d=Estratto (es,r1,p1)
a1=Abs(a-b)
a2=Abs(c-d)
If a2=a1 Then
If r1=r+1 Or r1=r+5 Then '<<--- ruote consec e diametrali
'If r1=r+1 Or r1=11-r Then ' <<--- ruote consec e gemellari
ColoreTesto 1
Scrivi DataEstrazione(es)&" "&Left(NomeRuota(r),2)&" "&_
StringaEstratti(es,r) &" -> "&Format2(a)&"."&Format2(b)&" Distanza Matematica "&a1
Scrivi DataEstrazione(es)&" "&Left(NomeRuota(r1),2)&" "&_
StringaEstratti(es,r1) &" -> "&Format2(c)&"."&Format2(d)&" Distanza Matematica "&a2
b1=Eval(a&b)
b2=Eval(c&d)
b3=Fuori90(b1+b2)
b4=90-b3
b5=Diametrale(b4)
ruote(1)=r
ruote(2)=r1
num(1)=d
ImpostaGiocata 1,num,ruote,post,x
numeri(1)=d
numeri(2)=b3
ImpostaGiocata 2,numeri,ruote,poste,x
numeri1(1)=d
numeri1(2)=b4
ImpostaGiocata 3,numeri1,ruote,poste,x
numeri2(1)=d
numeri2(2)=b5
ImpostaGiocata 4,numeri2,ruote,poste,x
numeri3(1)=d
numeri3(2)=b3
numeri3(3)=b4
numeri3(4)=b5
ImpostaGiocata 5,numeri3,ruote,posta,x
Scrivi
ColoreTesto 0
Gioca es
Scrivi"*******************************************************"
End If
End If
Next
Next
Next
Next
Next

ScriviResoconto
End Sub

 

[Sakti]

Guarda se va bene...
DISTANZA DIABOLICA..

ColoreTesto 2 :Scrivi String(47,32)&"DISTANZA DIABOLICA di Osvaldo Manara",1
Scrivi
Scrivi String(52,32)&"",1
ColoreTesto 0

Sub main()
Dim num(1)
Dim numeri(2)
Dim numeri1(2)
Dim numeri2(2)
Dim numeri3(4)
Dim post(1)
Dim poste(2)
Dim posta(4)
Dim ruote(10)
post(1)=1
poste(2)=1
posta(2)=1
posta(3)=1
posta(4)=1
tmp=InputBox("Quante estrazioni controllo?",,50)
x=InputBox("Per quante estrazioni deve durare il gioco?",,9)
fin=EstrazioneFin
ini=fin-tmp
For es=ini To fin
Messaggio CStr (EstrazioneFin - es)
AvanzamentoElab ini,fin,es
For r=1 To 9
For r1=r+1 To 10
For p= 1 To 4
For p1=p+1 To 5
a=Estratto (es,r,p)
b=Estratto (es,r,p1)
c=Estratto (es,r1,p)
d=Estratto (es,r1,p1)
a1=Abs(a-b)
a2=Abs(c-d)
If a2=a1 Then
If r1=r+1 Or r1=r+5 Then '<<--- ruote consec e diametrali
'If r1=r+1 Or r1=11-r Then ' <<--- ruote consec e gemellari
ColoreTesto 1
Scrivi DataEstrazione(es)&" "&Left(NomeRuota(r),2)&" "&_
StringaEstratti(es,r) &" -> "&Format2(a)&"."&Format2(b)&" Distanza Matematica "&a1
Scrivi DataEstrazione(es)&" "&Left(NomeRuota(r1),2)&" "&_
StringaEstratti(es,r1) &" -> "&Format2(c)&"."&Format2(d)&" Distanza Matematica "&a2
b1=Eval(a&b)
b2=Eval(c&d)
b3=Fuori90(b1+b2)
b4=90-b3
b5=Diametrale(b4)
ruote(1)=r
ruote(2)=r1
num(1)=d
ImpostaGiocata 1,num,ruote,post,x
numeri(1)=d
numeri(2)=b3
ImpostaGiocata 2,numeri,ruote,poste,x
numeri1(1)=d
numeri1(2)=b4
ImpostaGiocata 3,numeri1,ruote,poste,x
numeri2(1)=d
numeri2(2)=b5
ImpostaGiocata 4,numeri2,ruote,poste,x
numeri3(1)=d
numeri3(2)=b3
numeri3(3)=b4
numeri3(4)=b5
ImpostaGiocata 5,numeri3,ruote,posta,x
Scrivi
ColoreTesto 0
Gioca es
Scrivi"*******************************************************"
End If
End If
Next
Next
Next
Next
Next

ScriviResoconto
End Sub

 

[Oscar]

Sub main()
Scrivi "FULMINE di OSVALDO MANARA",1
Dim n,t,r1,r2,n1,n2,n3,n4
Dim x(10), am(10), am1(10), am2(10)
Dim ruota(2),ruote(10), posta(5), poste(5), poste1(5)
poste1(1)=1
posta(2)=1.5
posta(3)=0.4
posta(4)=0.1
poste(2)=1
For n=8200 To EstrazioneFin
Messaggio DataEstrazione : t=1
Do While DISAMBO(n,t,r1,n1,n2,r2,n3,n4)=True
ruota(1)=r1
ruota(2)=r2
ruote(1)=r1
ruote(2)=r2
ruote(3)=11
ruote(4)=12
x(1)=n1
x(2)=n2
x(3)=n3
x(4)=n4
If NumeriRipetuti(x)=False Then
OrdinaMatrice x,1
y1=Fuori90(x(4)+x(1))
y2=Fuori90(x(2)+x(3))
y3=Distanza(x(4),x(3))
y4=Distanza(x(1),x(2))
y5=Distanza(x(4),x(2))
y6=Distanza(x(1),x(3))
If y1=y2 And y3=y4 And y5=y6 Then
Scrivi "----------------------------------------------------------" : ColoreTesto 2
Scrivi " RUOTA ESTRATTI ORDINATI Somma Oriz. D.V - D.D." : ColoreTesto 0
Scrivi FormatSpace(NomeRuota(r1),10)&" "&format2(CInt(n1))&" "&format2(CInt(n2))& " "&_
Format2(x(4))&" "& Format2(x(1))&" "& FormatSpace(y1,3)&" "& FormatSpace(y3,3)&" "& FormatSpace(y5,3),1

Scrivi FormatSpace(NomeRuota(r2),10)&" "&format2(CInt(n3))&" "&format2(CInt(n4))& " "&_
Format2(x(3))&" "& Format2(x(2))&" "& FormatSpace(y2,3)&" "& FormatSpace(y4,3)&" "& FormatSpace(y6,3),1
Scrivi
am(1)=x(4)
ImpostaGiocata 1,am,ruota,poste1,9
am1(1)=x(4)
am1(2)=x(1)
ImpostaGiocata 2,am1,ruote,poste,9
am1(2)=x(2)
ImpostaGiocata 3,am1,ruote,poste,9
am1(2)=x(3)
ImpostaGiocata 4,am1,ruote,poste,9
am2(1)=x(1)
am2(2)=x(2)
am2(3)=x(3)
am2(4)=x(4)
'ImpostaGiocata 5,am2,ruote,posta,9
Gioca n
End If
End If
t=t+1
Loop
Next
ScriviResoconto
End Sub

Function DISAMBO(estrazione, tentativo, byref ruota1, byref numero1, byref numero2, byref ruota2, byref numero3, byref numero4)
Dim trovati,r,rr,i,ii,j,jj
trovati=0
For r= 1 To 9
For i= 1 To 4
For j=i+1 To 5 '* 1a
a=Estratto (estrazione,r,i)
b=Estratto(estrazione,r,j)
c1=Cadenza(a)
c2=Cadenza(b)
d1=Figura(a)
d2=Figura(b)
For rr=r+1 To 10
aa=Estratto(estrazione,rr,i)
bb=Estratto(estrazione,rr,j)
cc1=Cadenza(aa)
cc2=Cadenza(bb)
dd1=Figura(aa)
dd2=Figura(bb)
If (c1=c2 And cc1=cc2 And c1=cc1) Or (d1=d2 And dd1=dd2 And d1=dd1) Then
trovati=trovati+1
If trovati=tentativo Then
numero1=a
numero2=b
numero3=aa
numero4=bb
ruota1=r
ruota2=rr
DISAMBO=True
Exit Function
End If
End If
Next
Next
Next
Next '* 2a
DISAMBO=False
End Function

 

[Sakti]

Ecco il Fulmine..

Sub Main()
Scrivi "FULMINE di OSVALDO MANARA",1
Dim n,t,r1,r2,n1,n2,n3,n4
Dim x(10), am(10), am1(10), am2(10)
Dim ruota(2),ruote(10), posta(5), poste(5), poste1(5)
poste1(1)=1
posta(2)=1.5
posta(3)=0.4
posta(4)=0.1
poste(2)=1
For n=9500 To EstrazioneFin
Messaggio DataEstrazione(n) : t=1
Do While DISAMBO(n,t,r1,n1,n2,r2,n3,n4)=True
ruota(1)=r1
ruota(2)=r2
ruote(1)=r1
ruote(2)=r2
ruote(3)=11
ruote(4)=12
x(1)=n1
x(2)=n2
x(3)=n3
x(4)=n4
If NumeriRipetuti(x)=False Then
OrdinaMatrice x,1
y1=Fuori90(x(4)+x(1))
y2=Fuori90(x(2)+x(3))
y3=Distanza(x(4),x(3))
y4=Distanza(x(1),x(2))
y5=Distanza(x(4),x(2))
y6=Distanza(x(1),x(3))
If y1=y2 And y3=y4 And y5=y6 Then
Scrivi "----------------------------------------------------------" : ColoreTesto 2
Scrivi " RUOTA ESTRATTI ORDINATI Somma Oriz. D.V - D.D." : ColoreTesto 0
Scrivi FormatSpace(NomeRuota(r1),10)&" "&Format2(CInt(n1))&" "&Format2(CInt(n2))& " "&_
Format2(x(4))&" "& Format2(x(1))&" "& FormatSpace(y1,3)&" "& FormatSpace(y3,3)&" "& FormatSpace(y5,3),1

Scrivi FormatSpace(NomeRuota(r1+1),10)&" "&Format2(CInt(n3))&" "&Format2(CInt(n4))& " "&_
Format2(x(3))&" "& Format2(x(2))&" "& FormatSpace(y2,3)&" "& FormatSpace(y4,3)&" "& FormatSpace(y6,3),1
Scrivi
am(1)=x(4)
ImpostaGiocata 1,am,ruota,poste1,16
am1(1)=x(4)
am1(2)=x(1)
ImpostaGiocata 2,am1,ruote,poste,16
am1(2)=x(2)
ImpostaGiocata 3,am1,ruote,poste,16
am1(2)=x(3)
ImpostaGiocata 4,am1,ruote,poste,16
am2(1)=x(1)
am2(2)=x(2)
am2(3)=x(3)
am2(4)=x(4)
'ImpostaGiocata 5,am2,ruote,posta,16
Gioca n,1
End If
End If
t=t+1
Loop
Next
ScriviResoconto
End Sub

Function DISAMBO(estrazione, tentativo, byref ruota1, byref numero1, byref numero2, byref ruota2, byref numero3, byref numero4)
Dim trovati,r,rr,i,ii,j,jj
trovati=0
For r= 1 To 9
For i= 1 To 4
For j=i+1 To 5 '* 1a
a=Estratto (estrazione,r,i)
b=Estratto(estrazione,r,j)
c1=Cadenza(a)
c2=Cadenza(b)
d1=Figura(a)
d2=Figura(b)
For rr=r+1 To 10
aa=Estratto(estrazione,rr,i)
bb=Estratto(estrazione,rr,j)
cc1=Cadenza(aa)
cc2=Cadenza(bb)
dd1=Figura(aa)
dd2=Figura(bb)
If (c1=c2 And cc1=cc2 And c1=cc1) Or (d1=d2 And dd1=dd2 And d1=dd1) Then
trovati=trovati+1
If trovati=tentativo Then
numero1=a
numero2=b
numero3=aa
numero4=bb
ruota1=r
ruota2=rr
DISAMBO=True
Exit Function
End If
End If
Next
Next
Next
Next '* 2a
DISAMBO=False
End Function