Option Explicit
' questo oggetto riceve i parametri necssari per creare la piramide dei ritardi comulati
Class clsPiramide
' variabili visibili solo dentro la classe
Private aNum ' contiene i numeri con cui la piramide viene calcolata
Private nSorte ' contiene il valore che indica la sorte a cui si riferisce la piramide
Private nClasseFrz ' classe formazione
Private idEstr ' contiene l'id estrazione a ci si riferisce la piramide
Private aRitPerRuota ' matrice a 2 dimensioni contiene i ritardi calcolati su ciascuna ruota
' è ordinata automaticamente quindi la ruota va letta dall'indice 0
' dell'elemento corrente , il ritardo dall'indice 1
Dim Tit(14) ' titoli della tabella
' è una proprieta di sola lettura riorna il ritardo piu alto sulle ruote
Public Property Get RitPiuAlto
' dato che la matrice è ordinata mi interessa l'indice 1
RitPiuAlto = aRitPerRuota(1,1)
End Property
' è una proprieta di sola lettura riorna la ruota al ritardo piu alto sulle ruote
Public Property Get RuotaRitPiuAlto
' dato che la matrice è ordinata mi interessa l'indice 1
RuotaRitPiuAlto = aRitPerRuota(1,0)
End Property
' serve ad inizializzare l'oggetto con i parametri necessari
' va lanciata dopo aver istanziato la classe
Sub Init(aN,nS,nC,idE)
Dim r
' assumo i parametri memorizzandoli nelle var locali
aNum = aN
nSorte = nS
idEstr = idE
nClasseFrz = nC
' inizializzo i valori per creare la tabella
For r = 1 To 10 : Tit(r) = FormatSpace(r,2,True) & "° Rit" : Next
Tit(11) = "Minimo" : Tit(12) = "Somma"
Tit(13) = "Rit Nat" : Tit(14) = "Min/RN"
' creo la piramide che rimane ancora un oggetto virtuale in memoria
CreaTabellaPiramide
End Sub
' sub privata visibile solo dentro la classe
' crea la piramide con i parametri forniti (numeri ruota estrazione)
' ordina la matrice dei ritardi per ruota
Private Sub CreaTabellaPiramide()
Dim r,i
ReDim aRitPerRuota(11,1)
ReDim aRuote(1)
i = 0
For r = 1 To 12
If r <> 11 Then
i = i + 1
aRuote(1) = r
aRitPerRuota(i,0) = r
aRitPerRuota(i,1) = RitardoCombinazioneTurbo(aRuote,aNum,nSorte,idEstr)
End If
Next
Call OrdinaMatrice(aRitPerRuota,- 1,1)
End Sub
Sub PrintOut
Dim k,a,b,c,t,x
Call Scrivi("Numeri : " & StringaNumeri(aNum,,True))
Call Scrivi("Sorte : " & NomeSorte(nSorte))
InitTabella(Tit)
For c = 1 To 10
t = 0 : ReDim V(14)
For x = c To 1 Step - 1
V(x) = SiglaRuota(aRitPerRuota(x,0)) & FormatSpace(aRitPerRuota(x,1),6,True)
t = t + aRitPerRuota(x,1)
Next
a = aRitPerRuota(c,1) : b = Round(1 / Prob(nClasseFrz,nSorte,Int(c)),2)
V(11) = a : V(12) = FormatSpace(t,4) : V(13) = b : V(14) = Round(a/b,2)
AddRigaTabella(V)
Next
Call CreaTabella
ColoreTesto 2 : Scrivi "Script By Joe",True : ColoreTesto 0
End Sub
End Class
Sub Main
Dim nSorte,nClasse,nIdEstr,e,k
Dim aElemFormazione() ' colonne apparetenenti alla formazione selezionata
Dim clsP ' oggetto clsPiraide
Dim collColonne ' collection delle colonne
Dim nPrimeDaMostrare ' limite prime n piramidi da mostrare
nIdEstr = EstrazioneFin
nPrimeDaMostrare = 100 'gestendo le formazioni che potrebebro avere anche molte colonne
' impostiamo un limite per le prime N (ordinate)
' sceglie una formazione
If ScegliNumeriAnalisi (aElemFormazione,nSorte,nClasse) Then
' predispongo l'array per i numeri da analizzare
ReDim aNum(nClasse)
' istanzio la collection che conterra tutte le colonne presenti nella formazione selezionata
Set collColonne = GetNewCollection
' ciclo sugli elementi della formazione e istanzio per ognuno
' l'oggetto clsPiramide che poi aggiungo alla collection
For k = 1 To UBound(aElemFormazione)
' leggo i numeri della colonna corrente
For e = 1 To UBound(aNum)
aNum(e) = aElemFormazione(k,e)
Next
' istanzio l'oggetto clsPiramide
Set clsP = New clsPiramide
' inizializzo l'oggetto clsPiramide
' l'inizializzazione calcola internamente i valori della piramide
Call clsP.Init(aNum,nSorte,nClasse,nIdEstr)
' aggiungo l'oggetto nella collection
collColonne.Add( clsP)
Call AvanzamentoElab(1,UBound(aElemFormazione),k)
If ScriptInterrotto Then Exit For
Next
' ordino la collection per la proprieta RitPiuAlto
' il valore della proprietà <RitPiuAlto> era stato calcolato in fase di inizializzazione dell'oggetto
' clsPiramide internamente alla classe
Call OrdinaItemCollection(collColonne,"RitPiuAlto",,,- 1)
' a questo punto nella collection <collColonne> abbiamo tutti gli oggetti clsPiramide ognuno rappresenta
' una colonna della formazione selezionata con tutti i suoi valori calcolati
' mostriamo in output le prime N piramidi
k = 0
For Each clsP In collColonne
Call clsP.PrintOut
Call Scrivi
k = k + 1
If k > nPrimeDaMostrare Then Exit For
Next
Set collColonne = Nothing
End If
End Sub
Function ScegliNumeriAnalisi (aElemFormazione,nSorte,nClasse)
If ScegliOpzione = 0 Then
ScegliNumeriAnalisi = ScegliNumeriManuale(aElemFormazione,nSorte,nClasse)
Else
ScegliNumeriAnalisi = RichiediFormazione(aElemFormazione,nSorte,nClasse)
End If
End Function
Function ScegliOpzione
Dim i
ReDim aVoci (1)
aVoci (0) = "Inserimento numeri manuale"
aVoci (1) = "Selezione da formazione"
i = ScegliOpzioneMenu( aVoci ,0)
ScegliOpzione = i
End Function
Function ScegliNumeriManuale(aElemFormazione,nSorte,nClasse)
ReDim aNum (0)
Dim nQ , k , n
nQ = ScegliNumeri(aNum)
If nQ > 0 Then
ReDim aElemFormazione(1,nQ)
For k = 1 To nQ
aElemFormazione(1,k) = aNum(k)
Next
nClasse = nQ
n = CInt(InputBox("Inserire i punti da realizzare",,1))
If n <= nClasse Then
nSorte= n
ScegliNumeriManuale= True
Else
MsgBox "I punti da realizzare non possono essere superiori alla classe",vbCritical
End If
End If
End Function
Function RichiediFormazione(aElemFormazione,nRetPuntiDaFare,nRetClasseFrz)
Dim s
Dim n
Dim id
ReDim aNomiForm(0)
Call ElencoFileInDirectory(GetDirectoryAppData & "formazioni\",aNomiForm,".frz")
id = ScegliOpzioneMenu(aNomiForm,1,"Selezione formazione")
If GetElementiFormazione(aNomiForm(id),aElemFormazione) Then
n = CInt(InputBox("Inserire i punti da realizzare su un qualsiasi elemento della formazione",,1))
nRetClasseFrz = GetClasseFormazione(aNomiForm(id))
If n <= nRetClasseFrz Then
nRetPuntiDaFare = n
RichiediFormazione = True
Else
MsgBox "I punti da realizzare non possono essere superiori alla classe della formazione",vbCritical
End If
End If
End Function
