Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,X,Clp,Es,Cer,Ok
Dim R1,R2,P1,P2,P3,P4,Salvo50,Sp,X1,X2,X3,X4
Dim DM12,DM23,DM34,DM41,Caso,Casi,Sf1,Sf2,Sf3,Sf4
Dim Amba(1),Ambo1(2),Ambo2(2),Ruo(2),Ruote(3)
Dim Po1(1),Po2(2),L(6),M(4),N1(1),N2(1),N3(1),N4(1)
Dim Ambetto1(2),Ambetto2(2),Ambetto3(2),Ambetto4(2)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9910))'9749 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))
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(1) & "LA BOMBA CICLOMETRICA - UN SOLO AMBO SECCO di ANGELO GARGIULO - SCRIPT UNOUNO50 alias SALVO50" & Space(1),1,,4,,3,,1
Po1(1) = 1
Po2(2) = 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 5
D = Estratto(Es,R2,P4)
If A > 0 And D > 0 Then
If D <> A And D <> B And D <> C 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 = 27 And DM23 = 18 And DM34 = 18 And DM41 = 27 _
Or DM23 = 27 And DM34 = 18 And DM41 = 18 And DM12 = 27 _
Or DM34 = 27 And DM41 = 18 And DM12 = 18 And DM23 = 27 _
Or DM41 = 27 And DM12 = 18 And DM23 = 18 And DM34 = 27 Then
'---------------------------------
If DM12 = 27 And DM23 = 18 And DM34 = 18 And DM41 = 27 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 27 And DM34 = 18 And DM41 = 18 And DM12 = 27 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 27 And DM41 = 18 And DM12 = 18 And DM23 = 27 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 27 And DM12 = 18 And DM23 = 18 And DM34 = 27 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
N1(1) = Fuori90(L(4) + 9)
N2(1) = Fuori90(L(4) + 18)
N3(1) = Fuori90(L(1) + 9)
N4(1) = Fuori90(L(1) + 18)
Ruo(1) = R1 : Ruo(2) = R2
Sf1 = SerieFreq(Es - 5,Es,N1,Ruo,1)
Sf2 = SerieFreq(Es - 5,Es,N2,Ruo,1)
Sf3 = SerieFreq(Es - 5,Es,N3,Ruo,1)
Sf4 = SerieFreq(Es - 5,Es,N4,Ruo,1)
Ok = 0
If(Sf1 > 0 Xor Sf2 > 0) Xor(Sf3 > 0 Xor Sf4 > 0)Then
If Sf1 > 0 Then Amba(1) = N2(1) : L(5) = N1(1) : L(6) = N2(1) : Ok = 1
If Sf2 > 0 Then Amba(1) = N1(1) : L(5) = N1(1) : L(6) = N2(1) : Ok = 1
If Sf3 > 0 Then Amba(1) = N4(1) : L(5) = N3(1) : L(6) = N4(1) : Ok = 1
If Sf4 > 0 Then Amba(1) = N3(1) : L(5) = N3(1) : L(6) = N4(1) : Ok = 1
If Ok = 1 Then
If Sf1 > 0 Or Sf2 > 0 Then Ambo1(1) = N1(1) : Ambo1(2) = N2(1)
If Sf3 > 0 Or Sf4 > 0 Then Ambo1(1) = N3(1) : Ambo1(2) = N4(1)
'Ambetti
Ambetto1(1) = Ambo1(1) : Ambetto1(2) = Fuori90(Ambo1(2) + 1)
Ambetto2(1) = Ambo1(1) : Ambetto2(2) = Fuori90((90 + Ambo1(2)) - 1)
Ambetto3(1) = Ambo1(2) : Ambetto3(2) = Fuori90(Ambo1(1) + 1)
Ambetto4(1) = Ambo1(2) : Ambetto4(2) = Fuori90((90 + Ambo1(1)) - 1)
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
End If
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_
Scrivi
Scrivi Space(24) & Format2(Amba(1)) & " Ambata",1,,,2
Scrivi
ImpostaGiocata 1,Amba,Ruo,Po1,5,1
ImpostaGiocata 2,Ambo1,Ruote,Po2,Clp
Gioca Es,1
Scrivi Space(24) & "AMBETTI",1,,,2
ImpostaGiocata 3,Ambetto1,Ruote,Po2,Clp
ImpostaGiocata 4,Ambetto2,Ruote,Po2,Clp
ImpostaGiocata 5,Ambetto3,Ruote,Po2,Clp
ImpostaGiocata 6,Ambetto4,Ruote,Po2,Clp
Gioca Es,1
End If
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 C > 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 = 27 And DM23 = 18 And DM34 = 18 And DM41 = 27 _
Or DM23 = 27 And DM34 = 18 And DM41 = 18 And DM12 = 27 _
Or DM34 = 27 And DM41 = 18 And DM12 = 18 And DM23 = 27 _
Or DM41 = 27 And DM12 = 18 And DM23 = 18 And DM34 = 27 Then
'---------------------------------
If DM12 = 27 And DM23 = 18 And DM34 = 18 And DM41 = 27 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 27 And DM34 = 18 And DM41 = 18 And DM12 = 27 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 27 And DM41 = 18 And DM12 = 18 And DM23 = 27 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 27 And DM12 = 18 And DM23 = 18 And DM34 = 27 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
N1(1) = Fuori90(L(4) + 9)
N2(1) = Fuori90(L(4) + 18)
N3(1) = Fuori90(L(1) + 9)
N4(1) = Fuori90(L(1) + 18)
Ruo(1) = R1 : Ruo(2) = R2
Sf1 = SerieFreq(Es - 5,Es,N1,Ruo,1)
Sf2 = SerieFreq(Es - 5,Es,N2,Ruo,1)
Sf3 = SerieFreq(Es - 5,Es,N3,Ruo,1)
Sf4 = SerieFreq(Es - 5,Es,N4,Ruo,1)
Ok = 0
If(Sf1 > 0 Xor Sf2 > 0) Xor(Sf3 > 0 Xor Sf4 > 0)Then
If Sf1 > 0 Then Amba(1) = N2(1) : L(5) = N1(1) : L(6) = N2(1) : Ok = 1
If Sf2 > 0 Then Amba(1) = N1(1) : L(5) = N1(1) : L(6) = N2(1) : Ok = 1
If Sf3 > 0 Then Amba(1) = N4(1) : L(5) = N3(1) : L(6) = N4(1) : Ok = 1
If Sf4 > 0 Then Amba(1) = N3(1) : L(5) = N3(1) : L(6) = N4(1) : Ok = 1
If Ok = 1 Then
If Sf1 > 0 Or Sf2 > 0 Then Ambo1(1) = N1(1) : Ambo1(2) = N2(1)
If Sf3 > 0 Or Sf4 > 0 Then Ambo1(1) = N3(1) : Ambo1(2) = N4(1)
'Ambetti
Ambetto1(1) = Ambo1(1) : Ambetto1(2) = Fuori90(Ambo1(2) + 1)
Ambetto2(1) = Ambo1(1) : Ambetto2(2) = Fuori90((90 + Ambo1(2)) - 1)
Ambetto3(1) = Ambo1(2) : Ambetto3(2) = Fuori90(Ambo1(1) + 1)
Ambetto4(1) = Ambo1(2) : Ambetto4(2) = Fuori90((90 + Ambo1(1)) - 1)
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
End If
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_
Scrivi
Scrivi Space(24) & Format2(Amba(1)) & " Ambata",1,,,2
Scrivi
ImpostaGiocata 1,Amba,Ruo,Po1,5,1
ImpostaGiocata 2,Ambo1,Ruote,Po2,Clp
Gioca Es,1
Scrivi Space(24) & "AMBETTI",1,,,2
ImpostaGiocata 3,Ambetto1,Ruote,Po2,Clp
ImpostaGiocata 4,Ambetto2,Ruote,Po2,Clp
ImpostaGiocata 5,Ambetto3,Ruote,Po2,Clp
ImpostaGiocata 6,Ambetto4,Ruote,Po2,Clp
Gioca Es,1
End If
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
