per salvo50 e tutti

[DRAGON8698]

Chi puo' creare un listato x spaziometria su questo?Grazie.

 

[salvo50]

Ciao a Tutti

Rudivall, Toon
Grazie

Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,Clp,Es,Cer,X,EsClp,Sp,R
   Dim R1,R2,P1,P2,P3,P4,Salvo50,Ambett1,Ambett2
   Dim DM12,DM23,DM34,DM41,Caso,Casi,Ambetti
   Dim RetNum1,RetVinc1,RetNum2,RetVinc2
   Dim Ambo1(2),Ambo2(2),Ruo(4),Po2(2),L(6),M(4)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10100))'10157 ESEMPIO NELL'ARTICOLO
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
   Cer = CInt(InputBox(" Vuoi visualizzare i cerchi ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   Ambetti = CInt(InputBox(" Vuoi giocare gli ambetti? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(1) & "LA STRUTTURA CICLOMETRICA a cura di ANGELO GARGIULO - SOLO DUE AMBI - SCRIPT SALVO50" & Space(1),1,,4,,3,,1
   Po2(2) = 1
   Sp = " "
   For Es = Ini To FIn
      Messaggio Es
      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)
               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 = 9 And DM23 = 27 And DM34 = 9 And DM41 = 45 _
                                 Or DM12 = 27 And DM23 = 9 And DM34 = 45 And DM41 = 9 _
                                 Or DM12 = 9 And DM23 = 45 And DM34 = 9 And DM41 = 27 _
                                 Or DM12 = 45 And DM23 = 9 And DM34 = 27 And DM41 = 9 Then
                                 '---------------------------------
                                 If DM12 = 9 And DM23 = 27 And DM34 = 9 And DM41 = 45 Then
                                    L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
                                 End If
                                 If DM12 = 27 And DM23 = 9 And DM34 = 45 And DM41 = 9 Then
                                    L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
                                 End If
                                 If DM12 = 9 And DM23 = 45 And DM34 = 9 And DM41 = 27 Then
                                    L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
                                 End If
                                 If DM12 = 45 And DM23 = 9 And DM34 = 27 And DM41 = 9 Then
                                    L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
                                 End If
                                 L(5) = Fuori90(L(4) + 9)
                                 L(6) = Fuori90(L(5) + 27)
                                 Ambo1(1) = L(4) : Ambo1(2) = L(6)
                                 Ambo2(1) = L(1) : Ambo2(2) = L(5)
                                 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
                                 Scrivi
                                 Scrivi
                                 Ruo(1) = R1 : Ruo(2) = R2 : Ruo(3) = NZ_ : Ruo(4) = TT_
                                 ImpostaGiocata 1,Ambo1,Ruo,Po2,Clp
                                 ImpostaGiocata 2,Ambo2,Ruo,Po2,Clp
                                 Gioca Es,1
                                 If Ambetti = 1 Then
                                    Scrivi Space(19) & "AMBETTI",1,,,2
                                    EsClp = Es + Clp
                                    If EsClp > FIn Then EsClp = FIn
                                    For X = Es + 1 To EsClp
                                       For R = 1 To 12
                                          If R = 11 Then R = 12
                                          Ambett1 = VerificaAmbetto(Ambo1,R,X,RetNum1,RetVinc1)
                                          Ambett2 = VerificaAmbetto(Ambo2,R,X,RetNum2,RetVinc2)
                                          If Ambett1 > 0 Then
                                             Scrivi(" Estrazione n." & Format2(X) & " del " & DataEstrazione(X)),1,0
                                             Scrivi " Ambetto su " & RetNum1 & Space(4) & " Vincita di " & RetVinc1,1
                                          End If
                                          If Ambett2 > 0 Then
                                             Scrivi(" Estrazione n." & Format2(X) & " del " & DataEstrazione(X)),1,0
                                             Scrivi " Ambetto su " & RetNum2 & Space(4) & " Vincita di " & RetVinc2,1
                                          End If
                                          Ambett1 = 0 : Ambett2 = 0
                                       Next
                                    Next
                                 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

 

[rudivall]

Caro Salvo grazie a te, sei una persona speciale...

 

[DRAGON8698]

GRAZIE