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.
Sub main()
Dim k
Dim r
Dim e
Dim nGioc
Dim aNum(1)
Dim aRuote(1)
Dim aPoste(1)
Dim TotEstr
aNum(1)= 5
aPoste(1) = 1
TotEstr = 8188
For k = 8088 To 8188
For r = 1 To 12
If r <> 11 then 'non su tutte then
For e = 1 To 5
If Estratto (k ,r,e) = aNum(1) Then
ngioc = ngioc +1
aRuote(1) = r
Call ImpostaGiocata (nGioc , aNum ,aRuote,aPoste,5,1)
Call Gioca (k)
Exit for
End If
Next
End If
Next
Call AvanzamentoElab(1,TotEstr,k)
Next
Call ScriviResoconto
End Sub
03.06.2004 Naz 00 1° estr. rilevato --> [00]
29.05.2004 Naz 00 Somma rilevata --> [90]
Estrazione generatrice del pronostico 07345 [ 44 - 03/06/2004]
G 0001
Numeri in gioco : 09.45 su NZ per Estratto,Ambo
N. [09.45 ] [NZ] [.. .. .. .. ..] C. 1 07346 [ 45 - 05/06/2004]
N. [09.45 ] [NZ] [.. .. .. .. ..] C. 2 07347 [ 46 - 09/06/2004]
N. [09.45 ] [NZ] [.. .. .. .. ..] C. 3 07348 [ 47 - 12/06/2004]
Interrotta per raggiunta durata
G 0002
Numeri in gioco : 09.45 su TT per Ambo
N. [09.45 ] [TT] [ ][.. .. .. .. ..] C. 1 07346 [ 45 - 05/06/2004]
N. [09.45 ] [TT] [BA][.. .. 09 .. ..] C. 2 Estratto 07347 [ 46 - 09/06/2004]
N. [09.45 ] [TT] [GE][.. .. .. .. 09] C. 3 Estratto 07348 [ 47 - 12/06/2004]
Interrotta per raggiunta durata
*********************************************************
*********************************************************
05.06.2004 Naz 00 1° estr. rilevato --> [00]
03.06.2004 Naz 00 Somma rilevata --> [90]
Estrazione generatrice del pronostico 07346 [ 45 - 05/06/2004]
G 0001
Numeri in gioco : 09.45 su NZ per Estratto,Ambo
N. [09.45 ] [NZ] [.. .. .. .. ..] C. 1 07347 [ 46 - 09/06/2004]
N. [09.45 ] [NZ] [.. .. .. .. ..] C. 2 07348 [ 47 - 12/06/2004]
N. [09.45 ] [NZ] [.. .. .. .. ..] C. 3 07349 [ 48 - 16/06/2004]
Interrotta per raggiunta durata
Sub Main()
Dim num(5)
Dim ruote(10)
Dim ruot(1)
Dim poste(2)
Dim post(2)
poste(1) = 1
poste(2) = 1
post(2)=1
tmp=InputBox("Quante estrazioni controllo?",,0)
clp=CInt(InputBox("Per quanti colpi?",,3))
fin=EstrazioneFin
ini=fin-tmp
For es=ini To fin
For r=12 To 12
Messaggio "Elaborazione ruota di "&NomeRuota(r)& " Estrazione del " &DataEstrazione(es)
a1=Estratto(es,r,1)
a2=Estratto(es,r,2)
a3=Estratto(es,r,3)
a4=Estratto(es,r,4)
a5=Estratto(es,r,5)
a6=Estratto(es-1,r,1)
a7=Estratto(es-1,r,2)
a8=Estratto(es-1,r,3)
a9=Estratto(es-1,r,4)
a10=Estratto(es-1,r,5)
aa4=Fuori90(a6+a7+a8+a9+a10)
If a1=90-aa4 Then
Scrivi DataEstrazione(es)&" "&Left(NomeRuota(r),3)& " " &StringaEstratti(es,r)&_
" 1° estr. rilevato --> ["&Format2(a1)&"]",1
Scrivi DataEstrazione(es-1)& " "& Left(NomeRuota(r),3)& " "& StringaEstratti(es-1,r)&_
" Somma rilevata --> ["&Format2(aa4)&"]",1
ruote(1) = r
ruot(1) = 11
num(1) = Vert(a1)
num(2) = Diametrale(a1)
ImpostaGiocata 1,num,ruote,poste,clp
ImpostaGiocata 2,num,ruot,post,clp
Gioca es
Scrivi"*********************************************************"
Scrivi"*********************************************************"
End If
Next
Next
ScriviResoconto
End Sub
Option Explicit
Sub Main()
'rif. 0902_83a Ro - Ripetuti sul quadro esteso - a ruota
'visualizza il quadro esteso con colorazione dei numeri ripetuti in una frequenza scelta
Dim Vet(),stat(),temp(),nu(),max(12)
Dim fin,estr,Ini,r,es,f,n,p,x,y,i,cu,maxcu,co,riga,rigo,t,u,cl,m,s
Dim sTmpRiga , nTmpColor
fin = EstrazioneFin -(InputBox("Quante es vuoi andare indietro rispetto a Estrazionefin?",,100))
estr = InputBox("Su quante estrazioni vuoi cercare i ripetuti?",,12)
f = CInt(InputBox("Quale frequenza devono avere i ripetuti?",,2)) 'se vuoi con freq maggiori metti l'apice
' davanti a f e sostituisci la riga dove tovi questo segno<<<<<<<<<<<<<<<
Ini = fin -(estr - 1)
ReDim vet(0)
ReDim stat(2,0)
ReDim temp(0)
ReDim nu(12,0)
For r = 1 To 12
If r <> 11 Then nu(r,0) = r
Next
'-----------------------------
For r = 1 To 11
If r = 11 Then r = 12
Erase vet
Erase stat
ReDim vet(estr*5)
n = 0
For es = Ini To fin
For p = 1 To 5
n = n + 1
vet(n) = Estratto(es,r,p)
Next
Next
'------------------------
OrdinaMatrice vet,1
x = UBound(vet)
ReDim stat(2,0)
For i = 1 To x
If vet(i) > vet(i - 1) Then
co = co + 1
ReDim Preserve stat(2,co)
stat(1,co) = vet(i)
stat(2,co) = 1
For y = i + 1 To x
If vet(i) = vet(y) Then stat(2,co) = stat(2,co) + 1
Next
End If
Next
'------------------------
cu = 0
ReDim temp(0)
For i = 1 To co
If stat(2,i) = 2 Then ' <<<<<<<<<< sostituisci con questa If stat(2,i)=> 2 Then
cu = cu + 1
ReDim Preserve temp(cu)
If cu > maxcu Then maxcu = cu
temp(cu) = stat(1,i)
End If
Next
max(r) = cu
ReDim Preserve nu(12,maxcu)
For i = 1 To cu
nu(r,i) = temp(i)
Next
Next
'--------------------------------------
Scrivi Chr(10) & " QUADRO ESTESO DEI NUMERI RIPETUTI ",1,0
ColoreTesto 2
Scrivi "--> " & f & " <-- ",1,0
ColoreTesto 0
Scrivi " VOLTE SU RUOTA UNICA " & Chr(10),1
Scrivi Space(4) & "Ru - Ripetuti ",1
riga = FormattaTesto("Data",Space(10),2)
For r = 1 To 12
'If max(r) > 0 Then riga = riga & Space(6) & SiglaRuota(r) & Space(7)
If max(r) > 0 Then riga = riga & FormattaTesto(SiglaRuota(r),Space(15),2)
rigo = ""
If max(r) > 0 Then
rigo = Space(4) & SiglaRuota(nu(r,0)) & Space(2)
For t = 1 To max(r)
rigo = rigo & " " & Format2(nu(r,t))
Next
u = u + 1
End If
If rigo <> "" Then Scrivi rigo
Next
If u > 0 Then
Scrivi
Scrivi riga,1
For es = Ini To fin
'ColoreTesto 0
'Call Scrivi(DataEstrazione(es),0,0)
sTmpRiga = DataEstrazione(es)
For r = 1 To 11
If r = 11 Then
r = 12
End If
If max(r) > 0 Then
'ColoreTesto 0
'Scrivi "|",0,0
sTmpRiga = sTmpRiga & "|"
If Not pari(r) Or r = 12 Then
cl = "#FF0000" ' rosso
Else
cl = "#0000FF" ' blue
End If
For p = 1 To 5
For m = 1 To max(r)
'ColoreTesto 0
nTmpColor ="#000000"
If Estratto(es,r,p) = nu(r,m) Then
'ColoreTesto cl
nTmpColor = cl
Exit For
End If
Next
If p < 5 Then s = " " Else s = ""
sTmpRiga = sTmpRiga & GetTestoColorato (Format2(Estratto(es,r,p)) , nTmpColor ) & s
'Call Scrivi(Format2(Estratto(es,r,p)) & s,1,0)
Next
'If r = 12 And p = 6 Or r = u And p = 6 Then Scrivi Chr(13)
'If r = 12 And p = 6 Then Scrivi Chr(13)
End If
Next
Call Scrivi (sTmpRiga)
Next
End If
ColoreTesto 2
If u = 0 Then Scrivi Chr(10) & " Nessun ripetuto con i parametri impostati "
If u > 0 And u < 11 Then
Scrivi Chr(10) & "NB: le ruote prive di " & f & " ripetuti, non vengono visualizzate"
End If
End Sub
Function FormattaTesto(sValue,sFmt,nAllineamento)
' nAllineamento
' 0 = allinea a sinistra
' 1 = allinea a destra
' 2 = allinea al centro
Dim k
Dim nSpSx,nSpDx,nLen
If sValue <> "" Then
If Len(
quote:Originally posted by LuigiB
Ciao mike , sinceramente non ho toccato niente che possa compromettere quella funzione ...non credo che ci siano dei bug all'epoca quando l'avevo testata dava gli stessi output di visual lotto.
Ho l'impressione che alcune funzioni del programa dato la mancanza dell'help non siano chiare lasciando spazio a equivoci ...
quote:Originally posted by LuigiB
e' vero Mike ora che mi hai dato un indizio in piu sono riuscito a correggere un errore che era capitato proprio per il motivo che
sospettavi ovvero le modifiche per la ricerca con gli ambi.
Nella prossima versioen sara corretto.
Ciao