L
LuigiB
Guest
caro legend non ho capito niente d iquello che mi hai chiesto ...
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.
Class clsProva
Private m_A,m_B
Public property get Mio
Mio= m_A+m_B
End property
Public property get tuo
Tuo = dist
End property
Sub init ( a,b)
m_A=a
M_B=b
End sub
Function dist
Dist =distanza (m_A,m_B)
End function
End class
Sub main
Dim cls
Dim a,b
Set cls= new clsProva
Call cls.Init( a,b)
Call scrivi ( cls .Mio,1,0,vbblue )
Call Scrivi ( cls.Tuo,1,0,vbRed )
End sub
Function idFiltro
Dim aFiltro
aFiltro =array ("IncrRitMaxSto = mIncrRitMaxCr","IncrRitMaxSto < = IncrRitMaxCr ", " IncrRitMaxSto > = IncrRitMaxCr ")
IdFiltro =ScegliOpzioneMenu ( aFiltro, 0,"Select Filtro Condizione ")
End function
i legend;n1939703 ha scritto:X tom
Che dati non riesci a manipolare?
La stringa degli incrementi non ti torna?
Pensavo per te fosse importante prima la calcolavi manualmente,
Non è corretta?
Se mi spieghi ,scusa non ho capito ci lavoro su.
Pezzo alla volta.
Ma dopo bisogna riportare tutto in uno script finale per non rovinare l efficienza e l eleganza dello script.
Aspetto tue direttive
Buona domenica
i legend;n1939758 ha scritto:Ciao tom sto ricompila no lo script con le midifiche perfavore mi sai dire la richiesta degli incrementi?
Vuoi selezionare solo le formazioni che hanno un tot di incrementi? Se si quanti?
Ciao luigi ci provo
Option Explicit
Class clsLunghetta
' Controllare sempre Salvo Errori
Private aNumeri
Private mInizio,mFine,aRuote,mSorte
Private mClasse
Private aElencoRit
Private aIdEstrElencoRit
Private aElencoIncrRitMax
Private aIdEstrIncrRitMax
Private aRitardiAllIncremento
Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mIncrRitardoMaxStorico,mStrIncRitMax
Private mFiltro
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 IncrRitMaxSto
IncrRitMaxSto = mIncrRitardoMaxStorico
End Property
Public Property Get StrIncRitMax
StrIncRitMax = mStrIncRitMax
End Property
Public Property Get StrIncrementi
StrIncrementi = StringaNumeri(aElencoIncrRitMax,,True)
End Property
Public Property Get StrFormazione
StrFormazione = StringaNumeri(aNumeri,,True)
End Property
Sub Init(sLunghetta,sCharSep,RangeInizio,RangeFine,VetRuote,sorteInGioco,iFiltro)
mInizio = RangeInizio
mFine = RangeFine
aRuote = VetRuote
mSorte = sorteInGioco
mFiltro = iFiltro
Call AlimentaVettoreLunghetta(sLunghetta,sCharSep)
Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
Call AlimentaVettoreIncrRitMax
End Sub
Sub EseguiStatistica
Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
End Sub
Private Sub AlimentaVettoreLunghetta(sLunghetta,sCharSep)
Dim k
If IsArray(sLunghetta) Then
ReDim anumeri(UBound(sLunghetta))
For k = 1 To UBound(sLunghetta)
anumeri(k) = sLunghetta(k)
Next
Else
Call SplitByChar((sCharSep & sLunghetta),sCharSep,anumeri)
End If
mClasse = UBound(anumeri)
End Sub
Private Sub AlimentaVettoreIncrRitMax
Dim nRitMax,nIncr,nId,k
nId = 0
ReDim aElencoIncrRitMax(0)
ReDim aIdEstrIncrRitMax(0)
ReDim aRitardiAllIncremento(0)
For k = 1 To UBound(aElencoRit)
If aElencoRit(k) > nRitMax Then
If nRitMax > 0 Then
nIncr = aElencoRit(k) - nRitMax
nId = nId + 1
ReDim Preserve aElencoIncrRitMax(nId)
aElencoIncrRitMax(nId) = nIncr
ReDim Preserve aIdEstrIncrRitMax(nId)
aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
ReDim Preserve aRitardiAllIncremento(nId)
aRitardiAllIncremento(nId) = aElencoRit(k)
End If
nRitMax = aElencoRit(k)
End If
Next
mStrIncRitMax = StringaNumeri(aElencoIncrRitMax,,True)
End Sub
Function IsCondizioneRispettata
Dim nUpper,Ris
nUpper = UBound(aElencoIncrRitMax)
mIncrRitardoMaxStorico = 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 >= 6 Then
Select Case mFiltro
Case 0
' incremento massimo storico è uguale all incremento Massimo corrente
Ris =(mIncrRitardoMaxStorico = aElencoIncrRitMax(nUpper))
Case 1
Ris =(mIncrRitardoMaxStorico <= aElencoIncrRitMax(nUpper))
Case 2
Ris =(mIncrRitardoMaxStorico >= 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("Formazione : " & StringaRuote(aRuote) & " " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
nUpperVetIncrRit = UBound(aElencoIncrRitMax)
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,"EstrIncrRitMax")
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")
Call InserisciGrafico
End Sub
End Class
Sub Main
Dim Inizio,Fine,aRuote,Sorte
Dim sDir,sFile,sFileCompleto
sDir = GetDirectoryAppData & "ArchiviVirtuali\"
sFile = ScegliFileArchivioVirt(sDir)
If sFile <> "" Then
sFileCompleto = sDir & sFile & ".dat"
Inizio = 1
Fine = QuantitaEstrazioniInFile(sFileCompleto)
Sorte = ScegliEsito
Call ScegliRuote(aRuote,Nothing)
If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 Then
Select Case ScegliTipoSviluppo
Case 1
Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte)
Case 2
Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte)
Case 3
Call AnalisiLunghetteFromScegliNumeri(Inizio,Fine,aRuote,Sorte)
End Select
End If
End If
End Sub
Function ScegliTipoSviluppo
ReDim aVoci(3)
aVoci(1) = "Da File txt con lunghette"
aVoci(2) = "Da sviluppo casuale"
aVoci(3) = "ScegliNumeri"
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)
Dim sFile,aLunghette,nTotLunghette
Dim k,sChrSep,id
Dim clsL,collLunghette
Dim Filtro
Filtro = GetidFiltro
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))
id = 0
For k = LBound(aLunghette) To nTotLunghette
id = id + 1
Set clsL = New clsLunghetta
Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte,Filtro)
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
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
Call Scrivi("Formazione esaminata : " & clsL.Strformazione)
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.Ritardomax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMax : " & clsl.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("aArrayIncrRitMax : " & clsL.StrIncrementi)
Scrivi
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni "
Scrivi "Lunghette esaminate " & nTotLunghette + 1
End If
End If
End If
End Sub
Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte)
Dim sFile,aLunghette,nTotLunghette,nClasse
Dim nTrov,nProdotte
Dim clsL,collLunghette
Dim Filtro
Filtro = GetidFiltro
Set collLunghette = GetNewCollection
nTotLunghette = Int(InputBox("Quanti lunghette devono essere trovate?",,4))
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)
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
'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
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
Call Scrivi("Formazione esaminata : " & clsL.Strformazione)
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.Ritardomax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMax : " & clsl.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("aArrayIncrRitMax : " & clsL.StrIncrementi)
Scrivi
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni "
Scrivi "Lunghette esaminate " & nProdotte
End If
End If
End Sub
Sub AnalisiLunghetteFromScegliNumeri(Inizio,Fine,aRuote,Sorte)
Dim nTotLunghette
Dim k,sChrSep,nClasse
Dim clsL,collLunghette
ReDim aLunghette(0)
Dim Filtro
Filtro = GetidFiltro
Set collLunghette = GetNewCollection
sChrSep = " "
ScegliNumeri(aLunghette)
nClasse = Int(InputBox("Quanti numeri nella lunghetta?",,3))
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)
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
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
Call Scrivi("Formazione esaminata : " & clsL.Strformazione)
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.Ritardomax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMax : " & clsl.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("aArrayIncrRitMax : " & clsL.StrIncrementi)
Scrivi
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 Function
Function ScegliFileArchivioVirt(sDir)
Dim i
ReDim aFile(0)
Call ElencoFileInDirectory(sDir,aFile,".dat")
If UBound(aFile) > 0 Then
i = ScegliOpzioneMenu(aFile,1,"scegliArchiovirtuale")
If i > 0 Then
ScegliFileArchivioVirt = aFile(i)
Else
ScegliFileArchivioVirt = ""
End If
Else
MsgBox "Non sono stati trovati i sistemi virtuali nella directory " & vbCrLf & sDir
End If
End Function
i legend;n1939762 ha scritto:Scusa tom non avevo visto il post.
Ok ma che ne dici se mettiamo un numero di default?
Fare un altro input box diventa un caOS per chi non ha dimestichezza
Fai le tue prove poi mi fai sapere
Allora nella function is condizione rispettata
Sostituisci
If aElencoRit ( ubound ( aElencoRit ) ) > 0 and aIdEstrIncrRitMax ( nUpper ) = mFine Then
Con
If aElencoRit ( ubound ( aElencoRit ) ) > 0 and aIdEstrIncrRitMax ( nUpper ) = mFine and nUpper >=6 then
Se vuoi di più cambi 6 con 10 0 quanto vuoi tu
Fammi sapere.
Buon pranzo
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
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)
' acquisisco i parametri per l'analisi
mInizio = RangeInizio
mFine = RangeFine
aRuote = vetRuote
mSorte = SorteInGioco
' 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
' verifica che l'incremento dell'ultimo ritmax sia uguale al massimo incr rit max conosciuto.
Dim nUpper
nUpper = UBound(aElencoIncrRitMax)
mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine Then
IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto)
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 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)
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)
Case 2
Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte)
Case 3
Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte)
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)
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)
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
'prova report solo per casi con incmaxsto = incmax
'If (clsL.IncrRitMax = clsL.IncrRitMaxSto) Then
' Call Scrivi(" IncrRitMaxSto : " & clsL.IncrRitMaxSto)
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
If(clsL.IncrRitMax - clsL.IncrRitMaxSto = 0) Then
Call Scrivi("Lunghetta : " & 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
End If
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)
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)
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("Lunghetta : " & clsL.LunghettaString)
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
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)
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)
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
If(clsL.IncrRitMax - clsL.IncrRitMaxSto = 0) Then
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
End If
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette
End If
'End If
'End If
End Sub
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
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)
' acquisisco i parametri per l'analisi
mInizio = RangeInizio
mFine = RangeFine
aRuote = vetRuote
mSorte = SorteInGioco
mFiltro = iFiltro
' 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 >= 6 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 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)
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)
Case 2
Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte)
Case 3
Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte)
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)
Dim sFile,aLunghette,nTotLunghette
Dim k,sChrSep
Dim clsL,collLunghette
Dim Filtro
Filtro = GetidFiltro
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)
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)
Dim sFile,aLunghette,nTotLunghette,nClasse
Dim nTrov,nProdotte
Dim clsL,collLunghette
Dim Filtro
Filtro = GetidFiltro
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)
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)
Dim nTotLunghette
Dim k,sChrSep,nClasse
ReDim aLunghette(0)
Dim clsL,collLunghette
Dim Filtro
Filtro = GetidFiltro
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)
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 Function
If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine And nUpper >= 6 Then