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.
Ciao a Tutti.
Per quanti sforzi abbia fatto non ci ho capito una mazza.
Se tu conosci il procedimento, spiegamelo con parole tue e con esempi ed io quando ho tempo cercherò di tradurre in script le tue spiegazioni.
Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,Clp,Es,Cer
Dim R1,R2,P1,P2,P3,P4,Salvo50,Caso,Casi
Dim DM12,DM23,DM34,DM41,Fa
Dim Po1(10),Po2(2),L(6),M(4)
Dim Amba(1),Ambo(2),Ruo(2),Ruote(4)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10000))
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(5) & "Una Figura Efficace (se chiusa correttamente: la 8)di Noel - Script Salvo50" & Space(5),1,,4,,3,,1
'Po1(1) = 1
Po1(8) = 1
Po1(9) = 1
Po2(2) = 1
For Es = Ini To FIn
Messaggio Es & " Tempo Trascorso " & TempoTrascorso
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 D > 0 Then
If A <> C And A <> D And B <> C And B <> D Then
Fa = Figura(A)
If Fa = 8 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 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 _
Or DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 _
Or DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 _
Or DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
'---------------------------------
If DM12 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
'L(5) = Diametrale M(2): L(6) = Diametrale
End If
If DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
L(5) = Diametrale(L(2))
L(6) = Diametrale(L(4))
Amba(1) = L(6)
Ambo(1) = L(5): Ambo(2) = L(6)
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"00000"),1,,,1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"00000"),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
Scrivi Space(20) & "PRONOSTICO",1,,,2
Scrivi
Scrivi Space(21) & "Ambata " & Format2(L(6)),1,,,1
Scrivi
Scrivi Space(20) & "Ambo " & Format2(L(5)) & " " & Format2(L(6)),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) = TT_
ImpostaGiocata 1,Amba,Ruo,Po1,Clp
ImpostaGiocata 2,Ambo,Ruote,Po2,Clp
Gioca Es,1
End If
End If
End If
End If
If ScriptInterrotto Then Exit Sub
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
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 = 11 Then R2 = 12
For P4 = 1 To 5
D = Estratto(Es,R2,P4)
If A > 0 And D > 0 And R1 <> R2 Then
If A <> C And A <> D And B <> C And B <> D Then
Fa = Figura(A)
If Fa = 8 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 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 _
Or DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 _
Or DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 _
Or DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
'---------------------------------
If DM12 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
L(5) = Diametrale(L(2))
L(6) = Diametrale(L(4))
Amba(1) = L(6)
Ambo(1) = L(5): Ambo(2) = L(6)
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"00000"),1,,,1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"00000"),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
Scrivi Space(20) & "PRONOSTICO",1,,,2
Scrivi
Scrivi Space(21) & "Ambata " & Format2(L(6)),1,,,1
Scrivi
Scrivi Space(20) & "Ambo " & Format2(L(5)) & " " & Format2(L(6)),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) = TT_ : Ruote(4) = NZ_
ImpostaGiocata 1,Amba,Ruo,Po1,Clp
ImpostaGiocata 2,Ambo,Ruote,Po2,Clp
Gioca Es,1
End If
End If
End If
End If
If ScriptInterrotto Then Exit Sub
Next
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi " Tempo Trascorso " & TempoTrascorso
End Sub
Ciao e' possibile elaborarlo per tutti i tipi di figure e non solo la 8?Grazie.Ciao a Tutti.
Bubù, Dragon8698
Grazie
Codice:Option Explicit Sub Main Dim FIn,Ini,A,B,C,D,Clp,Es,Cer Dim R1,R2,P1,P2,P3,P4,Salvo50,Caso,Casi Dim DM12,DM23,DM34,DM41,Fa Dim Po1(10),Po2(2),L(6),M(4) Dim Amba(1),Ambo(2),Ruo(2),Ruote(4) FIn = EstrazioneFin Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10000)) 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(5) & "Una Figura Efficace (se chiusa correttamente: la 8)di Noel - Script Salvo50" & Space(5),1,,4,,3,,1 'Po1(1) = 1 Po1(8) = 1 Po1(9) = 1 Po2(2) = 1 For Es = Ini To FIn Messaggio Es & " Tempo Trascorso " & TempoTrascorso 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 D > 0 Then If A <> C And A <> D And B <> C And B <> D Then Fa = Figura(A) If Fa = 8 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 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 _ Or DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 _ Or DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 _ Or DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then '--------------------------------- If DM12 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 Then L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4) 'L(5) = Diametrale M(2): L(6) = Diametrale End If If DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 Then L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1) End If If DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 Then L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2) End If If DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3) End If L(5) = Diametrale(L(2)) L(6) = Diametrale(L(4)) Amba(1) = L(6) Ambo(1) = L(5): Ambo(2) = L(6) Caso = Caso + 1 Casi = Casi + 1 Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"00000"),1,,,1 Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"00000"),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 Scrivi Space(20) & "PRONOSTICO",1,,,2 Scrivi Scrivi Space(21) & "Ambata " & Format2(L(6)),1,,,1 Scrivi Scrivi Space(20) & "Ambo " & Format2(L(5)) & " " & Format2(L(6)),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) = TT_ ImpostaGiocata 1,Amba,Ruo,Po1,Clp ImpostaGiocata 2,Ambo,Ruote,Po2,Clp Gioca Es,1 End If End If End If End If If ScriptInterrotto Then Exit Sub Next Next Next Next Next If ScriptInterrotto Then Exit Sub Next 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 = 11 Then R2 = 12 For P4 = 1 To 5 D = Estratto(Es,R2,P4) If A > 0 And D > 0 And R1 <> R2 Then If A <> C And A <> D And B <> C And B <> D Then Fa = Figura(A) If Fa = 8 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 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 _ Or DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 _ Or DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 _ Or DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then '--------------------------------- If DM12 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 Then L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4) End If If DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 Then L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1) End If If DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 Then L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2) End If If DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3) End If L(5) = Diametrale(L(2)) L(6) = Diametrale(L(4)) Amba(1) = L(6) Ambo(1) = L(5): Ambo(2) = L(6) Caso = Caso + 1 Casi = Casi + 1 Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"00000"),1,,,1 Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"00000"),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 Scrivi Space(20) & "PRONOSTICO",1,,,2 Scrivi Scrivi Space(21) & "Ambata " & Format2(L(6)),1,,,1 Scrivi Scrivi Space(20) & "Ambo " & Format2(L(5)) & " " & Format2(L(6)),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) = TT_ : Ruote(4) = NZ_ ImpostaGiocata 1,Amba,Ruo,Po1,Clp ImpostaGiocata 2,Ambo,Ruote,Po2,Clp Gioca Es,1 End If End If End If End If If ScriptInterrotto Then Exit Sub Next Next Next Next Next Next If ScriptInterrotto Then Exit Sub Next ScriviResoconto Scrivi " Tempo Trascorso " & TempoTrascorso End Sub
Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,Clp,Es,Cer
Dim R1,R2,P1,P2,P3,P4,Salvo50,Caso,Casi
Dim DM12,DM23,DM34,DM41
Dim Po1(10),Po2(2),L(6),M(4)
Dim Amba(1),Ambo(2),Ruo(2),Ruote(4)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10000))
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(5) & "Una Figura Efficace (se chiusa correttamente)di Noel - Script Salvo50" & Space(5),1,,4,,3,,1
'Po1(1) = 1
Po1(8) = 1
Po1(9) = 1
Po2(2) = 1
For Es = Ini To FIn
Messaggio Es & " Tempo Trascorso " & TempoTrascorso
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 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 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 _
Or DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 _
Or DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 _
Or DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
'---------------------------------
If DM12 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
'L(5) = Diametrale M(2): L(6) = Diametrale
End If
If DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
L(5) = Diametrale(L(2))
L(6) = Diametrale(L(4))
Amba(1) = L(6)
Ambo(1) = L(5): Ambo(2) = L(6)
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"00000"),1,,,1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"00000"),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
Scrivi Space(20) & "PRONOSTICO",1,,,2
Scrivi
Scrivi Space(21) & "Ambata " & Format2(L(6)),1,,,1
Scrivi
Scrivi Space(20) & "Ambo " & Format2(L(5)) & " " & Format2(L(6)),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) = TT_
ImpostaGiocata 1,Amba,Ruo,Po1,Clp
ImpostaGiocata 2,Ambo,Ruote,Po2,Clp
Gioca Es,1
End If
End If
End If
If ScriptInterrotto Then Exit Sub
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
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 = 11 Then R2 = 12
For P4 = 1 To 5
D = Estratto(Es,R2,P4)
If A > 0 And D > 0 And R1 <> R2 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 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 _
Or DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 _
Or DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 _
Or DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
'---------------------------------
If DM12 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
L(5) = Diametrale(L(2))
L(6) = Diametrale(L(4))
Amba(1) = L(6)
Ambo(1) = L(5): Ambo(2) = L(6)
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"00000"),1,,,1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"00000"),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
Scrivi Space(20) & "PRONOSTICO",1,,,2
Scrivi
Scrivi Space(21) & "Ambata " & Format2(L(6)),1,,,1
Scrivi
Scrivi Space(20) & "Ambo " & Format2(L(5)) & " " & Format2(L(6)),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) = TT_ : Ruote(4) = NZ_
ImpostaGiocata 1,Amba,Ruo,Po1,Clp
ImpostaGiocata 2,Ambo,Ruote,Po2,Clp
Gioca Es,1
End If
End If
End If
If ScriptInterrotto Then Exit Sub
Next
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi " Tempo Trascorso " & TempoTrascorso
End Sub
grazieCiao a Tutti.
Per tutte le figure
Codice:Option Explicit Sub Main Dim FIn,Ini,A,B,C,D,Clp,Es,Cer Dim R1,R2,P1,P2,P3,P4,Salvo50,Caso,Casi Dim DM12,DM23,DM34,DM41 Dim Po1(10),Po2(2),L(6),M(4) Dim Amba(1),Ambo(2),Ruo(2),Ruote(4) FIn = EstrazioneFin Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10000)) 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(5) & "Una Figura Efficace (se chiusa correttamente)di Noel - Script Salvo50" & Space(5),1,,4,,3,,1 'Po1(1) = 1 Po1(8) = 1 Po1(9) = 1 Po2(2) = 1 For Es = Ini To FIn Messaggio Es & " Tempo Trascorso " & TempoTrascorso 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 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 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 _ Or DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 _ Or DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 _ Or DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then '--------------------------------- If DM12 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 Then L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4) 'L(5) = Diametrale M(2): L(6) = Diametrale End If If DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 Then L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1) End If If DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 Then L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2) End If If DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3) End If L(5) = Diametrale(L(2)) L(6) = Diametrale(L(4)) Amba(1) = L(6) Ambo(1) = L(5): Ambo(2) = L(6) Caso = Caso + 1 Casi = Casi + 1 Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"00000"),1,,,1 Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"00000"),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 Scrivi Space(20) & "PRONOSTICO",1,,,2 Scrivi Scrivi Space(21) & "Ambata " & Format2(L(6)),1,,,1 Scrivi Scrivi Space(20) & "Ambo " & Format2(L(5)) & " " & Format2(L(6)),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) = TT_ ImpostaGiocata 1,Amba,Ruo,Po1,Clp ImpostaGiocata 2,Ambo,Ruote,Po2,Clp Gioca Es,1 End If End If End If If ScriptInterrotto Then Exit Sub Next Next Next Next Next If ScriptInterrotto Then Exit Sub Next 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 = 11 Then R2 = 12 For P4 = 1 To 5 D = Estratto(Es,R2,P4) If A > 0 And D > 0 And R1 <> R2 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 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 _ Or DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 _ Or DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 _ Or DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then '--------------------------------- If DM12 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 Then L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4) End If If DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 Then L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1) End If If DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 Then L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2) End If If DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3) End If L(5) = Diametrale(L(2)) L(6) = Diametrale(L(4)) Amba(1) = L(6) Ambo(1) = L(5): Ambo(2) = L(6) Caso = Caso + 1 Casi = Casi + 1 Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"00000"),1,,,1 Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"00000"),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 Scrivi Space(20) & "PRONOSTICO",1,,,2 Scrivi Scrivi Space(21) & "Ambata " & Format2(L(6)),1,,,1 Scrivi Scrivi Space(20) & "Ambo " & Format2(L(5)) & " " & Format2(L(6)),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) = TT_ : Ruote(4) = NZ_ ImpostaGiocata 1,Amba,Ruo,Po1,Clp ImpostaGiocata 2,Ambo,Ruote,Po2,Clp Gioca Es,1 End If End If End If If ScriptInterrotto Then Exit Sub Next Next Next Next Next Next If ScriptInterrotto Then Exit Sub Next ScriviResoconto Scrivi " Tempo Trascorso " & TempoTrascorso End Sub
Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,Clp,Es,Cer
Dim R1,R2,P1,P2,P3,P4,Salvo50,Caso,Casi
Dim DM12,DM23,DM34,DM41,SommaL5L6
Dim Po2(2),L(6),M(4),Ruote(4)
Dim Ambo1(2),Ambo2(2),Ambo3(2)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10075))
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(8) & "Una Figura Efficace di Noel (Con Modifica di Zetrix) - Script Salvo50" & Space(8),1,,4,,3,,1
Po2(2) = 1
For Es = Ini To FIn
Messaggio Es & " Tempo Trascorso " & TempoTrascorso
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 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 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 _
Or DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 _
Or DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 _
Or DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
'---------------------------------
If DM12 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
L(5) = Fuori90((90 + L(2)) - 9)
L(6) = Fuori90(L(3) + 18)
SommaL5L6 = Fuori90(L(5) + L(6))
Ambo1(1) = L(5) : Ambo1(2) = L(6)
Ambo2(1) = SommaL5L6 : Ambo2(2) =(L(5))
Ambo3(1) = SommaL5L6 : Ambo3(2) =(L(6))
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"00000"),1,,,1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"00000"),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 Space(22) & Format2(L(5)) & " + " & Format2(L(6)) & " = " & Format2(SommaL5L6),1,,,1
Scrivi
Scrivi Space(23) & "PRONOSTICO",1,,,2
Scrivi
Scrivi Space(21) & "1° Ambo " & Format2(L(5)) & " " & Format2(L(6)),1,,,1
Scrivi Space(21) & "2° Ambo " & Format2(SommaL5L6) & " " & Format2(L(5)),1,,,1
Scrivi Space(21) & "3° Ambo " & Format2(SommaL5L6) & " " & Format2(L(6)),1,,,1
Scrivi
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = TT_
ImpostaGiocata 1,Ambo1,Ruote,Po2,Clp
ImpostaGiocata 2,Ambo2,Ruote,Po2,Clp
ImpostaGiocata 3,Ambo3,Ruote,Po2,Clp
Gioca Es,1
End If
End If
End If
If ScriptInterrotto Then Exit Sub
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
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 = 11 Then R2 = 12
For P4 = 1 To 5
D = Estratto(Es,R2,P4)
If A > 0 And D > 0 And R1 <> R2 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 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 _
Or DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 _
Or DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 _
Or DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
'---------------------------------
If DM12 = 36 And DM23 = 9 And DM34 = 9 And DM41 = 36 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 36 And DM34 = 9 And DM41 = 9 And DM12 = 36 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 36 And DM41 = 9 And DM12 = 9 And DM23 = 36 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 36 And DM12 = 9 And DM23 = 9 And DM34 = 36 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
L(5) = Fuori90((90 + L(2)) - 9)
L(6) = Fuori90(L(3) + 18)
SommaL5L6 = Fuori90(L(5) + L(6))
Ambo1(1) = L(5) : Ambo1(2) = L(6)
Ambo2(1) = SommaL5L6 : Ambo2(2) =(L(5))
Ambo3(1) = SommaL5L6 : Ambo3(2) =(L(6))
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"00000"),1,,,1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"00000"),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
End If
Scrivi Space(22) & Format2(L(5)) & " + " & Format2(L(6)) & " = " & Format2(SommaL5L6),1,,,1
Scrivi
Scrivi Space(23) & "PRONOSTICO",1,,,2
Scrivi
Scrivi Space(21) & "1° Ambo " & Format2(L(5)) & " " & Format2(L(6)),1,,,1
Scrivi Space(21) & "2° Ambo " & Format2(SommaL5L6) & " " & Format2(L(5)),1,,,1
Scrivi Space(21) & "3° Ambo " & Format2(SommaL5L6) & " " & Format2(L(6)),1,,,1
Scrivi
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = TT_ : Ruote(4) = NZ_
ImpostaGiocata 1,Ambo1,Ruote,Po2,Clp
ImpostaGiocata 2,Ambo2,Ruote,Po2,Clp
ImpostaGiocata 3,Ambo3,Ruote,Po2,Clp
Gioca Es,1
End If
End If
End If
If ScriptInterrotto Then Exit Sub
Next
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi " Tempo Trascorso " & TempoTrascorso
End Sub