i legend
Premium Member
ciao luigi Grazie Mille Dopo provo ad aggiornare da mio fratello
se non mi e possibile e ci fosse un altra possibilita grazie
allora vediamo se ho capito bene
idFiltro e quantita incrementi lo passo direttamente nella sub cosi scrivo una volta sola volta i parametri nella sub main
cosi ho risolto tutti i punti?
altrimenti li passo alla funzione in questa maniera
isCondizioneRispettata(idFiltro,qIncrRitMax)
Ciao sei mitico come prof
se non mi e possibile e ci fosse un altra possibilita grazie
Codice:
Option Explicit
Class clsLunghetta
Private aNumeri ' contiene i numeri della lunghetta
Private mInizio,mFine,aRuote,mSorte ' parametri per il range analisi
Private mClasse ' contine la classe della lunghetta
Private aElencoRit ' conterra l'elenco dei ritardi per la lunghetta
Private aIdEstrElencoRit ' conterra l'elenco dei ritardi per la lunghetta
Private aElencoIncrRitMax ' contiene l'elnco degli incrementi del ritardo max
Private aIdEstrIncrRitMax ' conterra l'elenco degli id estrazione in
' cui si è registrato l'incremento del ritmax conosciuto
Private aRitardiAllIncremento ' contiene il valore del ritardo all'idestrazione in cui
' si è verificato l'incremento
Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza ' valori statistici
Private mIncrRitardoMaxSto,mStrIncRitSto
Private mFiltro,mQIncrRitMax
Public Property Get IncrRitMaxSto
IncrRitMaxSto = mIncrRitardoMaxSto
End Property
Public Property Get strIncRitMaxSto
strIncRitMaxSto = mStrIncRitSto
End Property
Public Property Get Ritardo
Ritardo = mRitardo
End Property
Public Property Get RitardoMax
RitardoMax = mRitardoMax
End Property
Public Property Get IncrRitMax
IncrRitMax = mIncrRitMax
End Property
Public Property Get Frequenza
Frequenza = mFrequenza
End Property
Public Property Get LunghettaString
LunghettaString = StringaNumeri(aNumeri)
End Property
' inizializza le proprietà dell'oggetto
Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco,iFiltro,iQIncrRitMax)
' acquisisco i parametri per l'analisi
mInizio = RangeInizio
mFine = RangeFine
aRuote = vetRuote
mSorte = SorteInGioco
mFiltro = iFiltro
mQIncrRitMax=iQIncrRitMax
' alimento il vettore con i numeri della lunghetta
Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
' calcolo l'elenco dei ritardi
Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
' alimento il vettore che contien l'elenco degli incrementi rit max
Call AlimentaVettoreIncrRitMax
End Sub
' esegue il calcolo dei valori statistici della lunghetta
Sub EseguiStatistica
Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
End Sub
Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
Dim k
If IsArray(sLunghetta) Then
' se la lunghetta è gia un array lo copio nel vettore locale dei numeri
ReDim aNumeri(UBound(sLunghetta))
For k = 1 To UBound(sLunghetta)
aNumeri(k) = sLunghetta(k)
Next
Else
' antepongo un carattere separatore per fare in modo che
' aNumeri si valorizzi dall'indice 1 (senno si sarebeb valorizzato dall'indice 0)
Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
End If
' valorizzo la classe della lunghetta
mClasse = UBound(aNumeri)
End Sub
Private Sub AlimentaVettoreIncrRitMax
Dim nRitMax,nIncr,nId,k
nId = 0
' inizializzo il vettore a 0 elementi
ReDim aElencoIncrRitMax(0)
ReDim aIdEstrIncrRitMax(0)
ReDim aRitardiAllIncremento(0)
' ciclo sul vettore dei ritardi
For k = 1 To UBound(aElencoRit)
' se il ritardo corrente supera il ritmax attuale..
If aElencoRit(k) > nRitMax Then
If nRitMax > 0 Then
' se il ritmax attuale è >0 (ivvero ne esiste uno)
' calcolo di quanto si è incrementato
nIncr = aElencoRit(k) - nRitMax
' incremento il contatore dei valori trovati
nId = nId + 1
' ridimensiono il vettore mantenendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aElencoIncrRitMax(nId)
' memorizzo il valore
aElencoIncrRitMax(nId) = nIncr
' ridimensiono il vettore mantnendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aIdEstrIncrRitMax(nId)
' memorizzo l'id dell'estrazione dove si è avuto l'incremento
aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
' ridimensiono il vettore mantnendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aRitardiAllIncremento(nId)
' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento
aRitardiAllIncremento(nId) = aElencoRit(k)
End If
nRitMax = aElencoRit(k)
End If
Next
mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
End Sub
Function IsCondizioneRispettata
Dim nUpper,Ris
nUpper = UBound(aElencoIncrRitMax)
mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,0,nUpper - 1)
' condizioni di filtro:
'1)Ultimo ritardo >0
'2)IncrRitMax e nell ultima estrazione esaminata
'3) Vengono considerate solo le formazioni che hanno avuto almeno sei incrementi del rit max sto
If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine And nUpper >= mQIncrRitMax Then
Select Case mFiltro
Case 0
' incremento massimo storico è uguale all incremento Massimo corrente
Ris =(mIncrRitardoMaxSto = aElencoIncrRitMax(nUpper))
Case 1
Ris =(mIncrRitardoMaxSto <= aElencoIncrRitMax(nUpper))
Case 2
Ris =(mIncrRitardoMaxSto >= aElencoIncrRitMax(nUpper))
End Select
IsCondizioneRispettata = Ris'
Else
IsCondizioneRispettata = False
End If
End Function
Sub DisegnaGraficoIncrRitMax
Dim x,y,k
Dim nValoreMaxX,nValoreMaxY,nValoreMinX
Dim nStepX,nStepY
Dim nUpperVetIncrRit
nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
nValoreMaxY = MassimoV(aElencoRit,1)
nStepX =(nValoreMaxX -(mInizio - 1)) \10
nStepY = nValoreMaxY \10
Call PreparaGrafico("Formaziione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
nUpperVetIncrRit = UBound(aElencoIncrRitMax)
' linea dell'incremento rit max
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aElencoIncrRitMax(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
' linea dell' rit max
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aRitardiAllIncremento(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
' scrive grafico nell'output
Call InserisciGrafico
End Sub
End Class
Sub Main
Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
Dim Filtro,qIncrRitMax
Dim bOk
sDir = GetDirectoryAppData & "ArchiviVirtuali\"
sFile = ScegliFileArchivioVirt(sDir)
If sFile <> "" Then
sFileCompleto = sDir & sFile & ".dat"
bOk = ApriFileBaseDati(sFileCompleto)
Else
bOk = True ' archivio normale
End If
If bOk Then
If ScegliRange(Inizio,Fine) Then
Sorte = ScegliEsito
Call ScegliRuote(aRuote,Nothing)
Filtro=GetidFiltro
qIncrRitMax=Int(InputBox("SelezionaQuantitaMinimaIncrementi","",6))
If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 Then
Call Scrivi("Archivio : " & Iif(sFile <> "",sFile,"Archivio lotto"))
Select Case ScegliTipoSviluppo
Case 1
Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,Filtro,qIncrRitMax)
Case 2
Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,Filtro,qIncrRitMax)
Case 3
Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,Filtro,qIncrRitMax)
End Select
End If
End If
End If
End Sub
Function ScegliFileArchivioVirt(sDir)
Dim i
ReDim aFile(0)
Call ElencoFileInDirectory(sDir,aFile,".dat")
aFile(0) = "Archivio reale"
i = ScegliOpzioneMenu(aFile,1,"Scegli archivio virtuale")
If i > 0 Then
ScegliFileArchivioVirt = aFile(i)
Else
ScegliFileArchivioVirt = ""
End If
End Function
Function ScegliTipoSviluppo
ReDim aVoci(3)
aVoci(1) = "Da file txt con lunghette"
aVoci(2) = "Da sviluppo casuale"
aVoci(3) = "Da sviluppo tabellare"
ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1)
End Function
Function GetChrSepFromRiga(sRiga)
Dim k,schr
schr = ""
For k = 1 To Len(sRiga)
schr = Mid(sRiga,k,1)
If IsNumeric(schr) = False Then
Exit For
End If
Next
GetChrSepFromRiga = schr
End Function
Sub AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,Filtro,qIncrRitMax)
Dim sFile,aLunghette,nTotLunghette
Dim k,sChrSep
Dim clsL,collLunghette
Set collLunghette = GetNewCollection
sFile = ScegliFile(GetDirectoryAppData,".txt")
If FileEsistente(sFile) Then
Call LeggiRigheFileDiTesto(sFile,aLunghette)
nTotLunghette = UBound(aLunghette)
If nTotLunghette > 0 Then
sChrSep = GetChrSepFromRiga(aLunghette(1))
For k = 0 To nTotLunghette
Set clsL = New clsLunghetta
Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte,Filtro,qIncrRitMax)
If clsL.IsCondizioneRispettata Then
Call clsL.EseguiStatistica
collLunghette.Add clsL
End If
If k Mod 50 = 0 Then
Call Messaggio("Righe esaminate : " & k)
Call AvanzamentoElab(1,nTotLunghette,k)
If ScriptInterrotto Then Exit For
End If
Next
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & "-" & GetInfoEstrazione(Fine)
Scrivi "Lunghette esaminate : " & nTotLunghette + 1 & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
Call Scrivi("Formazione : " & clsL.LunghettaString)
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi(" IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi(" s incrementi : " & clsL.strIncRitMaxSto)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette + 1
End If
End If
End If
'End If
'fine prova selezione report solo per i casi voluti...
End Sub
Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,Filtro,qIncrRitMax)
Dim sFile,aLunghette,nTotLunghette,nClasse
Dim nTrov,nProdotte
Dim clsL,collLunghette
Set collLunghette = GetNewCollection
nTotLunghette = Int(InputBox("Quante lunghette devono essere trovate ?",,10))
nClasse = Int(InputBox("Quanti numeri nella lunghetta",,Sorte))
If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then
nTrov = 0
nProdotte = 0
Do While nTrov < nTotLunghette
Set clsL = New clsLunghetta
ReDim aNum(nClasse)
Call GetColonnaCasuale(nClasse,aNum)
nProdotte = nProdotte + 1
Call clsL.Init(aNum,"",Inizio,Fine,aRuote,Sorte,Filtro,qIncrRitMax)
If clsL.IsCondizioneRispettata Then
Call clsL.EseguiStatistica
collLunghette.Add clsL
nTrov = nTrov + 1
End If
If nProdotte Mod 50 = 0 Then
Call Messaggio("combinazioni esaminate " & nProdotte & " valide " & nTrov)
Call DoEventsEx
If ScriptInterrotto Then Exit Do
End If
Loop
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
Call Scrivi("Formazione : " & clsL.LunghettaString)
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi(" IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi(" s incrementi : " & clsL.strIncRitMaxSto)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette
End If
End If
End Sub
Sub AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,Filtro,qIncrRitMax)
Dim nTotLunghette
Dim k,sChrSep,nClasse
ReDim aLunghette(0)
Dim clsL,collLunghette
Set collLunghette = GetNewCollection
sChrSep = " "
ScegliNumeri(aLunghette)
nClasse = CInt(InputBox(" classe sviluppo ",,2))
nTotLunghette = InitSviluppoIntegrale(aLunghette,nClasse)
k = 0
Do While GetCombSviluppo(aLunghette)
k = k + 1
Set clsL = New clsLunghetta
Call clsL.Init(aLunghette,sChrSep,Inizio,Fine,aRuote,Sorte,Filtro,qIncrRitMax)
If clsL.IsCondizioneRispettata Then
Call clsL.EseguiStatistica
collLunghette.Add clsL
End If
If k Mod 50 = 0 Then
Call Messaggio("Righe esaminate " & k & " valide " & collLunghette. count)
DoEventsEx
Call AvanzamentoElab(1,nTotLunghette,k)
If ScriptInterrotto Then Exit Do
End If
Loop
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
Call Scrivi("Formazione : " & clsL.LunghettaString)
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi(" IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi(" s incrementi : " & clsL.strIncRitMaxSto)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette
End If
End Sub
Function GetidFiltro
Dim aFiltro
aFiltro = Array("IncrRitMaxSto=mIncrRitMaxCr","IncrRitMaxSto<=mIncrRitMaxCr","IncrRitMaxSto>=mIncrRitMaxCr")
GetidFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
End FunctionidFiltro e quantita incrementi lo passo direttamente nella sub cosi scrivo una volta sola volta i parametri nella sub main
cosi ho risolto tutti i punti?
altrimenti li passo alla funzione in questa maniera
isCondizioneRispettata(idFiltro,qIncrRitMax)
Ciao sei mitico come prof
sto fondendo... lo script a forza di testarlo... 
