Option Explicit
Class clsGiocata
Private m_Posta
Private m_Ruote
Private m_Numeri
Private m_Sorte
Private m_SorteInterruzione
Private m_Attesa
Private m_Id
Private m_GiocateDaInterrompere
Private m_Durata
Private m_MotivoInterruzione
Sub Class_Initialize
' codice
End Sub
Sub Class_Terminate
' codice
End Sub
Public Property Get Posta
Posta = m_Posta
End Property
Public Property Let Posta(NewValue)
m_Posta = NewValue
End Property
Public Property Get Ruote
Ruote = m_Ruote
End Property
Public Property Let Ruote(NewValue)
m_Ruote = NewValue
End Property
Public Property Get Numeri
Numeri = m_Numeri
End Property
Public Property Let Numeri(NewValue)
m_Numeri = NewValue
End Property
Public Property Get Sorte
Sorte = m_Sorte
End Property
Public Property Let Sorte(NewValue)
m_Sorte = NewValue
End Property
Public Property Get SorteInterruzione
SorteInterruzione = m_SorteInterruzione
End Property
Public Property Let SorteInterruzione(NewValue)
m_SorteInterruzione = NewValue
End Property
Public Property Get Attesa
Attesa = m_Attesa
End Property
Public Property Let Attesa(NewValue)
m_Attesa = NewValue
End Property
Public Property Get Durata
Durata = m_Durata
End Property
Public Property Let Durata(NewValue)
m_Durata = NewValue
End Property
Public Property Get Id
Id = m_Id
End Property
Public Property Let Id(NewValue)
m_Id = NewValue
End Property
Public Property Get GiocateDaInterrompere
GiocateDaInterrompere = m_GiocateDaInterrompere
End Property
Public Property Let GiocateDaInterrompere(NewValue)
m_GiocateDaInterrompere = NewValue
End Property
Public Property Get MotivoInterruzione
MotivoInterruzione = m_MotivoInterruzione
End Property
Public Property Let MotivoInterruzione(NewValue)
m_MotivoInterruzione = NewValue
End Property
Function GetSommaPoste()
Dim k,t
t = 0
For k = 1 To UBound(m_Posta)
t = t + m_Posta(k)
Next
GetSommaPoste = t
End Function
Function IsSorteVincente(nSorte)
Dim k
For k = nSorte To 1 Step - 1
If k <= UBound(m_Posta) Then
If m_Posta(k) > 0 Then
IsSorteVincente = True
Exit For
End If
End If
Next
End Function
Function QuantitaNumeri
QuantitaNumeri = UBound(m_Numeri)
End Function
Function QuantitaRuote
QuantitaRuote = UBound(m_Ruote)
End Function
Function GetStringaRuote
Dim s,k
s = ""
For k = 1 To UBound(m_Ruote)
s = s & SiglaRuota(m_Ruote(k)) & "."
Next
GetStringaRuote = RimuoviLastChr(s,".")
End Function
Function GetStringaSorte
Dim s,k
s = ""
For k = 1 To UBound(m_Posta)
If m_Posta(k) > 0 Then
s = s & Left(NomeSorte(k),1) & "/"
End If
Next
GetStringaSorte = RimuoviLastChr(s,"/")
End Function
End Class
Dim collGiocate
Dim nSpesaTotale
Dim nVincitaTot
Dim aPuntiPerRuota
Dim nBolletteGioc,nBolletteVinc,nCasi,nPrimaGioc,nUltimaGioc, aAndamento , aSpesa , aVincita
Const cInterrottaEsitoVerificato = 1
Const cInterrottaRaggiuntaDurata = 2
Const cInterrottaAltraCombVerificata = 3
Function IsCollection(coll)
On Error Resume Next
If coll.count >= 0 Then
IsCollection = True
End If
If Err <> 0 Then
IsCollection = False
End If
End Function
Sub MyImpostaGiocata(id,aNumeri,aRuote,aPoste,Durata,SorteInterr,Attesa,GiocateDaInterr)
Dim clsGioc
If IsCollection(collGiocate) = False Then
Set collGiocate = GetNewCollection
End If
If IsEmpty(aPuntiPerRuota) Then
ReDim aPuntiPerRuota(11,5)
ReDim aAndamento (0)
ReDim aSpesa (0)
ReDim aVincita (0)
nBolletteGioc = 0
nBolletteVinc = 0
nPrimaGioc = 0
nUltimaGioc = 0
nCasi = 0
nSpesaTotale = 0
nVincitaTot = 0
End If
Set clsGioc = New clsGiocata
clsGioc.id = id
clsGioc.Numeri = aNumeri
clsGioc.Ruote = aRuote
clsGioc.Posta = aPoste
clsGioc.Durata = Durata
clsGioc.Attesa = Attesa
clsGioc.SorteInterruzione = Iif(SorteInterr > 0,SorteInterr,100)
clsGioc.GiocateDaInterrompere = GiocateDaInterr
clsGioc.MotivoInterruzione = 0
collGiocate.Add clsGioc
End Sub
Sub MyGioca(idEstr)
Dim clsGioc
Dim nColpi
Dim nMaxEstr
Dim idEstrTmp
Dim bAlmenoUnaTrovata
nMaxEstr = EstrazioniArchivio
nColpi = 0
Call Scrivi("Estrazione generatrice del pronostico : " & GetInfoEstrazione(idEstr))
nCasi = nCasi + 1
If nPrimaGioc = 0 Then nPrimaGioc = idEstr
nUltimaGioc = idEstr
For idEstrTmp = idEstr + 1 To nMaxEstr
nColpi = nColpi + 1
bAlmenoUnaTrovata = False
For Each clsGioc In collGiocate
If clsGioc.MotivoInterruzione = 0 Then
bAlmenoUnaTrovata = True
If nColpi > clsGioc.Attesa Then
If nColpi <= clsGioc.Durata Then
Call EseguiGiocata(clsGioc,idEstrTmp,nColpi)
If clsGioc.MotivoInterruzione <> 0 Then
Call ScriviMotivoInterruzione(clsGioc.MotivoInterruzione)
Exit For
End If
Else
clsGioc.MotivoInterruzione = cInterrottaRaggiuntaDurata
Call ScriviMotivoInterruzione(clsGioc.MotivoInterruzione)
Exit For
End If
End If
End If
Next
If bAlmenoUnaTrovata = False Then Exit For
For Each clsGioc In collGiocate
If clsGioc.MotivoInterruzione <> 0 Then
Call InterrompiGiocateCollegate(clsGioc.GiocateDaInterrompere)
End If
Next
Next
ReDim Preserve aAndamento (nCasi)
ReDim Preserve aSpesa (nCasi)
ReDim Preserve aVincita(nCasi)
aAndamento (nCasi) = nVincitaTot - nSpesaTotale
aSpesa (nCasi) = nSpesaTotale
aVincita(nCasi) = nVincitaTot
Set collGiocate = Nothing
End Sub
Sub EseguiGiocata(clsGioc,idEstr,nColpo)
nSpesaTotale = nSpesaTotale + clsGioc.GetSommaPoste
ReDim aNumeriEstrazione(0)
Dim abNum
Dim k,r,e,nPunti,nQComb
Dim ruota,sRuota
Dim sRigaOutput,sRigaOutputTmp
Dim sRigaEstratti
Dim aRuote,aPoste
nBolletteGioc = nBolletteGioc + 1
sRigaOutput = FormatSpace(StringaNumeri(clsGioc.numeri),30) & " su " & FormatSpace(clsGioc.GetStringaRuote,30) & " per " & FormatSpace(clsGioc.GetStringaSorte,30)
sRigaOutput = sRigaOutput & " Colpo : " & FormatSpace(nColpo,6,True) & " "
Call GetEstrazioneCompleta(idEstr,aNumeriEstrazione)
abNum = ArrayNumeriToBool(clsGioc.Numeri)
aRuote = clsGioc.ruote
aPoste = clsGioc.Posta
For r = 1 To UBound(aRuote)
nPunti = 0
ruota = aRuote(r)
sRuota = SiglaRuota(ruota)
If ruota = 12 Then ruota = 11
sRigaEstratti = ""
For e = 1 To 5
If abNum(aNumeriEstrazione(ruota,e)) Then
nPunti = nPunti + 1
sRigaEstratti = sRigaEstratti & Format2(aNumeriEstrazione(ruota,e)) & "."
Else
sRigaEstratti = sRigaEstratti & "__" & "."
End If
Next
If clsGioc.IsSorteVincente(nPunti) Then
nBolletteVinc = nBolletteVinc + 1
sRigaOutput = sRigaOutput & " [" & sRuota & " " & sRigaEstratti & "] (" & NomeSorte(nPunti) & ") "
For k = nPunti To 1 Step - 1
If k <= UBound (aPoste) Then
If aPoste(k) > 0 Then
nQComb = Combinazioni(nPunti,k)
aPuntiPerRuota(ruota,k) = aPuntiPerRuota(ruota,k) + nQComb
nVincitaTot = nVincitaTot + nQComb * GetPremioLotto(clsGioc.QuantitaNumeri,k,clsGioc.QuantitaRuote,False) * aPoste(k)
End If
End If
Next
If nPunti >= clsGioc.SorteInterruzione Then
clsGioc.MotivoInterruzione = cInterrottaEsitoVerificato
End If
Call Scrivi(sRigaOutput,True,,,vbRed)
Else
Call Scrivi(sRigaOutput)
End If
Next
End Sub
Sub InterrompiGiocateCollegate(GiocateDaInterrompere)
Dim clsG,k
If IsArray(GiocateDaInterrompere) Then
For k = 1 To UBound(GiocateDaInterrompere)
For Each clsG In collGiocate
If clsG.MotivoInterruzione = 0 Then
If clsG.ID = GiocateDaInterrompere(k) Then
clsG.MotivoInterruzione = cInterrottaAltraCombVerificata
End If
End If
Next
Next
Else
If(GiocateDaInterrompere) <> 0 Then
For Each clsG In collGiocate
If clsG.MotivoInterruzione = 0 Then
clsG.MotivoInterruzione = cInterrottaAltraCombVerificata
End If
Next
End If
End If
End Sub
Sub ScriviMotivoInterruzione(Codice)
Select Case Codice
Case cInterrottaEsitoVerificato
Call Scrivi("Interrotta per esito verificato")
Case cInterrottaRaggiuntaDurata
Call Scrivi("Interrotta per raggiunta durata")
Case cInterrottaAltraCombVerificata
Call Scrivi("Interrotta per esito verificato su giocata collegata")
End Select
End Sub
Sub MyScriviResoconto
Dim nTempomedioRilev
Dim r , ruota , e
nTempomedioRilev = Dividi((nUltimaGioc -(nPrimaGioc - 1)),nCasi)
Call Scrivi
Call Scrivi
Call Scrivi(FormatSpace("Casi esaminati ",30) & " : " & nCasi)
Call Scrivi(FormatSpace("Prima estrazione generatrice ",30) & " : " & nPrimaGioc)
Call Scrivi(FormatSpace("Ultima estrazione generatrice ",30) & " : " & nUltimaGioc)
Call Scrivi(FormatSpace("Tempo medio rilevamento ",30) & " : " & nTempomedioRilev)
Call Scrivi(FormatSpace("Capitale speso ",30) & " : " & nSpesaTotale )
Call Scrivi(FormatSpace("Vincita ",30) & " : " & nVincitaTot )
Call Scrivi(FormatSpace("Guadagno ",30) & " : " & nVincitaTot - nSpesaTotale )
Call Scrivi
ReDim aT(6)
aT(1)= "Ruota"
aT(2)= "Estratto"
aT(3)= "Ambo"
aT(4)= "Terno"
aT(5)= "Quaterna"
aT(6) = "Cinquina"
Call InitTabella (aT)
For r = 1 To 11
If r =11 Then
ruota = 12
Else
ruota = r
End If
aT (1) = NomeRuota(ruota)
For e = 1 To 5
aT(e +1) = aPuntiPerRuota(r,e)
Next
Call AddRigaTabella( aT )
Next
Call CreaTabella
Call Scrivi
DisegnaGrafico
End Sub
Sub LeggiValoriPerGrafico (aValori , aValoriDaleggere)
Dim k
ReDim aValori ( nCasi , 2)
For k = 1 To nCasi
aValori (k ,1) = k
aValori(k,2) = aValoriDaleggere(k)
Next
End Sub
Function GetDivisorePreGrafico (nValore)
Dim nDivisore
If nValore > 0 And nValore <= 10 Then
nDivisore = 1
ElseIf nValore >10 And nValore <= 100 Then
nDivisore = 10
ElseIf nValore >100 And nValore <= 1000 Then
nDivisore = 100
ElseIf nValore >1000 And nValore <= 10000 Then
nDivisore = 1000
Else
nDivisore = nValore / 4
End If
GetDivisorePreGrafico = nDivisore
End Function
Sub DisegnaGrafico
Dim nValMax , nValMin
ReDim aValori (0)
Dim nDivisore
If nSpesaTotale > nVincitaTot Then
nValMax = nSpesaTotale
Else
nValMax = nVincitaTot
End If
nValMin = MinimoV(aAndamento ) -100
If nValMin > 0 Then
nValMin =0
Else
nValMin = nValMin -1
End If
Call PreparaGrafico ( "",0 ,nCasi ,nValMin , nValMax ,nCasi /10 , (nValMax +Abs(nValMin)) / 10)
Call LayOutGrafico ( vbBlue , RGB(239,239,239), vbBlue ,"Casi" , "Euro")
Call LeggiValoriPerGrafico (aValori , aAndamento)
Call DisegnaLineaGrafico (aValori ,vbMagenta , "Andamento economico")
Call LeggiValoriPerGrafico (aValori , aSpesa)
Call DisegnaLineaGrafico (aValori ,vbRed , "Spesa")
Call LeggiValoriPerGrafico (aValori , aVincita)
Call DisegnaLineaGrafico (aValori ,vbGreen , "Vincita")
Call InserisciGrafico
End Sub
Sub Main
ReDim aPoste(1)
ReDim aNum(1)
Dim k
' GIOCO SU BARI PER ESTRATTO
ReDim aRuote(1)
aRuote(1) = BA_
For k = 4000 To 8000 Step 300
ReDim aPoste(1)
ReDim aNum(1)
aPoste(1) = 1
' La prima giocata è il numero 45 , non ha sorte interruzione e non ha giocate collegate da interrompere , dura per 300 colpi
aNum(1) = 45
Call MyImpostaGiocata(1,aNum,aRuote,aPoste,300, 0,0,0 )
' La seconda giocata è il numero 90 , ha sorte interruzione e appena esce l'esito si interrompono tutte le giocate in corso e le i stessa
' anche questa duura 300 colpi ma si interrompe alla sorte verificata
aNum(1) = 90
Call MyImpostaGiocata(2,aNum,aRuote,aPoste,300,1,0,1)
ReDim aNum(2)
aNum(1) = 45
aNum(2) = 90
ReDim aPoste (2)
aPoste(2) =1
Call MyImpostaGiocata(3,aNum,aRuote,aPoste,300,2,0,1)
' gioco all'estrazione 8000
Call MyGioca(k)
Next
Call MyScriviResoconto
End Sub
Cordiali saluti
a quanto pare questo blocco di 255 colpi non bisogna sorpassarlo nemmeno in via 
Ciao 
