Sub main()
Dim nu1(10),nu2(10),nu3(10),nu4(10),nu(4)
Dim ruote(10),ruota(10),ru(12)
Dim poste(5),poste1(5),poste2(5),posta(5)
posta(1) = 1
poste(2) = 1
poste1(2) = 1
poste2(2) = 1
poste2(3) = 1
poste2(4) = 1
ColoreTesto 2
Scrivi String (75,"*")
ColoreTesto 1
Scrivi String(30," ")& "LE PIRAMIDI DI MATEMATICO "& String(15," "),1
Scrivi
Scrivi Now &_
Chr (32) &Chr (108)& Chr (105)& Chr (115)&Chr (116)&Chr (46)& Chr (32) & Chr (98)& Chr (121)& Chr (32) & Chr (68) & Chr (106)& Chr (78) & Chr (111) & Chr ( 109) & Chr (97)& Chr ( 100) & Chr (101),1
Scrivi String (2,Chr(11)): ColoreTesto 1
ColoreTesto 0
Scrivi String(75,"*")
ColoreTesto 0
im=CInt(InputBox("Pronostico dall'estrazione mensile numero? ( Scrivi 0=ultima estrazione mese Scrivi da 1 a 19= indice mensile Scrivi 20= ad ogni estrazione )",">",18))
r=InputBox("Qual' è la Ruota di Calcolo ","ruota di Calcolo",5)
r1=CInt(InputBox("Qual' è la 1° RUOTA DI GIOCO ","RUOTA DI GIOCO ",5))
ruot=CInt(InputBox("SCEGLI 2° RUOTA DI GIOCO ","RUOTA DI GIOCO ",6))
'r2=InputBox("Qual' è la 2° ruota di gioco ","ruota di gioco",11)
z=CInt(InputBox ("Quante estrazione controllare?","estrazioni",38))
k = CInt (InputBox("Quanti colpi di Gioco?","",12))
fin = EstrazioneFin
ini = fin - z
For es = ini To fin
If (eval(im)=0 And IsUltimaDelMese(es))Or (eval(im)>0 And IndiceMensile(es)=eval(im))Or (eval(im)=20 And es=es) Then
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)
ru(1)=r1
ru(2)=ruot
If(ruot >0 And ruot<>11)Or ruot=11 Then
If(ruot >0 And ruot<>11) Then ru(2)=ruot
If ruot=11 Then ru(1)=1:ru(2)=2:ru(3)=3:ru(4)=4:ru(5)=5:ru(6)=6:ru(7)=7:ru(8)=8:ru(9)=9:ru(10)=10: ru(11)=12
Scrivi
'Scrivi "***DjNomade***",1
t=t+1
Scrivi "------------------------------------------------------------",1
Scrivi Space(10)&riga,1
ColoreTesto 2
If (eval(im)=0 And IsUltimaDelMese(es)) Then Scrivi "--------------------------- Ultima del Mese --- Giocata n° "& Format2(t),1
If (eval(im)>0 And IndiceMensile(es)=eval(im)) Then Scrivi "--------------- "&IndiceMensile(es)&"° ESTRAZIONE del Mese Giocata n° "& Format2(t),1
If (eval(im)=20 And es=es) Then Scrivi "--------------- "&IndiceMensile(es)&"° ESTRAZIONE del Mese Giocata n° "& Format2(t),1
ColoreTesto 0
Scrivi
Scrivi
Scrivi (es)& " "& DataEstrazione(es,1)&" < "&siglaRuota(r)& " "& StringaEstratti(es,r),1
Scrivi
Scrivi
ColoreTesto 0
'*************************************
nr=(a1&a2&a3)
pir3=nr ' Assegnamo a pir il numero
Piramidiza9999 (pir3) '<------------ richiamo la Funzione
ColoreTesto 2
Scrivi "Risulatato---> "& Fuori90(pir3),1
ColoreTesto 0
Scrivi
'*************************************
nr1=(a2&a3&a4)
pir=nr1 ' Assegnamo a pir il numero
Piramidiza99 (pir) '<------------ richiamo la Funzione
ColoreTesto 2
Scrivi "Risulatato---> "& Fuori90(pir),1
ColoreTesto 0
Scrivi
'****************************************
nr2=(a3&a4&a5)
pir1=nr2 ' Assegnamo a pir il numero
Piramidiza9 (pir1) '<------------ richiamo la Funzione
ColoreTesto 2
Scrivi "Risultato---> "& Fuori90(pir1),1
ColoreTesto 0
Scrivi
'*******************************************
nr3=(a4&a5&a1)
pir2=nr3 ' Assegnamo a pir il numero
Piramidiza999 (pir2) '<------------ richiamo la Funzione
ColoreTesto 2
Scrivi "Risultato---> "& Fuori90(pir2),1
ColoreTesto 0
Scrivi
ColoreTesto 0
Scrivi String(75,"_"),1
'*******************************************
nr4=(a5&a1&a2)
pir4=nr4 ' Assegnamo a pir il numero
Piramidiza99999 (pir4) '<------------ richiamo la Funzione
ColoreTesto 2
Scrivi "Risultato---> "& Fuori90(pir4),1
ColoreTesto 0
Scrivi
ColoreTesto 1
Scrivi String(75,"_"),1
nu1(1) = Fuori90(pir3)
nu1(2) = Fuori90(pir)
nu1(3) = Fuori90(pir1)
nu1(4) = Fuori90(pir2)
nu1(5) = Fuori90(pir4)
ImpostaGiocata 1,nu1,ru,poste2,k
Gioca es
End If
End If
Next
ScriviResoconto
End Sub
'Functio Aggiuntiva
Dim pir3
Function Piramidiza9999 (piramide)
s=0
lun = Len(Pir3)
Piramide=pir3
Scrivi "Piramide a - 9" ' visuallizare a video la piramide
Scrivi Piramide,1 ' visuallizare a video la piramide
Do Until lun < 3
For i = 1 To Len(Piramide) - 1
vt1 = CInt(Mid(Piramide, i, 1)) + CInt(Mid(Piramide, i + 1, 1))
If vt1 > 9 Then vt1 = vt1 - 9
vatmp = vatmp & vt1
Next
Piramide = vatmp
s=s+1
Scrivi String (s," ") & piramide,1 ' visuallizare a video la piramide
lun = Len(vatmp)
vatmp = ""
Loop
pir3= (piramide)
End Function
'Functio Aggiuntiva
Dim pir
Function Piramidiza99 (piramide)
s=0
lun = Len(Pir)
Piramide=pir
Scrivi "Piramide a - 9" ' visuallizare a video la piramide
Scrivi Piramide,1 ' visuallizare a video la piramide
Do Until lun < 3
For i = 1 To Len(Piramide) - 1
vt1 = CInt(Mid(Piramide, i, 1)) + CInt(Mid(Piramide, i + 1, 1))
If vt1 > 9 Then vt1 = vt1 - 9
vatmp = vatmp & vt1
Next
Piramide = vatmp
s=s+1
Scrivi String (s," ") & piramide,1 ' visuallizare a video la piramide
lun = Len(vatmp)
vatmp = ""
Loop
pir= (piramide)
End Function
'Functio Aggiuntiva
Dim pir1
Function Piramidiza9 (piramide)
s=0
lun = Len(Pir1)
Piramide=pir1
Scrivi "Piramide a - 9" ' visuallizare a video la piramide
Scrivi Piramide,1 ' visuallizare a video la piramide
Do Until lun < 3
For i = 1 To Len(Piramide) - 1
vt1 = CInt(Mid(Piramide, i, 1)) + CInt(Mid(Piramide, i + 1, 1))
If vt1 > 9 Then vt1 = vt1 - 9
vatmp = vatmp & vt1
Next
Piramide = vatmp
s=s+1
Scrivi String (s," ") & piramide,1 ' visuallizare a video la piramide
lun = Len(vatmp)
vatmp = ""
Loop
pir1=(piramide)
End Function
'Functio Aggiuntiva
Dim pir2
Function Piramidiza999(piramide)
s=0
lun = Len(Pir2)
Piramide=pir2
Scrivi "Piramide a - 9" ' visuallizare a video la piramide
Scrivi Piramide,1 ' visuallizare a video la piramide
Do Until lun < 3
For i = 1 To Len(Piramide) - 1
vt1 = CInt(Mid(Piramide, i, 1)) + CInt(Mid(Piramide, i + 1, 1))
If vt1 > 9 Then vt1 = vt1 - 9
vatmp = vatmp & vt1
Next
Piramide = vatmp
s=s+1
Scrivi String (s," ") & piramide,1 ' visuallizare a video la piramide
lun = Len(vatmp)
vatmp = ""
Loop
pir2=Fuori90 (piramide)
End Function
'Functio Aggiuntiva
Dim pir4
Function Piramidiza99999(piramide)
s=0
lun = Len(Pir4)
Piramide=pir4
Scrivi "Piramide a - 9" ' visuallizare a video la piramide
Scrivi Piramide,1 ' visuallizare a video la piramide
Do Until lun < 3
For i = 1 To Len(Piramide) - 1
vt1 = CInt(Mid(Piramide, i, 1)) + CInt(Mid(Piramide, i + 1, 1))
If vt1 > 9 Then vt1 = vt1 - 9
vatmp = vatmp & vt1
Next
Piramide = vatmp
s=s+1
Scrivi String (s," ") & piramide,1 ' visuallizare a video la piramide
lun = Len(vatmp)
vatmp = ""
Loop
pir4=Fuori90 (piramide)
End Function
'Funzione realizzata dal bravissimo Joe
Function IsUltimaDelMese (idEstr)
Dim sData , sDataNew
Dim idGiornoSettimana
Dim gMancanti
Dim nMeseCorr
sData = Replace(DataEstrazione(idEstr) , "." , "/")
nMeseCorr = Month(sData)
idGiornoSettimana = WeekDay (sData)
Select Case idGiornoSettimana
Case vbTuesday ' martedi
gMancanti =2
Case vbThursday ' giovedi
gMancanti = 1
Case vbFriday ' venerdi ' non c'era
gMancanti = 1 ' non c'era
Case vbSaturday ' sabato
gMancanti = 3
End Select
sDataNew = DateAdd( "d" , gMancanti ,sData)
If Month (sDataNew) <> nMeseCorr Then
IsUltimaDelMese = True
Else
IsUltimaDelMese = False
End If
End Function
