Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
Altra condizione regalo per i volenterosi il listato per spaziometria e' gradito
- Creatore Discussione tiberio1
- Data di inizio
salvo50
Advanced Member >PLATINUM PLUS<
Ciao a Tutti.
Codice:
Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,Clp,Es,Cer,Salvo50
Dim R1,R2,P1,P2,P3,P4,P5,P6,E1,E2,Caso,Casi
Dim DM12,DM23,DM34,DM41,Abb1,Abb2,Amba
Dim Ambata(1),Ambo1(2),Ambo2(2),Ruote(4),M(4)
Dim Ter(3),Ruo(2),Po1(1),Po2(2),Po3(3),L(4)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9890))'9711 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(14) & "LA BOMBA CICLOMETRICA di ANGELO GARGIULO - SCRIPT SALVO50" & Space(14),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 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 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 = 27 And DM23 = 27 And DM34 = 27 And DM41 = 9 _
Or DM12 = 27 And DM23 = 27 And DM34 = 9 And DM41 = 27 _
Or DM12 = 27 And DM23 = 9 And DM34 = 27 And DM41 = 27 _
Or DM12 = 9 And DM23 = 27 And DM34 = 27 And DM41 = 27 Then
'---------------------------------
L(1) = Fuori90(M(1) + 9)
L(2) = Fuori90(M(2) + 9)
L(3) = Fuori90(M(3) + 9)
L(4) = Fuori90(M(4) + 9)
If DM12 = 27 And DM23 = 27 And DM34 = 27 And DM41 = 9 Then
Amba = L(1) : Abb1 = L(2) : Abb2 = L(3)
End If
If DM12 = 27 And DM23 = 27 And DM34 = 9 And DM41 = 27 Then
Amba = L(4) : Abb1 = L(1) : Abb2 = L(2)
End If
If DM12 = 27 And DM23 = 9 And DM34 = 27 And DM41 = 27 Then
Amba = L(3) : Abb1 = L(4) : Abb2 = L(1)
End If
If DM12 = 9 And DM23 = 27 And DM34 = 27 And DM41 = 27 Then
Amba = L(2) : Abb1 = L(3) : Abb2 = L(4)
End If
Ambata(1) = Amba
Ambo1(1) = Amba : Ambo1(2) = Abb1
Ambo2(1) = Amba : Ambo2(2) = Abb2
Ter(1) = Amba : Ter(2) = Abb1 : Ter(3) = Abb2
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 Or E1 = C 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 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(27) & Format2(Amba) & " Ambata ",1
Scrivi Space(24) & Format2(Abb1) & " " & Format2(Abb2) & " Abbinamenti per Ambo ",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
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
ImpostaGiocata 1,Ambata,Ruo,Po1,Clp
ImpostaGiocata 2,Ambo1,Ruote,Po2,Clp
ImpostaGiocata 3,Ambo2,Ruote,Po2,Clp
ImpostaGiocata 4,Ter,Ruote,Po3,Clp
Gioca Es
End If
End If
End If
Next
End If
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
For R1 = 1 To 12
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)
'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 = 27 And DM23 = 27 And DM34 = 27 And DM41 = 9 _
Or DM12 = 27 And DM23 = 27 And DM34 = 9 And DM41 = 27 _
Or DM12 = 27 And DM23 = 9 And DM34 = 27 And DM41 = 27 _
Or DM12 = 9 And DM23 = 27 And DM34 = 27 And DM41 = 27 Then
'---------------------------------
L(1) = Fuori90(M(1) + 9)
L(2) = Fuori90(M(2) + 9)
L(3) = Fuori90(M(3) + 9)
L(4) = Fuori90(M(4) + 9)
If DM12 = 27 And DM23 = 27 And DM34 = 27 And DM41 = 9 Then
Amba = L(1) : Abb1 = L(2) : Abb2 = L(3)
End If
If DM12 = 27 And DM23 = 27 And DM34 = 9 And DM41 = 27 Then
Amba = L(4) : Abb1 = L(1) : Abb2 = L(2)
End If
If DM12 = 27 And DM23 = 9 And DM34 = 27 And DM41 = 27 Then
Amba = L(3) : Abb1 = L(4) : Abb2 = L(1)
End If
If DM12 = 9 And DM23 = 27 And DM34 = 27 And DM41 = 27 Then
Amba = L(2) : Abb1 = L(3) : Abb2 = L(4)
End If
Ambata(1) = Amba
Ambo1(1) = Amba : Ambo1(2) = Abb1
Ambo2(1) = Amba : Ambo2(2) = Abb2
Ter(1) = Amba : Ter(2) = Abb1 : Ter(3) = Abb2
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) & Format2(Amba) & " Ambata ",1
Scrivi Space(24) & Format2(Abb1) & " " & Format2(Abb2) & " Abbinamenti per Ambo ",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
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
ImpostaGiocata 1,Ambata,Ruo,Po1,Clp
ImpostaGiocata 2,Ambo1,Ruote,Po2,Clp
ImpostaGiocata 3,Ambo2,Ruote,Po2,Clp
ImpostaGiocata 4,Ter,Ruote,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
Ultima estrazione Lotto
-
Estrazione del lotto
sabato 01 agosto 2026Bari4654364701Cagliari7730047918Firenze8476102744Genova3213713846Milano1023182003Napoli7336109007Palermo6146245732Roma8978230735Torino2159347386Venezia7401304654Nazionale7165170920Estrazione Simbolotto
Nazionale
0309373039
