| Ciao Dragonzf Zf, quello chiusura 69 è unico, cioè se la chiusura è 69 i numeri devono essere sempre gli stessi, e penso che in tutte le estrazioni non ce ne saranno molte, quindi mi sono permesso di fare CHIUSURA X quello che viene, viene, la chiusura è il vertice del triangolo finale, lo script per questo metodo l'avevo già fatto, quindi lo posto, il secondo metodo quello della bomba ciclometrica lo devo fare non è pronto Option Explicit Sub Main Dim FIn,Ini,A,B,C,D,X,Clp,Es,Cer Dim R1,R2,P1,P2,P3,P4,Salvo50,Sp Dim DM12,DM23,DM34,DM41,Caso,Casi Dim Amba(1),Ambo1(2),Ambo2(2),Terna(3),Ruo(2) Dim Po1(1),Po2(2),Po3(3),L(6),M(4),N(3),Ruote(4) FIn = EstrazioneFin Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9768))'9768 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(14) & "CHIUSURA X di ANGELO GARGIULO - SCRIPT UNOUNO50 alias SALVO50" & Space(14),1,,4,,3,,1 Po1(1) = 1 Po2(2) = 1 Po3(2) = 1 'Po3(3) = 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 = 45 And DM23 = 9 And DM34 = 9 And DM41 = 27 _ Or DM23 = 45 And DM34 = 9 And DM41 = 9 And DM12 = 27 _ Or DM34 = 45 And DM41 = 9 And DM12 = 9 And DM23 = 27 _ Or DM41 = 45 And DM12 = 9 And DM23 = 9 And DM34 = 27 Then '--------------------------------- If DM12 = 45 And DM23 = 9 And DM34 = 9 And DM41 = 27 Then L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4) End If If DM23 = 45 And DM34 = 9 And DM41 = 9 And DM12 = 27 Then L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1) End If If DM34 = 45 And DM41 = 9 And DM12 = 9 And DM23 = 27 Then L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2) End If If DM41 = 45 And DM12 = 9 And DM23 = 9 And DM34 = 27 Then L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3) End If L(5) = Fuori90((90 + L(1)) - 9) L(6) = Fuori90(L(5) + 18) N(1) = Fuori90((90 + L(5)) - 9) N(2) = Fuori90((90 + N(1)) - 36) N(3) = Fuori90(N(1) + 36) Amba(1) = N(1) Ambo1(1) = N(1): Ambo1(2) = N(2) Ambo2(1) = N(1): Ambo2(2) = N(3) 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) = 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 DisegnaCerchioCiclometrico N,1,1,,,1,1 End If Scrivi Scrivi Space(24) & Format2(N(1)) & " Ambata",1,,,2 Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1 Scrivi Space(25) & Format2(N(2)) & Sp & Format2(N(3)),1 Scrivi Ruo(1) = R1 : Ruo(2) = R2 Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_ ImpostaGiocata 1,Amba,Ruo,Po1,5,1 ImpostaGiocata 2,Ambo1,Ruo,Po2,Clp ImpostaGiocata 3,Ambo2,Ruo,Po2,Clp ImpostaGiocata 4,Terna,Ruote,Po3,Clp Gioca Es,1 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 D > 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 = 45 And DM23 = 9 And DM34 = 9 And DM41 = 27 _ Or DM23 = 45 And DM34 = 9 And DM41 = 9 And DM12 = 27 _ Or DM34 = 45 And DM41 = 9 And DM12 = 9 And DM23 = 27 _ Or DM41 = 45 And DM12 = 9 And DM23 = 9 And DM34 = 27 Then '--------------------------------- If DM12 = 45 And DM23 = 9 And DM34 = 9 And DM41 = 27 Then L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4) End If If DM23 = 45 And DM34 = 9 And DM41 = 9 And DM12 = 27 Then L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1) End If If DM34 = 45 And DM41 = 9 And DM12 = 9 And DM23 = 27 Then L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2) End If If DM41 = 45 And DM12 = 9 And DM23 = 9 And DM34 = 27 Then L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3) End If L(5) = Fuori90((90 + L(1)) - 9) L(6) = Fuori90(L(5) + 18) N(1) = Fuori90((90 + L(5)) - 9) N(2) = Fuori90((90 + N(1)) - 36) N(3) = Fuori90(N(1) + 36) Amba(1) = N(1) Ambo1(1) = N(1): Ambo1(2) = N(2) Ambo2(1) = N(1): Ambo2(2) = N(3) 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 M,1,1,,,1,1 DisegnaCerchioCiclometrico L,1,1,,,1,1 DisegnaCerchioCiclometrico N,1,1,,,1,1 End If Scrivi Scrivi Space(24) & Format2(N(1)) & " Ambata",1,,,2 Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1 Scrivi Space(25) & Format2(N(2)) & Sp & Format2(N(3)),1 Scrivi Ruo(1) = R1 : Ruo(2) = R2 Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_ ImpostaGiocata 1,Amba,Ruo,Po1,5,1 ImpostaGiocata 2,Ambo1,Ruo,Po2,Clp ImpostaGiocata 3,Ambo2,Ruo,Po2,Clp ImpostaGiocata 4,Terna,Ruote,Po3,Clp Gioca Es,1 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 Edited by Unouno50 - 30/5/2021, 20:09
|