Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,G,Clp,Es,Cer,Salvo50,Z,EsClp
Dim R1,R2,P1,P2,P3,P4,P5,P6,E1,E2,Caso,Casi
Dim DM12,DM23,DM34,DM41,Sf1,Sf2,Medio1,DiamMedio1
Dim Abb1,Abb2,Abb3,Abb4,Ch,DiamCh,xM1,xM2
Dim Amba(2),Ambo(2),Penta(5),Po3(4)
Dim L(6),M(4),Ruo1(2),Ruo2(4),Po1(1),Po2(5)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10600))'9701 Esempio nell'articolo
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,7))
Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,0))
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(18) & "L'AMBO UNICO di ANGELO GARGIULO - SCRIPT SALVO50" & Space(18),1,,4,,3,,1
Scrivi Space(28) & "CON MODIFICA DI ADELEADELE" & Space(31),1,,4,,3,,1
Po1(1) = 1
Po2(2) = 1
Po3(2) = 1
Po3(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)
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)
'M1--M2
'| |
'M4--M3
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 = 18 And DM23 = 18 And DM34 = 18 And DM41 = 36 _
Or DM12 = 18 And DM23 = 18 And DM34 = 36 And DM41 = 18 _
Or DM12 = 18 And DM23 = 36 And DM34 = 18 And DM41 = 18 _
Or DM12 = 36 And DM23 = 18 And DM34 = 18 And DM41 = 18 Then
'---------------------------------
If DM12 = 18 And DM23 = 18 And DM34 = 18 And DM41 = 36 Then
Ch = Fuori90(M(4) + 18)
DiamCh = Diametrale(Ch)
End If
If DM12 = 18 And DM23 = 18 And DM34 = 36 And DM41 = 18 Then
Ch = Fuori90(M(3) + 18)
DiamCh = Diametrale(Ch)
End If
If DM12 = 18 And DM23 = 36 And DM34 = 18 And DM41 = 18 Then
Ch = Fuori90(M(2) + 18)
DiamCh = Diametrale(Ch)
End If
If DM12 = 36 And DM23 = 18 And DM34 = 18 And DM41 = 18 Then
Ch = Fuori90(M(1) + 18)
DiamCh = Diametrale(Ch)
End If
xM1 =(M(3) + M(4))
Medio1 = xM1 / 2
' xM2 =(M(1) + M(2))
' Medio2 = xM2 / 2
DiamMedio1 = DiametraleD(Medio1)
Abb1 = Fuori90(A + C)
Abb2 = Fuori90(B + D)
Abb3 = Differenza(A,C)
Abb4 = Differenza(B,D)
Amba(1) = Medio1 : Amba(2) = DiamMedio1
Ruo1(1) = R1 : Ruo1(2) = R2
Penta(1) = DiamMedio1 : Penta(2) = Abb1 : Penta(3) = Abb2 : Penta(4) = Abb3 : Penta(5) = Abb4
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,2
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,1
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(27) & " Ambata = " & Format2(DiamCh),1,,,2
Scrivi Space(13) & Format2(M(3)) & " + " & Format2(M(4)) & " = " & FormattaStringa(xM1,"000"),1,0
Scrivi " / 2 = ",1,0
Scrivi Format2(Medio1),1,0,,2
Scrivi " Ambata 1 ",1
Scrivi Space(12) & "Diametrale In Decina ",1,0
Scrivi Format2(DiamMedio1),1,0,,2
Scrivi " Ambata 2"
Scrivi Space(17) & " Abbinamenti Per Ambo",1,,,1
Scrivi Space(15) & Format2(A) & " + " & Format2(C) & " = " & Format2(Abb1),1,0
Scrivi " Abbinamento 1",1
Scrivi Space(15) & Format2(B) & " + " & Format2(D) & " = " & Format2(Abb2),1,0
Scrivi " Abbinamento 2",1
Scrivi Space(15) & Format2(A) & " - " & Format2(C) & " = " & Format2(Abb3),1,0
Scrivi " Abbinamento 3",1
Scrivi Space(15) & Format2(B) & " - " & Format2(D) & " = " & Format2(Abb4),1,0
Scrivi " Abbinamento 4",1
Scrivi
If Cer = 1 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4) : L(5) = DiamCh
DisegnaCerchioCiclometrico L,1,1,,,1,1
End If
G = 1
Ruo2(1) = R1 : Ruo2(2) = R2 : Ruo2(3) = NZ_ : Ruo2(4) = TT_
ImpostaGiocata G,Amba,Ruo1,Po1,Clp
For Z = 1 To UBound(Penta)
If Amba(2) <> Penta(Z)Then
Ambo(1) = Amba(2): Ambo(2) = Penta(Z)
If Ambo(2) > 0 Then
G = G + 1
ImpostaGiocata G,Ambo,Ruo2,Po2,Clp
End If
End If
Next
G = G + 1
ImpostaGiocata G,Penta,Ruo2,Po3,Clp
Gioca Es
End If
End If
End If
Next
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
End Sub
