SUPER LOTTO

IL QUADRATOA DIAGONALE FISSA FABARRI

« Older   Newer »
  Share  
CAT_IMG Posted on 23/1/2018, 09:55

Group:
Administrator
Posts:
8,316
Location:
Pescara

Status:


IL QUADRATO A DIAGONALE FISSA

Risultano 4 numeri da giocare per ambata su 2 ruote, l'ambata dovrebbe uscire a colpo per non andare in perdita, nello script ho messo la ricerca per un colpo, naturalmente si può cambiare. Nell'articolo oltre alla ricerca dei 4 numeri, fa riferimento anche a quei casi dove una delle due somme delle distanze sia diversa da 90, e calcolare il numero da modificare per avere la somma delle distanze uguale a 90, per questo ancora non ho trovato la formula per individuare il numero, ma ci sto provando.



'Progetto - QUADRATO A DIAGONALE FISSA - by FABARRI
'Script - by Salvo50
Option Explicit
Sub Main
Dim r1,p1,p2,es,r2,estr1,estr2,estr3,estr4
Dim fin,Ini,caso,casi,clp,esq,somma1,somma2,idestr,col,esqcol
Dim ru(3),posta(2),poste(1)
Dim diff13ve,diff24ve,diff12or,diff34or,diff14in,diff23in
Dim ambo1(2),ambo2(2),ambo3(2),ambo4(2),ambata(4)
TestoInBandaPassante "***** Progetto QUADRATO A DIAGONALE FISSA by Fabarri, script by Salvo50 ****** ",1,5,0
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9180)
clp = InputBox("Per quanti colpi vuoi fare la ricerca",,1)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,20))
poste(1) = 1
posta(2) = 1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
AvanzamentoElab esq,esqcol,es
caso = 0
For r1 = 1 To 10
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12
For p1 = 1 To 4
For p2 = p1 + 1 To 5
estr1 = Estratto(es,r1,p1)
estr2 = Estratto(es,r1,p2)
estr3 = Estratto(es,r2,p1)
estr4 = Estratto(es,r2,p2)
If estr1 <> estr2 And estr1 <> estr3 And estr1 <> estr4 Then
If estr2 <> estr3 And estr2 <> estr4 And estr3 <> estr4 Then
'differenze primo triangolo
diff13ve = Differenza(estr1,estr3)
diff34or = Differenza(estr3,estr4)
'differenze secondo triangolo
diff12or = Differenza(estr1,estr2)
diff24ve = Differenza(estr2,estr4)
'Differenza Diagonale fissa triagoli
diff14in = Differenza(estr1,estr4)
If diff13ve > 45 Then diff13ve = 90 - diff13ve
If diff34or > 45 Then diff34or = 90 - diff34or
If diff12or > 45 Then diff12or = 90 - diff12or
If diff24ve > 45 Then diff24ve = 90 - diff24ve
If diff14in > 45 Then diff14in = 90 - diff14in
If diff13ve = 45 Or diff34or = 45 Or diff12or = 45 Or diff24ve = 45 Then
somma1 = diff13ve + diff34or + diff14in
somma2 = diff24ve + diff12or + diff14in
If somma1 = 90 And somma2 = 90 Then
caso = caso + 1
casi = casi + 1
Scrivi String(90,"*") & " Caso N" & Format2(caso) & " Estraz. " & Format2(es)
Scrivi String(90,"*") & " Casi Totali N" & Format2(casi)
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1) & " Seconda Ruota "_
& Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2)
Scrivi Left(NomeRuota(r1),2) & " " & Format2(estr1) & Space(1) & Format2(estr2),0,0
Scrivi " Distanze Primo Triangolo --> ",0,0
ColoreTesto 2
Scrivi Format2(diff13ve) & Space(5) & Format2(diff34or)_
& Space(5) & Format2(diff14in) & " Somma = " &(somma1)
ColoreTesto 0
Scrivi Left(NomeRuota(r2),2) & " " & Format2(estr3) & Space(1) & Format2(estr4),0,0
Scrivi " Distanze Secondo Triangolo --> ",0,0
ColoreTesto 1
Scrivi Format2(diff12or) & Space(5) & Format2(diff24ve)_
& Space(5) & Format2(diff14in) & " Somma = " &(somma2)
ColoreTesto 0
Scrivi
ru(1) = r1
ru(2) = r2
'ru(3) = 11
ambo1(1) = estr1
ambo1(2) = estr2
ImpostaGiocata 1,ambo1,ru,posta,clp
ambo2(1) = estr3
ambo2(2) = estr4
ImpostaGiocata 2,ambo2,ru,posta,clp
ambo3(1) = estr1
ambo3(2) = estr3
ImpostaGiocata 3,ambo3,ru,posta,clp
ambo4(1) = estr2
ambo4(2) = estr4
ImpostaGiocata 4,ambo4,ru,posta,clp
ambata(1) = estr1
ambata(2) = estr2
ambata(3) = estr3
ambata(4) = estr4
ImpostaGiocata 5,ambata,ru,poste,clp
Gioca es
End If
End If
End If
End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub

