Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,E,X,Clp,Es,Es2,Cer
Dim R1,R2,P1,P2,P3,P4,P5,Salvo50,Ok,Sp
Dim DM13,DM34,DM45,DM51,Caso,Casi,Quar
Dim Num1,Num2,Num3,Num4,Qua(4)
Dim Amba(1),Ambo1(2),Ambo2(2),Ambo3(2),Ruo(2)
Dim Nu1(2),Nu2(2),Nu3(2),Nu4(2),L(6),M(5),N(4)
Dim Posta(1),Poste(2),Posts(4),Ruote(4)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9627))'9627 ESEMPIO NELL'ARTICOLO
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
Quar = CInt(InputBox(" Vuoi Giocare Anche la Quartina? SI = 1, NO un qualsiasi altro numero ",Salvo50,0))
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(14) & "I Quattro Vertici di Angelo Gargiulo - Script Salvo50" & Space(14),1,,4,,3,,1
Posta(1) = 1
Poste(2) = 1
Posts(2) = 1
Posts(3) = 1
'Posts(4) = 1
Sp = " "
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 12
If R1 = 11 Then R1 = 12
For P1 = 1 To 3
For P2 = P1 + 1 To 4
For P3 = P2 + 1 To 5
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
C = Estratto(Es,R1,P3)
For R2 = 1 To 12
If R2 <> R1 Then
If R2 = 11 Then R2 = 12
For P4 = 1 To 4
For P5 = P4 + 1 To 5
D = Estratto(Es,R2,P4)
E = Estratto(Es,R2,P5)
If A > 0 And D > 0 Then
If(A = D And B <> E And C <> E) Or(A = E And B <> D And C <> D)_
Or(B = D And A <> E And C <> E) Or(B = E And A <> D And C <> D)_
Or(C = D And A <> E And B <> E) Or(C = E And A <> D And B <> D) Then
M(1) = A : M(2) = B : M(3) = C : M(4) = D : M(5) = E
Call OrdinaMatrice(M,1)
DM13 = Distanza(M(1),M(3)) : DM34 = Distanza(M(3),M(4))
DM45 = Distanza(M(4),M(5)) : DM51 = Distanza(M(5),M(1))
If DM13 = 09 And DM34 = 27 And DM45 = 18 And DM51 = 36 _
Or DM34 = 09 And DM45 = 27 And DM51 = 18 And DM13 = 36 _
Or DM45 = 09 And DM51 = 27 And DM13 = 18 And DM34 = 36 _
Or DM51 = 09 And DM13 = 27 And DM34 = 18 And DM45 = 36 Then
'---------------------------------
If DM13 = 09 And DM34 = 27 And DM45 = 18 And DM51 = 36 Then
L(1) = M(1) : L(2) = M(3) : L(3) = M(4) : L(4) = M(5)
End If
If DM34 = 09 And DM45 = 27 And DM51 = 18 And DM13 = 36 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(5) : L(4) = M(1)
End If
If DM45 = 09 And DM51 = 27 And DM13 = 18 And DM34 = 36 Then
L(1) = M(4) : L(2) = M(5) : L(3) = M(1) : L(4) = M(3)
End If
If DM51 = 09 And DM13 = 27 And DM34 = 18 And DM45 = 36 Then
L(1) = M(5) : L(2) = M(1) : L(3) = M(3) : L(4) = M(4)
End If
L(5) = Fuori90(L(4) + 18)
L(6) = Diametrale(L(5))
N(1) = Fuori90(L(4) + 9)
N(2) = Fuori90(N(1) + 18)
N(3) = Fuori90(L(2) + 9)
N(4) = Fuori90(L(3) + 9)
Nu1(1) = L(4) : Nu1(2) = L(5)
Nu2(1) = L(5) : Nu2(2) = L(1)
Nu3(1) = L(2) : Nu3(2) = L(6)
Nu4(1) = L(3) : Nu4(2) = L(4)
Ruo(1) = R1 : Ruo(2) = R2
Ok = 0
For Es2 = Es - 1 To Es - 30 Step - 1
If SerieFreqTurbo(Es2,Es2,Nu1,Ruo,2) > 0 Then
Num1 = N(1) : Num2 = N(2) : Num3 = N(3) : Num4 = N(4)
Ok = 1 : Exit For
End If
'
If SerieFreqTurbo(Es2,Es2,Nu2,Ruo,2) > 0 Then
Num1 = N(2) : Num2 = N(1) : Num3 = N(3) : Num4 = N(4)
Ok = 1 : Exit For
End If
If SerieFreqTurbo(Es2,Es2,Nu3,Ruo,2) > 0 Then
Num1 = N(3) : Num2 = N(1) : Num3 = N(2) : Num4 = N(4)
Ok = 1 : Exit For
End If
If SerieFreqTurbo(Es2,Es2,Nu4,Ruo,2) > 0 Then
Num1 = N(4) : Num2 = N(1) : Num3 = N(2) : Num4 = N(3)
Ok = 1 : Exit For
End If
Next
If Ok = 1 Then
Amba(1) = Num1
Ambo1(1) = Num1: Ambo1(2) = Num2
Ambo2(1) = Num1: Ambo2(2) = Num3
Ambo3(1) = Num1: Ambo3(2) = Num4
Qua(1) = Num1 : Qua(2) = Num2 : Qua(3) = Num3 : Qua(4) = Num4
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
Scrivi
ReDim MatrCasella(5,1)
MatrCasella(1,0) = R1
MatrCasella(1,1) = P1
MatrCasella(2,0) = R1
MatrCasella(2,1) = P2
MatrCasella(3,0) = R1
MatrCasella(3,1) = P3
MatrCasella(4,0) = R2
MatrCasella(4,1) = P4
MatrCasella(5,0) = R2
MatrCasella(5,1) = P5
Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
Scrivi
If Cer = 1 Then
DisegnaCerchioCiclometrico M,1,1,,,1,1
DisegnaCerchioCiclometrico L,1,1,,,1,1
DisegnaCerchioCiclometrico N,1,1,,,1,1
End If
Scrivi
Scrivi Space(24) & Format2(Num1) & " Ambata",1,,,2
Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1
Scrivi Space(24) & Format2(Num2) & Sp & Format2(Num3) & Sp & Format2(Num4),1
Scrivi
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
ImpostaGiocata 1,Amba,Ruo,Posta,5
ImpostaGiocata 2,Ambo1,Ruote,Poste,Clp
ImpostaGiocata 3,Ambo2,Ruote,Poste,Clp
ImpostaGiocata 4,Ambo3,Ruote,Poste,Clp
If Quar = 1 Then ImpostaGiocata 5,Qua,Ruote,Posts,Clp
Gioca Es,1
End If
End If
End If
End If
Next
Next
End If
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi " Tempo Trascorso" & TempoTrascorso
End Sub
Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,Clp,Es,Es2,Cer,Sp
Dim R1,R2,P1,P2,P3,P4,P5,Salvo50,Ok
Dim DM12,DM23,DM34,DM41,Caso,Casi,Quar
Dim Num1,Num2,Num3,Num4,Qua(4)
Dim Amba(1),Ambo1(2),Ambo2(2),Ambo3(2),Ruo(2)
Dim Nu1(2),Nu2(2),Nu3(2),Nu4(2),L(6),M(4),N(4)
Dim Posta(1),Poste(2),Posts(4),Ruote(4)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9850))'9627 ESEMPIO NELL'ARTICOLO
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
Quar = CInt(InputBox(" Vuoi Giocare Anche la Quartina? SI = 1, NO un qualsiasi altro numero ",Salvo50,0))
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(14) & "I Quattro Vertici di Angelo Gargiulo - Script Salvo50" & Space(14),1,,4,,3,,1
Scrivi Space(19) & "Senza Numero Uguale Nelle Ruote di Calcolo" & Space(20),1,,4,,3,,1
Sp = " "
Posta(1) = 1
Poste(2) = 1
Posts(2) = 1
Posts(3) = 1
'Posts(4) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 12
If R1 = 11 Then R1 = 12
For P1 = 1 To 3
For P2 = P1 + 1 To 4
For P3 = P2 + 1 To 5
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
C = Estratto(Es,R1,P3)
For R2 = 1 To 12
If R2 <> R1 Then
If R2 = 11 Then R2 = 12
For P4 = 1 To 5
D = Estratto(Es,R2,P4)
If A > 0 And D > 0 Then
If A <> D And B <> D And C <> D Then
M(1) = A : M(2) = B : M(3) = C : M(4) = D
Call OrdinaMatrice(M,1)
DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
If DM12 = 09 And DM23 = 27 And DM34 = 18 And DM41 = 36 _
Or DM23 = 09 And DM34 = 27 And DM41 = 18 And DM12 = 36 _
Or DM34 = 09 And DM41 = 27 And DM12 = 18 And DM23 = 36 _
Or DM41 = 09 And DM12 = 27 And DM23 = 18 And DM34 = 36 Then
'---------------------------------
If DM12 = 09 And DM23 = 27 And DM34 = 18 And DM41 = 36 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 09 And DM34 = 27 And DM41 = 18 And DM12 = 36 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 09 And DM41 = 27 And DM12 = 18 And DM23 = 36 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 09 And DM12 = 27 And DM23 = 18 And DM34 = 36 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
L(5) = Fuori90(L(4) + 18)
L(6) = Diametrale(L(5))
N(1) = Fuori90(L(4) + 9)
N(2) = Fuori90(N(1) + 18)
N(3) = Fuori90(L(2) + 9)
N(4) = Fuori90(L(3) + 9)
Nu1(1) = L(4) : Nu1(2) = L(5)
Nu2(1) = L(5) : Nu2(2) = L(1)
Nu3(1) = L(2) : Nu3(2) = L(6)
Nu4(1) = L(3) : Nu4(2) = L(4)
Ruo(1) = R1 : Ruo(2) = R2
Ok = 0
For Es2 = Es - 1 To Es - 30 Step - 1
If SerieFreqTurbo(Es2,Es2,Nu1,Ruo,2) > 0 Then
Num1 = N(1) : Num2 = N(2) : Num3 = N(3) : Num4 = N(4)
Ok = 1 : Exit For
End If
If SerieFreqTurbo(Es2,Es2,Nu2,Ruo,2) > 0 Then
Num1 = N(2) : Num2 = N(1) : Num3 = N(3) : Num4 = N(4)
Ok = 1 : Exit For
End If
If SerieFreqTurbo(Es2,Es2,Nu3,Ruo,2) > 0 Then
Num1 = N(3) : Num2 = N(1) : Num3 = N(2) : Num4 = N(4)
Ok = 1 : Exit For
End If
If SerieFreqTurbo(Es2,Es2,Nu4,Ruo,2) > 0 Then
Num1 = N(4) : Num2 = N(1) : Num3 = N(2) : Num4 = N(3)
Ok = 1 : Exit For
End If
Next
If Ok = 1 Then
Amba(1) = Num1
Ambo1(1) = Num1: Ambo1(2) = Num2
Ambo2(1) = Num1: Ambo2(2) = Num3
Ambo3(1) = Num1: Ambo3(2) = Num4
Qua(1) = Num1 : Qua(2) = Num2 : Qua(3) = Num3 : Qua(4) = Num4
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
Scrivi
ReDim MatrCasella(4,1)
MatrCasella(1,0) = R1
MatrCasella(1,1) = P1
MatrCasella(2,0) = R1
MatrCasella(2,1) = P2
MatrCasella(3,0) = R1
MatrCasella(3,1) = P3
MatrCasella(4,0) = R2
MatrCasella(4,1) = P4
Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
Scrivi
If Cer = 1 Then
DisegnaCerchioCiclometrico M,1,1,,,1,1
DisegnaCerchioCiclometrico L,1,1,,,1,1
DisegnaCerchioCiclometrico N,1,1,,,1,1
End If
Scrivi
Scrivi Space(24) & Format2(Num1) & " Ambata",1,,,2
Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1
Scrivi Space(23) & Format2(Num2) & Sp & Format2(Num3) & Sp & Format2(Num4),1
Scrivi
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
ImpostaGiocata 1,Amba,Ruo,Posta,5
ImpostaGiocata 2,Ambo1,Ruote,Poste,Clp
ImpostaGiocata 3,Ambo2,Ruote,Poste,Clp
ImpostaGiocata 4,Ambo3,Ruote,Poste,Clp
If Quar = 1 Then ImpostaGiocata 5,Qua,Ruote,Posts,Clp
Gioca Es,1
End If
End If
End If
End If
Next
End If
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
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)
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)
If A > 0 And D > 0 Then
If A <> C And A <> D And B <> C And B <> D Then
M(1) = A : M(2) = B : M(3) = C : M(4) = D
Call OrdinaMatrice(M,1)
DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
If DM12 = 09 And DM23 = 27 And DM34 = 18 And DM41 = 36 _
Or DM23 = 09 And DM34 = 27 And DM41 = 18 And DM12 = 36 _
Or DM34 = 09 And DM41 = 27 And DM12 = 18 And DM23 = 36 _
Or DM41 = 09 And DM12 = 27 And DM23 = 18 And DM34 = 36 Then
'---------------------------------
If DM12 = 09 And DM23 = 27 And DM34 = 18 And DM41 = 36 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 09 And DM34 = 27 And DM41 = 18 And DM12 = 36 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 09 And DM41 = 27 And DM12 = 18 And DM23 = 36 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 09 And DM12 = 27 And DM23 = 18 And DM34 = 36 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
L(5) = Fuori90(L(4) + 18)
L(6) = Diametrale(L(5))
N(1) = Fuori90(L(4) + 9)
N(2) = Fuori90(N(1) + 18)
N(3) = Fuori90(L(2) + 9)
N(4) = Fuori90(L(3) + 9)
Nu1(1) = L(4) : Nu1(2) = L(5)
Nu2(1) = L(5) : Nu2(2) = L(1)
Nu3(1) = L(2) : Nu3(2) = L(6)
Nu4(1) = L(3) : Nu4(2) = L(4)
Ruo(1) = R1 : Ruo(2) = R2
Ok = 0
For Es2 = Es - 1 To Es - 30 Step - 1
If SerieFreqTurbo(Es2,Es2,Nu1,Ruo,2) > 0 Then
Num1 = N(1) : Num2 = N(2) : Num3 = N(3) : Num4 = N(4)
Ok = 1 : Exit For
End If
'
If SerieFreqTurbo(Es2,Es2,Nu2,Ruo,2) > 0 Then
Num1 = N(2) : Num2 = N(1) : Num3 = N(3) : Num4 = N(4)
Ok = 1 : Exit For
End If
If SerieFreqTurbo(Es2,Es2,Nu3,Ruo,2) > 0 Then
Num1 = N(3) : Num2 = N(1) : Num3 = N(2) : Num4 = N(4)
Ok = 1 : Exit For
End If
If SerieFreqTurbo(Es2,Es2,Nu4,Ruo,2) > 0 Then
Num1 = N(4) : Num2 = N(1) : Num3 = N(2) : Num4 = N(3)
Ok = 1 : Exit For
End If
Next
If Ok = 1 Then
Amba(1) = Num1
Ambo1(1) = Num1: Ambo1(2) = Num2
Ambo2(1) = Num1: Ambo2(2) = Num3
Ambo3(1) = Num1: Ambo3(2) = Num4
Qua(1) = Num1 : Qua(2) = Num2 : Qua(3) = Num3 : Qua(4) = Num4
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
Scrivi
ReDim MatrCasella(4,1)
MatrCasella(1,0) = R1
MatrCasella(1,1) = P1
MatrCasella(2,0) = R1
MatrCasella(2,1) = P2
MatrCasella(3,0) = R2
MatrCasella(3,1) = P3
MatrCasella(4,0) = R2
MatrCasella(4,1) = P4
Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
Scrivi
If Cer = 1 Then
DisegnaCerchioCiclometrico M,1,1,,,1,1
DisegnaCerchioCiclometrico L,1,1,,,1,1
DisegnaCerchioCiclometrico N,1,1,,,1,1
End If
Scrivi
Scrivi Space(24) & Format2(Num1) & " Ambata",1,,,2
Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1
Scrivi Space(23) & Format2(Num2) & Sp & Format2(Num3) & Sp & Format2(Num4),1
Scrivi
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
ImpostaGiocata 1,Amba,Ruo,Posta,5
ImpostaGiocata 2,Ambo1,Ruote,Poste,Clp
ImpostaGiocata 3,Ambo2,Ruote,Poste,Clp
ImpostaGiocata 4,Ambo3,Ruote,Poste,Clp
If Quar = 1 Then ImpostaGiocata 5,Qua,Ruote,Posts,Clp
Gioca Es,1
End If
End If
End If
End If
Next
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi " Tempo Trascorso" & TempoTrascorso
End Sub