https://forum.lottoced.com/threads/a-gentile-richiesta-un-listato.2199319/
Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,G,Clp,Es,Cer,Salvo50
Dim R1,R2,P1,P2,P3,P4,P5,P6,E1,E2,Caso,Casi
Dim DM12,DM23,DM34,DM41,Sf1,Sf2,Medio1,Medio2
Dim Abb1,Abb2,Abb3,Abb4,Ch,DiamCh,xM1,xM2
Dim Amba1(1),Amba2(1),Ambo1(2),Ambo2(2),Ruote(4)
Dim Ambata(1),L(6),M(4),Ruo(2),Po1(1),Po2(5)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9740))'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,1))
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) & "ESTRATTI UNITI ED ISOTOPI" & Space(31),1,,4,,3,,1
Po1(1) = 1
Po2(2) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 9
For P1 = 1 To 4
P2 = P1 + 1
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
For R2 = R1 + 1 To 10
C = Estratto(Es,R2,P1)
D = Estratto(Es,R2,P2)
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
Ruo(1) = R1 : Ruo(2) = R2
Amba1(1) = Medio1 : Amba2(1) = Medio2
Sf1 = 2 : Sf2 = 2
Sf1 = SerieFreqTurbo(Es - 4,Es,Amba1,Ruo,1)
Sf2 = SerieFreqTurbo(Es - 4,Es,Amba2,Ruo,1)
If Sf1 = 0 Or Sf2 = 0 Then
Ambata(1) = DiamCh
Ambo1(1) = DiamCh : Ambo1(2) = Medio1
Ambo2(1) = DiamCh : Ambo2(2) = Medio2
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(22) & " Abbinamenti Per Ambo",1,,,1
Scrivi Space(15) & Format2(M(3)) & " + " & Format2(M(4)) & " = " & FormattaStringa(xM1,"000"),1,0
Scrivi " / 2 = " & Format2(Medio1) & " Abbinamento 1",1
Scrivi Space(15) & Format2(M(1)) & " + " & Format2(M(2)) & " = " & FormattaStringa(xM2,"000"),1,0
Scrivi " / 2 = " & Format2(Medio2) & " Abbinamento 2",1
Scrivi Space(1) & "Se Cerca un solo ambo, è perchè l'altro abbinamento è stato",1,0,,1
Scrivi " riscontrato nelle 4 estrazioni A ritroso",1,,,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 = 2
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
ImpostaGiocata 1,Ambata,Ruo,Po1,Clp
If Sf1 = 0 Then ImpostaGiocata G,Ambo1,Ruote,Po2,Clp : G = G + 1
If Sf2 = 0 Then ImpostaGiocata G,Ambo2,Ruote,Po2,Clp
Gioca Es
End If
End If
End If
End If
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
End Sub
