Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,E,F,Es,Cer,Clp
Dim R1,R2,P1,P2,P3,P4,Salvo50,Sp
Dim MaxAB,MaxCD,MinAB,MinCD,Caso,Casi
Dim DistAB,DistCD,DistAD,DistAC,DistBD,DistBC
Dim Abb1,Abb2,Abb3,Abb4
Dim X(4),Y(5),Z(5)
Dim Amba1(1),Amba2(1),Ambo1(2),Ambo2(2),Ambo3(2),Ambo4(2),Ambo5(2)
Dim Terno1(3),Terno2(3),Penta(5),Po1(1),Po2(2),Po3(3),Po4(5),Ruote(2)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10000))
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(14) & "Ruote Consecutive 2 Distanze con Numero Comune - Script Salvo50 " & Space(14),1,,4,,3,,1
Po1(1) = 1
Po2(2) = 1
Po3(2) = 1
Po3(3) = 1
Po4(2) = 1
Po4(3) = 1
Po4(4) = 1
Po4(5) = 1
Sp = " "
For Es = Ini To FIn
Messaggio Es & " Tempo Trascorso" & TempoTrascorso
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)
R2 = R1 + 1
If R2 = 11 Then R2 = 1
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
MinAB = Minimo(A,B) : MinCD = Minimo(C,D) : MaxAB = Massimo(A,B) : MaxCD = Massimo(C,D)
DistAB = Distanza(A,B) : DistCD = Distanza(C,D) : DistAD = Distanza(A,D)
DistAC = Distanza(A,C) : DistBD = Distanza(B,D) : DistBC = Distanza(B,C)
If(DistAB = 18 And DistCD = 27)Or(DistAB = 27 And DistCD = 18) Then
If MaxAB = MinCD Or MinAB = MaxCD Or MaxAB = MaxCD Or MinAB = MinCD Then
'
If DistAD > 17 And DistAC > 17 And DistBD > 17 And DistBC > 17 Then
'
If(DistAB = 18 And DistCD = 27) And(MinAB = MinCD) Then
E = Diametrale(MinAB)
F = Fuori90(MaxCD + 27)
If F = MinCD Then F = Fuori90((90 + MaxCD) - 27)
End If
If(DistAB = 27 And DistCD = 18) And(MinAB = MinCD) Then
E = Diametrale(MinAB)
F = Fuori90(MaxCD + 18)
If F = MinCD Then F = Fuori90((90 + MaxCD) - 18)
End If
If(DistAB = 18 And DistCD = 27) And(MaxAB = MaxCD) Then
E = Diametrale(MaxAB)
F = Fuori90(MinCD + 27)
If F = MaxCD Then F = Fuori90((90 + MinCD) - 27)
End If
If(DistAB = 27 And DistCD = 18) And(MaxAB = MaxCD) Then
E = Diametrale(MaxAB)
F = Fuori90(MinAB + 27)
If F = MaxAB Then F = Fuori90((90 + MinAB) - 27)
End If
If(DistAB = 27 And DistCD = 18) And(MaxAB = MinCD) Then
E = Diametrale(MaxAB)
F = Fuori90(MaxCD + 18)
If F = MinCD Then F = Fuori90((90 + MaxCD) - 18)
End If
If(DistAB = 18 And DistCD = 27) And(MaxAB = MinCD) Then
E = Diametrale(MaxAB)
F = Fuori90(MaxCD + 27)
If F = MinCD Then F = Fuori90((90 + MaxCD) - 27)
End If
If(DistAB = 18 And DistCD = 27) And(MinAB = MaxCD) Then
E = Diametrale(MinAB)
F = Fuori90(MaxAB + 18)
If F = MinAB Then F = Fuori90((90 + MaxAB) - 18)
End If
If(DistAB = 27 And DistCD = 18) And(MinAB = MaxCD) Then
E = Diametrale(MinAB)
F = Fuori90(MaxAB + 27)
If F = MinAB Then F = Fuori90((90 + MaxAB) - 27)
End If
Abb1 = Fuori90(F + 9) : Abb2 = Fuori90(F + 27)
Abb3 = Fuori90(E + 36) : Abb4 = Diametrale(Abb3)
X(1) = A : X(2) = B : X(3) = C : X(4) = D
Y(1) = A : Y(2) = B : Y(3) = C : Y(4) = D : Y(5) = E
Z(1) = A : Z(2) = B : Z(3) = C : Z(4) = D : Z(5) = F
Amba1(1) = F
Amba2(1) = E
'
Ambo1(1) = F : Ambo1(2) = E
'
Ambo2(1) = F : Ambo2(2) = Abb1
Ambo3(1) = F : Ambo3(2) = Abb2
'
Ambo4(1) = E : Ambo4(2) = Abb3
Ambo5(1) = E : Ambo5(2) = Abb4
'
Terno1(1) = F : Terno1(2) = Abb1 : Terno1(3) = Abb2
Terno2(1) = E : Terno2(2) = Abb3 : Terno2(3) = Abb4
'
Penta(1) = Abb1 : Penta(2) = Abb2 : Penta(3) = Abb4 : Penta(4) = F : Penta(5) = E
' Terna(1) = N(1): Terna(2) = N(2): Terna(3) = N(3)
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 X,1,1,,,1,1
DisegnaCerchioCiclometrico Y,1,1,,,1,1
DisegnaCerchioCiclometrico Z,1,1,,,1,1
End If
Scrivi
Scrivi
Ruote(1) = R1 : Ruote(2) = R2
ImpostaGiocata 1,Amba1,Ruote,Po1,Clp,1
ImpostaGiocata 2,Amba2,Ruote,Po1,Clp,1
ImpostaGiocata 3,Ambo1,Ruote,Po2,Clp,2
ImpostaGiocata 4,Ambo2,Ruote,Po2,Clp,2
ImpostaGiocata 5,Ambo3,Ruote,Po2,Clp,2
ImpostaGiocata 6,Ambo4,Ruote,Po2,Clp,2
ImpostaGiocata 7,Ambo5,Ruote,Po2,Clp,2
ImpostaGiocata 8,Terno1,Ruote,Po3,Clp
ImpostaGiocata 9,Terno2,Ruote,Po3,Clp
ImpostaGiocata 10,Penta,Ruote,Po4,Clp
Gioca Es,1
End If
End If
End If
End If
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi " Tempo Trascorso" & TempoTrascorso
End Sub
