vincenzo4221
Advanced Member >PLATINUM<
GRAZIE Luigi , mi faccio sentire presto bene , (navigo con pennetta in luogo non servito bene).
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.
IL RITARDO CUMULATO
- Creatore Discussione vincenzo4221
- Data di inizio
L
LuigiB
Guest
ok non so se hai copiato lo script prima dell 19.08 .. se si copia quello che c'è ora perche c'era una correzione. ciao
L
LuigiB
Guest
Ciao a tutti ,eccco unavariante dello script che cosente di ordinare le piramidi per uno qualsiasi de valori della griglia
Codice:
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
Dim aGriglia (10,14,1) ' contiene i valori che verranno stampati nella griglia
' 10 righe , 14 colonne , all'indice 0 la ruota
' all'indice 1 il valore
' le colonne da 11 a 14 non hanno ruota
Private nRigaG , nColonnaG ' usate per leggere la proprieta ValoreGriglia
' è una proprieta di sola lettura ritorna 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 ritorna 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
' è una proprieta di sola lettura ritorna il valore dalla matrice aGriglia alle coordinate previste
' il valore si trova all'indice 1
Public Property Get ValoreGriglia
ValoreGriglia = aGriglia( nRigaG ,nColonnaG ,1)
End Property
' serve ad inizializzare l'oggetto con i parametri necessari
' va lanciata dopo aver istanziato la classe
Sub Init(aN,nS,nC,idE , nRG , nCG)
Dim r
' assumo i parametri memorizzandoli nelle var locali
aNum = aN
nSorte = nS
idEstr = idE
nClasseFrz = nC
nRigaG = nRG
nColonnaG = nCG
' 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
' alimento i dati della griglia
AlimentaMatriceGriglia
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
Private Sub AlimentaMatriceGriglia
Dim k,a,b,c,t,x
For c = 1 To 10
t = 0
For x = c To 1 Step - 1
aGriglia(c ,x,0) = SiglaRuota(aRitPerRuota(x,0))
aGriglia(c ,x,1) = aRitPerRuota(x,1)
t = t + aRitPerRuota(x,1)
Next
a = aRitPerRuota(c,1) : b = CicloTeorico(nClasseFrz,nSorte,Int(c))
aGriglia(c ,11,1) = a
aGriglia(c ,12,1) = t
aGriglia(c ,13,1) = b
aGriglia(c ,14,1) = Dividi( a , b)
Next
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 = CicloTeorico(nClasseFrz,nSorte,Int(c)) ' 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
Sub PrintOut
Dim c,x
Call Scrivi("Numeri : " & StringaNumeri(aNum,,True))
Call Scrivi("Sorte : " & NomeSorte(nSorte))
InitTabella(Tit)
ReDim aV(14)
For c = 1 To 10
For x = 1 To 14
If x <= 10 Then
aV(x) = aGriglia ( c ,x,0) & " " & FormatSpace (aGriglia ( c ,x,1), 5,True )
Else
aV(x) = Round (aGriglia ( c ,x,1),2)
End If
Next
Call AddRigaTabella (aV)
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
Dim nRigaGriglia , nColGriglia ' usate per gestire l'ordinamento
Dim sTipoOrd ' ordinamento scelto
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
If ScegliOrdinamento ( nRigaGriglia , nColGriglia , sTipoOrd) 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,nRigaGriglia , nColGriglia)
' 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,"ValoreGriglia",,,- 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
Call Scrivi ("Analisi all'estrazione " & GetInfoEstrazione (nIdEstr),True)
Call Scrivi ("Piramidi ordinate per " & sTipoOrd , True)
Call Scrivi
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 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
Function ScegliOrdinamento (RetRiga , RetColonna , sRetOrd )
Dim k , r , i
ReDim av(140)
av(0) = "Ritardo più alto"
For r = 1 To 10
For k = 1 To 14
i = i +1
If k <=10 Then
av(i) = "Ruote - " & r & " -PosClass -" & k
ElseIf k = 11 Then
av(i) = "Ruote - " & r & " -Minimo"
ElseIf k = 12 Then
av(i) = "Ruote - " & r & " -Somma"
ElseIf k = 13 Then
av(i) = "Ruote - " & r & " -RitardoNat"
ElseIf k = 14 Then
av(i) = "Ruote - " & r & " -Min/RitNat"
End If
Next
Next
i = ScegliOpzioneMenu(av ,0)
sRetOrd = ""
RetRiga =0
RetColonna =0
If i >0 Then
sRetOrd = av(i)
ReDim v(0)
Call SplitByChar( av(i) ,"-" ,v)
RetRiga = Int(v(1))
If InStr(av(i) , "PosClass") >0 Then
RetColonna = Int(v(3))
ElseIf InStr(av(i) , "Minimo") >0 Then
RetColonna = 11
ElseIf InStr(av(i) , "Somma") >0 Then
RetColonna = 12
ElseIf InStr(av(i) , "RitardoNat") >0 Then
RetColonna = 13
ElseIf InStr(av(i) , "Min/RitNat") >0 Then
RetColonna = 14
End If
ElseIf i =0 Then
sRetOrd = av(i)
RetRiga =1
RetColonna = 1
End If
If RetRiga >0 And RetColonna > 0 Then
ScegliOrdinamento = True
End If
End Function
L
LuigiB
Guest
ciao , ancora una nuova variante .
Questa consente di calcolare una tabellina con i valori massimi assoluti.
Questa consente di calcolare una tabellina con i valori massimi assoluti.
Codice:
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
Dim aGriglia(10,14,1) ' contiene i valori che verranno stampati nella griglia
' 10 righe , 14 colonne , all'indice 0 la ruota
' all'indice 1 il valore
' le colonne da 11 a 14 non hanno ruota
Private nRigaG,nColonnaG ' usate per leggere la proprieta ValoreGriglia
' è una proprieta di sola lettura ritorna 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 ritorna 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
' è una proprieta di sola lettura ritorna il valore dalla matrice aGriglia alle coordinate previste
' il valore si trova all'indice 1
Public Property Get ValoreGriglia
ValoreGriglia = aGriglia(nRigaG,nColonnaG,1)
End Property
' serve ad inizializzare l'oggetto con i parametri necessari
' va lanciata dopo aver istanziato la classe
Sub Init(aN,nS,nC,idE,nRG,nCG)
Dim r
' assumo i parametri memorizzandoli nelle var locali
aNum = aN
nSorte = nS
idEstr = idE
nClasseFrz = nC
nRigaG = nRG
nColonnaG = nCG
' 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
' alimento i dati della griglia
AlimentaMatriceGriglia
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
Private Sub AlimentaMatriceGriglia
Dim k,a,b,c,t,x
For c = 1 To 10
t = 0
For x = c To 1 Step - 1
aGriglia(c,x,0) = SiglaRuota(aRitPerRuota(x,0))
aGriglia(c,x,1) = aRitPerRuota(x,1)
t = t + aRitPerRuota(x,1)
Next
a = aRitPerRuota(c,1) : b = CicloTeorico(nClasseFrz,nSorte,Int(c))
aGriglia(c,11,1) = a
aGriglia(c,12,1) = t
aGriglia(c,13,1) = b
aGriglia(c,14,1) = Dividi(a,b)
Next
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 = CicloTeorico(nClasseFrz,nSorte,Int(c)) ' 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
Function GetValoreGriglia (nRiga , nColonna)
GetValoreGriglia = CDbl (aGriglia (nRiga, nColonna ,1))
End Function
Function GetRuotaGriglia (nRiga , nColonna)
GetRuotaGriglia = aGriglia (nRiga, nColonna ,0)
End Function
Sub PrintOut
Dim c,x
Call Scrivi("Numeri : " & StringaNumeri(aNum,,True))
Call Scrivi("Sorte : " & NomeSorte(nSorte))
InitTabella(Tit)
ReDim aV(14)
For c = 1 To 10
For x = 1 To 14
If x <= 10 Then
aV(x) = aGriglia(c,x,0) & " " & FormatSpace(aGriglia(c,x,1),5,True)
Else
aV(x) = Round(aGriglia(c,x,1),2)
End If
Next
Call AddRigaTabella(aV)
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
Dim nRigaGriglia,nColGriglia ' usate per gestire l'ordinamento
Dim sTipoOrd ' ordinamento scelto
Dim ImizioStatMaxRapp
nIdEstr = EstrazioneFin
nPrimeDaMostrare = 100 'gestendo le formazioni che potrebebro avere anche molte colonne
' impostiamo un limite per le prime N (ordinate)
ImizioStatMaxRapp = 3950
If nIdEstr < ImizioStatMaxRapp Then
ImizioStatMaxRapp =1
End If
' sceglie una formazione
If ScegliNumeriAnalisi(aElemFormazione,nSorte,nClasse) Then
If ScegliOrdinamento(nRigaGriglia,nColGriglia,sTipoOrd) Then
Call Scrivi("Analisi all'estrazione " & GetInfoEstrazione(nIdEstr),True)
Call Scrivi("Piramidi ordinate per " & sTipoOrd,True)
Call Scrivi
Call InitCalcoloRappPiuAlti (aElemFormazione,nSorte,nClasse , ImizioStatMaxRapp , nIdEstr )
' 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,nRigaGriglia,nColGriglia)
' 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,"ValoreGriglia",,,- 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 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
Function ScegliOrdinamento(RetRiga,RetColonna,sRetOrd)
Dim k,r,i
ReDim av(140)
av(0) = "Ritardo più alto"
For r = 1 To 10
For k = 1 To 14
i = i + 1
If k <= 10 Then
av(i) = "Ruote - " & r & " -PosClass -" & k
ElseIf k = 11 Then
av(i) = "Ruote - " & r & " -Minimo"
ElseIf k = 12 Then
av(i) = "Ruote - " & r & " -Somma"
ElseIf k = 13 Then
av(i) = "Ruote - " & r & " -RitardoNat"
ElseIf k = 14 Then
av(i) = "Ruote - " & r & " -Min/RitNat"
End If
Next
Next
i = ScegliOpzioneMenu(av,0)
sRetOrd = ""
RetRiga = 0
RetColonna = 0
If i > 0 Then
sRetOrd = av(i)
ReDim v(0)
Call SplitByChar(av(i),"-",v)
RetRiga = Int(v(1))
If InStr(av(i),"PosClass") > 0 Then
RetColonna = Int(v(3))
ElseIf InStr(av(i),"Minimo") > 0 Then
RetColonna = 11
ElseIf InStr(av(i),"Somma") > 0 Then
RetColonna = 12
ElseIf InStr(av(i),"RitardoNat") > 0 Then
RetColonna = 13
ElseIf InStr(av(i),"Min/RitNat") > 0 Then
RetColonna = 14
End If
ElseIf i = 0 Then
sRetOrd = av(i)
RetRiga = 1
RetColonna = 1
End If
If RetRiga > 0 And RetColonna > 0 Then
ScegliOrdinamento = True
End If
End Function
Sub CalcolaValoriPiuAltiAssoluti ( aElemFormazione, nClasse , nSorte , Inizio , Fine , aRetValori , nIdColValCerc)
Dim k ,e,r
Dim clsP
Dim idEstr
Dim nMaxRapp
ReDim aRetValori (10, 2) ' all'indice 0 l'estrazione dell'evento
' all'indice 1 il valore riscontrato
' all'indice 2 i numeri
Set clsP = New clsPiramide
ReDim aNum (nClasse)
For k = 1 To UBound(aElemFormazione)
Call Messaggio ("Colonna " & k)
' leggo i numeri della colonna corrente
For e = 1 To UBound(aNum)
aNum(e) = aElemFormazione(k,e)
Next
For idEstr = Inizio To Fine
Call clsP.Init(aNum,nSorte,nClasse,idEstr,0 ,0)
For r = 1 To 10
If clsP.GetValoreGriglia (r , nIdColValCerc) > aRetValori (r ,1) Then
aRetValori (r ,1) = clsP.GetValoreGriglia (r , nIdColValCerc)
aRetValori (r ,0) = idEstr
aRetValori (r ,2) =StringaNumeri(aNum)
End If
Next
If idEstr Mod 10 = 0 Then
Call AvanzamentoElab( Inizio , Fine ,idEstr)
If ScriptInterrotto Then Exit For
End If
Next
If ScriptInterrotto Then Exit For
Next
Set clsP = Nothing
End Sub
Sub InitCalcoloRappPiuAlti (aElemFormazione,nSorte,nClasse , Inizio , Fine )
Dim k
If MsgBox ("Creare la tabellina dei rapporti massimi ?" , vbQuestion + vbYesNo) = vbYes Then
ReDim aRetValori (10 ,2)
Call CalcolaValoriPiuAltiAssoluti ( aElemFormazione, nClasse , nSorte , Inizio , Fine , aRetValori , 14)
ReDim aV(4)
aV (1) = "Q.Ruote"
aV(2) = "Rapporto"
aV(3) = "Estrazione"
aV(4) = "Numeri"
Call InitTabella ( aV)
For k = 1 To 10
aV(1) = k
aV(2) = aRetValori( k ,1)
aV(3) = aRetValori( k ,0)
aV(4) = aRetValori( k ,2)
Call AddRigaTabella( aV )
Next
Call CreaTabella
Call Scrivi
End If
End Sub
Sub InitCalcoloSommwPiuAlti (aElemFormazione,nSorte,nClasse , Inizio , Fine )
Dim k
If MsgBox ("Creare la tabellina delle somme massime ?" , vbQuestion + vbYesNo) = vbYes Then
ReDim aRetValori (10 ,2)
Call CalcolaValoriPiuAltiAssoluti ( aElemFormazione, nClasse , nSorte , Inizio , Fine , aRetValori , 12)
ReDim aV(4)
aV (1) = "Q.Ruote"
aV(2) = "Rapporto"
aV(3) = "Estrazione"
aV(4) = "Numeri"
Call InitTabella ( aV)
For k = 1 To 10
aV(1) = k
aV(2) = aRetValori( k ,1)
aV(3) = aRetValori( k ,0)
aV(4) = aRetValori( k ,2)
Call AddRigaTabella( aV )
Next
Call CreaTabella
Call Scrivi
End If
End Sub
L
LuigiB
Guest
Ciao Legend .. un saluto ..!
vincenzo4221
Advanced Member >PLATINUM<
Ciao Luigi , ci hai fatto veramente un regalo eccezionale , che non ha prezzo , un giocattolino x gli amanti del gioco.
Sono da solo 1 minuto sullo script , voglio avere il tempo di valutare delle cose , e purtroppo mi manca in questi giorni il tempo e possibilità, ci risentiamo domani sera.
Una domanda si potrebbe avere la possibilità di escludere o meno la ruota Nazionale ?
Sono da solo 1 minuto sullo script , voglio avere il tempo di valutare delle cose , e purtroppo mi manca in questi giorni il tempo e possibilità, ci risentiamo domani sera.
Una domanda si potrebbe avere la possibilità di escludere o meno la ruota Nazionale ?
L
LuigiB
Guest
Ciao a tutti , in questo script viene gestita l'eventuale esclusione della ruota nazionale
Houdini non ho capito ...
Houdini non ho capito ...
Codice:
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
Dim aGriglia(10,14,1) ' contiene i valori che verranno stampati nella griglia
' 10 righe , 14 colonne , all'indice 0 la ruota
' all'indice 1 il valore
' le colonne da 11 a 14 non hanno ruota
Private nRigaG,nColonnaG ' usate per leggere la proprieta ValoreGriglia
Private bIncludiNaz ' gestisce l'esclusione della ruota nazionale
' è una proprieta di sola lettura ritorna 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 ritorna 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
' è una proprieta di sola lettura ritorna il valore dalla matrice aGriglia alle coordinate previste
' il valore si trova all'indice 1
Public Property Get ValoreGriglia
ValoreGriglia = aGriglia(nRigaG,nColonnaG,1)
End Property
' serve ad inizializzare l'oggetto con i parametri necessari
' va lanciata dopo aver istanziato la classe
Sub Init(aN,nS,nC,idE,nRG,nCG , bNz)
Dim r
' assumo i parametri memorizzandoli nelle var locali
aNum = aN
nSorte = nS
idEstr = idE
nClasseFrz = nC
nRigaG = nRG
nColonnaG = nCG
bIncludiNaz = bNz
' 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
' alimento i dati della griglia
AlimentaMatriceGriglia
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
Dim nUpper
If bIncludiNaz Then
nUpper =12
Else
nUpper =11
End If
ReDim aRitPerRuota((nUpper-1) ,1)
ReDim aRuote(1)
i = 0
For r = 1 To nUpper
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
Private Sub AlimentaMatriceGriglia
Dim k,a,b,c,t,x
For c = 1 To 10
t = 0
For x = c To 1 Step - 1
aGriglia(c,x,0) = SiglaRuota(aRitPerRuota(x,0))
aGriglia(c,x,1) = aRitPerRuota(x,1)
t = t + aRitPerRuota(x,1)
Next
a = aRitPerRuota(c,1) : b = CicloTeorico(nClasseFrz,nSorte,Int(c))
aGriglia(c,11,1) = a
aGriglia(c,12,1) = t
aGriglia(c,13,1) = b
aGriglia(c,14,1) = Dividi(a,b)
Next
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 = CicloTeorico(nClasseFrz,nSorte,Int(c)) ' 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
Function GetValoreGriglia(nRiga,nColonna)
GetValoreGriglia = CDbl(aGriglia(nRiga,nColonna,1))
End Function
Function GetRuotaGriglia(nRiga,nColonna)
GetRuotaGriglia = aGriglia(nRiga,nColonna,0)
End Function
Sub PrintOut
Dim c,x
Call Scrivi("Numeri : " & StringaNumeri(aNum,,True))
Call Scrivi("Sorte : " & NomeSorte(nSorte))
InitTabella(Tit)
ReDim aV(14)
For c = 1 To 10
For x = 1 To 14
If x <= 10 Then
aV(x) = aGriglia(c,x,0) & " " & FormatSpace(aGriglia(c,x,1),5,True)
Else
aV(x) = Round(aGriglia(c,x,1),2)
End If
Next
Call AddRigaTabella(aV)
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
Dim nRigaGriglia,nColGriglia ' usate per gestire l'ordinamento
Dim sTipoOrd ' ordinamento scelto
Dim ImizioStatMaxRapp
Dim bIncludiNaz
nIdEstr = EstrazioneFin
nPrimeDaMostrare = 100 'gestendo le formazioni che potrebebro avere anche molte colonne
' impostiamo un limite per le prime N (ordinate)
bIncludiNaz = False
ImizioStatMaxRapp = 3950
If nIdEstr < ImizioStatMaxRapp Then
ImizioStatMaxRapp = 1
End If
' sceglie una formazione
If ScegliNumeriAnalisi(aElemFormazione,nSorte,nClasse) Then
If ScegliOrdinamento(nRigaGriglia,nColGriglia,sTipoOrd) Then
If MsgBox("Includere la ruota nazionale ?" , vbQuestion + vbYesNo ) = vbYes Then bIncludiNaz = True
Call Scrivi("Analisi all'estrazione " & GetInfoEstrazione(nIdEstr),True)
Call Scrivi("Piramidi ordinate per " & sTipoOrd,True)
Call Scrivi
Call InitCalcoloRappPiuAlti(aElemFormazione,nSorte,nClasse,ImizioStatMaxRapp,nIdEstr,bIncludiNaz )
' 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,nRigaGriglia,nColGriglia,bIncludiNaz )
' 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,"ValoreGriglia",,,- 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 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
Function ScegliOrdinamento(RetRiga,RetColonna,sRetOrd)
Dim k,r,i
ReDim av(140)
av(0) = "Ritardo più alto"
For r = 1 To 10
For k = 1 To 14
i = i + 1
If k <= 10 Then
av(i) = "Ruote - " & r & " -PosClass -" & k
ElseIf k = 11 Then
av(i) = "Ruote - " & r & " -Minimo"
ElseIf k = 12 Then
av(i) = "Ruote - " & r & " -Somma"
ElseIf k = 13 Then
av(i) = "Ruote - " & r & " -RitardoNat"
ElseIf k = 14 Then
av(i) = "Ruote - " & r & " -Min/RitNat"
End If
Next
Next
i = ScegliOpzioneMenu(av,0)
sRetOrd = ""
RetRiga = 0
RetColonna = 0
If i > 0 Then
sRetOrd = av(i)
ReDim v(0)
Call SplitByChar(av(i),"-",v)
RetRiga = Int(v(1))
If InStr(av(i),"PosClass") > 0 Then
RetColonna = Int(v(3))
ElseIf InStr(av(i),"Minimo") > 0 Then
RetColonna = 11
ElseIf InStr(av(i),"Somma") > 0 Then
RetColonna = 12
ElseIf InStr(av(i),"RitardoNat") > 0 Then
RetColonna = 13
ElseIf InStr(av(i),"Min/RitNat") > 0 Then
RetColonna = 14
End If
ElseIf i = 0 Then
sRetOrd = av(i)
RetRiga = 1
RetColonna = 1
End If
If RetRiga > 0 And RetColonna > 0 Then
ScegliOrdinamento = True
End If
End Function
Sub CalcolaValoriPiuAltiAssoluti(aElemFormazione,nClasse,nSorte,Inizio,Fine,aRetValori,bIncludiNaz , nIdColValCerc)
Dim k,e,r
Dim clsP
Dim idEstr
Dim nMaxRapp
ReDim aRetValori(10,2) ' all'indice 0 l'estrazione dell'evento
' all'indice 1 il valore riscontrato
' all'indice 2 i numeri
Set clsP = New clsPiramide
ReDim aNum(nClasse)
For k = 1 To UBound(aElemFormazione)
Call Messaggio("Colonna " & k)
' leggo i numeri della colonna corrente
For e = 1 To UBound(aNum)
aNum(e) = aElemFormazione(k,e)
Next
For idEstr = Inizio To Fine
Call clsP.Init(aNum,nSorte,nClasse,idEstr,0,0 ,bIncludiNaz )
For r = 1 To 10
If clsP.GetValoreGriglia(r,nIdColValCerc) > aRetValori(r,1) Then
aRetValori(r,1) = clsP.GetValoreGriglia(r,nIdColValCerc)
aRetValori(r,0) = idEstr
aRetValori(r,2) = StringaNumeri(aNum)
End If
Next
If idEstr Mod 10 = 0 Then
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
End If
Next
If ScriptInterrotto Then Exit For
Next
Set clsP = Nothing
End Sub
Sub InitCalcoloRappPiuAlti(aElemFormazione,nSorte,nClasse,Inizio,Fine, bIncludiNaz)
Dim k
If MsgBox("Creare la tabellina dei rapporti massimi ?",vbQuestion + vbYesNo) = vbYes Then
ReDim aRetValori(10,2)
Call CalcolaValoriPiuAltiAssoluti(aElemFormazione,nClasse,nSorte,Inizio,Fine,aRetValori,bIncludiNaz , 14)
ReDim aV(4)
aV(1) = "Q.Ruote"
aV(2) = "Rapporto"
aV(3) = "Estrazione"
aV(4) = "Numeri"
Call InitTabella(aV)
For k = 1 To 10
aV(1) = k
aV(2) = aRetValori(k,1)
aV(3) = aRetValori(k,0)
aV(4) = aRetValori(k,2)
Call AddRigaTabella(aV)
Next
Call CreaTabella
Call Scrivi
End If
End Sub
Sub InitCalcoloSommwPiuAlti(aElemFormazione,nSorte,nClasse,Inizio,Fine , bIncludiNaz)
Dim k
If MsgBox("Creare la tabellina delle somme massime ?",vbQuestion + vbYesNo) = vbYes Then
ReDim aRetValori(10,2)
Call CalcolaValoriPiuAltiAssoluti(aElemFormazione,nClasse,nSorte,Inizio,Fine,aRetValori,bIncludiNaz ,12)
ReDim aV(4)
aV(1) = "Q.Ruote"
aV(2) = "Somme"
aV(3) = "Estrazione"
aV(4) = "Numeri"
Call InitTabella(aV)
For k = 1 To 10
aV(1) = k
aV(2) = aRetValori(k,1)
aV(3) = aRetValori(k,0)
aV(4) = aRetValori(k,2)
Call AddRigaTabella(aV)
Next
Call CreaTabella
Call Scrivi
End If
End Sub
B
Beppignello
Guest
scusate se faccio una richiesta, che mi pare una informazione utile, sempre che sia possibile
è possibile a quest'ultimo script, inserire una colonna con RitMaxSto nelle 10 formazioni della piramide, come se fossero ruote unificate?
url immagine
è possibile a quest'ultimo script, inserire una colonna con RitMaxSto nelle 10 formazioni della piramide, come se fossero ruote unificate?
url immagine
Ultima modifica di un moderatore:
Ultima estrazione Lotto
-
Estrazione del lotto
sabato 11 gennaio 2025Bari7343015881Cagliari6960180210Firenze2532185554Genova4805403469Milano1007704479Napoli1189013480Palermo3780824477Roma7804383956Torino0813302724Venezia5675361870Nazionale6383193180Estrazione Simbolotto
Bari
3534122320
