Rilancio

genios · 26 Settembre 2018

Ciao Cinzia ti espongo il tutto con due foto.

Questo il primo step .

Come dovrebbe essere l' out . l' altra foto la spiegazione

genios · 3 Luglio 2019

Script al post # 21 rimasto in sospeso qualcuno se la sente di svilupparlo ?

Ciao Eugenio

LuigiB · 3 Luglio 2019

Coiao , un regalino per l'estate una mia versione della richiesta al primo post con ulteriori dati statistici , verificare se corretto.
Lo script analizza una formazione scelta tra le formazioni registrate , percio si puo usare non solo per le decine della richieesta ma anche per altri gruppi se non ci sono basta crearli.

saluti a tutti ... e a Silop e Joe in particolare ...

p.s.

dato che ho visto davvero notevoli progressi di molti vi incito ad usare anche le classi nei vostri script...
la ruota nazionale non l'ho messa apposta cosi chi se la sente per capire bene il flusso puo farlo lui ...

Codice:

Class clsCollCombinazioni
   Private mColl
   Private mSorte
   Private mRitardo(12)
   Private mFrequenza(12)
   Private mPresenze(12)
   Private mRitardoMax(12)
   Private mIncrRitardoMax(12)
   Private mMaxIncrRitardoMax(12)
   Private mPresenzeConsec(12)
   Private mPresenzeConsecMax(12)
   Private mEsiti(12)
   Private mNome
   Public Property Get Nome
      Nome = mNome
   End Property
   Public Property Let Nome(v)
      mNome = v
   End Property
   Sub Class_Initialize
      Set mColl = GetNewCollection
   End Sub
   Public Property Let Sorte(v)
      mSorte = v
   End Property
   Public Property Get Sorte
      Sorte = mSorte
   End Property
   Public Property Get Ritardo(r)
      Ritardo = mRitardo(r)
   End Property
   Public Property Get Frequenza(r)
      Frequenza = mFrequenza(r)
   End Property
   Public Property Get Presenze(r)
      Presenze = mPresenze(r)
   End Property
   Public Property Get RitardoMax(r)
      RitardoMax = mRitardoMax(r)
   End Property
   Public Property Get IncrRitardoMax(r)
      IncrRitardoMax = mIncrRitardoMax(r)
   End Property
   Public Property Get MaxIncrRitardoMax(r)
      MaxIncrRitardoMax = mMaxIncrRitardoMax(r)
   End Property
   Public Property Get PresenzeConsec(r)
      PresenzeConsec = mPresenzeConsec(r)
   End Property
   Public Property Get PresenzeConsecMax(r)
      PresenzeConsecMax = mPresenzeConsecMax(r)
   End Property
   Public Property Get Esiti(r)
      Esiti = mEsiti(r)
   End Property
   Sub AddCombinazione(aN)
      Dim cComb
      Dim sKey
      Set cComb = New clsCombinazione
      cComb.SetNumeri(aN)
      sKey = "k" & StringaNumeri(aN,,True)
      Call AddItemColl(mColl,cComb,sKey)
   End Sub
   Sub CalcolaStatistica(aRuote,idEstr,nFreqMin,nLenCiclo ,nRetEstrControllate)
      Dim cComb,r
      Dim aNumEstratti
      Dim nFreq,nEsiti
      Dim idEstrTmp
      Dim nPunti

      ' Call GetEstrazioneCompleta  (idEstr, aNumEstratti )
      For r = 1 To UBound(aRuote)
          nRetEstrControllate =0
         If aRuote(r) <> 0 And aRuote(r) <> TT_ Then
            nFreq = 0
            nEsiti = 0
            For idEstrTmp = idEstr To idEstr +(nLenCiclo - 1)
               If GetArrayNumeriRuota(idEstrTmp,aRuote(r),aNumEstratti) Then
                  nRetEstrControllate =  nRetEstrControllate +1
                  For Each cComb In mColl
                     nPunti = cComb.PuntiSu(aNumEstratti)
                     If nPunti >= mSorte Then
                        nFreq = nFreq + Combinazioni(nPunti,mSorte)
                        nEsiti = nEsiti + 1
                     End If
                  Next
               End If
            Next
            If nFreq >= nFreqMin Then
               If mIncrRitardoMax(r) > mMaxIncrRitardoMax(r) Then mMaxIncrRitardoMax(r) = mIncrRitardoMax(r)
               mIncrRitardoMax(r) = 0
               If mRitardo(r) > mRitardoMax(r) Then mRitardoMax(r) = mRitardo(r)
               mRitardo(r) = 0
               mFrequenza(r) = mFrequenza(r) + nFreq
               mPresenzeConsec(r) = mPresenzeConsec(r) + 1
               mPresenze(r) = mPresenze(r) + 1
            Else
               mRitardo(r) = mRitardo(r) + 1
               If mRitardo(r) > mRitardoMax(r) Then mIncrRitardoMax(r) = mIncrRitardoMax(r) + 1
               If mPresenzeConsec(r) > mPresenzeConsecMax(r) Then mPresenzeConsecMax(r) = mPresenzeConsec(r)
               mPresenzeConsec(r) = 0
            End If
         End If
      Next
   End Sub
   Function GetStringaNumeri
      Dim s,o
      For Each o In mColl
         s = s & o.GetStringaNumeri & vbCrLf
      Next
      GetStringaNumeri = RimuoviLastChr(s,vbCrLf)
   End Function