Continuo con IL QUADRATO A DIAGONALE FISSA con la ricerca di quei triangoli con somma diversa di 90, nello script che ho fatto faccio apparire in rosso le distanze e le somme diverse da 90 ed in azzurro (dopo la correzione) quelle con somma 90, quindi azzurro ok, rosso non ok, la formula per trovare il numero da sostituire a quello errato, non l'ho trovata, ho usato anche la formuletta trovata da Enplein ma non andava bene in questo caso, allora ho avuto l'idea di incrementare una variabile da 1 a 90 ed ad ogni incremento fare i calcoli finche non trovo il numero giusto.

Quindi avevo pensato di usare un - while wend - ma andava in anomalia di < overflow >, l'ho cambiato con - do while loop - ma non c'è stato verso, ho inserito - abs,int,fix,cint,eval - andava sempre in errore di < overflow >, allora ho optato per un FOR NEXT, uso l'incremento come numero e faccio i calcoli, quando la somma che mi interessa è uguale a 90, con - EXIT FOR - esco e passo oltre, non lo so se è normale usare - FOR NEXT - in questo modo.


'Progetto - QUADRATO A DIAGONALE FISSA con correzione somma triangoli diversa da 90 - by FABARRI
'Script - by Salvo50
Option Explicit
Dim r1,p1,p2,es,r2,estr1,estr2,estr3,estr4,k,k1,e2,e3
Dim fin,Ini,caso,casi,clp,esq,somma1,somma2,idestr,col,esqcol
Dim ru(3),poste(1),ambat(1),ambata(1)
Dim diff13ve,diff24ve,diff12or,diff34or,diff14in
Sub Main
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9300)
clp = InputBox("Per quanti colpi vuoi fare la ricerca",,4)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,50))
poste(1) = 1

esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
AvanzamentoElab esq,esqcol,es
caso = 0
For r1 = 1 To 10
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12
For p1 = 1 To 4
For p2 = p1 + 1 To 5
estr1 = (Estratto(es,r1,p1))
estr2 = (Estratto(es,r1,p2))
estr3 = (Estratto(es,r2,p1))
estr4 = (Estratto(es,r2,p2))
e2 = estr2
e3 = estr3
If estr1 <> estr2 And estr1 <> estr3 And estr1 <> estr4 Then
If estr2 <> estr3 And estr2 <> estr4 And estr3 <> estr4 Then
'------------------------------------------
'A = estr1
'B = estr2
'C = estr3
'D = estr4
'A-----B
'| |
'| |
'C-----D
'A,C,D = Primo triangolo
'A,B,D = Secondo triangolo
'**************************Primo Triangolo*****************************************
calcoli
complemento90
If diff13ve = 45 Or diff34or = 45 Or diff12or = 45 Or diff24ve = 45 Then
somma1 = diff13ve + diff34or + diff14in
somma2 = diff24ve + diff12or + diff14in
End If
If somma1 <> 90 And somma2 = 90 Then
caso = caso + 1
casi = casi + 1
preuscite
uscite
k = 0
For k = 1 To 90
diff13ve = Differenza(k,estr1)
diff34or = Differenza(k,estr4)
complemento90
somma1 = diff14in + diff13ve + diff34or
estr3 = k
If somma1 = 90 Then Exit For
Next
Scrivi " Sostituito il " & Format2(e3) & " con il " & Format2(estr3)
Scrivi
uscite
If somma1 = 90 Then
ru(1) = r1
ru(2) = r2
ambata(1) = estr3
ImpostaGiocata 1,ambata,ru,poste,clp
Gioca es
End If
End If
'**************************Secondo Triangolo*****************************************
estr3 = e3
calcoli
complemento90
If somma2 <> 90 And somma1 = 90 Then
caso = caso + 1
casi = casi + 1
preuscite
uscite
k1 = 0
For k1 = 1 To 90
diff12or = Differenza(k1,estr1)
diff24ve = Differenza(k1,estr4)
complemento90
somma2 = diff14in + diff12or + diff24ve
estr2 = k1
If somma2 = 90 Then Exit For
Next
Scrivi " Sostituito il " & Format2(e2) & " con il " & Format2(estr2)
Scrivi
uscite
If somma2 = 90 Then
ru(1) = r1
ru(2) = r2
ambat(1) = estr2
ImpostaGiocata 1,ambat,ru,poste,clp
Gioca es
End If
End If
End If
End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub
Function preuscite
Scrivi String(90,"*") & " Caso N" & Format2(caso) & " Estraz. " & Format2(es)
Scrivi String(90,"*") & " Casi Totali N" & Format2(casi)
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1) & " Seconda Ruota "_
& Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2)
End Function
Function uscite
Scrivi Left(NomeRuota(r1),2) & " " & Format2(estr1) & Space(1) & Format2(estr2),0,0
Scrivi " Distanze Secondo Triangolo --> ",0,0
If somma2 = 90 Then
ColoreTesto 1
Else
ColoreTesto 2
End If
Scrivi Format2(diff12or) & Space(5) & Format2(diff24ve)_
& Space(5) & Format2(diff14in) & " Somma 2 = " &(somma2)
ColoreTesto 0
'----------------------------------------------------
Scrivi Left(NomeRuota(r2),2) & " " & Format2(estr3) & Space(1) & Format2(estr4),0,0
Scrivi " Distanze Primo Triangolo --> ",0,0
If somma1 = 90 Then
ColoreTesto 1
Else
ColoreTesto 2
End If
Scrivi Format2(diff13ve) & Space(5) & Format2(diff34or)_
& Space(5) & Format2(diff14in) & " Somma 1 = " &(somma1)
ColoreTesto 0
Scrivi
End Function
Function calcoli
'differenze primo triangolo
diff13ve = Differenza(estr1,estr3)
diff34or = Differenza(estr3,estr4)
'differenze secondo triangolo
diff12or = Differenza(estr1,estr2)
diff24ve = Differenza(estr2,estr4)
'Differenza Diagonale fissa triagoli
diff14in = Differenza(estr1,estr4)
End Function
Function complemento90
If diff13ve > 45 Then diff13ve = 90 - diff13ve
If diff34or > 45 Then diff34or = 90 - diff34or
If diff12or > 45 Then diff12or = 90 - diff12or
If diff24ve > 45 Then diff24ve = 90 - diff24ve
If diff14in > 45 Then diff14in = 90 - diff14in
End Function
 
Web  Contacts  Top
CAT_IMG Posted on 23/1/2018, 11:20
Avatar

Group:
Utente
Posts:
3,010
Location:
avellino

Status:


CITAZIONE (pigreko73.. @ 23/1/2018, 09:55) 
IL QUADRATO A DIAGONALE FISSA

Risultano 4 numeri da giocare per ambata su 2 ruote, l'ambata dovrebbe uscire a colpo per non andare in perdita, nello script ho messo la ricerca per un colpo, naturalmente si può cambiare. Nell'articolo oltre alla ricerca dei 4 numeri, fa riferimento anche a quei casi dove una delle due somme delle distanze sia diversa da 90, e calcolare il numero da modificare per avere la somma delle distanze uguale a 90, per questo ancora non ho trovato la formula per individuare il numero, ma ci sto provando.



