ILQUADRATO ARMONICO FABARRI

'Progetto - IL QUADRATO ARMONICO - by FABARRI
'Script - by Salvo50
Option Explicit
Sub Main
TestoInBandaPassante "***** Progetto IL QUADRATO ARMONICO by Fabarri, script by Salvo50 ****** ",1,5,0
Scrivi
Scrivi
Dim r1,p,pp,es,r2,clp,esq
Dim estr1,estr2,destr1,destr2,cestr1,cestr2
Dim diorestr1,diorestr2,diverestr1,diverestr2,dincrestr1,dincrestr2
Dim difforiz,diffvert,diffincr
Dim fin,Ini,ru(1),poste(2)
Dim ambata(2),idestr,ruota,col,esqcol
poste(1) = 1
'poste(2) = 1
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9270)
clp = InputBox("Per quanti colpi vuoi fare la ricerca",,3)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,30))
r1 = InputBox("Inserisci numero ruota ( 1 - 10 NAZ 12)",ruota,8)
ru(1) = r1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
AvanzamentoElab esq,esqcol,es
ColoreTesto 2
Scrivi String(110,"*") & " " & es
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1),2
For p = 1 To 4
For pp = p + 1 To 5
estr1 = Format2(Estratto(es,r1,p))
estr2 = Format2(Estratto(es,r1,pp))
If Not Gemello(estr1) Then
If Not Gemello(estr2) Then
destr1 = Decina(estr1)
cestr1 = Cadenza(estr1)
destr2 = Decina(estr2)
cestr2 = Cadenza(estr2)
If destr1 <> destr2 Then
If destr1 <> cestr2 Then
If cestr1 <> cestr2 Then
If cestr1 <> destr2 Then
'distanza orizzontale
diorestr1 =(Differenza(destr1,cestr1))
diorestr2 =(Differenza(destr2,cestr2))
If(diorestr1) > 5 Then diorestr1 = 10 - diorestr1
If(diorestr2) > 5 Then diorestr2 = 10 - diorestr2
'distanza verticale
diverestr1 =(Differenza(destr1,destr2))
diverestr2 =(Differenza(cestr1,cestr2))
If(diverestr1) > 5 Then diverestr1 = 10 - diverestr1
If(diverestr2) > 5 Then diverestr2 = 10 - diverestr2
'distanza incrociata
dincrestr1 =(Differenza(destr1,cestr2))
dincrestr2 =(Differenza(cestr1,destr2))
If(dincrestr1) > 5 Then dincrestr1 = 10 - dincrestr1
If(dincrestr2) > 5 Then dincrestr2 = 10 - dincrestr2
'differenza totale orizzontale verticale e incrociata
difforiz = Differenza(diorestr1,diorestr2)
diffvert = Differenza(diverestr1,diverestr2)
diffincr = Differenza(dincrestr1,dincrestr2)
If difforiz = 90 Then difforiz = 0
If diffvert = 90 Then diffvert = 0
If diffincr = 90 Then diffincr = 0
If difforiz = diffvert And difforiz = diffincr And diffvert = diffincr Then
Scrivi String(70,"*")
Scrivi " Ambi Diff. Orizz." & Space(4) & " Diff. Vert." & Space(4) & "Diff. Incroc."
Scrivi " " & estr1 & Space(12) & diorestr1 & Space(15) & diverestr1 & Space(15) & dincrestr1
Scrivi " " & estr2 & Space(12) & diorestr2 & Space(15) & diverestr2 & Space(15) & dincrestr2
Scrivi String(70,"-")
Scrivi "Differenza" & Space(6) & difforiz & Space(15) & diffvert & Space(15) & diffincr

ambata(1) = estr1
ambata(2) = estr2
ImpostaGiocata 1,ambata,ru,poste,clp
Gioca es
End If
End If
End If
End If
End If
End If
End If
Next
Next
Next
ScriviResoconto
End Sub

' LA MASSIMA ARMONIA QUADRATICA --- Importanza del "fattore 45" x f
Sub Main()
Dim ru(2)
Dim ambata(2)
Dim posta(5)
posta(1) = 1
clp = 10
co = 0
ini = EstrazioneFin - 566
fin = EstrazioneFin
For es = ini To fin
For p = 1 To 4
For r = 1 To 10
For rr = r + 1 To 12
If rr = 11 Then rr = 12 End If
'A --- C
'| |
'B --- D
a = Estratto(es,r,p)
c = Estratto(es,r,p + 1)
b = Estratto(es,rr,p)
d = Estratto(es,rr,p + 1)
If Distanza(a,d) = 45 And Distanza(b,c) = 45 And Distanza(a,c) = Distanza(b,d) And Distanza(a,b) = Distanza(c,d)And Fuori90(a + c) = Fuori90(b + d) And Fuori90(a + b) = Fuori90(c + d) Then
co = co + 1
ambata(1) = d
'ambata(2) = Fuori90(a + b + c + d)
ru(1) = r ' prima ruota in gioco
ru(2) = rr ' seconda ruota in gioco
Scrivi "---------------------------------------------------------------"
ColoreTesto 1
Scrivi " Generatori previsione isotopi : " & a & "-" & c & " dist orizz " & Distanza(a,c) & "-" & Distanza(b,d)
Scrivi " : " & b & "-" & d & " dist diagonale 45 "_
& " su " & NomeRuota(r) & " e " & NomeRuota(rr) & " caso " & co
ColoreTesto 0
ImpostaGiocata 1,ambata,ru,posta,clp
Gioca es,True,,2 ' x spaziometria di luigiB
'Gioca es ' x L8 ...

End If
Next
Next
Next
Next
ColoreTesto 1
Scrivi
Scrivi
Scrivi " CASI TROVATI : " & co
ColoreTesto 0
ScriviResoconto
Scrivi String(40,"=") & "listato by claudio8 x f",1
ColoreTesto 0
End Sub