End Class
Class clsCombinazione
   Private aN()
   Private aBN()
   Sub Class_Initialize
      ReDim aN(0)
      ReDim abn(90)
   End Sub
   Sub SetNumeri(aNum)
      Dim k
      Dim nClasse
      nClasse = UBound(aNum)
      ReDim aN(nClasse)
      For k = 1 To nClasse
         aN(k) = aNum(k)
         aBN(aN(k)) = True
      Next
   End Sub
   Function PuntiSu(aNum)
      Dim p,k
      p = 0
      For k = 1 To UBound(aNum)
         If aBN(aNum(k)) Then
            p = p + 1
         End If
      Next
      PuntiSu = p
   End Function
   Function GetStringaNumeri
      GetStringaNumeri = StringaNumeri(aN,,True)
   End Function
End Class
Sub Main

   Dim nGiocata
   Dim k,e,j,ee,i
   Dim Ini,fin,idEstr
   ReDim aRt(11)

   Dim aCollComb
   Dim sDirComb
   Dim cCollComb
   Dim nFreqPerCiclo
   Dim nSorte
   Dim nLenCiclo
   Dim aSubTitolo
   Dim sNomeFromazione
   Dim nCicli , nEstrNonControllate
   Dim nEstrControllate
   Dim bAnalizza ,bConteggiaUltimoCiclo
   Dim nColoreCelledati , nColoreA , nColoreB


   nEstrNonControllate =0
   nFreqPerCiclo = Int(InputBox("Frequenze per ciclo","Frequenze",2))
   nLenCiclo = Int(InputBox("Lunghezza ciclo","Lunghezza ciclo",9))
   sDirComb = GetDirectoryAppData & "FormazioniTesto\decine\"
   nSorte = ScegliEsito(2)


   Ini = EstrazioneIni
   fin = EstrazioneFin

   For k = 1 To 10
      aRt(k) = k
   Next
   aRt(11) = 12

   If MsgBox ("Conteggio ultimo ciclo ? " ,  vbQuestion + vbYesNo ) = vbYes  Then
      bConteggiaUltimoCiclo  = True
   Else
      bConteggiaUltimoCiclo = False
   End If
   sNomeFromazione = scegliFormazione
   If AlimentaCollCombDaFormazioni(aCollComb,sNomeFromazione,nSorte) Then
      For k = Ini To fin


         If bConteggiaUltimoCiclo Then
               bAnalizza = True
         Else
               bAnalizza =  (k + (nLenCiclo -1))  <= fin
         End If



         If bAnalizza Then
            For j = 1 To UBound(aCollComb)
               Call aCollComb(j).CalcolaStatistica(aRt,k,nFreqPerCiclo,nLenCiclo ,nEstrControllate)
            Next
            k = k +(nLenCiclo - 1)
            nCicli =   nCicli  +1
         Else
            nEstrNonControllate  =nEstrNonControllate +1

         End If
         Call AvanzamentoElab(Ini,fin,k)
         If ScriptInterrotto Then Exit For
      Next
   End If
   aSubTitolo = Array("","Rit","RitMx","IncRMx","MaxIncRMx","Frq","Pres","PresCons","MaxPresCons")

   nColoreA = RGB(192,192,192)
   nColoreB = RGB(251,250,189)
   nColoreCelledati = nColoreB

   ReDim aTitoli(81)
   ReDim aSubTitoli(81)
   ReDim aValori(81)
   ReDim aColSpan(81)
   ReDim aColori (81)
   i = 1
   aColSpan(1) = 1
   aSubTitoli(1) = ""
   aTitoli(1) = "Numeri"
   aColori (1) = RGB(196,244,208)
   For k = 1 To 10
      If nColoreCelledati = nColoreA Then
         nColoreCelledati = nColoreB
      Else
         nColoreCelledati = nColoreA
      End If
      For e = 1 To 8
         i = i + 1
         If e = 1 Then
            aTitoli(i) = NomeRuota(k)
            aColSpan(i) = 8
         Else
            aTitoli(i) = ""
            aColSpan(i) = 0
         End If
         aSubTitoli(i) = aSubTitolo(e)
         aColori (i) = nColoreCelledati
      Next
   Next

   Call Scrivi ("Inizio                               : " & GetInfoEstrazione (Ini))
   Call Scrivi ("Fine                                 : " & GetInfoEstrazione (fin))
   Call Scrivi ("Per sorte                            : " & NomeSorte (nSorte ))
   Call Scrivi ("Lunghezza ciclo                      : " & nLenCiclo )
   Call Scrivi ("Cicli                                : " & nCicli )
   Call Scrivi ("Parziali ultimo ciclo                : " & nEstrControllate & "/" & nLenCiclo )
   Call Scrivi ("Estr ciclo parz non conteggiato      : " & nEstrNonControllate  )
   If nEstrNonControllate    > 0 Then  Call Scrivi ("Inizio ultimo ciclo                  : " & GetInfoEstrazione ((fin - nEstrNonControllate  ) +1))


   Call Scrivi




   Call InitTabella(aTitoli, vbBlue, , , vbWhite ,,aColSpan)
   Call AddRigaTabella(aSubTitoli ,vbRed, , , vbWhite )
   For j = 1 To UBound(aCollComb)
      i = 1
      aValori(i) = aCollComb(j).GetStringaNumeri
      For k = 1 To 10
         For e = 1 To 8
            i = i + 1
            Select Case e
            Case 1
               aValori(i) = aCollComb(j).Ritardo(k)
            Case 2
               aValori(i) = aCollComb(j).RitardoMax(k)
            Case 3
               aValori(i) = aCollComb(j).IncrRitardoMax(k)
            Case 4
               aValori(i) = aCollComb(j).MaxIncrRitardoMax(k)
            Case 5
               aValori(i) = aCollComb(j).Frequenza(k)
            Case 6
               aValori(i) = aCollComb(j).Presenze(k)
            Case 7
               aValori(i) = aCollComb(j).PresenzeConsec(k)
            Case 8
               aValori(i) = aCollComb(j).PresenzeConsecMax(k)
            End Select
         Next
      Next
      Call AddRigaTabella(aValori ,aColori  )
   Next
   CreaTabella