'Progetto - QUADRATO A DIAGONALE FISSA - by FABARRI
'Script - by Salvo50
Option Explicit
Sub Main
Dim r1,p1,p2,es,r2,estr1,estr2,estr3,estr4
Dim fin,Ini,caso,casi,clp,esq,somma1,somma2,idestr,col,esqcol
Dim ru(3),posta(2),poste(1)
Dim diff13ve,diff24ve,diff12or,diff34or,diff14in,diff23in
Dim ambo1(2),ambo2(2),ambo3(2),ambo4(2),ambata(4)
TestoInBandaPassante "***** Progetto QUADRATO A DIAGONALE FISSA by Fabarri, script by Salvo50 ****** ",1,5,0
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9180)
clp = InputBox("Per quanti colpi vuoi fare la ricerca",,1)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,20))
poste(1) = 1
posta(2) = 1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
AvanzamentoElab esq,esqcol,es
caso = 0
For r1 = 1 To 10
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12
For p1 = 1 To 4
For p2 = p1 + 1 To 5
estr1 = Estratto(es,r1,p1)
estr2 = Estratto(es,r1,p2)
estr3 = Estratto(es,r2,p1)
estr4 = Estratto(es,r2,p2)
If estr1 <> estr2 And estr1 <> estr3 And estr1 <> estr4 Then
If estr2 <> estr3 And estr2 <> estr4 And estr3 <> estr4 Then
'differenze primo triangolo
diff13ve = Differenza(estr1,estr3)
diff34or = Differenza(estr3,estr4)
'differenze secondo triangolo
diff12or = Differenza(estr1,estr2)
diff24ve = Differenza(estr2,estr4)
'Differenza Diagonale fissa triagoli
diff14in = Differenza(estr1,estr4)
If diff13ve > 45 Then diff13ve = 90 - diff13ve
If diff34or > 45 Then diff34or = 90 - diff34or
If diff12or > 45 Then diff12or = 90 - diff12or
If diff24ve > 45 Then diff24ve = 90 - diff24ve
If diff14in > 45 Then diff14in = 90 - diff14in
If diff13ve = 45 Or diff34or = 45 Or diff12or = 45 Or diff24ve = 45 Then
somma1 = diff13ve + diff34or + diff14in
somma2 = diff24ve + diff12or + diff14in
If somma1 = 90 And somma2 = 90 Then
caso = caso + 1
casi = casi + 1
Scrivi String(90,"*") & " Caso N" & Format2(caso) & " Estraz. " & Format2(es)
Scrivi String(90,"*") & " Casi Totali N" & Format2(casi)
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1) & " Seconda Ruota "_
& Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2)
Scrivi Left(NomeRuota(r1),2) & " " & Format2(estr1) & Space(1) & Format2(estr2),0,0
Scrivi " Distanze Primo Triangolo --> ",0,0
ColoreTesto 2
Scrivi Format2(diff13ve) & Space(5) & Format2(diff34or)_
& Space(5) & Format2(diff14in) & " Somma = " &(somma1)
ColoreTesto 0
Scrivi Left(NomeRuota(r2),2) & " " & Format2(estr3) & Space(1) & Format2(estr4),0,0
Scrivi " Distanze Secondo Triangolo --> ",0,0
ColoreTesto 1
Scrivi Format2(diff12or) & Space(5) & Format2(diff24ve)_
& Space(5) & Format2(diff14in) & " Somma = " &(somma2)
ColoreTesto 0
Scrivi
ru(1) = r1
ru(2) = r2
'ru(3) = 11
ambo1(1) = estr1
ambo1(2) = estr2
ImpostaGiocata 1,ambo1,ru,posta,clp
ambo2(1) = estr3
ambo2(2) = estr4
ImpostaGiocata 2,ambo2,ru,posta,clp
ambo3(1) = estr1
ambo3(2) = estr3
ImpostaGiocata 3,ambo3,ru,posta,clp
ambo4(1) = estr2
ambo4(2) = estr4
ImpostaGiocata 4,ambo4,ru,posta,clp
ambata(1) = estr1
ambata(2) = estr2
ambata(3) = estr3
ambata(4) = estr4
ImpostaGiocata 5,ambata,ru,poste,clp
Gioca es
End If
End If
End If
End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub
Nello Spoiler script modificato per Lottodesk ed l8+
'Progetto - QUADRATO A DIAGONALE FISSA - by FABARRI
'Script - by Salvo50
Option Explicit
Sub Main
Dim r1,p1,p2,es,r2,estr1,estr2,estr3,estr4
Dim fin,Ini,caso,casi,clp,esq,somma1,somma2,idestr,col,esqcol
Dim ru(3),posta(2),poste(1)
Dim diff13ve,diff24ve,diff12or,diff34or,diff14in,diff23in
Dim ambo1(2),ambo2(2),ambo3(2),ambo4(2),ambata(4)
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9350)
clp = InputBox("Per quanti colpi vuoi fare la ricerca",,1)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,fin))
poste(1) = 1
posta(2) = 1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
AvanzamentoElab esq,esqcol,es
caso = 0
For r1 = 1 To 10
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12
For p1 = 1 To 4
For p2 = p1 + 1 To 5
estr1 = Estratto(es,r1,p1)
estr2 = Estratto(es,r1,p2)
estr3 = Estratto(es,r2,p1)
estr4 = Estratto(es,r2,p2)
If estr1 <> estr2 And estr1 <> estr3 And estr1 <> estr4 Then
If estr2 <> estr3 And estr2 <> estr4 And estr3 <> estr4 Then
'differenze primo triangolo
diff13ve = Abs(estr1-estr3)
diff34or = Abs(estr3-estr4)
'differenze secondo triangolo
diff12or = Abs(estr1-estr2)
diff24ve = Abs(estr2-estr4)
'Differenza Diagonale fissa triagoli
diff14in = Abs(estr1-estr4)
If diff13ve > 45 Then diff13ve = 90 - diff13ve
If diff34or > 45 Then diff34or = 90 - diff34or
If diff12or > 45 Then diff12or = 90 - diff12or
If diff24ve > 45 Then diff24ve = 90 - diff24ve
If diff14in > 45 Then diff14in = 90 - diff14in
If diff13ve = 45 Or diff34or = 45 Or diff12or = 45 Or diff24ve = 45 Then
somma1 = diff13ve + diff34or + diff14in
somma2 = diff24ve + diff12or + diff14in
If somma1 = 90 And somma2 = 90 Then
caso = caso + 1
casi = casi + 1
Scrivi String(90,"*") & " Caso N" & Format2(caso) & " Estraz. " & Format2(es)
Scrivi String(90,"*") & " Casi Totali N" & Format2(casi)
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1) & " Seconda Ruota "_
& Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2)
Scrivi Left(NomeRuota(r1),2) & " " & Format2(estr1) & Space(1) & Format2(estr2),0,0
Scrivi " Distanze Primo Triangolo --> ",0,0
ColoreTesto 2
Scrivi Format2(diff13ve) & Space(5) & Format2(diff34or)_
& Space(5) & Format2(diff14in) & " Somma = " &(somma1)
ColoreTesto 0
Scrivi Left(NomeRuota(r2),2) & " " & Format2(estr3) & Space(1) & Format2(estr4),0,0
Scrivi " Distanze Secondo Triangolo --> ",0,0
ColoreTesto 1
Scrivi Format2(diff12or) & Space(5) & Format2(diff24ve)_
& Space(5) & Format2(diff14in) & " Somma = " &(somma2)
ColoreTesto 0
Scrivi
ru(1) = r1
ru(2) = r2
'ru(3) = 11
ambo1(1) = estr1
ambo1(2) = estr2
ImpostaGiocata 1,ambo1,ru,posta,clp
ambo2(1) = estr3
ambo2(2) = estr4
ImpostaGiocata 2,ambo2,ru,posta,clp
ambo3(1) = estr1
ambo3(2) = estr3
ImpostaGiocata 3,ambo3,ru,posta,clp
ambo4(1) = estr2
ambo4(2) = estr4
ImpostaGiocata 4,ambo4,ru,posta,clp
ambata(1) = estr1
ambata(2) = estr2
ambata(3) = estr3
ambata(4) = estr4
ImpostaGiocata 5,ambata,ru,poste,clp
Gioca es
End If
End If
End If
End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub



