CODICE
'Le vincite volano con gli aquiloni
'Metodo di Antonio Fiacco
'Elaborato da Florindi Franco il 17/01/2003
'--------------------------------------------
Sub main()
Dim ruote(10),ru(1)
Dim ambo1(2),ambo2(2),ambo3(2),ambo4(2),ambo5(2),ambo6(2)
Dim poste(2)
poste(2)=1
t=0
tst=" **************************** "
tst1="TRIANGOLI REGOLARI"
spc1=(90-Len(tst))/2
spc2=(90-Len(tst1))/2
tst2="CON GLI AQUILONI"
spc3=(90-Len(tst2))/2
Scrivi Space(spc1)&tst& Chr(10),1
Scrivi Space(spc2)&tst1& Chr(10),1
Scrivi Space(spc3)&tst2& Chr(10),1
Scrivi Space(spc1)&tst& Chr(10),1
ColoreTesto 2 : Scrivi Space((90-Len("ANTONIO FIACCO"))/2)&"ANTONIO FIACCO"& Chr(10),1
ColoreTesto 1 : Scrivi String(65,"*")&"listato da Franco Florindi"& Chr(10),1
ColoreTesto 0
rs=InputBox("Quante estrazioni vuoi controllare?",,100)
stp=InputBox("VUOI INTERROMPERE LE GIOCATE AL 1° ESITO POSITIVO ???"&_
Chr(13)&Chr(13)& "SI = 1" &Chr(13)& "NO = 0",,1)
ini= EstrazioneFin -rs
fin= EstrazioneFin
'--------------------------------------------------------------------------------
Scrivi
Scrivi String(33," ")&"****** Rendiconto ****** ",1
Scrivi String(33," ")& DataEstrazione(ini)&" - "& DataEstrazione(fin)
Scrivi
'--------------------------------------------------------------------------------
For es = ini To fin
Messaggio CStr(DataEstrazione(es))
For r=1 To 10
For p=1 To 3
a1=Estratto(es,r,p)
a2=Estratto(es,r,p+2)
d1=Distanza(a1,a2)
s1=(a1+a2)
If d1<>18 Then '<----- Attivando questo controllo elimina gli ambi ripetuti.
If Pari(s1)= True Then 'Controlla la coppia pari o dispari
pm=s1/2 ' punto medio della coppia
pmd=Diametrale(pm)' diametrale del vertice
For r1=1 To 10 '<------- Controlla la presenza del punto medio o del suo diametrale (Vertice) nella ruota r1
If r<>r1 Then
b1=Estratto(es,r1,p+1)
If pm=b1 Or pmd =b1 Then
If pm=b1 Then vr=pm
If pmd=b1 Then vr=pmd
vrd=Diametrale(vr)
ex=es+1 'Incrementa l'estrazione
If ex<= fin Then
For pp =1 To 5 '<-------Controlla l'uscita del diametrale del Vertice sortito nelle ruote r o r1
If Estratto(ex,r,pp)=vrd Or Estratto(ex,r1,pp)=vrd Then
If Estratto(ex,r,pp)= vrd Then r2=r
If Estratto(ex,r1,pp)= vrd Then r2=r1
'Alla condizione rispettata si applicano le Formule DIEMME
na1=Fuori90(13*(a1+4*vrd+2*a2))
na2=Fuori90(13*(a2+4*vrd+2*a1))
na3=Diametrale(na1)
na4=Diametrale(na2)
nb1=Fuori90(13*(2*a1+vrd+4*a2))
nb2=Fuori90(13*(2*a2+vrd+4*a1))
nb3=Diametrale(nb1)
nb4=Diametrale(nb2)
nc1=Fuori90(13*(4*a1+2*vrd+a2))
nc2=Fuori90(13*(4*a2+2*vrd+a1))
nc3=Diametrale(nc1)
nc4=Diametrale(nc2)
'----------------------------------
'Previsioni........
ambo1(1)=na1
ambo1(2)=na2
ambo2(1)=na3
ambo2(2)=na4
ambo3(1)=nb1
ambo3(2)=nb2
ambo4(1)=nb3
ambo4(2)=nb4
ambo5(1)=nc1
ambo5(2)=nc2
ambo6(1)=nc3
ambo6(2)=nc4
ruote(1)=r
ruote(2)=r1
ru(1)=r2
t=t+1
Scrivi
Scrivi "---------------------------------------------------------------------"
Scrivi DataEstrazione(es) &" "& Left(SiglaRuota(r),2) & " " & Format2 (a1) &" "& Format2 (a2)&" (Pos. "& Format2(p)&"-"&_
Format2(p+2)&")"&" [Punto medio:"& Format2(pm)&"-"& Format2(pmd)&"] "& Left(SiglaRuota(r1),2) &" "& Format2 (vr) &" (Pos. "&_
Format2(p+1)&")"
Scrivi DataEstrazione(ex)&" "& Left(SiglaRuota(r2),2) & " " & Format2 (vrd)&" "&" (Pos. "& Format2(pp)&")"
Scrivi"--------------------------------------------------------------"& "Giocata n° "& Format2(t)
ImpostaGiocata 1,ambo1,ruote,poste,8,2
ImpostaGiocata 2,ambo2,ruote,poste,8,2
ImpostaGiocata 3,ambo3,ruote,poste,8,2
ImpostaGiocata 4,ambo4,ruote,poste,8,2
ImpostaGiocata 5,ambo5,ruote,poste,8,2
ImpostaGiocata 6,ambo6,ruote,poste,8,2
If stp=1 Then
For x =1 To 6
For xx=1 To 6
ImpostaInterruzioni x,xx,2
Next
Next
End If
Gioca ex
ResettaGiocate
End If : Next
End If
End If
End If
Next
End If
End If : Next : Next : Next
ScriviResoconto
ColoreTesto 1
Scrivi String(70,"=")&"listato da franco florindi",1
ColoreTesto 0
End Sub
