Da Un Suggerimento Di Tascione "Raccolta Script con Cerchio Ciclometrico"

[salvo50]

'https://forum.lottoced.com/threads/script-su-metodi-cabalistici-ciclometrici-c.2089682/page-40
Metodo il Trapezio con ambi uniti e isotopi di Domenico Manna

Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,Clp,Es,Cer
   Dim R1,R2,P1,P2,Salvo50
   Dim SoAB,SoCD
   Dim DM12,DM23,DM34,DM41,Caso,Casi
   Dim Ambo1(2),Ambo2(2),Ambo3(2),Ruo(3)
   Dim Posta(2),L(6),M(4)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9000))'L'estrazione 5739 esempio nelle spiegazioni
   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 "Metodo il Trapezio con ambi uniti e isotopi di Domenico Manna - Script Salvo50" & Space(5),1,,4,,3,,1
   Posta(2) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 4
            P2 = P1 + 1
            A = Estratto(Es,R1,P1)
            B = Estratto(Es,R1,P2)
            SoAB = Fuori90(A + B)
            For R2 = R1 + 1 To 12
               If R2 = 11 Then R2 = 12
               C = Estratto(Es,R2,P1)
               D = Estratto(Es,R2,P2)
               SoCD = Fuori90(C + D)
               If A > 0 And C > 0 And SoAB = SoCD 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 = 20 And DM34 = 27 And DM41 = 16 _
                        Or DM12 = 20 And DM23 = 27 And DM34 = 16 And DM41 = 27_
                        Or DM12 = 27 And DM23 = 16 And DM34 = 27 And DM41 = 20_
                        Or DM12 = 16 And DM23 = 27 And DM34 = 20 And DM41 = 27 Then
                        '---------------------------------
                        If DM12 = 27 And DM23 = 20 And DM34 = 27 And DM41 = 16 Then
                           L(5) = Fuori90(M(2) + 16) : L(6) = Fuori90(L(5) + 2)
                           Ambo1(1) = Fuori90(M(2) + 16)
                           Ambo2(1) = Fuori90(M(2) + 2)
                           Ambo3(1) = Fuori90(M(2) + 2)
                        End If
                        If DM12 = 20 And DM23 = 27 And DM34 = 16 And DM41 = 27 Then
                           L(5) = Fuori90(M(1) + 16) : L(6) = Fuori90(L(5) + 2)
                           Ambo1(1) = Fuori90(M(1) + 16)
                           Ambo2(1) = Fuori90(M(1) + 2)
                           Ambo3(1) = Fuori90(M(1) + 2)
                           '
                        End If
                        If DM12 = 27 And DM23 = 16 And DM34 = 27 And DM41 = 20 Then
                           L(5) = Fuori90(M(4) + 16) : L(6) = Fuori90(L(5) + 2)
                           Ambo1(1) = Fuori90(M(4) + 16)
                           Ambo2(1) = Fuori90(M(4) + 2)
                           Ambo3(1) = Fuori90(M(4) + 2)
                        End If
                        If DM12 = 16 And DM23 = 27 And DM34 = 20 And DM41 = 27 Then
                           L(5) = Fuori90(M(3) + 16) : L(6) = Fuori90(L(5) + 2)
                           Ambo1(1) = Fuori90(M(3) + 16)
                           Ambo2(1) = Fuori90(M(3) + 2)
                           Ambo3(1) = Fuori90(M(3) + 2)
                        End If
                        Ambo1(2) = Fuori90(Ambo1(1) + 2)
                        Ambo2(2) = Fuori90(Ambo2(1) + 2)
                        Ambo3(2) = Fuori90(Ambo2(1) + 16)
                        L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
                        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) = P1
                        MatrCasella(4,0) = R2
                        MatrCasella(4,1) = P2
                        Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
                        Scrivi
                        Scrivi Space(10) & " La Somma Uguale è " & Format2(SoAB),1
                       Scrivi
                        If Cer = 1 Then
                           DisegnaCerchioCiclometrico M,1,1,,,1,1
                           DisegnaCerchioCiclometrico L,1,1,,,1,1
                        End If
                        Scrivi
                        Ruo(1) = R1 : Ruo(2) = R2 : Ruo(3) = TT_
                        ImpostaGiocata 1,Ambo1,Ruo,Posta,Clp
                        ImpostaGiocata 2,Ambo2,Ruo,Posta,Clp
                        ImpostaGiocata 3,Ambo3,Ruo,Posta,Clp
                        Gioca Es,1
                        '
                     End If
                  End If
               End If
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi " Tempo Trascorso" & TempoTrascorso
End Sub