Continuo con IL QUADRATO A DIAGONALE FISSA con la ricerca di quei triangoli con somma diversa di 90, nello script che ho fatto faccio apparire in rosso le distanze e le somme diverse da 90 ed in azzurro (dopo la correzione) quelle con somma 90, quindi azzurro ok, rosso non ok, la formula per trovare il numero da sostituire a quello errato, non l'ho trovata, ho usato anche la formuletta trovata da Enplein ma non andava bene in questo caso, allora ho avuto l'idea di incrementare una variabile da 1 a 90 ed ad ogni incremento fare i calcoli finche non trovo il numero giusto.

Quindi avevo pensato di usare un - while wend - ma andava in anomalia di < overflow >, l'ho cambiato con - do while loop - ma non c'è stato verso, ho inserito - abs,int,fix,cint,eval - andava sempre in errore di < overflow >, allora ho optato per un FOR NEXT, uso l'incremento come numero e faccio i calcoli, quando la somma che mi interessa è uguale a 90, con - EXIT FOR - esco e passo oltre, non lo so se è normale usare - FOR NEXT - in questo modo.


'Progetto - QUADRATO A DIAGONALE FISSA con correzione somma triangoli diversa da 90 - by FABARRI
'Script - by Salvo50
Option Explicit
Dim r1,p1,p2,es,r2,estr1,estr2,estr3,estr4,k,k1,e2,e3
Dim fin,Ini,caso,casi,clp,esq,somma1,somma2,idestr,col,esqcol
Dim ru(3),poste(1),ambat(1),ambata(1)
Dim diff13ve,diff24ve,diff12or,diff34or,diff14in
Sub Main
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9300)
clp = InputBox("Per quanti colpi vuoi fare la ricerca",,4)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,50))
poste(1) = 1

esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
AvanzamentoElab esq,esqcol,es
caso = 0
For r1 = 1 To 10
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12
For p1 = 1 To 4
For p2 = p1 + 1 To 5
estr1 = (Estratto(es,r1,p1))
estr2 = (Estratto(es,r1,p2))
estr3 = (Estratto(es,r2,p1))
estr4 = (Estratto(es,r2,p2))
e2 = estr2
e3 = estr3
If estr1 <> estr2 And estr1 <> estr3 And estr1 <> estr4 Then
If estr2 <> estr3 And estr2 <> estr4 And estr3 <> estr4 Then
'------------------------------------------
'A = estr1
'B = estr2
'C = estr3
'D = estr4
'A-----B
'| |
'| |
'C-----D
'A,C,D = Primo triangolo
'A,B,D = Secondo triangolo
'**************************Primo Triangolo*****************************************
calcoli
complemento90
If diff13ve = 45 Or diff34or = 45 Or diff12or = 45 Or diff24ve = 45 Then
somma1 = diff13ve + diff34or + diff14in
somma2 = diff24ve + diff12or + diff14in
End If
If somma1 <> 90 And somma2 = 90 Then
caso = caso + 1
casi = casi + 1
preuscite
uscite
k = 0
For k = 1 To 90
diff13ve = Differenza(k,estr1)
diff34or = Differenza(k,estr4)
complemento90
somma1 = diff14in + diff13ve + diff34or
estr3 = k
If somma1 = 90 Then Exit For
Next
Scrivi " Sostituito il " & Format2(e3) & " con il " & Format2(estr3)
Scrivi
uscite
If somma1 = 90 Then
ru(1) = r1
ru(2) = r2
ambata(1) = estr3
ImpostaGiocata 1,ambata,ru,poste,clp
Gioca es
End If
End If
'**************************Secondo Triangolo*****************************************
estr3 = e3
calcoli
complemento90
If somma2 <> 90 And somma1 = 90 Then
caso = caso + 1
casi = casi + 1
preuscite
uscite
k1 = 0
For k1 = 1 To 90
diff12or = Differenza(k1,estr1)
diff24ve = Differenza(k1,estr4)
complemento90
somma2 = diff14in + diff12or + diff24ve
estr2 = k1
If somma2 = 90 Then Exit For
Next
Scrivi " Sostituito il " & Format2(e2) & " con il " & Format2(estr2)
Scrivi
uscite
If somma2 = 90 Then
ru(1) = r1
ru(2) = r2
ambat(1) = estr2
ImpostaGiocata 1,ambat,ru,poste,clp
Gioca es
End If
End If
End If
End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub
Function preuscite
Scrivi String(90,"*") & " Caso N" & Format2(caso) & " Estraz. " & Format2(es)
Scrivi String(90,"*") & " Casi Totali N" & Format2(casi)
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1) & " Seconda Ruota "_
& Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2)
End Function
Function uscite
Scrivi Left(NomeRuota(r1),2) & " " & Format2(estr1) & Space(1) & Format2(estr2),0,0
Scrivi " Distanze Secondo Triangolo --> ",0,0
If somma2 = 90 Then
ColoreTesto 1
Else
ColoreTesto 2
End If
Scrivi Format2(diff12or) & Space(5) & Format2(diff24ve)_
& Space(5) & Format2(diff14in) & " Somma 2 = " &(somma2)
ColoreTesto 0
'----------------------------------------------------
Scrivi Left(NomeRuota(r2),2) & " " & Format2(estr3) & Space(1) & Format2(estr4),0,0
Scrivi " Distanze Primo Triangolo --> ",0,0
If somma1 = 90 Then
ColoreTesto 1
Else
ColoreTesto 2
End If
Scrivi Format2(diff13ve) & Space(5) & Format2(diff34or)_
& Space(5) & Format2(diff14in) & " Somma 1 = " &(somma1)
ColoreTesto 0
Scrivi
End Function
Function calcoli
'differenze primo triangolo
diff13ve = Differenza(estr1,estr3)
diff34or = Differenza(estr3,estr4)
'differenze secondo triangolo
diff12or = Differenza(estr1,estr2)
diff24ve = Differenza(estr2,estr4)
'Differenza Diagonale fissa triagoli
diff14in = Differenza(estr1,estr4)
End Function
Function complemento90
If diff13ve > 45 Then diff13ve = 90 - diff13ve
If diff34or > 45 Then diff34or = 90 - diff34or
If diff12or > 45 Then diff12or = 90 - diff12or
If diff24ve > 45 Then diff24ve = 90 - diff24ve
If diff14in > 45 Then diff14in = 90 - diff14in
End Function

