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.
Option Explicit
Sub Main
Dim Fig1,Fig2,Fig3,Fig4,FIn,Ini,Clp
Dim R1,R2,P1,P2,P3,P4,P5,P6,Es,Caso,Casi
Dim E1,E2,A,B,C,D,FA,FB,FC,FD,Sp,Sorte
Dim RetEsito,RetColpi,RetEstratti,RetId
Dim Ruote(2),Ru(2),Post(5)
ReDim aNum1(10),aNum2(10)
'Post(1) = 1
Post(2) = 1
Post(3) = 1
'Post(4) = 1
'Post(5) = 1
Sp = " "
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9000)
P1 = CInt(InputBox(" Indica la posizione del primo estratto della prima ruota",,1))
Fig1 = CInt(InputBox(" Indica la figura che deve avere il primo estratto della prima ruota",,1))
'
P2 = CInt(InputBox(" Indica la posizione del secondo estratto della prima ruota",,3))
Fig2 = CInt(InputBox(" Indica la figura che deve avere il secondo estratto della prima ruota",,2))
'
P3 = CInt(InputBox(" Indica la posizione del primo estratto della seconda ruota",,4))
Fig3 = CInt(InputBox(" Indica la figura che deve avere il primo estratto della seconda ruota",,8))
'
P4 = CInt(InputBox(" Indica la posizione del secondo estratto della seconda ruota",,2))
Fig4 = CInt(InputBox(" Indica la figura che deve avere il secondo estratto della seconda ruota",,7))
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare? ",,5))
'Sorte = CInt(InputBox(" Per qualè sorte? 1 per Ambata, 2 per Ambo, ecc... ",,3))
Call ScegliNumeri(aNum1)
Call ScegliNumeri(aNum2)
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(12) & " CHIESTO DA KUBES - SCELTA FIGURE E POSIZIONI ESTRATTI - SCRIPT SALVO50",1,,4,,3,,1
For Es = Ini To FIn
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 10
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
FA = Figura(A) : FB = Figura(B)
If Fig1 = FA And Fig2 = FB Then
For R2 = R1 + 1 To 12
C = Estratto(Es,R2,P3)
D = Estratto(Es,R2,P4)
FC = Figura(C) : FD = Figura(D)
If Fig3 = FC And Fig4 = FD Then
Ru(1) = R1
Ru(2) = R2
'Ru(3) = TU_
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
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 " <--in Rosso Figure scelte " & FA & " " & FB,1
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 " <--in Rosso Figure scelte " & FC & " " & FD,1
Scrivi
Scrivi " Numeri scelti per 1ª Giocata " & StringaNumeri(aNum1,Sp,True),1,,,1
Scrivi " Numeri scelti per 2ª Giocata " & StringaNumeri(aNum2,Sp,True),1,,,2
Scrivi
ImpostaGiocata 1,aNum1,Ru,Post,Clp
ImpostaGiocata 2,aNum2,Ru,Post,Clp
Gioca Es,,,1
End If
Next
End If
Next
Next
ScriviResoconto
End Sub
Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp,Salvo50,K,G
Dim R1,R2,P1,P2,P3,P4,E1,E2,Caso,Casi
Dim Somma,A,B,C,D,Sorte,S1,S2,Idestr
Dim RetEsito,RetColpi,RetEstratti,RetId
Dim Ruo(2)
ReDim aNum(20)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9100))
Somma = CInt(InputBox("Inserisci la Somma comune da trovare",Salvo50,15))
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,18))
Call ScegliNumeri(aNum)
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(6) & "PER BYRON 2 SOMME UGUALI PER LUNGHETTA - SCRIPT SALVO50 con l'aiuto di MASTER",1,,4,,3,,1
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
C = Estratto(Es,R2,P1)
D = Estratto(Es,R2,P2)
S1 = Fuori90(A + B) : S2 = Fuori90(C + D)
If(S1 = S2 And S1 = Somma) Then
Ruo(1) = R1
Ruo(2) = R2
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 P3 = 1 To 5
E1 = Estratto(Es,R1,P3)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi " <-- Rossi somma " & S1,1
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P4 = 1 To 5
E2 = Estratto(Es,R2,P4)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi " <-- Rossi somma " & S2,1
Scrivi
Scrivi " In gioco [ " & StringaNumeri(aNum) & " ]",1
Scrivi
K = 0
G = Es + Clp
If G > FIn Then G = FIn
For Idestr = Es + 1 To G
K = K + 1
Call VerificaEsito(aNum,Ruo,Idestr,1,1,Nothing,RetEsito,RetColpi,RetEstratti,RetId)
ColoreTesto 0
If RetEsito = "" Then Scrivi Idestr & " - " & Format2(K) & "° - " & Space(33) & " ESITO NON VERIFICATO ",1,,,1
If RetEsito <> "" Then
If RetEsito = "Ambo" Then ColoreTesto 2
If RetEsito = "Terno" Then ColoreTesto 1
If RetEsito = "Quaterna" Then ColoreTesto 7
If RetEsito = "Cinqina" Then ColoreTesto 3
Call Scrivi(Idestr & " - " & Format2(K) & "° - " & RetEstratti & " - " & RetEsito & " " & vbTab & GetInfoEstrazione(RetId),1)
ColoreTesto 0
End If
Next
Scrivi
End If
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
End Sub
Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp,Salvo50,K,G
Dim R1,R2,P1,P2,P3,P4,E1,E2,Caso,Casi
Dim Dist,A,B,C,D,Sorte,D1,D2,Idestr
Dim RetEsito,RetColpi,RetEstratti,RetId
Dim Ruo(2)
ReDim aNum(20)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9100))
Dist = CInt(InputBox("Inserisci la Distanza Ciclometrica da trovare",Salvo50,15))
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,18))
Call ScegliNumeri(aNum)
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi "PER BYRON 2 DISTANZE CICLOMETRICHE UGUALI PER LUNGHETTA - SCRIPT SALVO50 con l'aiuto di Master",1,,4,,3,,1
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
C = Estratto(Es,R2,P1)
D = Estratto(Es,R2,P2)
D1 = Distanza(A,B) : D2 = Distanza(C,D)
If(D1 = D2 And D1 = Dist) Then
Ruo(1) = R1
Ruo(2) = R2
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 P3 = 1 To 5
E1 = Estratto(Es,R1,P3)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi " <-- Rossi Distanza " & D1,1
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P4 = 1 To 5
E2 = Estratto(Es,R2,P4)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi " <-- Rossi Distanza " & D2,1
Scrivi
Scrivi " In gioco [ " & StringaNumeri(aNum) & " ]",1
Scrivi
K = 0 : G = 0
G = Es + Clp
If G > FIn Then G = FIn
For Idestr = Es + 1 To G
K = K + 1
Call VerificaEsito(aNum,Ruo,Idestr,1,1,Nothing,RetEsito,RetColpi,RetEstratti,RetId)
ColoreTesto 0
If RetEsito = "" Then Scrivi Idestr & " - " & Format2(K) & "° - " & Space(30) & " ESITO NON VERIFICATO ",1,,,1
If RetEsito <> "" Then
If RetEsito = "Ambo" Then ColoreTesto 2
If RetEsito = "Terno" Then ColoreTesto 1
If RetEsito = "Quaterna" Then ColoreTesto 7
If RetEsito = "Cinqina" Then ColoreTesto 3
Call Scrivi(Idestr & " - " & Format2(K) & "° - " & RetEstratti & " - " & RetEsito & " " & vbTab & GetInfoEstrazione(RetId),1)
ColoreTesto 0
End If
Next
End If
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
End Sub
BYRON;n2174245 ha scritto:Non volgio solo un grazie ti prego contattami in privato è giusto una ricompensa