End Sub
Function AlimentaCollCombDaFormazioni(aCollComb,sFormazione,nSorte)
   Dim aFiles
   Dim k,j,e,nInserite
   Dim aRighe
   Dim aElementi
   Call GetElementiFormazione(sFormazione,aElementi)
   ReDim aCollComb(UBound(aElementi))
   For j = 1 To UBound(aElementi)
      Set aCollComb(j) = New clsCollCombinazioni
      aCollComb(j).Nome = sFormazione
      aCollComb(j).sorte = nSorte
      ReDim aN(UBound(aElementi,2))
      For e = 1 To UBound(aElementi,2)
         aN(e) = aElementi(j,e)
      Next
      aCollComb(j).AddCombinazione(aN)
      nInserite = nInserite + 1
   Next
   AlimentaCollCombDaFormazioni = nInserite > 0
End Function
Function scegliFormazione
   ReDim aFiles(0)
   Dim i
   Call ElencoFileInDirectory(GetDirectoryAppData & "formazioni\",aFiles,".frz")
   i = ScegliOpzioneMenu(aFiles)
   If i > 0 Then
      scegliFormazione = aFiles(i)
   End If
End Function

genios · 3 Luglio 2019

Grazie LuigiB.

Ciao Eugenio

genios · 3 Luglio 2019

LuigiB Qualcosa non quadra in RitMx e MaxIncRMx sulle ruote di CA e GE .

Ciao Eugenio

genios · 3 Luglio 2019

Risolto .

Ciao Eugenio

silop2005 · 4 Luglio 2019

[TABLE="border: 0, cellpadding: 0, cellspacing: 0"]
[TR]
[TD="width: 755"][IMG2=JSON]{"data-align":"none","data-size":"full","src":"http:\/\/www.silop.it\/image\/LOGOSILOP.gif"}[/IMG2]
SPMT vers. 1.6.31_Agg.Web e relativo plugin SVP vers. 1.0.56 e Plugin_FTP vers. 1.0 e SpazioScript vers.1.0.9[/TD]
[/TR]
[TR]
[TD]======================[/TD]
[/TR]
[TR]
[TD]Ciao LuigiB ,[/TD]
[/TR]
[TR]
[TD]======================[/TD]
[/TR]
[TR]
[TD]ricambio i saluti e ti ringrazio del regalino d'estate.[/TD]
[/TR]
[TR]
[TD]Fa molto piacere leggerti ogni tanto su questo forum,[/TD]
[/TR]
[TR]
[TD]io e Joe sul mio spazio web stiamo cercando di fare (Lui)[/TD]
[/TR]
[TR]
[TD]un programmino che aggiorna il tuo bel programma Spaziometria[/TD]
[/TR]
[TR]
[TD]l'archivio lotto da una fonte alternativa ufficiale che è il Televideo Rai,[/TD]
[/TR]
[TR]
[TD]qui puoi vedere il thread su lottoced :[/TD]
[/TR]
[TR]
[TD]

https://forum.lottoced.com/forum/lottoced/area-download/2176472-aggiornamento-archivio-lotto

[/TD]
[/TR]
[TR]
[TD]mentre se vai sul mio sito IN_DIRETTA_by_Silop[/TD]
[/TR]
[TR]
[TD]puoi vedere la pagina dedicata allo sviluppo del progettino.[/TD]
[/TR]
[TR]
[TD]Ti faccio tanti auguri e una felice estate in tranquillità.[/TD]
[/TR]
[TR]
[TD]======================[/TD]
[/TR]
[TR]
[TD]Ringrazio Genios che ha ripreso questo vecchio argomento.[/TD]
[/TR]
[TR]
[TD]======================[/TD]
[/TR]
[TR]
[TD]Buon giornata a tutto il forum.[/TD]
[/TR]
[TR]
[TD][IMG2=JSON]{"data-align":"none","data-size":"full","src":"http:\/\/www.silop.it\/image\/stickman.gif"}[/IMG2][/TD]
[/TR]
[TR]
[TD]======================[/TD]
[/TR]
[TR]
[TD]A presto[/TD]
[/TR]
[TR]
[TD]Silop

[/TD]
[/TR]
[/TABLE]

joe · 4 Luglio 2019

Ringrazio e ricambio i graditi saluti di LuigiB,

ed anche ringrazio Silop per l'aver molto contribuito a questo lavoro che si sta cercando di completare.

Penso di essere a buon punto, avendo oggi, potuto testare e ritrovare ben funzionanti alcune

delle parti relative all'aggiornamento dell' archvio-base (e remoto) che poi viene messa a disposizione di tutti.

Ricordo che Archivio e PlugIn sono già disponibili / funzionanti /aggiornati.

Con questi ... è possibile aggiornare (sottolineo aggiornare) l' Archivio Lotto di Spaziometria

in un solo colpo, di tutte le estrazioni mancanti

e/o di quelle eventualmente troncate per eliminare errori

a partire dalla prima Estrazione di questo 2019.

Buona serata a tutte/i.

druid · 5 Luglio 2019

Buongiorno joe e tutti gli intervenuti.

Leggo qualche post sopra che stai realizzando un "sistema" per l'aggiornamento "automatico" delle estrazioni tramite il televideo rai.

La domanda e' questa: essendo il sito di silop (cosi' a prima vista leggendo la conformazione/composizione del sito) di tipo statico, come gestisci l'evento che il giorno dell'estrazione scarica in automatico la nuova estrazione del lotto dal televideo?