Nello Spoiler script modificato per Lottodesk ed l8+
'Progetto - QUADRATO A DIAGONALE FISSA con correzione somma triangoli diversa da 90 - by FABARRI
'Script - by Salvo50
Option Explicit
Dim r1,p1,p2,es,r2,estr1,estr2,estr3,estr4,k,k1,e2,e3
Dim fin,Ini,caso,casi,clp,esq,somma1,somma2,idestr,col,esqcol
Dim ru(3),poste(1),ambat(1),ambata(1)
Dim diff13ve,diff24ve,diff12or,diff34or,diff14in
Sub Main
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9350)
clp = InputBox("Per quanti colpi vuoi fare la ricerca",,4)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,fin))
poste(1) = 1

esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
AvanzamentoElab esq,esqcol,es
caso = 0
For r1 = 1 To 10
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12
For p1 = 1 To 4
For p2 = p1 + 1 To 5
estr1 = (Estratto(es,r1,p1))
estr2 = (Estratto(es,r1,p2))
estr3 = (Estratto(es,r2,p1))
estr4 = (Estratto(es,r2,p2))
e2 = estr2
e3 = estr3
If estr1 <> estr2 And estr1 <> estr3 And estr1 <> estr4 Then
If estr2 <> estr3 And estr2 <> estr4 And estr3 <> estr4 Then
'------------------------------------------
'A = estr1
'B = estr2
'C = estr3
'D = estr4
'A-----B
'| |
'| |
'C-----D
'A,C,D = Primo triangolo
'A,B,D = Secondo triangolo
'**************************Primo Triangolo*****************************************
calcoli
complemento90
If diff13ve = 45 Or diff34or = 45 Or diff12or = 45 Or diff24ve = 45 Then
somma1 = diff13ve + diff34or + diff14in
somma2 = diff24ve + diff12or + diff14in
End If
If somma1 <> 90 And somma2 = 90 Then
caso = caso + 1
casi = casi + 1
preuscite
uscite
k = 0
For k = 1 To 90
diff13ve = Abs(k-estr1)
diff34or = Abs(k-estr4)
complemento90
somma1 = diff14in + diff13ve + diff34or
estr3 = k
If somma1 = 90 Then Exit For
Next
Scrivi " Sostituito il " & Format2(e3) & " con il " & Format2(estr3)
Scrivi
uscite
If somma1 = 90 Then
ru(1) = r1
ru(2) = r2
ambata(1) = estr3
ImpostaGiocata 1,ambata,ru,poste,clp
Gioca es
End If
End If
'**************************Secondo Triangolo*****************************************
estr3 = e3
calcoli
complemento90
If somma2 <> 90 And somma1 = 90 Then
caso = caso + 1
casi = casi + 1
preuscite
uscite
k1 = 0
For k1 = 1 To 90
diff12or = Abs(k1-estr1)
diff24ve = Abs(k1-estr4)
complemento90
somma2 = diff14in + diff12or + diff24ve
estr2 = k1
If somma2 = 90 Then Exit For
Next
Scrivi " Sostituito il " & Format2(e2) & " con il " & Format2(estr2)
Scrivi
uscite
If somma2 = 90 Then
ru(1) = r1
ru(2) = r2
ambat(1) = estr2
ImpostaGiocata 1,ambat,ru,poste,clp
Gioca es
End If
End If
End If
End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub
Function preuscite
Scrivi String(90,"*") & " Caso N" & Format2(caso) & " Estraz. " & Format2(es)
Scrivi String(90,"*") & " Casi Totali N" & Format2(casi)
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1) & " Seconda Ruota "_
& Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2)
End Function
Function uscite
Scrivi Left(NomeRuota(r1),2) & " " & Format2(estr1) & Space(1) & Format2(estr2),0,0
Scrivi " Distanze Secondo Triangolo --> ",0,0
If somma2 = 90 Then
ColoreTesto 1
Else
ColoreTesto 2
End If
Scrivi Format2(diff12or) & Space(5) & Format2(diff24ve)_
& Space(5) & Format2(diff14in) & " Somma 2 = " &(somma2)
ColoreTesto 0
'----------------------------------------------------
Scrivi Left(NomeRuota(r2),2) & " " & Format2(estr3) & Space(1) & Format2(estr4),0,0
Scrivi " Distanze Primo Triangolo --> ",0,0
If somma1 = 90 Then
ColoreTesto 1
Else
ColoreTesto 2
End If
Scrivi Format2(diff13ve) & Space(5) & Format2(diff34or)_
& Space(5) & Format2(diff14in) & " Somma 1 = " &(somma1)
ColoreTesto 0
Scrivi
End Function
Function calcoli
'differenze primo triangolo
diff13ve = Abs(estr1-estr3)
diff34or = Abs(estr3-estr4)
'differenze secondo triangolo
diff12or = Abs(estr1-estr2)
diff24ve = Abs(estr2-estr4)
'Differenza Diagonale fissa triagoli
diff14in = Abs(estr1-estr4)
End Function
Function complemento90
If diff13ve > 45 Then diff13ve = 90 - diff13ve
If diff34or > 45 Then diff34or = 90 - diff34or
If diff12or > 45 Then diff12or = 90 - diff12or
If diff24ve > 45 Then diff24ve = 90 - diff24ve
If diff14in > 45 Then diff14in = 90 - diff14in
End Function
 
Top
1 replies since 23/1/2018, 09:55   492 views
  Share