i risultati che dà..spero tu riesca a listarlo x facilitare i calcoli .
'Progetto - IL CALCOLO COMPLEMENTARE DI PAOLO CARTA
' UNA MODIFICA SULLA CABALA DI LORD BYRON
'Script - by Salvo50
Option Explicit
Sub Main
Dim D1,D2,D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13
Dim A1,A2,A3,A4,A5,B1,B2,B3,B4,B5,S6S7,XA1
Dim S1,S2,S3,S4,S5,S6,S7,S10,S11,S12,Ind
Dim L,Nu,C1,C2,Cm91S6,Sc1c2,Caso,Casi,Clp
Dim Cm90S6,A1S7,Fin,Ini,Es,R1,Es1000,Ess
Dim Ambata(2),Posta(2),Ruota(1),S20(10)
Scrivi "PROGETTO - IL CALCOLO COMPLEMENTARE DI PAOLO CARTA - UNA MODIFICA SULLA CABALA DI LORD BYRON "
Clp = 10
Posta(1) = 1
Fin = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,5000)'estrazione articolo 9004
Ind = InputBox("Inserisci quante estrazioni vuoi andare indietro nella ricerca",,400)
Clp = CInt(InputBox("Per quanti colpi vuoi fare la ricerca?",,13))
Call ScegliRange(Ini,Fin,Ini,EstrazioneFin)
For Es = Ini To Fin
Messaggio Es
AvanzamentoElab Ini,Fin,Es
Caso = 0
For R1 = 1 To 10
B1 = Estratto(Es,R1,1)
B2 = Estratto(Es,R1,2)
B3 = Estratto(Es,R1,3)
B4 = Estratto(Es,R1,4)
B5 = Estratto(Es,R1,5)
S6 = Fuori90(B1 + B2 + B3 + B4 + B5) ' somma estratti 2a ruota
XA1 = 0
XA1 = 90 - S6
Es1000 = Es - Ind
If Es1000 < 1 Then Es1000 = 1
For Ess = Es - 1 To Es1000 Step - 1
A1 = Estratto(Ess,R1,1)
A2 = Estratto(Ess,R1,2)
A3 = Estratto(Ess,R1,3)
A4 = Estratto(Ess,R1,4)
A5 = Estratto(Ess,R1,5)
If XA1 = A1 Then Exit For
Next
If XA1 = A1 Then
'-----------------------------------------
S1 = Fuori90(A1 + A2 + A3 + A4 + A5) : If S1 < 10 Then S1 = S1 + 90
S2 = Fuori90(A2 + A3 + A4 + A5 + B1) : If S2 < 10 Then S2 = S2 + 90
S3 = Fuori90(A3 + A4 + A5 + B1 + B2) : If S3 < 10 Then S3 = S3 + 90
S4 = Fuori90(A4 + A5 + B1 + B2 + B3) : If S4 < 10 Then S4 = S4 + 90
S5 = Fuori90(A5 + B1 + B2 + B3 + B4) : If S5 < 10 Then S5 = S5 + 90
D1 = Fuori90(90 +(A1 - A2))
D2 = Fuori90(90 +(A2 - A3))
D3 = Fuori90(90 +(A3 - A4))
D4 = Fuori90(90 +(A4 - A5))
D5 = Fuori90(90 +(A5 - B1))
D6 = Fuori90(90 +(B1 - B2))
'----------------------------
D7 = Fuori90(90 +(S1 - S2)) : If D7 < 10 Then D7 = D7 + 90
D8 = Fuori90(90 +(S2 - S3)) : If D8 < 10 Then D8 = D8 + 90
D9 = Fuori90(90 +(S3 - S4)) : If D9 < 10 Then D9 = D9 + 90
D10 = Fuori90(90 +(S4 - S5)) : If D10 < 10 Then D10 = D10 + 90
D11 = Fuori90(90 +(S5 - S6)) : If D11 < 10 Then D11 = D11 + 90
S10 = Fuori90(D1 + D2 + D3 + D4 + D5 + D6 + D7 + D8 + D9 + D10 + D11)'somma distanze
'
S20(1) = Fuori90(B1 + B2 + B3)
S20(2) = Fuori90(B1 + B2 + B4)
S20(3) = Fuori90(B1 + B2 + B5)
S20(4) = Fuori90(B1 + B3 + B4)
S20(5) = Fuori90(B1 + B3 + B5)
S20(6) = Fuori90(B1 + B4 + B5)
S20(7) = Fuori90(B2 + B3 + B4)
S20(8) = Fuori90(B2 + B3 + B5)
S20(9) = Fuori90(B2 + B4 + B5)
S20(10) = Fuori90(B3 + B4 + B5)
If S20(1) = 90 Xor S20(2) = 90 Xor S20(3) = 90 Xor S20(4) = 90 Xor S20(5) = 90 _
Xor S20(6) = 90 Xor S20(7) = 90 Xor S20(8) = 90 Xor S20(9) = 90 Xor S20(10) = 90 Then
If S20(1) = 90 Then C1 = B4 : C2 = B5
If S20(2) = 90 Then C1 = B3 : C2 = B5
If S20(3) = 90 Then C1 = B3 : C2 = B4
If S20(4) = 90 Then C1 = B2 : C2 = B5
If S20(5) = 90 Then C1 = B2 : C2 = B4
If S20(6) = 90 Then C1 = B2 : C2 = B3
If S20(7) = 90 Then C1 = B1 : C2 = B5
If S20(8) = 90 Then C1 = B1 : C2 = B4
If S20(9) = 90 Then C1 = B1 : C2 = B3
If S20(10) = 90 Then C1 = B1 : C2 = B2
Cm91S6 = 91 - S6
Cm90S6 = 90 - S6
Sc1c2 = Fuori90(C1 + C2)
If Cm91S6 - C1 = S6 Or Cm91S6 - C2 = S6 And Sc1c2 = S6 And 90 - S6 = A1 Then
Ambata(1) = Fuori90(S10 + B1)
S7 = Fuori90(B2 + B3 + B4 + B5 + Ambata(1)) ' somma settima colonna più numero incognito
A1S7 = Fuori90(A1 + S7) ' somma 1o estratto 1a ruota più somma settima colonna
If S10 = A1S7 Then
S6S7 = Fuori90(S6 + S7)
Ambata(2) = 90 - S6S7
S11 = Fuori90(S1 + S2 + S3 + S4 + S5 + S6)
S12 = Fuori90(S11 + S10)
If S12 = 90 Then
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & FormattaStringa(Ess,"0000") & " del " & DataEstrazione(Ess)),1,0
Scrivi " " & SiglaRuota(R1) & " " & StringaEstratti(Ess,R1),1
Scrivi(" Estrazione n." & FormattaStringa(Es,"0000") & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1),1
Scrivi
Scrivi Space(20) & Format2(A1) & " " & Format2(A2) & " " & Format2(A3) & " " & Format2(A4),1,0
Scrivi " " & Format2(A5) & " " & Format2(B1) & " " & Format2(B2) & " - Distanze " & Format2(D1),1,0
Scrivi " " & Format2(D2) & " " & Format2(D3) & " " & Format2(D4) & " " & Format2(D5) & " " & Format2(D6),1
Scrivi Space(20) & Format2(A2) & " " & Format2(A3) & " " & Format2(A4) & " " & Format2(A5),1,0
Scrivi " " & Format2(B1) & " " & Format2(B2) & " " & Format2(B3),1
Scrivi Space(20) & Format2(A3) & " " & Format2(A4) & " " & Format2(A5) & " " & Format2(B1),1,0
Scrivi " " & Format2(B2) & " " & Format2(B3) & " " & Format2(B4) & Space(33) & "Somma Distanze = ",1,0
ColoreTesto 1
Scrivi Format2(S10),1
ColoreTesto 0
Scrivi Space(20) & Format2(A4) & " " & Format2(A5) & " " & Format2(B1) & " " & Format2(B2),1,0
Scrivi " " & Format2(B3) & " " & Format2(B4) & " " & Format2(B5),1
Scrivi Space(20) & Format2(A5) & " " & Format2(B1) & " " & Format2(B2) & " " & Format2(B3),1,0
Scrivi " " & Format2(B4) & " " & Format2(B5),1,0
ColoreTesto 2
Scrivi " " & Format2(Ambata(1)),1,0
ColoreTesto 0
Scrivi " - Distanze " & Format2(D7) & " " & Format2(D8) & " " & Format2(D9) & " " & Format2(D10) & " " & Format2(D11),1
Scrivi Space(20) & String(20,"-")
Scrivi Space(13) & " Somme " & Format2(S1) & " " & Format2(S2) & " " & Format2(S3) & " " & Format2(S4),1,0
Scrivi " " & Format2(S5) & " " & Format2(S6) & " - Somma delle somme ",1,0
ColoreTesto 1
Scrivi Format2(S11),1
Scrivi Space(38) & Format2(S7) & " - Settima Somma",1
ColoreTesto 0
Scrivi Space(44) & "Ambo Complementare = " & Format2(C1) & " " & Format2(C2),1
Scrivi
Scrivi Space(20) & Format2(S10) & " + " & Format2(S11) & " = " & Format2(S12),1,0
Scrivi " 1a Equazione - Somma delle distanze + Somma delle Somme, uguale a 90 ",1
Scrivi Space(20) & Format2(A1) & " + " & Format2(S7) & " = " & Format2(S10),1,0
Scrivi " 2a Equazione - Primo Estratto 1a Ruota + Settima Somma, uguale a Somma delle Distanze ",1
Scrivi
Scrivi Space(20) & "Prima Ambata ",1,0
ColoreTesto 2
Scrivi Format2(Ambata(1)),1,0
ColoreTesto 0
Scrivi " - Seconda Ambata ",1,0
ColoreTesto 2
Scrivi Format2(Ambata(2)),1
ColoreTesto 0
Scrivi
Ruota(1) = R1
ImpostaGiocata 1,Ambata,Ruota,Posta,Clp
Gioca Es
End If
End If
End If
End If
End If
Next
Next
ScriviResoconto
End Sub'Progetto - IL CALCOLO COMPLEMENTARE DI PAOLO CARTA - mod Salvo50
' UNA MODIFICA SULLA CABALA DI LORD BYRON
'
'Script - by Salvo50
Option Explicit
Sub Main
Dim D1,D2,D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13
Dim A1,A2,A3,A4,A5,B1,B2,B3,B4,B5,S6S7,XA1
Dim S1,S2,S3,S4,S5,S6,S7,S10,S11,S12,Ind
Dim L,Nu,C1,C2,Cm91S6,Sc1c2,Caso,Casi,Clp
Dim Cm90S6,A1S7,Fin,Ini,Es,R1,Es1000,Ess
Dim Ambata(2),Posta(2),Ruota(1),S20(10)
Scrivi "PROGETTO - IL CALCOLO COMPLEMENTARE DI PAOLO CARTA - UNA MODIFICA SULLA CABALA DI LORD BYRON - Mod Salvo50 "
Clp = 10
Posta(1) = 1
Fin = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9000)'estrazione articolo 9004
Ind = InputBox("Inserisci quante estrazioni vuoi andare indietro nella ricerca",,400)
Clp = CInt(InputBox("Per quanti colpi vuoi fare la ricerca?",,13))
Call ScegliRange(Ini,Fin,Ini,EstrazioneFin)
For Es = Ini To Fin
Messaggio Es
AvanzamentoElab Ini,Fin,Es
Caso = 0
For R1 = 1 To 10
B1 = Estratto(Es,R1,1)
B2 = Estratto(Es,R1,2)
B3 = Estratto(Es,R1,3)
B4 = Estratto(Es,R1,4)
B5 = Estratto(Es,R1,5)
S6 = Fuori90(B1 + B2 + B3 + B4 + B5) ' somma estratti 2a ruota
XA1 = 0
XA1 = 90 - S6
Es1000 = Es - Ind
If Es1000 < 1 Then Es1000 = 1
For Ess = Es - 1 To Es1000 Step - 1
A1 = Estratto(Ess,R1,1)
A2 = Estratto(Ess,R1,2)
A3 = Estratto(Ess,R1,3)
A4 = Estratto(Ess,R1,4)
A5 = Estratto(Ess,R1,5)
If XA1 = A1 Then Exit For
Next
If XA1 = A1 Then
'-----------------------------------------
S1 = Fuori90(A1 + A2 + A3 + A4 + A5) : If S1 < 10 Then S1 = S1 + 90
S2 = Fuori90(A2 + A3 + A4 + A5 + B1) : If S2 < 10 Then S2 = S2 + 90
S3 = Fuori90(A3 + A4 + A5 + B1 + B2) : If S3 < 10 Then S3 = S3 + 90
S4 = Fuori90(A4 + A5 + B1 + B2 + B3) : If S4 < 10 Then S4 = S4 + 90
S5 = Fuori90(A5 + B1 + B2 + B3 + B4) : If S5 < 10 Then S5 = S5 + 90
D1 = Fuori90(90 +(A1 - A2))
D2 = Fuori90(90 +(A2 - A3))
D3 = Fuori90(90 +(A3 - A4))
D4 = Fuori90(90 +(A4 - A5))
D5 = Fuori90(90 +(A5 - B1))
D6 = Fuori90(90 +(B1 - B2))
'----------------------------
D7 = Fuori90(90 +(S1 - S2)) : If D7 < 10 Then D7 = D7 + 90
D8 = Fuori90(90 +(S2 - S3)) : If D8 < 10 Then D8 = D8 + 90
D9 = Fuori90(90 +(S3 - S4)) : If D9 < 10 Then D9 = D9 + 90
D10 = Fuori90(90 +(S4 - S5)) : If D10 < 10 Then D10 = D10 + 90
D11 = Fuori90(90 +(S5 - S6)) : If D11 < 10 Then D11 = D11 + 90
S10 = Fuori90(D1 + D2 + D3 + D4 + D5 + D6 + D7 + D8 + D9 + D10 + D11)'somma distanze
'
S20(1) = Fuori90(B1 + B2 + B3)
S20(2) = Fuori90(B1 + B2 + B4)
S20(3) = Fuori90(B1 + B2 + B5)
S20(4) = Fuori90(B1 + B3 + B4)
S20(5) = Fuori90(B1 + B3 + B5)
S20(6) = Fuori90(B1 + B4 + B5)
S20(7) = Fuori90(B2 + B3 + B4)
S20(8) = Fuori90(B2 + B3 + B5)
S20(9) = Fuori90(B2 + B4 + B5)
S20(10) = Fuori90(B3 + B4 + B5)
If S20(1) = 90 Xor S20(2) = 90 Xor S20(3) = 90 Xor S20(4) = 90 Xor S20(5) = 90 _
Xor S20(6) = 90 Xor S20(7) = 90 Xor S20(8) = 90 Xor S20(9) = 90 Xor S20(10) = 90 Then
If S20(1) = 90 Then C1 = B4 : C2 = B5
If S20(2) = 90 Then C1 = B3 : C2 = B5
If S20(3) = 90 Then C1 = B3 : C2 = B4
If S20(4) = 90 Then C1 = B2 : C2 = B5
If S20(5) = 90 Then C1 = B2 : C2 = B4
If S20(6) = 90 Then C1 = B2 : C2 = B3
If S20(7) = 90 Then C1 = B1 : C2 = B5
If S20(8) = 90 Then C1 = B1 : C2 = B4
If S20(9) = 90 Then C1 = B1 : C2 = B3
If S20(10) = 90 Then C1 = B1 : C2 = B2
Cm91S6 = 91 - S6
Cm90S6 = 90 - S6
Sc1c2 = Fuori90(C1 + C2)
Ambata(1) = Fuori90(S10 + B1)
S7 = Fuori90(B2 + B3 + B4 + B5 + Ambata(1)) ' somma settima colonna più numero incognito
A1S7 = Fuori90(A1 + S7) ' somma 1o estratto 1a ruota più somma settima colonna
If S10 = A1S7 Then
S6S7 = Fuori90(S6 + S7)
Ambata(2) = 90 - S6S7
S11 = Fuori90(S1 + S2 + S3 + S4 + S5 + S6)
S12 = Fuori90(S11 + S10)
If S12 = 90 Then
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & FormattaStringa(Ess,"0000") & " del " & DataEstrazione(Ess)),1,0
Scrivi " " & SiglaRuota(R1) & " " & StringaEstratti(Ess,R1),1
Scrivi(" Estrazione n." & FormattaStringa(Es,"0000") & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1),1
Scrivi
Scrivi Space(20) & Format2(A1) & " " & Format2(A2) & " " & Format2(A3) & " " & Format2(A4),1,0
Scrivi " " & Format2(A5) & " " & Format2(B1) & " " & Format2(B2) & " - Distanze " & Format2(D1),1,0
Scrivi " " & Format2(D2) & " " & Format2(D3) & " " & Format2(D4) & " " & Format2(D5) & " " & Format2(D6),1
Scrivi Space(20) & Format2(A2) & " " & Format2(A3) & " " & Format2(A4) & " " & Format2(A5),1,0
Scrivi " " & Format2(B1) & " " & Format2(B2) & " " & Format2(B3),1
Scrivi Space(20) & Format2(A3) & " " & Format2(A4) & " " & Format2(A5) & " " & Format2(B1),1,0
Scrivi " " & Format2(B2) & " " & Format2(B3) & " " & Format2(B4) & Space(33) & "Somma Distanze = ",1,0
ColoreTesto 1
Scrivi Format2(S10),1
ColoreTesto 0
Scrivi Space(20) & Format2(A4) & " " & Format2(A5) & " " & Format2(B1) & " " & Format2(B2),1,0
Scrivi " " & Format2(B3) & " " & Format2(B4) & " " & Format2(B5),1
Scrivi Space(20) & Format2(A5) & " " & Format2(B1) & " " & Format2(B2) & " " & Format2(B3),1,0
Scrivi " " & Format2(B4) & " " & Format2(B5),1,0
ColoreTesto 2
Scrivi " " & Format2(Ambata(1)),1,0
ColoreTesto 0
Scrivi " - Distanze " & Format2(D7) & " " & Format2(D8) & " " & Format2(D9) & " " & Format2(D10) & " " & Format2(D11),1
Scrivi Space(20) & String(20,"-")
Scrivi Space(13) & " Somme " & Format2(S1) & " " & Format2(S2) & " " & Format2(S3) & " " & Format2(S4),1,0
Scrivi " " & Format2(S5) & " " & Format2(S6) & " - Somma delle somme ",1,0
ColoreTesto 1
Scrivi Format2(S11),1
Scrivi Space(38) & Format2(S7) & " - Settima Somma",1
ColoreTesto 0
Scrivi Space(44) & "Ambo Complementare = " & Format2(C1) & " " & Format2(C2),1
Scrivi
Scrivi Space(20) & Format2(S10) & " + " & Format2(S11) & " = " & Format2(S12),1,0
Scrivi " 1a Equazione - Somma delle distanze + Somma delle Somme, uguale a 90 ",1
Scrivi Space(20) & Format2(A1) & " + " & Format2(S7) & " = " & Format2(S10),1,0
Scrivi " 2a Equazione - Primo Estratto 1a Ruota + Settima Somma, uguale a Somma delle Distanze ",1
Scrivi
Scrivi Space(20) & "Prima Ambata ",1,0
ColoreTesto 2
Scrivi Format2(Ambata(1)),1,0
ColoreTesto 0
Scrivi " - Seconda Ambata ",1,0
ColoreTesto 2
Scrivi Format2(Ambata(2)),1
ColoreTesto 0
Scrivi
Ruota(1) = R1
ImpostaGiocata 1,Ambata,Ruota,Posta,Clp
Gioca Es
End If
End If
End If
End If
Next
Next
ScriviResoconto
End Sub
'PROGETTO - QUATTRO LATI PER UNA QUATERNA - BY GAETANO TOTI
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim FIn,Es,Esq,Clp,Col,Esqcol,Clp2,Salvo50
Dim Posta(1),Ruote(1),Ruota(1),Poste(5),Sestina(6),Ambata(2),Post(5)
Dim Ambo1(2),Ambo2(2),Ambo3(2),Ambo4(2),Ambo5(2),Ambo6(2),Ambo7(2),Ambo8(2),Ambo9(2)
Dim R1,Caso,Casi,AB,BD,DE,AE,NB,Dec
Dim A,B,C,D,E,R,Estr1,Estr2,Estr4,Estr3,Estr5,somma1,somma2
Dim AmbPrinc,AmbSecon,Abb1,Abb2,Abb3,Abb4
FIn = EstrazioneFin
'7089 esempio nell'articolo, dal 7301 al 7497 per 196 estrazioni,
'periodo dal gennaio 2004 al settembre 2005 descritto nell'articolo
Esq = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9400)'7089
Clp = InputBox("Per quanti colpi vuoi giocare le ambate?",,4)
Clp2 = InputBox("Per quanti colpi vuoi giocare gli ambi e la sestina?",,7)
Col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,FIn))'196
Posta(1) = 1
Poste(2) = 1
Post(2) = 1
Post(3) = 1
'Post(4) = 1
'Post(5) = 1
Esqcol = Esq + Col
If Esqcol > FIn Then Esqcol = FIn
For Es = Esq To Esqcol
Messaggio Es
AvanzamentoElab Esq,Esqcol,Es
Caso = 0
For R1 = 1 To 10
A = Estratto(Es,R1,1)
B = Estratto(Es,R1,2)
C = Estratto(Es,R1,3)
D = Estratto(Es,R1,4)
E = Estratto(Es,R1,5)
'A---B
'| |
'E---D
AB = Distanza(A,B)
BD = Distanza(B,D)
DE = Distanza(D,E)
AE = Distanza(A,E)
If AB = DE And BD = AE Then
NB = Int(Sqr((AB * AB) +(BD * BD)))
Dec = Decina(NB)
If Dec =(5) Then
AmbPrinc = Fuori90(NB + 65)
AmbSecon = Fuori90(AmbPrinc + 5)
Else
AmbPrinc = Fuori90(NB + 10)
AmbSecon = Fuori90(AmbPrinc + 30)
End If
If AmbPrinc <> 31 Then
Abb1 = Fuori90(90 +(C - 7))
Abb2 = Fuori90(90 +(C - 4))
Abb3 = Fuori90(NB + 58)
Abb4 = Fuori90(E + 64)
Ambata(1) = AmbPrinc : Ambata(2) = AmbSecon
Ambo1(1) = AmbPrinc : Ambo1(2) = AmbSecon
Ambo2(1) = AmbPrinc : Ambo2(2) = Abb1
Ambo3(1) = AmbPrinc : Ambo3(2) = Abb2
Ambo4(1) = AmbPrinc : Ambo4(2) = Abb3
Ambo5(1) = AmbPrinc : Ambo5(2) = Abb4
Ambo6(1) = AmbSecon : Ambo6(2) = Abb1
Ambo7(1) = AmbSecon : Ambo7(2) = Abb2
Ambo8(1) = AmbSecon : Ambo8(2) = Abb3
Ambo9(1) = AmbSecon : Ambo9(2) = Abb4
Sestina(1) = AmbPrinc
Sestina(2) = AmbSecon
Sestina(3) = Abb1
Sestina(4) = Abb2
Sestina(5) = Abb3
Sestina(6) = Abb4
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1),1
Scrivi
Scrivi "Ambata Principale " & Format2(AmbPrinc),1
Scrivi "Ambata Secondaria " & Format2(AmbSecon),1
Scrivi "Abbinamenti per Ambo " & Format2(Abb1) & " " & Format2(Abb2) & " " & Format2(Abb3) & " " & Format2(Abb4),1
Scrivi "Sestina " & Format2(AmbPrinc) & " " & Format2(AmbSecon),1,0
Scrivi " " & Format2(Abb1) & " " & Format2(Abb2) & " " & Format2(Abb3) & " " & Format2(Abb4),1
Scrivi
Ruota(1) = R1
Ruote(1) = TU_
ImpostaGiocata 1,Ambata,Ruota,Posta,Clp,1
ImpostaGiocata 2,Ambo1,Ruota,Poste,Clp2,2
ImpostaGiocata 3,Ambo2,Ruota,Poste,Clp2,2
ImpostaGiocata 4,Ambo3,Ruota,Poste,Clp2,2
ImpostaGiocata 5,Ambo4,Ruota,Poste,Clp2,2
ImpostaGiocata 6,Ambo5,Ruota,Poste,Clp2,2
ImpostaGiocata 7,Ambo6,Ruota,Poste,Clp2,2
ImpostaGiocata 8,Ambo7,Ruota,Poste,Clp2,2
ImpostaGiocata 9,Ambo8,Ruota,Poste,Clp2,2
EliminaRipetuti Sestina
ImpostaGiocata 10,Sestina,Ruote,Post,Clp2
Gioca Es
End If
End If
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi Space(52) & " PROGETTO - QUATTRO LATI PER UNA QUATERNA - BY GAETANO TOTI"
Scrivi Space(52) & " SCRIPT BY Salvo50"
End Sub
'PROGETTO - FRA CABALA E CICLOMETRIA - a cura di GIACOMO SCIONTI
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp1,Clp2,Clp3
Dim Ruote(2),Ruots(1),Poste(2),Posta(1)
Dim Ambata(1),Amb1(2),Amb2(2),Amb3(2),Amb4(2)
Dim Amb5(2),Amb6(2),Amb7(2),Amb8(2)
Dim R1,R2,Caso,Casi,P1,P2,A1,A2,B1,B2,E1,E2
Dim SommaA,SommaB,Somma1,Somma2,P11,P12
Dim Abb1,Abb2,Abb3,Abb4,Abb5,Abb6,Abb7
Dim Diff1,Diff2
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9440)'6798 esempio nell'articolo
Clp1 = InputBox("Per quanti colpi vuoi giocare l'ambata?",,5)
Clp2 = InputBox("Per quanti colpi vuoi giocare gli ambi per le ruote di calcolo?",,5)
Clp3 = InputBox("Per quanti colpi vuoi giocare gli ambi per tutte le ruote?",,5)
Call ScegliRange(Ini,FIn,Ini,FIn)
Poste(2) = 1
Posta(1) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 9
For R2 = R1 + 1 To 10
If((R2 = R1 + 5) And(R2 < 11)) Or(R2 = R1 + 1) Then
For P1 = 1 To 4
For P2 = P1 + 1 To 5
A1 = Estratto(Es,R1,P1)
A2 = Estratto(Es,R1,P2)
'----------------------
B1 = Estratto(Es,R2,P1)
B2 = Estratto(Es,R2,P2)
If A1 <> B1 And A1 <> B2 And A2 <> B1 And A2 <> B2 Then
SommaA = Fuori90(A1 + A2)
SommaB = Fuori90(B1 + B2)
If SommaA = SommaB Then
Abb1 = Fuori90(SommaA + A1)
Abb2 = Fuori90(SommaA + A2)
Abb3 = Fuori90(SommaB + B1)
Abb4 = Fuori90(SommaB + B2)
'
Somma1 = Fuori90(SommaA + Abb1 + Abb2)
Somma2 = Fuori90(SommaB + Abb3 + Abb4)
If Somma1 = Somma2 Then
Abb5 = Fuori90(Somma1 * 4)
Diff1 = Differenza(Abb1,Abb3)
Diff2 = Differenza(Abb2,Abb4)
If Diff1 = Diff2 Then
Abb6 = Fuori90(Diff1 + Diff2)
Abb7 = Fuori90(Abb1 + Abb2 + Abb3 + Abb4)
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 2
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P11 = 1 To 5
E1 = Estratto(Es,R1,P11)
If E1 = A1 Or E1 = A2 Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi " Somma (Estratti in Rosso) = " & Format2(SommaA),1
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P12 = 1 To 5
E2 = Estratto(Es,R2,P12)
If E2 = B1 Or E2 = B2 Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi " Somma (Estratti in Rosso) = " & Format2(SommaB),1
Scrivi
ColoreTesto 2
Scrivi Space(31) & Format2(SommaA),1:Scrivi:Scrivi
Scrivi Space(22) & Format2(A1) & Space(16) & Format2(A2),1:
ColoreTesto 1
Scrivi Space(25) & Format2(Abb1) & Space(10) & Format2(Abb2),1
ColoreTesto 2
Scrivi Space(25) & Format2(Diff1) & Space(4) & Format2(Abb6) & Space(4) & Format2(Diff2),1
ColoreTesto 1
Scrivi Space(31) & Format2(Abb7),1
Scrivi Space(25) & Format2(Abb3) & Space(10) & Format2(Abb4),1
ColoreTesto 2
Scrivi Space(22) & Format2(B1) & Space(16) & Format2(B2),1
ColoreTesto 0
Scrivi
Ruote(1) = R1
Ruote(2) = R2
Ruots(1) = 11
Ambata(1) = SommaA
ImpostaGiocata 1,Ambata,Ruote,Posta,Clp1
Amb1(1) = SommaA
Amb1(2) = Abb1
ImpostaGiocata 2,Amb1,Ruote,Poste,Clp2
Amb2(1) = SommaA
Amb2(2) = Abb2
ImpostaGiocata 3,Amb2,Ruote,Poste,Clp2
Amb3(1) = SommaA
Amb3(2) = Abb3
ImpostaGiocata 4,Amb3,Ruote,Poste,Clp2
Amb4(1) = SommaA
Amb4(2) = Abb4
ImpostaGiocata 5,Amb4,Ruote,Poste,Clp2
Amb5(1) = SommaA
Amb5(2) = Abb5
ImpostaGiocata 6,Amb5,Ruote,Poste,Clp2
Amb6(1) = SommaA
Amb6(2) = Abb6
ImpostaGiocata 7,Amb6,Ruots,Poste,Clp3
Amb7(1) = SommaA
Amb7(2) = Abb7
ImpostaGiocata 8,Amb7,Ruots,Poste,Clp3
Amb8(1) = Abb6
Amb8(2) = Abb7
ImpostaGiocata 9,Amb8,Ruots,Poste,Clp3
Gioca Es
End If
End If
End If
End If
Next
Next
End If
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi Space(46) & " PROGETTO - FRA CABALA E CICLOMETRIA - a cura di GIACOMO SCIONTI"
Scrivi Space(46) & " SCRIPT BY Salvo50"
End Sub
'PROGETTO - AMBATA CICLOMETRICA - a cura di LUCIANA GIORGETTI
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp1,Salvo50
Dim Num1(1),Ruote(2),Posta(1)
Dim R1,R2,P1,P2,P3,P4,P,PP,A,B,C,D,E1,E2
Dim Dist1,Dist2,Ambata,Caso,Casi
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9540)
Clp1 = InputBox("Per quanti colpi vuoi giocare l'ambata?",Salvo50,5)
Call ScegliRange(EstrazioneIni,EstrazioneFin,Ini,FIn)
Scrivi "AMBATA CICLOMETRICA - a cura di LUCIANA GIORGETTI - Script by Salvo50",1,,,1,3,,1
Posta(1) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 10
For P1 = 1 To 4
For P2 = P1 + 1 To 5
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
Dist1 = Distanza(A,B)
If Dist1 = 18 Or Dist1 = 36 Then
For R2 = R1 + 1 To 12
If R2 = 11 Then R2 = 12
For P3 = 1 To 4
For P4 = P3 + 1 To 5
C = Estratto(Es,R2,P3)
D = Estratto(Es,R2,P4)
Dist2 = Distanza(C,D)
If Dist2 = 18 Or Dist2 = 36 Then
If Dist1 <> Dist2 Then
Ambata = Fuori90(A + B + C + D)
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 2
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P = 1 To 5
E1 = Estratto(Es,R1,P)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi " <-- Rossi con Distanza Ciclometrica " & Format2(Dist1),1
'Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For PP = 1 To 5
E2 = Estratto(Es,R2,PP)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi " <-- Rossi con Distanza Ciclometrica " & Format2(Dist2),1
Scrivi
Scrivi Space(24) & Format2(A) & " + " & Format2(B) & " + " & Format2(C),1,0
Scrivi " + " & Format2(D) & " = Ambata ",1,0
ColoreTesto 2
Scrivi Format2(Ambata),1
ColoreTesto 0
Scrivi
Ruote(1) = R1
Ruote(2) = R2
Num1(1) = Ambata
ImpostaGiocata 1,Num1,Ruote,Posta,Clp1
Gioca Es
End If
End If
Next
Next
Next
End If
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi Space(52) & " PROGETTO - AMBATA CICLOMETRICA - a cura di LUCIANA GIORGETTI"
Scrivi Space(52) & " SCRIPT BY Salvo50"
End Sub
'PROGETTO - DOPPIA AMBATA SU UNA RUOTA a cura di BENITO BUZZON
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim FIn,Ini,Es,Clp,Clp2,Salvo50,Ruota
Dim R1,Caso,Casi,A,B,P1,E1,F1,F2,IniR
Dim Num(4),Ruo(1),Tut(1),Post1(1),FInR
Dim Amba(2),Post2(3)
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9000)'6348 l'ultimo esempio nell'articolo
Clp = InputBox("Per quanti colpi vuoi giocare le Ambate?",,8)
Clp2 = InputBox("Per quanti colpi vuoi giocare la quartina?",,8)
Ruota = InputBox("Vuoi fare la ricerca per Tutte le Ruote - Si = 0 - Per Ruota Singola Indica il Numero - da 1 a 10 Per Nazionale 12 ?",Salvo50,0)
If Ruota = 0 Then
IniR = 1
FInR = 12
Else
IniR = Ruota
FInR = Ruota
End If
Call ScegliRange(EstrazioneIni,FIn,Ini,EstrazioneFin)
Scrivi Space(8) & "DOPPIA AMBATA SU UNA RUOTA A cura di BENITO BUZZON - SCRIPT SALVO50",1,,4,,3,,1
Post1(1) = 1
Post2(2) = 1
Post2(3) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = IniR To FInR
A = Estratto(Es,R1,1)
B = Estratto(Es,R1,5)
If A > 0 And A < 9 Then
F1 = Figura(B)
Amba(1) = A & F1
Amba(2) = Vert(Amba(1))
Num(1) = Amba(1)
Num(2) = Amba(2)
Num(3) = Amba(1) - A
Num(4) = Vert(Num(3))
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P1 = 1 To 5
E1 = Estratto(Es,R1,P1)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(15) & " Le Due Ambate " & Format2(Num(1)) & " " & Format2(Num(2)),1
Scrivi Space(15) & " I Due Abbinamenti " & Format2(Num(3)) & " " & Format2(Num(4)),1
Scrivi
Ruo(1) = R1
Tut(1) = TU_
ImpostaGiocata 1,Amba,Ruo,Post1,Clp
ImpostaGiocata 2,Num,Tut,Post2,Clp
Gioca Es
End If
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi Space(52) & " DOPPIA AMBATA SU UNA RUOTA a cura di BENITO BUZZON"
Scrivi Space(52) & " SCRIPT BY Salvo50"
End Subdemonio;n2147727 ha scritto:
'PROGETTO - DISTANZA 7 DI ANGELO GARGIULO
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim FIn,Ini,Es,Clp,Clp2,Salvo50,Caso,Casi
Dim R1,R2,A,B,C,D,P1,P2,P3,P4,P5,P6,E1,E2,OK
Dim DiM1M2,DiM2M3,DiM3M4,Amba,Abb1,Abb2,Abb3
Dim Ambata(1),Num1(2),Num2(2),Num3(2),Num4(4)
Dim Ruo(2),Tut(1),Post1(1),Post2(3),Post3(3),M(4)
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,7499) '7499 Primo Esempio nell'articolo
Clp = InputBox("Per quanti colpi vuoi giocare l'Ambata?",,5)
Clp2 = InputBox("Per quanti colpi vuoi giocare gli ambi e la quartina?",,8)
Call ScegliRange(EstrazioneIni,FIn,Ini,EstrazioneFin)
Scrivi Space(8) & "DISTANZA 7 di ANGELO GARGIULO - SCRIPT SALVO50",1,,4,,3,,1
Post1(1) = 1
Post2(2) = 1
Post3(2) = 1
'Post3(3) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 10
For P1 = 1 To 4
For P2 = P1 + 1 To 5
A = Estratto(Es,R1,P1) : If A > 0 Then
B = Estratto(Es,R1,P2)
If Distanza(A,B) = 7 Then
For R2 = R1 + 1 To 12
C = Estratto(Es,R2,P1) : If C > 0 Then
D = Estratto(Es,R2,P2)
If Distanza(C,D) = 7 Then
M(1) = A : M(2) = B : M(3) = C : M(4) = D
Call OrdinaMatrice(M,1)
DiM1M2 = Distanza(M(1),M(2))
DiM2M3 = Distanza(M(2),M(3))
DiM3M4 = Distanza(M(3),M(4))
OK = 0
If(DiM1M2 = 5 And DiM2M3 = 2 And DiM3M4 = 5) Or(DiM1M2 = 2 And DiM2M3 = 5 And DiM3M4 = 2) Then
If(DiM1M2 = 5 And DiM2M3 = 2 And DiM3M4 = 5) Then
Amba = Fuori90(M(4) + 5)
Abb1 = Fuori90(M(4) + 2)
Abb2 = Fuori90(90 +(M(1) - 5))
Abb3 = Fuori90(90 +(M(1) - 2))
OK = 1
End If
If(DiM1M2 = 2 And DiM2M3 = 5 And DiM3M4 = 2) Then
Amba = Fuori90(M(4) + 2)
Abb1 = Fuori90(M(4) + 5)
Abb2 = Fuori90(90 +(M(1) - 2))
Abb3 = Fuori90(90 +(M(1) - 5))
OK = 1
End If
If OK = 1 Then
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P5 = 1 To 5
E1 = Estratto(Es,R1,P5)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P6 = 1 To 5
E2 = Estratto(Es,R2,P6)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(10) & "Estratti in ordine crescente " & Format2(M(1)) & " " & Format2(M(2)),1,0
Scrivi " " & Format2(M(3)) & " " & Format2(M(4)),1
Scrivi Space(10) & "Ambata più Abbinamenti " & Format2(Amba) & " " & Format2(Abb1),1,0
Scrivi " " & Format2(Abb2) & " " & Format2(Abb3),1
Scrivi
Ruo(1) = R1 : Ruo(2) = R2
Tut(1) = TU_
Ambata(1) = Amba
ImpostaGiocata 1,Ambata,Ruo,Post1,Clp
Num1(1) = Amba : Num1(2) = Abb1
ImpostaGiocata 2,Num1,Ruo,Post2,Clp2,2
Num2(1) = Amba : Num2(2) = Abb2
ImpostaGiocata 3,Num2,Ruo,Post2,Clp2,2
Num3(1) = Amba : Num3(2) = Abb3
ImpostaGiocata 4,Num3,Ruo,Post2,Clp2,2
Num4(1) = Amba : Num4(2) = Abb1
Num4(3) = Abb2 : Num4(4) = Abb3
ImpostaGiocata 5,Num4,Ruo,Post3,Clp2
Gioca Es
End If
End If
End If
End If
Next
End If
End If
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi Space(52) & " DISTANZA 7 di ANGELO GARGIULO"
Scrivi Space(52) & " SCRIPT BY Salvo50"
End Sub
'PROGETTO - EVOLUZIONE BEN II - a cura di MICHELE PACE
'SCRIPT BY SALVO50
Option Explicit
Dim Amba(1),Ambo1(2),Ambo2(2),Ambo3(2),Ambo4(2),Ambo5(2),Penta(5)
Sub Main
Dim FIn,Es,Ini,Clp1,Clp2
Dim Ruote(2),Ruots(1),Posta(5),Poste(5),Post(3)
Dim R1,R2,Caso,Casi,P1,P2,p3,p4,P,PP,E1,E2
Dim DAB,DCD,DAC,DBD,DAD,DBC,A,B,C,D,Co
Dim SomOr1,SomOr2,SomVe1,SomVe2,SomDi1,SomDi2,Ok
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9520)
Clp1 = InputBox("Per quanti colpi vuoi giocare l'Ambata e gli Ambi?",,8)
Clp2 = InputBox("Per quanti colpi vuoi giocare la Cinquina?",,8)
Call ScegliRange(EstrazioneIni,FIn,Ini,EstrazioneFin)
Scrivi Space(12) & "EVOLUZIONE BEN II - a cura di MICHELE PACE - SCRIPT SALVO50",1,,4,,3,,1
Posta(1) = 1
Poste(2) = 1
Post(2) = 1
'Post(3) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 9
For P1 = 1 To 4
For P2 = P1 + 1 To 5
If P2 = P1 + 1 Or(P1 = 1 And P2 = 5) Then
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
For R2 = R1 + 1 To 10
For p3 = 1 To 4
For p4 = p3 + 1 To 5
If p4 = p3 + 1 Or(p3 = 1 And p4 = 5) Then
C = Estratto(Es,R2,p3)
D = Estratto(Es,R2,p4)
'A---B
'| |
'C---D
DAB = Distanza(A,B) : DCD = Distanza(C,D) : DAC = Distanza(A,C)
DBD = Distanza(B,D) : DAD = Distanza(A,D) : DBC = Distanza(B,C)
If(DAB = 45 And DCD = 45) Or(DAC = 45 And DBD = 45)Or(DAD = 45 And DBC = 45) Then
Ok = 0
If((A + B)Mod 2) = 0 And((C + D)Mod 2) = 0 Then Ok = 1
If((A + C)Mod 2) = 0 And((B + D)Mod 2) = 0 Then Ok = 1
If((A + D)Mod 2) = 0 And((B + C)Mod 2) = 0 Then Ok = 1
If Ok = 1 Then
SomOr1 = A + B : SomOr2 = C + D
SomVe1 = A + C : SomVe2 = B + D
SomDi1 = A + D : SomDi2 = B + C
If((SomOr1 = SomOr2) And pari(SomOr1)) Then
Amba(1) = SomOr1 / 2
Ambo1(1) = Amba(1)
If A < B Then
Ambo1(2) = Fuori90(90 +(Amba(1) - A))
Else
Ambo1(2) = Fuori90(90 +(Amba(1) - B))
End If
Ambo2(1) = Diametrale(Amba(1))
Ambo2(2) = Diametrale(Ambo1(2))
'------------------------------------
Ambo3(1) = Amba(1)
If C < D Then
Ambo3(2) = Fuori90(90 +(Amba(1) - C))
Else
Ambo3(2) = Fuori90(90 +(Amba(1) - D))
End If
Call Finale
Ok = 2
End If
'
'
If((SomVe1 = SomVe2) And pari(SomVe1)) Then
Amba(1) = SomVe1 / 2
Ambo1(1) = Amba(1)
If A < C Then
Ambo1(2) = Fuori90(90 +(Amba(1) - A))
Else
Ambo1(2) = Fuori90(90 +(Amba(1) - C))
End If
Ambo2(1) = Diametrale(Amba(1))
Ambo2(2) = Diametrale(Ambo1(2))
'------------------------------------
Ambo3(1) = Amba(1)
If B < D Then
Ambo3(2) = Fuori90(90 +(Amba(1) - B))
Else
Ambo3(2) = Fuori90(90 +(Amba(1) - D))
End If
Call Finale
Ok = 2
End If
'
'
If((SomDi1 = SomDi2) And pari(SomDi1)) Then
Amba(1) = SomDi1 / 2
Ambo1(1) = Amba(1)
If A < D Then
Ambo1(2) = Fuori90(90 +(Amba(1) - A))
Else
Ambo1(2) = Fuori90(90 +(Amba(1) - D))
End If
Ambo2(1) = Diametrale(Amba(1))
Ambo2(2) = Diametrale(Ambo1(2))
'------------------------------------
Ambo3(1) = Amba(1)
If B < C Then
Ambo3(2) = Fuori90(90 +(Amba(1) - B))
Else
Ambo3(2) = Fuori90(90 +(Amba(1) - C))
End If
Call Finale
Ok = 2
End If
If Ok = 2 Then
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 2
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P = 1 To 5
E1 = Estratto(Es,R1,P)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For PP = 1 To 5
E2 = Estratto(Es,R2,PP)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(30) & " In uno dei gruppi Oriz. Vert. Diag le somme devono essere pari",1,,,2 ',3,,1
Scrivi " Distanza 45" & Space(25) & "Somme " & Space(10),1,0
Scrivi " Somme" & Space(11) & " Somme",1
Scrivi " Oriz. Vert. Diag" & Space(20) & " Orizontali" & Space(7),1,0
Scrivi "Verticali Diagonali",1
Scrivi Space(8) & Format2(A) & " " & Format2(B) & Space(29),1,0
Scrivi FormattaStringa(SomOr1,"000") & Space(14) & FormattaStringa(SomVe1,"000"),1,0
Scrivi Space(14) & FormattaStringa(SomDi1,"000"),1
Scrivi Space(8) & Format2(C) & " " & Format2(D) & Space(29),1,0
Scrivi FormattaStringa(SomOr2,"000") & Space(14) & FormattaStringa(SomVe2,"000"),1,0
Scrivi Space(14) & FormattaStringa(SomDi2,"000"),1
Scrivi
Scrivi Space(38) & " L'Ambata " & Format2(Amba(1)) & " è = ad una somma pari diviso 2",1,,,2
Scrivi
Ruote(1) = R1
Ruote(2) = R2
Ruots(1) = TU_
Co = 1
If SerieFreq(Es - 8,Es,Amba,Ruote,1) = 0 Then
ImpostaGiocata Co,Amba,Ruote,Posta,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo1,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo1,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo2,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo2,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo3,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo3,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo4,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo4,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo5,Ruots,2) = 0 Then
ImpostaGiocata Co,Ambo5,Ruots,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Penta,Ruote,2) = 0 Then
ImpostaGiocata Co,Penta,Ruote,Post,Clp2
End If
Gioca Es
End If
End If
End If
End If
Next
Next
Next
End If
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi Space(52) & " PROGETTO - EVOLUZIONE BEN II - a cura di MICHELE PACE"
Scrivi Space(52) & " SCRIPT BY Salvo50"
End Sub
Function Finale
Ambo4(1) = Diametrale(Ambo3(1))
Ambo4(2) = Diametrale(Ambo3(2))
Ambo5(1) =(Amba(1))
Ambo5(2) = Diametrale(Amba(1))
Penta(1) = Ambo1(2)
Penta(2) = Ambo2(1)
Penta(3) = Ambo2(2)
Penta(4) = Ambo3(2)
Penta(5) = Ambo4(2)
End Function'PROGETTO - EVOLUZIONE BEN II - Versione con estratti anche non uniti - a cura di MICHELE PACE
'SCRIPT BY SALVO50
Option Explicit
Dim Amba(1),Ambo1(2),Ambo2(2),Ambo3(2),Ambo4(2),Ambo5(2),Penta(5)
Sub Main
Dim FIn,Es,Ini,Clp1,Clp2
Dim Ruote(2),Ruots(1),Posta(5),Poste(5),Post(3)
Dim R1,R2,Caso,Casi,P1,P2,p3,p4,P,PP,E1,E2
Dim DAB,DCD,DAC,DBD,DAD,DBC,A,B,C,D,Co
Dim SomOr1,SomOr2,SomVe1,SomVe2,SomDi1,SomDi2,Ok
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9420)
Clp1 = InputBox("Per quanti colpi vuoi giocare l'Ambata e gli Ambi?",,8)
Clp2 = InputBox("Per quanti colpi vuoi giocare la Cinquina?",,8)
Call ScegliRange(EstrazioneIni,FIn,Ini,EstrazioneFin)
Scrivi Space(12) & "EVOLUZIONE BEN II - a cura di MICHELE PACE - Versione con estratti anche non uniti - SCRIPT SALVO50",1,,4,,3,,1
Posta(1) = 1
Poste(2) = 1
Post(2) = 1
'Post(3) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 9
For P1 = 1 To 4
For P2 = P1 + 1 To 5
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
For R2 = R1 + 1 To 10
For p3 = 1 To 4
For p4 = p3 + 1 To 5
C = Estratto(Es,R2,p3)
D = Estratto(Es,R2,p4)
'A---B
'| |
'C---D
DAB = Distanza(A,B) : DCD = Distanza(C,D) : DAC = Distanza(A,C)
DBD = Distanza(B,D) : DAD = Distanza(A,D) : DBC = Distanza(B,C)
If(DAB = 45 And DCD = 45) Or(DAC = 45 And DBD = 45)Or(DAD = 45 And DBC = 45) Then
Ok = 0
If((A + B)Mod 2) = 0 And((C + D)Mod 2) = 0 Then Ok = 1
If((A + C)Mod 2) = 0 And((B + D)Mod 2) = 0 Then Ok = 1
If((A + D)Mod 2) = 0 And((B + C)Mod 2) = 0 Then Ok = 1
If Ok = 1 Then
SomOr1 = A + B : SomOr2 = C + D
SomVe1 = A + C : SomVe2 = B + D
SomDi1 = A + D : SomDi2 = B + C
If((SomOr1 = SomOr2) And pari(SomOr1)) Then
Amba(1) = SomOr1 / 2
Ambo1(1) = Amba(1)
If A < B Then
Ambo1(2) = Fuori90(90 +(Amba(1) - A))
Else
Ambo1(2) = Fuori90(90 +(Amba(1) - B))
End If
Ambo2(1) = Diametrale(Amba(1))
Ambo2(2) = Diametrale(Ambo1(2))
'------------------------------------
Ambo3(1) = Amba(1)
If C < D Then
Ambo3(2) = Fuori90(90 +(Amba(1) - C))
Else
Ambo3(2) = Fuori90(90 +(Amba(1) - D))
End If
Call Finale
Ok = 2
End If
'
'
If((SomVe1 = SomVe2) And pari(SomVe1)) Then
Amba(1) = SomVe1 / 2
Ambo1(1) = Amba(1)
If A < C Then
Ambo1(2) = Fuori90(90 +(Amba(1) - A))
Else
Ambo1(2) = Fuori90(90 +(Amba(1) - C))
End If
Ambo2(1) = Diametrale(Amba(1))
Ambo2(2) = Diametrale(Ambo1(2))
'------------------------------------
Ambo3(1) = Amba(1)
If B < D Then
Ambo3(2) = Fuori90(90 +(Amba(1) - B))
Else
Ambo3(2) = Fuori90(90 +(Amba(1) - D))
End If
Call Finale
Ok = 2
End If
'
'
If((SomDi1 = SomDi2) And pari(SomDi1)) Then
Amba(1) = SomDi1 / 2
Ambo1(1) = Amba(1)
If A < D Then
Ambo1(2) = Fuori90(90 +(Amba(1) - A))
Else
Ambo1(2) = Fuori90(90 +(Amba(1) - D))
End If
Ambo2(1) = Diametrale(Amba(1))
Ambo2(2) = Diametrale(Ambo1(2))
'------------------------------------
Ambo3(1) = Amba(1)
If B < C Then
Ambo3(2) = Fuori90(90 +(Amba(1) - B))
Else
Ambo3(2) = Fuori90(90 +(Amba(1) - C))
End If
Call Finale
Ok = 2
End If
If Ok = 2 Then
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 2
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P = 1 To 5
E1 = Estratto(Es,R1,P)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For PP = 1 To 5
E2 = Estratto(Es,R2,PP)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(30) & " In uno dei gruppi Oriz. Vert. Diag le 2 somme devono essere pari",1,,,2 ',3,,1
Scrivi " Distanza 45" & Space(25) & "Somme " & Space(10),1,0
Scrivi " Somme" & Space(11) & " Somme",1
Scrivi " Oriz. Vert. Diag" & Space(20) & " Orizontali" & Space(7),1,0
Scrivi "Verticali Diagonali",1
Scrivi Space(8) & Format2(A) & " " & Format2(B) & Space(29),1,0
Scrivi FormattaStringa(SomOr1,"000") & Space(14) & FormattaStringa(SomVe1,"000"),1,0
Scrivi Space(14) & FormattaStringa(SomDi1,"000"),1
Scrivi Space(8) & Format2(C) & " " & Format2(D) & Space(29),1,0
Scrivi FormattaStringa(SomOr2,"000") & Space(14) & FormattaStringa(SomVe2,"000"),1,0
Scrivi Space(14) & FormattaStringa(SomDi2,"000"),1
Scrivi
Scrivi Space(38) & " L'Ambata " & Format2(Amba(1)) & " è = ad una somma pari diviso 2",1,,,2
Scrivi
Ruote(1) = R1
Ruote(2) = R2
Ruots(1) = TU_
Co = 1
If SerieFreq(Es - 8,Es,Amba,Ruote,1) = 0 Then
ImpostaGiocata Co,Amba,Ruote,Posta,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo1,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo1,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo2,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo2,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo3,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo3,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo4,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo4,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo5,Ruots,2) = 0 Then
ImpostaGiocata Co,Ambo5,Ruots,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Penta,Ruote,2) = 0 Then
ImpostaGiocata Co,Penta,Ruote,Post,Clp2
End If
Gioca Es
End If
End If
End If
Next
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi Space(52) & " PROGETTO - EVOLUZIONE BEN II - Versione con estratti anche non uniti - a cura di MICHELE PACE"
Scrivi Space(52) & " SCRIPT BY Salvo50"
End Sub
Function Finale
Ambo4(1) = Diametrale(Ambo3(1))
Ambo4(2) = Diametrale(Ambo3(2))
Ambo5(1) =(Amba(1))
Ambo5(2) = Diametrale(Amba(1))
Penta(1) = Ambo1(2)
Penta(2) = Ambo2(1)
Penta(3) = Ambo2(2)
Penta(4) = Ambo3(2)
Penta(5) = Ambo4(2)
End Function'Modifica chiesta da Pulce50
'L'impianto di ricerca è identico al metodo di Michele Pace = due ambi anche non uniti
'con Distanza 45 Or, Vr, Di, su due ruote diverse e con somma fra i due ambi di misura pari.
'Quindi la I° parte del metodo va bene.
'Ambata = metà della somma intera (non ridotta sotto i 90)
'Capi gioco = l?ambata ed il suo Diametrale
'Da abbinare x ambo:
'ai numeri risultanti dalle somme Orizzontali,verticali,diagonali,
'questa volta ridotti a numeri sotto i 90,(4 numeri senza i ripetuti)
'alla somma dei 4 numeri Base e dal suo diametrale.
'Ai 4 numeri Base
'In totale 20 ambi x 2 ruote.
'Con gli identici controlli sulle estrazioni precedenti come da te già introdotto.
'--------------------------------------------------------------------------------------
'PROGETTO - EVOLUZIONE BEN II - Versione con estratti anche non uniti - a cura di MICHELE PACE
'Con modifica chiesta da PULCE50
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp1,AmbP,AmbS,SQ
Dim R1,R2,Caso,Casi,P1,P2,p3,p4,P,PP,E1,E2,DSQ
Dim DAB,DCD,DAC,DBD,DAD,DBC,A,B,C,D,Co
Dim SomOr1,SomOr2,SomVe1,SomVe2,SomDi1,SomDi2,Ok
Dim CAB,CCD,CAC,CBD,CAD,CBC,AB1,AB2,AB3,AB4,AB5
Dim Ruote(2),Poste(2),Posta(2),Ambo21(2)
Dim Ambo1(2),Ambo2(2),Ambo3(2),Ambo4(2),Ambo5(2)
Dim Ambo6(2),Ambo7(2),Ambo8(2),Ambo9(2),Ambo10(2)
Dim Ambo11(2),Ambo12(2),Ambo13(2),Ambo14(2),Ambo15(2)
Dim Ambo16(2),Ambo17(2),Ambo18(2),Ambo19(2),Ambo20(2)
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9500)
Clp1 = InputBox("Per quanti colpi vuoi giocare gli Ambi?",,5)
Call ScegliRange(EstrazioneIni,FIn,Ini,EstrazioneFin)
Scrivi Space(12) & "EVOLUZIONE BEN II - a cura di MICHELE PACE - con modifica chiesta da PULCE50 - SCRIPT SALVO50",1,,4,,3,,1
Posta(1) = 1
Posta(2) = 1
Poste(2) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 9
For P1 = 1 To 4
For P2 = P1 + 1 To 5
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
For R2 = R1 + 1 To 10
For p3 = 1 To 4
For p4 = p3 + 1 To 5
C = Estratto(Es,R2,p3)
D = Estratto(Es,R2,p4)
'A---B
'| |
'C---D
DAB = Distanza(A,B) : DCD = Distanza(C,D) : DAC = Distanza(A,C)
DBD = Distanza(B,D) : DAD = Distanza(A,D) : DBC = Distanza(B,C)
If(DAB = 45 And DCD = 45) Or(DAC = 45 And DBD = 45)Or(DAD = 45 And DBC = 45) Then
Ok = 0
If((A + B)Mod 2) = 0 And((C + D)Mod 2) = 0 Then Ok = 1
If((A + C)Mod 2) = 0 And((B + D)Mod 2) = 0 Then Ok = 1
If((A + D)Mod 2) = 0 And((B + C)Mod 2) = 0 Then Ok = 1
If Ok = 1 Then
SomOr1 = A + B : SomOr2 = C + D
SomVe1 = A + C : SomVe2 = B + D
SomDi1 = A + D : SomDi2 = B + C
CAB = Cadenza(SomOr1) : CCD = Cadenza(SomOr2)
CAC = Cadenza(SomVe1) : CBD = Cadenza(SomVe2)
CAD = Cadenza(SomDi1) : CBC = Cadenza(SomDi2)
If((SomOr1 = SomOr2) And pari(SomOr1)) Then
AmbP = SomOr1 / 2
If CAC = CBD Then
AB1 = Fuori90(SomOr1) : AB2 = Fuori90(SomVe1): AB3 = Fuori90(SomDi1): AB4 = Fuori90(SomDi2)
Else
AB1 = Fuori90(SomOr1) : AB2 = Fuori90(SomVe1): AB3 = Fuori90(SomVe2): AB4 = Fuori90(SomDi2)
Ok = 2
End If
End If
If((SomVe1 = SomVe2) And pari(SomVe1)) Then
AmbP = SomVe1 / 2
If CAB = CCD Then
AB1 = Fuori90(SomVe1) : AB2 = Fuori90(SomOr1): AB3 = Fuori90(SomDi1): AB4 = Fuori90(SomDi2)
Else
AB1 = Fuori90(SomVe1) : AB2 = Fuori90(SomOr1): AB3 = Fuori90(SomOr2): AB4 = Fuori90(SomDi2)
Ok = 2
End If
End If
If((SomDi1 = SomDi2) And pari(SomDi1)) Then
AmbP = SomDi1 / 2
If CAB = CCD Then
AB1 = Fuori90(SomDi1) : AB2 = Fuori90(SomOr1): AB3 = Fuori90(SomVe1): AB4 = Fuori90(SomVe2)
Else
AB1 = Fuori90(SomDi1) : AB2 = Fuori90(SomOr1): AB3 = Fuori90(SomOr2): AB4 = Fuori90(SomVe2)
Ok = 2
End If
End If
If Ok = 2 Then
AmbS = Diametrale(AmbP)
Ambo1(1) = AmbP : Ambo1(2) = AmbS
Ambo2(1) = AmbP : Ambo2(2) = AB1
Ambo3(1) = AmbP : Ambo3(2) = AB2
Ambo4(1) = AmbP : Ambo4(2) = AB3
Ambo5(1) = AmbP : Ambo5(2) = AB4
Ambo6(1) = AmbS : Ambo6(2) = AB1
Ambo7(1) = AmbS : Ambo7(2) = AB2
Ambo8(1) = AmbS : Ambo8(2) = AB3
Ambo9(1) = AmbS : Ambo9(2) = AB4
SQ = Fuori90(A + B + C + D)
DSQ = Diametrale(SQ)
Ambo10(1) = AmbP : Ambo10(2) = SQ
Ambo11(1) = AmbP : Ambo11(2) = DSQ
Ambo12(1) = AmbS : Ambo12(2) = SQ
Ambo13(1) = AmbS : Ambo13(2) = DSQ
Ambo14(1) = AmbP : Ambo14(2) = A
Ambo15(1) = AmbP : Ambo15(2) = B
Ambo16(1) = AmbP : Ambo16(2) = C
Ambo17(1) = AmbP : Ambo17(2) = D
Ambo18(1) = AmbS : Ambo18(2) = A
Ambo19(1) = AmbS : Ambo19(2) = B
Ambo20(1) = AmbS : Ambo20(2) = C
Ambo21(1) = AmbS : Ambo21(2) = D
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 2
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P = 1 To 5
E1 = Estratto(Es,R1,P)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For PP = 1 To 5
E2 = Estratto(Es,R2,PP)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(30) & " In uno dei gruppi Oriz. Vert. Diag le 2 somme devono essere pari",1,,,2 ',3,,1
Scrivi " Distanza 45" & Space(25) & "Somme " & Space(10),1,0
Scrivi " Somme" & Space(11) & " Somme",1
Scrivi " Oriz. Vert. Diag" & Space(20) & " Orizontali" & Space(7),1,0
Scrivi "Verticali Diagonali",1
Scrivi Space(8) & Format2(A) & " " & Format2(B) & Space(29),1,0
Scrivi FormattaStringa(SomOr1,"000") & Space(14) & FormattaStringa(SomVe1,"000"),1,0
Scrivi Space(14) & FormattaStringa(SomDi1,"000"),1
Scrivi Space(8) & Format2(C) & " " & Format2(D) & Space(29),1,0
Scrivi FormattaStringa(SomOr2,"000") & Space(14) & FormattaStringa(SomVe2,"000"),1,0
Scrivi Space(14) & FormattaStringa(SomDi2,"000"),1
Scrivi
Scrivi Space(30) & " L'Ambata Principale " & Format2(AmbP) & " è uguale ad una somma pari diviso 2",1,,,2
Scrivi Space(30) & " L'Ambata Secondaria " & Format2(AmbS) & " è uguale al Diametrale di " & Format2(AmbP),1,,,1
Scrivi
Ruote(1) = R1
Ruote(2) = R2
'Ruots(1) = TU_
Co = 1
If SerieFreq(Es - 8,Es,Ambo1,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo1,Ruote,Posta,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo2,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo2,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo3,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo3,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo4,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo4,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo5,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo5,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo6,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo6,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo7,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo7,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo8,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo8,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo9,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo9,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo10,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo10,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo11,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo11,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo12,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo12,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo13,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo13,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo14,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo14,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo15,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo15,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo16,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo16,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo17,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo17,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo18,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo18,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo19,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo19,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo20,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo20,Ruote,Poste,Clp1
Co = Co + 1
End If
If SerieFreq(Es - 8,Es,Ambo21,Ruote,2) = 0 Then
ImpostaGiocata Co,Ambo21,Ruote,Poste,Clp1
Co = Co + 1
End If
Gioca Es
End If
End If
End If
Next
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi Space(52) & " EVOLUZIONE BEN II - a cura di MICHELE PACE - con modifica chiesta da PULCE50"
Scrivi Space(52) & " SCRIPT BY Salvo50"
End Sub
'PROGETTO - IL QUADRATO D'ORO - a cura di PETRAZZOLI ANTONIO
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp,Col,Esqcol
Dim R1,R2,P1,P2,E1,E2,Salvo50
Dim Caso,Casi,A,B,C,D,Somma
Dim Post1(1),Post2(1),Post3(2),post4(2),Ruote(2)
Dim Num1(4),H(4),S(2),SS,P(2),Ambo4(2)
Dim AmbaP(1),AmbaS(1),Ambo1(2),Ambo2(2),Ambo3(2)
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9570)
Clp = InputBox("Per quanti colpi vuoi giocare le ambate?",Salvo50,5)
Call ScegliRange(EstrazioneIni,EstrazioneFin,Ini,FIn)
Scrivi "IL QUADRATO D'ORO - a cura di PETRAZZOLI ANTONIO - Script by Salvo50",1,,4,,3,,1
Post1(1) = 2
Post2(1) = 1
Post3(2) = 2
post4(2) = 1
R1 = RO_
R2 = PA_
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
A = Estratto(Es,R1,1)
B = Estratto(Es,R1,2)
C = Estratto(Es,R2,1)
D = Estratto(Es,R2,2)
H(1) = A : H(2) = B : H(3) = C : H(4) = D
Call OrdinaMatrice(H,1)
S(1) = Fuori90(H(1) + H(3))
S(2) = Fuori90(H(2) + H(4))
SS = StringaNumeri(S,"",True)
P(1) = Piramide(SS,1)
P(2) = Piramide(SS,2)
P(2) = Fuori90(P(2))
AmbaP(1) = P(2)
AmbaS(1) = Vert(P(2))
Ambo1(1) = P(2) : Ambo1(2) = S(1) : Ambo2(1) = P(2) : Ambo2(2) = S(2)
Ambo3(1) = AmbaS(1) : Ambo3(2) = S(1) : Ambo4(1) = AmbaS(1) : Ambo4(2) = S(2)
Num1(1) = P(2) : Num1(2) = AmbaS(1) : Num1(3) = S(1) : Num1(4) = S(2)
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P1 = 1 To 5
E1 = Estratto(Es,R1,P1)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P2 = 1 To 5
E2 = Estratto(Es,R2,P2)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(25) & "Ord. Crescente " & Space(9) & " Somme",1
Scrivi Space(8) & "Estratti" & Space(8) & "In Senso Orario " & Space(7) & " Diagonali",1
Scrivi Space(9) & Format2(A) & " " & Format2(B) & Space(15) & Format2(H(1)) & " " & Format2(H(2)) & Space(17) & Format2(S(1)),1
Scrivi Space(9) & Format2(C) & " " & Format2(D) & Space(15) & Format2(H(4)) & " " & Format2(H(3)) & Space(17) & Format2(S(2)),1
Scrivi
Scrivi Space(25) & " Piramide",1
ColoreTesto 2
Scrivi Space(27) & SS,1
Scrivi Space(27) & P(1),1
Scrivi Space(27) & P(2),1
ColoreTesto 0
Ruote(1) = R1
Ruote(2) = R2
ImpostaGiocata 1,AmbaP,Ruote,Post1,Clp
ImpostaGiocata 2,AmbaS,Ruote,Post2,Clp
ImpostaGiocata 3,Ambo1,Ruote,Post3,Clp
ImpostaGiocata 4,Ambo2,Ruote,Post3,Clp
ImpostaGiocata 5,Ambo3,Ruote,post4,Clp
ImpostaGiocata 6,Ambo4,Ruote,post4,Clp
ImpostaGiocata 7,Num1,Ruote,post4,Clp
Gioca Es
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
End Sub'PROGETTO - IL QUADRATO D'ORO - a cura di PETRAZZOLI ANTONIO - modifica per tutte le ruote Salvo50
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp,Col,Esqcol
Dim R1,R2,P1,P2,E1,E2,Salvo50
Dim Caso,Casi,A,B,C,D,Somma
Dim Post1(1),Post2(1),Post3(2),post4(2),Ruote(2)
Dim Num1(4),H(4),S(2),SS,P(2),Ambo4(2)
Dim AmbaP(1),AmbaS(1),Ambo1(2),Ambo2(2),Ambo3(2)
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9570)
Clp = InputBox("Per quanti colpi vuoi giocare le ambate?",,5)
Call ScegliRange(EstrazioneIni,EstrazioneFin,Ini,FIn)
Scrivi "IL QUADRATO D'ORO - a cura di PETRAZZOLI ANTONIO - modifica per tutte le ruote Salvo50 - Script by Salvo50",1,,4,,3,,1
Post1(1) = 2
Post2(1) = 1
Post3(2) = 2
post4(2) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 10
R2 = R1 + 1
If R2 = 11 Then R2 = 12
A = Estratto(Es,R1,1)
B = Estratto(Es,R1,2)
C = Estratto(Es,R2,1)
D = Estratto(Es,R2,2)
H(1) = A : H(2) = B : H(3) = C : H(4) = D
Call OrdinaMatrice(H,1)
S(1) = Fuori90(H(1) + H(3))
S(2) = Fuori90(H(2) + H(4))
SS = StringaNumeri(S,"",True)
P(1) = Piramide(SS,1)
P(2) = Piramide(SS,2)
P(2) = Fuori90(P(2))
AmbaP(1) = P(2)
AmbaS(1) = Vert(P(2))
Ambo1(1) = P(2) : Ambo1(2) = S(1) : Ambo2(1) = P(2) : Ambo2(2) = S(2)
Ambo3(1) = AmbaS(1) : Ambo3(2) = S(1) : Ambo4(1) = AmbaS(1) : Ambo4(2) = S(2)
Num1(1) = P(2) : Num1(2) = AmbaS(1) : Num1(3) = S(1) : Num1(4) = S(2)
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P1 = 1 To 5
E1 = Estratto(Es,R1,P1)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P2 = 1 To 5
E2 = Estratto(Es,R2,P2)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(25) & "Ord. Crescente " & Space(9) & " Somme",1
Scrivi Space(8) & "Estratti" & Space(8) & "In Senso Orario " & Space(7) & " Diagonali",1
Scrivi Space(9) & Format2(A) & " " & Format2(B) & Space(15) & Format2(H(1)) & " " & Format2(H(2)) & Space(17) & Format2(S(1)),1
Scrivi Space(9) & Format2(C) & " " & Format2(D) & Space(15) & Format2(H(4)) & " " & Format2(H(3)) & Space(17) & Format2(S(2)),1
Scrivi
Scrivi Space(25) & " Piramide",1
ColoreTesto 2
Scrivi Space(27) & SS,1
Scrivi Space(27) & P(1),1
Scrivi Space(27) & P(2),1
ColoreTesto 0
Ruote(1) = R1
Ruote(2) = R2
ImpostaGiocata 1,AmbaP,Ruote,Post1,Clp
ImpostaGiocata 2,AmbaS,Ruote,Post2,Clp
ImpostaGiocata 3,Ambo1,Ruote,Post3,Clp
ImpostaGiocata 4,Ambo2,Ruote,Post3,Clp
ImpostaGiocata 5,Ambo3,Ruote,post4,Clp
ImpostaGiocata 6,Ambo4,Ruote,post4,Clp
ImpostaGiocata 7,Num1,Ruote,post4,Clp
Gioca Es
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
End Sub'PROGETTO - IL QUADRATO D'ORO - a cura di PETRAZZOLI ANTONIO - modifica con ruote a scelta Salvo50
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp,Col,Esqcol
Dim R1,R2,P1,P2,E1,E2,Salvo50
Dim Caso,Casi,A,B,C,D,Somma
Dim Post1(1),Post2(1),Post3(2),post4(2),Ruote(2)
Dim Num1(4),H(4),S(2),SS,P(2),Ambo4(2)
Dim AmbaP(1),AmbaS(1),Ambo1(2),Ambo2(2),Ambo3(2)
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9550)
Clp = InputBox("Per quanti colpi vuoi giocare le ambate?",Salvo50,5)
R1 = InputBox("Scegli la PRIMA ruota (1 - 10 per Nazionale 12)?",Salvo50,1)
R2 = InputBox("Scegli la SECONDA ruota (1 - 10 per Nazionale 12)?",Salvo50,2)
If R2 = 11 Then R2 = 12
If R1 = R2 Or R1 > 12 Or R2 > 12 Then
If R1 = R2 Then MsgBox " Hai scelta la stessa ruota"
If R1 > 12 Or R2 > 12 Then MsgBox " La ruota scelta non esiste"
Exit Sub
End If
Call ScegliRange(EstrazioneIni,EstrazioneFin,Ini,FIn)
Scrivi "IL QUADRATO D'ORO - a cura di PETRAZZOLI ANTONIO - modifica con ruote a scelta Salvo50 - Script by Salvo50",1,,4,,3,,1
Post1(1) = 2
Post2(1) = 1
Post3(2) = 2
post4(2) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
If R2 = 11 Then R2 = 12
A = Estratto(Es,R1,1)
B = Estratto(Es,R1,2)
C = Estratto(Es,R2,1)
D = Estratto(Es,R2,2)
H(1) = A : H(2) = B : H(3) = C : H(4) = D
Call OrdinaMatrice(H,1)
S(1) = Fuori90(H(1) + H(3))
S(2) = Fuori90(H(2) + H(4))
SS = StringaNumeri(S,"",True)
P(1) = Piramide(SS,1)
P(2) = Piramide(SS,2)
P(2) = Fuori90(P(2))
AmbaP(1) = P(2)
AmbaS(1) = Vert(P(2))
Ambo1(1) = P(2) : Ambo1(2) = S(1) : Ambo2(1) = P(2) : Ambo2(2) = S(2)
Ambo3(1) = AmbaS(1) : Ambo3(2) = S(1) : Ambo4(1) = AmbaS(1) : Ambo4(2) = S(2)
Num1(1) = P(2) : Num1(2) = AmbaS(1) : Num1(3) = S(1) : Num1(4) = S(2)
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P1 = 1 To 5
E1 = Estratto(Es,R1,P1)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P2 = 1 To 5
E2 = Estratto(Es,R2,P2)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(25) & "Ord. Crescente " & Space(9) & " Somme",1
Scrivi Space(8) & "Estratti" & Space(8) & "In Senso Orario " & Space(7) & " Diagonali",1
Scrivi Space(9) & Format2(A) & " " & Format2(B) & Space(15) & Format2(H(1)) & " " & Format2(H(2)) & Space(17) & Format2(S(1)),1
Scrivi Space(9) & Format2(C) & " " & Format2(D) & Space(15) & Format2(H(4)) & " " & Format2(H(3)) & Space(17) & Format2(S(2)),1
Scrivi
Scrivi Space(25) & " Piramide",1
ColoreTesto 2
Scrivi Space(27) & SS,1
Scrivi Space(27) & P(1),1
Scrivi Space(27) & P(2),1
ColoreTesto 0
Ruote(1) = R1
Ruote(2) = R2
ImpostaGiocata 1,AmbaP,Ruote,Post1,Clp
ImpostaGiocata 2,AmbaS,Ruote,Post2,Clp
ImpostaGiocata 3,Ambo1,Ruote,Post3,Clp
ImpostaGiocata 4,Ambo2,Ruote,Post3,Clp
ImpostaGiocata 5,Ambo3,Ruote,post4,Clp
ImpostaGiocata 6,Ambo4,Ruote,post4,Clp
ImpostaGiocata 7,Num1,Ruote,post4,Clp
Gioca Es
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
End Sub