Ti ringrazio per l'eventuale risposta.

Ciao

sorujoe · 7 Luglio 2019

Ottimo lo script di LuigiB qualcuno capace potrebbe inserire anche la ruota nazionale?

joe · 8 Luglio 2019

Ciao druid
attualmente l'archivio messo a disposizione di tutti

è aggiornato manualmente da Silop.

Sto cercando di automatizzare alcune di queste procedure.

Non è ancora definibile in livello di automazione che si potrà

raggiungere. In teoria sì potrebbe arrivare al punto in cui

Spaziometria si aggiorni da sé di tutte le estrazioni disponibili.

Esattamente come adesso controlla se ci sono nuove versioni del programma...

Potrebbe controllare se ci sono estrazioni non ancora scaricate.

druid · 9 Luglio 2019

Ciao Joe, grazie per la risposta.
Avevo frainteso, leggendo gli ultimi post, che stavi lavorando sul modo di aggiornare gli archivi in modo automatico, cioe' senza l'ausilio umano, e volevo confrontarmi con te......
Stavo lavorando anch'io sullo stesso fronte, e dopo "milioni di ricerche di info" mi sono reso persuaso che la "cosa" non funziona sui siti statici (pagine web con desinenza .html o simili - come quello di Silop per intenderci), ma solo su quelli dinamici (pagine web con desinenza .aspx o .php) dove e' possibile utilizzare linguaggi di scripting per la gestione degli eventi (ad esempio al cambio di data di estrazione sul televideo automaticamente mi scarica l'ultima estrazione).

Buon lavoro.
Ciao.

solare · 9 Luglio 2019

Complimenti e grazie ancora a Luigi.
Mancherebbe la possibilità di automatizzare le colonne dal più piccolo al più grande e viceversa.

joe · 9 Luglio 2019

Druid prova a chiedere a Gam.

Dovrebbe poterti indirizzare ad una soluzione.

druid · 10 Luglio 2019

Ciao, se ti riferisci al sito di lotto Gam anche quello e' un sito dinamico che usa wp come cms.
Grazie cmq.
Ciao

genios · 10 Luglio 2019

Per LuigiB o chi riesce mettere mano a questo splendido script . Occorre aggiungere la colonna combinazione ad ogni ruota altrimenti diventa molto difficile confrontare il ritardo specialmente nelle combinazioni molto numerose .

Ciao Eugenio

LuigiB · 10 Luglio 2019

Codice:

Class clsCollCombinazioni
   Private mColl
   Private mSorte
   Private mRitardo(12)
   Private mFrequenza(12)
   Private mPresenze(12)
   Private mRitardoMax(12)
   Private mIncrRitardoMax(12)
   Private mMaxIncrRitardoMax(12)
   Private mPresenzeConsec(12)
   Private mPresenzeConsecMax(12)
   Private mEsiti(12)
   Private mNome
   Public Property Get Nome
      Nome = mNome
   End Property
   Public Property Let Nome(v)
      mNome = v
   End Property
   Sub Class_Initialize
      Set mColl = GetNewCollection
   End Sub
   Public Property Let Sorte(v)
      mSorte = v
   End Property
   Public Property Get Sorte
      Sorte = mSorte
   End Property
   Public Property Get Ritardo(r)
      Ritardo = mRitardo(r)
   End Property
   Public Property Get Frequenza(r)
      Frequenza = mFrequenza(r)
   End Property
   Public Property Get Presenze(r)
      Presenze = mPresenze(r)
   End Property
   Public Property Get RitardoMax(r)
      RitardoMax = mRitardoMax(r)
   End Property
   Public Property Get IncrRitardoMax(r)
      IncrRitardoMax = mIncrRitardoMax(r)
   End Property
   Public Property Get MaxIncrRitardoMax(r)
      MaxIncrRitardoMax = mMaxIncrRitardoMax(r)
   End Property
   Public Property Get PresenzeConsec(r)
      PresenzeConsec = mPresenzeConsec(r)
   End Property
   Public Property Get PresenzeConsecMax(r)
      PresenzeConsecMax = mPresenzeConsecMax(r)
   End Property
   Public Property Get Esiti(r)
      Esiti = mEsiti(r)
   End Property
   Sub AddCombinazione(aN)
      Dim cComb
      Dim sKey
      Set cComb = New clsCombinazione
      cComb.SetNumeri(aN)
      sKey = "k" & StringaNumeri(aN,,True)
      Call AddItemColl(mColl,cComb,sKey)
   End Sub
   Sub CalcolaStatistica(aRuote,idEstr,nFreqMin,nLenCiclo,nRetEstrControllate)
      Dim cComb,r
      Dim aNumEstratti
      Dim nFreq,nEsiti
      Dim idEstrTmp
      Dim nPunti

      ' Call GetEstrazioneCompleta  (idEstr, aNumEstratti )
      For r = 1 To UBound(aRuote)
          nRetEstrControllate = 0
         If aRuote(r) <> 0 And aRuote(r) <> TT_ Then
            nFreq = 0
            nEsiti = 0
            For idEstrTmp = idEstr To idEstr +(nLenCiclo - 1)
               If GetArrayNumeriRuota(idEstrTmp,aRuote(r),aNumEstratti) Then
                  nRetEstrControllate = nRetEstrControllate + 1
                  For Each cComb In mColl
                     nPunti = cComb.PuntiSu(aNumEstratti)
                     If nPunti >= mSorte Then
                        nFreq = nFreq + Combinazioni(nPunti,mSorte)
                        nEsiti = nEsiti + 1
                     End If
                  Next
               End If
            Next
            If nFreq >= nFreqMin Then
               If mIncrRitardoMax(r) > mMaxIncrRitardoMax(r) Then mMaxIncrRitardoMax(r) = mIncrRitardoMax(r)
               mIncrRitardoMax(r) = 0
               If mRitardo(r) > mRitardoMax(r) Then mRitardoMax(r) = mRitardo(r)
               mRitardo(r) = 0
               mFrequenza(r) = mFrequenza(r) + nFreq
               mPresenzeConsec(r) = mPresenzeConsec(r) + 1
               mPresenze(r) = mPresenze(r) + 1
            Else
               mRitardo(r) = mRitardo(r) + 1
               If mRitardo(r) > mRitardoMax(r) Then mIncrRitardoMax(r) = mIncrRitardoMax(r) + 1
               If mPresenzeConsec(r) > mPresenzeConsecMax(r) Then mPresenzeConsecMax(r) = mPresenzeConsec(r)
               mPresenzeConsec(r) = 0
            End If
         End If
      Next
   End Sub
   Function GetStringaNumeri
      Dim s,o
      For Each o In mColl
         s = s & o.GetStringaNumeri & vbCrLf
      Next
      GetStringaNumeri = RimuoviLastChr(s,vbCrLf)
   End Function
End Class
Class clsCombinazione
   Private aN()
   Private aBN()
   Sub Class_Initialize
      ReDim aN(0)
      ReDim abn(90)
   End Sub
   Sub SetNumeri(aNum)
      Dim k
      Dim nClasse
      nClasse = UBound(aNum)
      ReDim aN(nClasse)
      For k = 1 To nClasse
         aN(k) = aNum(k)
         aBN(aN(k)) = True
      Next
   End Sub
   Function PuntiSu(aNum)
      Dim p,k
      p = 0
      For k = 1 To UBound(aNum)
         If aBN(aNum(k)) Then
            p = p + 1
         End If
      Next
      PuntiSu = p
   End Function
   Function GetStringaNumeri
      GetStringaNumeri = StringaNumeri(aN,,True)
   End Function
End Class
Sub Main

   Dim nGiocata
   Dim k,e,j,ee,i
   Dim Ini,fin,idEstr
   ReDim aRt(11)

   Dim aCollComb
   Dim sDirComb
   Dim cCollComb
   Dim nFreqPerCiclo
   Dim nSorte
   Dim nLenCiclo
   Dim aSubTitolo
   Dim sNomeFromazione
   Dim nCicli,nEstrNonControllate
   Dim nEstrControllate
   Dim bAnalizza,bConteggiaUltimoCiclo
   Dim nColoreCelledati,nColoreCelleTitolo,nColoreA,nColoreB,nColoreTitoloA,nColoreTitoloB


   nEstrNonControllate = 0
   nFreqPerCiclo = Int(InputBox("Frequenze per ciclo","Frequenze",2))
   nLenCiclo = Int(InputBox("Lunghezza ciclo","Lunghezza ciclo",9))
   sDirComb = GetDirectoryAppData & "FormazioniTesto\decine\"
   nSorte = ScegliEsito(2)


   Ini = EstrazioneIni
   fin = EstrazioneFin

   For k = 1 To 10
      aRt(k) = k
   Next
   aRt(11) = 12

   If MsgBox("Conteggio ultimo ciclo ? ",vbQuestion + vbYesNo) = vbYes Then
      bConteggiaUltimoCiclo = True
   Else
      bConteggiaUltimoCiclo = False
   End If
   sNomeFromazione = scegliFormazione
   If AlimentaCollCombDaFormazioni(aCollComb,sNomeFromazione,nSorte) Then
      For k = Ini To fin


         If bConteggiaUltimoCiclo Then
               bAnalizza = True
         Else
               bAnalizza =(k +(nLenCiclo - 1)) <= fin
         End If



         If bAnalizza Then
            For j = 1 To UBound(aCollComb)
               Call aCollComb(j).CalcolaStatistica(aRt,k,nFreqPerCiclo,nLenCiclo,nEstrControllate)
            Next
            k = k +(nLenCiclo - 1)
            nCicli = nCicli + 1
         Else
            nEstrNonControllate = nEstrNonControllate + 1

         End If
         Call AvanzamentoElab(Ini,fin,k)
         If ScriptInterrotto Then Exit For
      Next
   End If
   aSubTitolo = Array("","Numeri","Rit","RitMx","IncRMx","MaxIncRMx","Frq","Pres","PresCons","MaxPresCons")

   nColoreA = RGB(192,192,192)
   nColoreB = RGB(251,250,189)

   nColoreTitoloA = RGB(88,80,250)
   nColoreTitoloB = RGB(56,89,167)


   ReDim aTitoli(99)
   ReDim aSubTitoli(99)
   ReDim aValori(99)
   ReDim aColSpan(99)
   ReDim aColori(99)
   ReDim aColoriTitolo(99)
   i = 0
   aColSpan(1) = 1
   aSubTitoli(1) = ""
   aTitoli(1) = "Numeri"
   'aColori(1) = RGB(196,244,208)
   nColoreCelleTitolo = nColoreTitoloB
    nColoreCelledati = nColoreB
   For k = 1 To 11
      If nColoreCelledati = nColoreA Then
         nColoreCelledati = nColoreB

      Else
         nColoreCelledati = nColoreA
      End If
      If nColoreCelleTitolo = nColoreTitoloA Then
         nColoreCelleTitolo = nColoreTitoloB

      Else
         nColoreCelleTitolo = nColoreTitoloA
      End If

      For e = 1 To 9
         i = i + 1
         If e = 1 Then
            aTitoli(i) = NomeRuota(Iif(k < 11,k,12))
            aColSpan(i) = 9
         Else
            aTitoli(i) = ""
            aColSpan(i) = 0
         End If
         aSubTitoli(i) = aSubTitolo(e)
         If e > 1 Then
            aColori(i) = nColoreCelledati
         Else
            aColori(i) = RGB(196,244,208)


         End If

         aColoriTitolo(i) = nColoreCelleTitolo


      Next
   Next

   Call Scrivi("Inizio                               : " & GetInfoEstrazione(Ini))
   Call Scrivi("Fine                                 : " & GetInfoEstrazione(fin))
   Call Scrivi("Per sorte                            : " & NomeSorte(nSorte))
   Call Scrivi("Lunghezza ciclo                      : " & nLenCiclo)
   Call Scrivi("Cicli                                : " & nCicli)
   Call Scrivi("Parziali ultimo ciclo                : " & nEstrControllate & "/" & nLenCiclo)
   Call Scrivi("Estr ciclo parz non conteggiato      : " & nEstrNonControllate)
   If nEstrNonControllate > 0 Then Call Scrivi("Inizio ultimo ciclo                  : " & GetInfoEstrazione((fin - nEstrNonControllate) + 1))


   Call Scrivi




   Call InitTabella(aTitoli,aColoriTitolo,,,vbWhite,,aColSpan)
   Call AddRigaTabella(aSubTitoli,vbRed,,,vbWhite)
   For j = 1 To UBound(aCollComb)
      i = 0
      aValori(i) = aCollComb(j).GetStringaNumeri
      For k = 1 To 11
         For e = 1 To 9
            i = i + 1
            Select Case e
            Case 1
               aValori(i) = aValori(0)
            Case 2
               aValori(i) = aCollComb(j).Ritardo(k)


            Case 3
               aValori(i) = aCollComb(j).RitardoMax(k)
            Case 4
               aValori(i) = aCollComb(j).IncrRitardoMax(k)
            Case 5
               aValori(i) = aCollComb(j).MaxIncrRitardoMax(k)
            Case 6
               aValori(i) = aCollComb(j).Frequenza(k)
            Case 7
               aValori(i) = aCollComb(j).Presenze(k)
            Case 8
               aValori(i) = aCollComb(j).PresenzeConsec(k)
            Case 9
               aValori(i) = aCollComb(j).PresenzeConsecMax(k)
            End Select
         Next
      Next
      Call AddRigaTabella(aValori,aColori)
   Next
   CreaTabella

End Sub
Function AlimentaCollCombDaFormazioni(aCollComb,sFormazione,nSorte)
   Dim aFiles
   Dim k,j,e,nInserite
   Dim aRighe
   Dim aElementi
   Call GetElementiFormazione(sFormazione,aElementi)
   ReDim aCollComb(UBound(aElementi))
   For j = 1 To UBound(aElementi)
      Set aCollComb(j) = New clsCollCombinazioni
      aCollComb(j).Nome = sFormazione
      aCollComb(j).sorte = nSorte
      ReDim aN(UBound(aElementi,2))
      For e = 1 To UBound(aElementi,2)
         aN(e) = aElementi(j,e)
      Next
      aCollComb(j).AddCombinazione(aN)
      nInserite = nInserite + 1
   Next
   AlimentaCollCombDaFormazioni = nInserite > 0
End Function
Function scegliFormazione
   ReDim aFiles(0)
   Dim i
   Call ElencoFileInDirectory(GetDirectoryAppData & "formazioni\",aFiles,".frz")
   i = ScegliOpzioneMenu(aFiles)
   If i > 0 Then
      scegliFormazione = aFiles(i)
   End If
End Function

genios · 11 Luglio 2019

Grazie LuigiB.

Ciao Eugenio

solare · 11 Luglio 2019

Grazie Luigi

sorujoe · 11 Luglio 2019

Diciamolo pure il MAESTRO LuigiB ........andrebbe CLONATO

Rilancio

Advanced Member >PLATINUM<

Allegati

Advanced Member >PLATINUM<

LuigiB

Guest

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Super Member >PLATINUM<

Advanced Member >GOLD<

Advanced Member >PLATINUM PLUS<

Super Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Super Member >PLATINUM<

Advanced Member >PLATINUM<

LuigiB

Guest

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >GOLD<