Novità

Script per numeri spia

G

gastaldop

Junior Member
Chiedo al buon Salvo50 se mi riesce a creare uno script che mi evidenza (non so se esiste gia') per ogni ambo i numeri spia che preannunciano la sua uscita.
Questo script mi deve richiedere per quale ruota, il periodo di ricerca temporale.
Grazie
 
Ciao a Tutti

gastaldop ha scritto:
Chiedo al buon Salvo50 se mi riesce a creare uno script che mi evidenza (non so se esiste gia') per ogni ambo i numeri spia che preannunciano la sua uscita.
Questo script mi deve richiedere per quale ruota, il periodo di ricerca temporale.
Grazie
Clicca per espandere...
Ne ho trovat 2, il primo è di LuigiB,
il secondo di Blackmore

LuigiB

Codice: 
Option Explicit
Class clsAmbo
    Private aNumeri(2)
    Private m_Presenze
    Private m_Key
    Private m_Ritardo
    Private m_RitardoMax
    
    Public Property Let Key(v)
        m_Key = v
    End Property
    Public Property Get Key()
        Key = m_Key
    End Property
    Public Property Get Presenze()
        Presenze = m_Presenze
    End Property
    Public Property Let Presenze(v)
        m_Presenze = v
    End Property
    Public Property Get NumeriString
        NumeriString = StringaNumeri(aNumeri,,True)
    End Property
    Public Property Get Ritardo
        Ritardo = m_Ritardo
    End Property
    Public Property Get RitardoMax
        RitardoMax = m_RitardoMax
    End Property
    
    Sub SetNumero(id,Numero)
        aNumeri(id) = Numero
    End Sub
    Sub StatisticaAmbo(nInizio,nFine,nRuota)
        ReDim aRuota(1)
        aRuota(1) = nRuota
        Call StatisticaFormazione(aNumeri,aRuota,2,m_Ritardo,m_RitardoMax,0,0,nInizio,nFine)
    End Sub
End Class
Class clsEstrazione
    Private m_collAmbi
    Private m_IdEst
    Private m_Inizio
    Private m_Fine
    Public Property Get Inizio
        Inizio = m_Inizio
    End Property
    Public Property Let Inizio(v)
        m_Inizio = v
    End Property
    Public Property Get Fine
        Fine = m_Fine
    End Property
    Public Property Let Fine(v)
        m_Fine = v
    End Property
    Public Property Get CollAmbi
        Set CollAmbi = m_collAmbi
    End Property
    Public Property Let IdEst(v)
        m_IdEst = v
    End Property
    Public Property Get IdEst()
        IdEst = m_IdEst
    End Property
    Sub Init(idEstr)
        Set m_collAmbi = GetNewCollection
        m_IdEst = idEstr
        m_Inizio = idEstr + 1
    End Sub
    Sub AddAmbo(aColonne,idColonna)
        Dim cAmbo
        Dim sKey
        sKey = "k" & Format2(aColonne(idColonna,1)) & "-" & Format2(aColonne(idColonna,2))
        Set cAmbo = GetItem(sKey,m_collAmbi)
        If cAmbo Is Nothing Then
            Set cAmbo = New clsAmbo
            Call cAmbo.SetNumero(1,aColonne(idColonna,1))
            Call cAmbo.SetNumero(2,aColonne(idColonna,2))
            cAmbo.Presenze = 1
            cAmbo.key = sKey
            m_collAmbi.Add cAmbo,sKey
        Else
            cAmbo.Presenze = cAmbo.Presenze + 1
        End If
    End Sub
    Function IsAmboPresente(sKey)
        Dim cAmbo
        Set cAmbo = GetItem(sKey,m_collAmbi)
        If Not(cAmbo Is Nothing) Then
            IsAmboPresente = True
        End If
    End Function
    Function GetAmboPiuFreq(nRetFrq)
        Dim cAmbo
        If m_collAmbi.count > 0 Then
            Call OrdinaItemCollection(m_collAmbi,"Presenze")
            Set cAmbo = m_collAmbi(1)
            GetAmboPiuFreq = cAmbo.NumeriString
            nRetFrq = cAmbo.Presenze
        Else
            GetAmboPiuFreq = ""
        End If
    End Function
End Class
Sub Main
    Dim nSpia
    Dim nInizio,nFine,nColpi
    Dim idEstr,k,e,i
    Dim nRuota
    Dim aColonne
    Dim cAmbo,cEstr
    Dim sKey
    Dim CollAmbi
    Dim CollEstrazioni
    Dim CollAmbiTot
    Dim bTrovato
    Dim nEs
    Const RigheMaxTabAmbiFreq = 20
    Const RigheMaxTabCopertura = 20
    Const RigheMaxRiepilogo = 20
    nSpia = CInt(InputBox("Inserisci Numero Spia",,20))
    nColpi = CInt(InputBox("Inserisci colpi",,6))
    nEs = CInt(InputBox("n° estrazioni di controllo",,2000))

    nInizio = EstrazioneFin - nEs
    nFine = EstrazioneFin
    nRuota = ScegliRuota
    Set CollAmbi = GetNewCollection
    Set CollEstrazioni = GetNewCollection
    Set CollAmbiTot = GetNewCollection
    If isNumeroValidoLotto(nSpia) And nColpi > 0 And nRuota > 0 Then
        For idEstr = nInizio To nFine
            bTrovato = IsNumeroPresenteInEstrazione(idEstr,nRuota,nSpia,0)
            If bTrovato Then
                Set cEstr = New clsEstrazione
                Call cEstr.Init(idEstr)
                For i = idEstr + 1 To idEstr + nColpi
                    ReDim aNum(5)
                    Call GetArrayNumeriRuota(i,nRuota,aNum)
                    If aNum(1) > 0 Then
                        Call OrdinaMatrice(aNum,1)
                        aColonne = SviluppoIntegrale(aNum,2)
                        For k = 1 To UBound(aColonne)
                            Call cEstr.AddAmbo(aColonne,k)
                            sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
                            Set cAmbo = GetItem(sKey,CollAmbi)
                            If cAmbo Is Nothing Then
                                Set cAmbo = New clsAmbo
                                cAmbo.key = sKey
                                Call cAmbo.SetNumero(1,aColonne(k,1))
                                Call cAmbo.SetNumero(2,aColonne(k,2))
                                cAmbo.Presenze = 1
                                CollAmbi.Add cAmbo,sKey
                            Else
                                cAmbo.Presenze = cAmbo.Presenze + 1
                            End If
                        Next
                    End If
                    cEstr.fine = i
                    If IsNumeroPresenteInEstrazione(i,nRuota,nSpia,0) Then
                        idEstr = i - 1
                        Exit For
                    End If
                Next
                CollEstrazioni.Add cEstr,"k" & cEstr.idEst
            End If
            Call AvanzamentoElab(nInizio,nFine,idEstr)
            If ScriptInterrotto Then Exit For
        Next
        Call OrdinaItemCollection(CollAmbi,"Presenze","Key")
        Call CalcolaCopertura(CollAmbiTot,CollEstrazioni)
        Call CreaTabRiepilogo(CollAmbi,CollAmbiTot,CollEstrazioni.count,nInizio,nFine,nRuota,RigheMaxRiepilogo)

        Call CreaTabPresenze(CollAmbi,RigheMaxTabAmbiFreq)
        Call CreaTabCopertura(CollAmbiTot,CollEstrazioni,RigheMaxTabCopertura)
        Call CreaTabCasiRilevati(CollEstrazioni,nSpia,nColpi,nRuota,nInizio,nFine)
    End If
End Sub
Function GetItem(sKey,CollAmbi)
    On Error Resume Next
    Set GetItem = Nothing
    Set GetItem = CollAmbi(sKey)
End Function
Sub AlimentaCollAmbiTot(collAmbi)
    Dim k,sKey
    ReDim aNum(90)
    Dim aColonne
    Dim cAmbo
    For k = 1 To 90
        aNum(k) = k
    Next
    aColonne = SviluppoIntegrale(aNum,2)
    For k = 1 To UBound(aColonne)
        sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
        Set cAmbo = New clsAmbo
        cAmbo.key = sKey
        Call cAmbo.SetNumero(1,aColonne(k,1))
        Call cAmbo.SetNumero(2,aColonne(k,2))
        cAmbo.Presenze = 0
        collAmbi.Add cAmbo,sKey
    Next
End Sub
Sub GetColoriRiga(aColori,nColDaEvid,ColoreLastCol)
    ReDim aColori(12)
    Dim k
    For k = 1 To 12
        If k = nColDaEvid Then
            aColori(k) = vbYellow
        Else
            aColori(k) = vbWhite
        End If
    Next
    aColori(12) = ColoreLastCol
End Sub
Sub CalcolaCopertura(CollAmbiTot,CollEstrazioni)
    Dim cAmbo
    Dim k
    Dim cEstr
    ' tabella copertura
    Call Messaggio("Calcolo copertura estrazioni")
    Call AlimentaCollAmbiTot(CollAmbiTot)
    k = 0
    For Each cAmbo In CollAmbiTot
        For Each cEstr In CollEstrazioni
            If cEstr.IsAmboPresente(cAmbo.key) Then
                cAmbo.presenze = cAmbo.presenze + 1
            End If
        Next
        k = k + 1
        Call AvanzamentoElab(1,CollAmbiTot.count,k)
        If ScriptInterrotto Then Exit For
    Next
    
End Sub
Sub CreaTabCopertura(CollAmbiTot,CollEstrazioni,nRigheMax)
    Dim cAmbo
    Dim k
    Dim cEstr
    
    Call OrdinaItemCollection(CollAmbiTot,"Presenze","Key")
    
    Call Scrivi("La seguente tabella indica la copertura degli ambi sulle estrazioni rilevate dai casi (" & CollEstrazioni.count & " casi)")
    Call Scrivi
    ' tabella copertura
    ReDim aTitoli(3)
    aTitoli(1) = "Ambo"
    aTitoli(2) = "Estrazioni Coperte"
    aTitoli(3) = "Percentuale"
    Call InitTabella(aTitoli)
    For Each cAmbo In CollAmbiTot
        If cAmbo.presenze > 0 Then
            ReDim aValori(3)
            aValori(1) = cAmbo.NumeriString
            aValori(2) = cAmbo.presenze
            aValori(3) = Round(Dividi((cAmbo.presenze * 100),CollEstrazioni.count),3) & " %"
            Call AddRigaTabella(aValori)
        End If
    Next
    Call Messaggio("Creazione tabella in corso ...")
    Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabPresenze(CollAmbi,nRigheMax)
    Dim cAmbo
    ' tabella presenze
    Call Scrivi("La seguente tabella indica la frequenza degli ambi")
    Call Scrivi
    'Call OrdinaItemCollection(CollAmbi,"Presenze")
    ReDim aTitoli(2)
    aTitoli(1) = "Ambo"
    aTitoli(2) = "Presenze"
    Call InitTabella(aTitoli)
    For Each cAmbo In CollAmbi
        ReDim aValori(2)
        aValori(1) = cAmbo.NumeriString
        aValori(2) = cAmbo.presenze
        Call AddRigaTabella(aValori)
    Next
    Call Messaggio("Creazione tabella in corso ...")
    Call CreaTabella(,,,nRigheMax)
End Sub
    'nInizio = EstrazioneFin - nes
    'nFine = EstrazioneFin
    'nRuota = ScegliRuota

Sub CreaTabCasiRilevati(CollEstrazioni,nSpia,nColpi,nRuota,nInizio,nFine)
    Dim i,k,n,nPosSpia,nFreq
    Dim cEstr
    ' tabella casi rilevati
    Call Scrivi("La seguente tabella indica i casi rilevati (" & CollEstrazioni.count & " casi)sulla ruota di " & SiglaRuota(nRuota) & " dal " & DataEstrazione(nInizio) & " a " & DataEstrazione(nFine))
    Call Scrivi
    Call Messaggio("Riepilogo  casi rilevati")
    ReDim aTitoli(12)
    aTitoli(1) = "Estrazione"
    aTitoli(2) = "Data"
    aTitoli(3) = "I"
    aTitoli(4) = "II"
    aTitoli(5) = "III"
    aTitoli(6) = "IV"
    aTitoli(7) = "V"
    aTitoli(8) = "Ambo Piu Frequente"
    aTitoli(9) = "Presenze"
    aTitoli(10) = "InizioAnalisi"
    aTitoli(11) = "FineAnalisi"
    aTitoli(12) = "EstrazioniSuccessive"
    i = 0
    Call InitTabella(aTitoli)
    For Each cEstr In CollEstrazioni
        ReDim aValori(12)
        aValori(1) = cEstr.idEst
        aValori(2) = DataEstrazione(cEstr.idEst)
        nPosSpia = 0
        For k = 1 To 5
            n = Estratto(cEstr.idEst,nRuota,k)
            aValori(k + 2) = n
            If n = nSpia Then
                nPosSpia = k
            End If
        Next
        aValori(8) = cEstr.GetAmboPiuFreq(nFreq)
        aValori(9) = nFreq
        aValori(10) = cEstr.Inizio
        aValori(11) = cEstr.Fine
        aValori(12) = cEstr.Fine -(cEstr.Inizio - 1)
        ReDim aColori(0)
        Call GetColoriRiga(aColori,nPosSpia + 2,Iif(aValori(12) = nColpi,vbGreen,vbYellow))
        Call AddRigaTabella(aValori,aColori)
        i = i + 1
        Call AvanzamentoElab(1,CollEstrazioni.count,i)
        If ScriptInterrotto Then Exit For
    Next
    Call Messaggio("Creazione tabella in corso ...")
    Call CreaTabella()
End Sub
Sub CreaTabRiepilogo(CollAmbi,CollAmbiTot,nCasiTrov,nInizio,nFine,nRuota,nRigheMax)
    Dim cAmboF,cAmboP
    Dim i
    
    Call Messaggio("Tabella riepilogo")

    ' tabella presenze
    Call Scrivi("La seguente tabella indica la frequenza degli ambi e le rispettive presenze")
    Call Scrivi
    ReDim aTitoli(8)
    aTitoli(1) = "Ambo"
    aTitoli(2) = "Presenze"
    aTitoli(3) = "Percentuale"
    aTitoli(4) = "Frequenza"
    aTitoli(5) = "Freq/Pres"
    aTitoli(6) = "Ritardo"
    aTitoli(7) = "RitMax"
    aTitoli(8) = "Ultima"
    
    Call InitTabella(aTitoli,vbBlue,,,vbWhite)
    
    ReDim aColori(8)
    aColori(1) = vbCyan
    aColori(2) = vbGreen
    aColori(3) = vbYellow
    aColori(4) = vbGreen
    aColori(5) = RGB(255,100,100)
    aColori(6) = RGB(255,90,90)
    aColori(7) = RGB(255,80,80)
    aColori(8) = RGB(255,70,70)
    
    
    For Each cAmboF In CollAmbi
        Set cAmboP = CollAmbiTot(cAmboF.key)
        Call cAmboF.StatisticaAmbo(nInizio,nFine,nRuota)
        ReDim aValori(8)
        aValori(1) = cAmboF.NumeriString
        aValori(2) = cAmboP.presenze
        aValori(3) = Round(Dividi((cAmboP.presenze * 100),nCasiTrov),3) & " %"
        aValori(4) = cAmboF.presenze
        aValori(5) = Round(Dividi(cAmboF.presenze,cAmboP.presenze),3)
        aValori(6) = cAmboF.Ritardo
        aValori(7) = cAmboF.RitardoMax
        aValori(8) = nFine - cAmboF.ritardo
        
        
        Call AddRigaTabella(aValori,aColori)
        i = i + 1
        Call AvanzamentoElab(1,nRigheMax,i)
        If ScriptInterrotto Then Exit For
        If i = nRigheMax Then Exit For

    Next
    Call Messaggio("Creazione tabella in corso ...")
    Call CreaTabella(2,- 1,,nRigheMax,0)
End Sub


Blackmore

Codice: 
Option Explicit
Class clsAmbo
   Private aNumeri(2)
   Private m_Presenze
   Private m_Key
   Private m_Ritardo
   Private m_RitardoMax
   Public Property Let Key(v)
      m_Key = v
   End Property
   Public Property Get Key()
      Key = m_Key
   End Property
   Public Property Get Presenze()
      Presenze = m_Presenze
   End Property
   Public Property Let Presenze(v)
      m_Presenze = v
   End Property
   Public Property Get NumeriString
      NumeriString = StringaNumeri(aNumeri,,True)
   End Property
   Public Property Get Ritardo
      Ritardo = m_Ritardo
   End Property
   Public Property Get RitardoMax
      RitardoMax = m_RitardoMax
   End Property
   Sub SetNumero(id,Numero)
      aNumeri(id) = Numero
   End Sub
   Sub StatisticaAmbo(nInizio,nFine,nRuota)
      ReDim aRuota(1)
      aRuota(1) = nRuota
      Call StatisticaFormazione(aNumeri,aRuota,2,m_Ritardo,m_RitardoMax,0,0,nInizio,nFine)
   End Sub
End Class
Class clsEstrazione
   Private m_collAmbi
   Private m_IdEst
   Private m_Inizio
   Private m_Fine
   Private m_aNumRilevati   
   Public Property Get Inizio
      Inizio = m_Inizio
   End Property
   Public Property Let Inizio(v)
      m_Inizio = v
   End Property
   Public Property Get Fine
      Fine = m_Fine
   End Property
   Public Property Let Fine(v)
      m_Fine = v
   End Property
   Public Property Get CollAmbi
      Set CollAmbi = m_collAmbi
   End Property
   Public Property Let IdEst(v)
      m_IdEst = v
   End Property
   Public Property Get IdEst()
      IdEst = m_IdEst
   End Property
   Public Property Let aNumRilevati(v)
  
      m_aNumRilevati = v
   End Property
   Public Property Get aNumRilevati
  
      aNumRilevati = m_aNumRilevati
   End Property
  

   Sub Init(idEstr)
      Set m_collAmbi = GetNewCollection
      m_IdEst = idEstr
      m_Inizio = idEstr + 1
   End Sub
   Sub AddAmbo(aColonne,idColonna)
      Dim cAmbo
      Dim sKey
      sKey = "k" & Format2(aColonne(idColonna,1)) & "-" & Format2(aColonne(idColonna,2))
      Set cAmbo = GetItem(sKey,m_collAmbi)
      If cAmbo Is Nothing Then
         Set cAmbo = New clsAmbo
         Call cAmbo.SetNumero(1,aColonne(idColonna,1))
         Call cAmbo.SetNumero(2,aColonne(idColonna,2))
         cAmbo.Presenze = 1
         cAmbo.key = sKey
         m_collAmbi.Add cAmbo,sKey
      Else
         cAmbo.Presenze = cAmbo.Presenze + 1
      End If
   End Sub
   Function IsAmboPresente(sKey)
      Dim cAmbo
      Set cAmbo = GetItem(sKey,m_collAmbi)
      If Not(cAmbo Is Nothing) Then
         IsAmboPresente = True
      End If
   End Function
   Function GetAmboPiuFreq(nRetFrq)
      Dim cAmbo
      If m_collAmbi.count > 0 Then
         Call OrdinaItemCollection(m_collAmbi,"Presenze")
         Set cAmbo = m_collAmbi(1)
         GetAmboPiuFreq = cAmbo.NumeriString
         nRetFrq = cAmbo.Presenze
      Else
         GetAmboPiuFreq = ""
      End If
   End Function
End Class
Sub Main
   Dim nInizio,nFine,nColpi
   Dim idEstr,k,e,i
   Dim nRuota
   Dim aColonne
   Dim cAmbo,cEstr
   Dim sKey
   Dim CollAmbi
   Dim CollEstrazioni
   Dim CollAmbiTot
   Dim bTrovato
   Dim TipoRicerca
   Dim aElemFormazione
   Const RigheMaxTabAmbiFreq = 20
   Const RigheMaxTabCopertura = 20
   Const RigheMaxRiepilogo = 20
   Dim aNumDaCercare
   Dim nPuntiDaFare
   Dim nClasseFrz
  
   TipoRicerca = GetTipoRicerca
   nColpi = CInt(InputBox("Inserisci colpi",,10))
   nInizio = EstrazioneIni
   nFine = EstrazioneFin
   nRuota = ScegliRuota
   Set CollAmbi = GetNewCollection
   Set CollEstrazioni = GetNewCollection
   Set CollAmbiTot = GetNewCollection
   If TipoRicerca = 0 Then
      ' numero spia
      ReDim aNumDaCercare(1)
      aNumDaCercare(1) = CInt(InputBox("Inserisci Numero Spia"))
      nPuntiDaFare = 1
   ElseIf TipoRicerca = 1 Then
      ' punti su lunghetta
      Call RichiediLunghetta(aNumDaCercare,nPuntiDaFare)
   ElseIf TipoRicerca = 2 Then
      ' punti su elemento formazione
      Call RichiediFormazione(aElemFormazione,nPuntiDaFare,nClasseFrz)
      ReDim aNumDaCercare(nClasseFrz)
   Else
      nPuntiDaFare = 1
      ReDim aNumDaCercare(1)

   End If
   If nColpi > 0 And nRuota > 0 And TipoRicerca >= 0 And nPuntiDaFare > 0 Then
      For idEstr = nInizio To nFine
         'bTrovato = IsNumeroPresenteInEstrazione(idEstr,nRuota,nSpia,0)
         bTrovato = VerificaCondizione(TipoRicerca,idEstr,nRuota,aNumDaCercare,nPuntiDaFare,aElemFormazione)

         If bTrovato Then
            Set cEstr = New clsEstrazione
            Call cEstr.Init(idEstr)
            cEstr.aNumRilevati = aNumDaCercare
            For i = idEstr + 1 To idEstr + nColpi
               ReDim aNum(5)
               Call GetArrayNumeriRuota(i,nRuota,aNum)
               If aNum(1) > 0 Then
                  Call OrdinaMatrice(aNum,1)
                  aColonne = SviluppoIntegrale(aNum,2)
                  For k = 1 To UBound(aColonne)
                     Call cEstr.AddAmbo(aColonne,k)
                     sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
                     Set cAmbo = GetItem(sKey,CollAmbi)
                     If cAmbo Is Nothing Then
                        Set cAmbo = New clsAmbo
                        cAmbo.key = sKey
                        Call cAmbo.SetNumero(1,aColonne(k,1))
                        Call cAmbo.SetNumero(2,aColonne(k,2))
                        cAmbo.Presenze = 1
                        CollAmbi.Add cAmbo,sKey
                     Else
                        cAmbo.Presenze = cAmbo.Presenze + 1
                     End If
                  Next
               End If
               cEstr.fine = i
               If TipoRicerca < 3 Then
                  If VerificaCondizione(TipoRicerca,i,nRuota,aNumDaCercare,nPuntiDaFare,aElemFormazione) Then
                     idEstr = i - 1
                     Exit For
                  End If
               End If
            Next
            CollEstrazioni.Add cEstr,"k" & cEstr.idEst
         End If
         Call AvanzamentoElab(nInizio,nFine,idEstr)
         If ScriptInterrotto Then Exit For
      Next
      Call OrdinaItemCollection(CollAmbi,"Presenze","Key")
      Call CalcolaCopertura(CollAmbiTot,CollEstrazioni)
      Call CreaTabRiepilogo(CollAmbi,CollAmbiTot,CollEstrazioni.count,nInizio,nFine,nRuota,RigheMaxRiepilogo)
      Call CreaTabPresenze(CollAmbi,RigheMaxTabAmbiFreq)
      Call CreaTabCopertura(CollAmbiTot,CollEstrazioni,RigheMaxTabCopertura)
      Call CreaTabCasiRilevati(CollEstrazioni,nPuntiDaFare,nColpi,nRuota)
   End If
End Sub
Function VerificaCondizione(TipoRicerca,idEstr,nRuota,aNumDaCercare,nPuntiDaFare,aElemFormazione)
   Dim bTrovato,k,e
   bTrovato = False
   Select Case TipoRicerca
   Case 0 ' numero spia
      bTrovato = IsNumeroPresenteInEstrazione(idEstr,nRuota,aNumDaCercare(1),0)
   Case 1 ' punti su lunghetta
      ReDim aNum(5)
      Call GetArrayNumeriRuota(idEstr,nRuota,aNum)
      If PuntiSuArray(aNum,aNumDaCercare) >= nPuntiDaFare Then
         bTrovato = True
      End If
   Case 2
      ReDim aNum(5)
      Call GetArrayNumeriRuota(idEstr,nRuota,aNum)
      
      For k = 1 To UBound(aElemFormazione)
         For e = 1 To UBound(aNumDaCercare)
            aNumDaCercare(e) = aElemFormazione(k,e)
         Next
         If PuntiSuArray(aNum,aNumDaCercare) >= nPuntiDaFare Then
            bTrovato = True
            Exit For
         End If

        
      Next
   Case 3 ' prima del mese
      If IndiceMensile(idEstr) = 1 Then
         bTrovato = True
      End If
   Case 4 ' ultima del Mese
      If IsUltimaDelMese(idEstr) Then
         bTrovato = True
      End If

   End Select
   VerificaCondizione = bTrovato
End Function
Function GetTipoRicerca()
   ReDim aVoci(4)
   aVoci(0) = "Numero spia"
   aVoci(1) = "Punti su lunghetta"
   aVoci(2) = "Punti su formazione"
   aVoci(3) = "Prima del mese"
   aVoci(4) = "Ultima del mese"
  
   GetTipoRicerca = ScegliOpzioneMenu(aVoci,0,"Selezione tipo ricerca")
End Function
Sub RichiediLunghetta(aNumDaCercare,nPuntiDaFare)
   Dim s
   Dim n
   s = InputBox("Inserire i numeri della lunghetta separati da , (virgola)",,"1,2,3,4")
   n = CInt(InputBox("Inserire i punti da realizzare sulla lunghetta",,1))
   ReDim aNumDaCercare(0)
   Call SplitByChar("0," & s,",",aNumDaCercare)
   If n > 0 Then
      nPuntiDaFare = n
   End If
End Sub
Sub RichiediFormazione(aElemFormazione,nPuntiDaFare,nClasseFrz)

   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))
      nClasseFrz = GetClasseFormazione(aNomiForm(id))
   End If
  
   If n > 0 Then
      nPuntiDaFare = n
   End If

End Sub
Function GetItem(sKey,CollAmbi)
   On Error Resume Next
   Set GetItem = Nothing
   Set GetItem = CollAmbi(sKey)
End Function
Sub AlimentaCollAmbiTot(collAmbi)
   Dim k,sKey
   Dim aColonne
   Dim cAmbo
   aColonne = SviluppoIntegrale(GetNumPerSviluppo,2)
   For k = 1 To UBound(aColonne)
      sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
      Set cAmbo = New clsAmbo
      cAmbo.key = sKey
      Call cAmbo.SetNumero(1,aColonne(k,1))
      Call cAmbo.SetNumero(2,aColonne(k,2))
      cAmbo.Presenze = 0
      collAmbi.Add cAmbo,sKey
   Next
End Sub
Sub GetColoriRiga(aColori,aColDaEvid,ColoreLastCol)
   ReDim aColori(12)
   Dim k
   For k = 1 To 12
      aColori(k) = vbWhite
   Next
   For k = 1 To UBound(aColDaEvid)
      If aColDaEvid(k) Then
         aColori(k + 2) = vbYellow
      End If
   Next
   aColori(12) = ColoreLastCol
End Sub
Sub CalcolaCopertura(CollAmbiTot,CollEstrazioni)
   Dim cAmbo
   Dim k
   Dim cEstr
   ' tabella copertura
   Call Messaggio("Calcolo copertura estrazioni")
   Call AlimentaCollAmbiTot(CollAmbiTot)
   k = 0
   For Each cAmbo In CollAmbiTot
      For Each cEstr In CollEstrazioni
         If cEstr.IsAmboPresente(cAmbo.key) Then
            cAmbo.presenze = cAmbo.presenze + 1
         End If
      Next
      k = k + 1
      Call AvanzamentoElab(1,CollAmbiTot.count,k)
      If ScriptInterrotto Then Exit For
   Next
   Call OrdinaItemCollection(CollAmbiTot,"Presenze","Key")
End Sub
Sub CreaTabCopertura(CollAmbiTot,CollEstrazioni,nRigheMax)
   Dim cAmbo
   Dim k
   Dim cEstr
   Call Scrivi("La seguente tabella indica la copertura degli ambi sulle estrazioni rilevate dai casi (" & CollEstrazioni.count & " casi)")
   Call Scrivi
   ' tabella copertura
   ReDim aTitoli(3)
   aTitoli(1) = "Ambo"
   aTitoli(2) = "Estrazioni Coperte"
   aTitoli(3) = "Percentuale"
   Call InitTabella(aTitoli)
   For Each cAmbo In CollAmbiTot
      If cAmbo.presenze > 0 Then
         ReDim aValori(3)
         aValori(1) = cAmbo.NumeriString
         aValori(2) = cAmbo.presenze
         aValori(3) = Round(ProporzioneX(cAmbo.presenze,CollEstrazioni.count,100),3) & " %"
         Call AddRigaTabella(aValori)
      End If
   Next
   Call Messaggio("Creazione tabella in corso ...")
   Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabPresenze(CollAmbi,nRigheMax)
   Dim cAmbo
   ' tabella presenze
   Call Scrivi("La seguente tabella indica la frequenza degli ambi")
   Call Scrivi
   'Call OrdinaItemCollection(CollAmbi,"Presenze")
   ReDim aTitoli(2)
   aTitoli(1) = "Ambo"
   aTitoli(2) = "Presenze"
   Call InitTabella(aTitoli)
   For Each cAmbo In CollAmbi
      ReDim aValori(2)
      aValori(1) = cAmbo.NumeriString
      aValori(2) = cAmbo.presenze
      Call AddRigaTabella(aValori)
   Next
   Call Messaggio("Creazione tabella in corso ...")
   Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabCasiRilevati(CollEstrazioni,nPuntiDaFare,nColpi,nRuota)
   Dim i,k,n,nPosSpia,nFreq
   Dim cEstr
   ' tabella casi rilevati
   Call Scrivi("La seguente tabella indica i casi rilevati (" & CollEstrazioni.count & " casi)")
   Call Scrivi
   Call Messaggio("Riepilogo  casi rilevati")
   ReDim aTitoli(12)
   aTitoli(1) = "Estrazione"
   aTitoli(2) = "Data"
   aTitoli(3) = "I"
   aTitoli(4) = "II"
   aTitoli(5) = "III"
   aTitoli(6) = "IV"
   aTitoli(7) = "V"
   aTitoli(8) = "Ambo Piu Frequente"
   aTitoli(9) = "Presenze"
   aTitoli(10) = "InizioAnalisi"
   aTitoli(11) = "FineAnalisi"
   aTitoli(12) = "EstrazioniSuccessive"
   i = 0
   Call InitTabella(aTitoli)
   For Each cEstr In CollEstrazioni
      ReDim aValori(12)
      aValori(1) = cEstr.idEst
      aValori(2) = DataEstrazione(cEstr.idEst)
      ReDim aPosTrovate(5)
      
      For k = 1 To 5
         n = Estratto(cEstr.idEst,nRuota,k)
         If IsNumeroPresenteInLunghetta(cEstr.anumrilevati,n) Then
            aPosTrovate(k) = True
         End If
         aValori(k + 2) = n
      Next
      aValori(8) = cEstr.GetAmboPiuFreq(nFreq)
      aValori(9) = nFreq
      aValori(10) = cEstr.Inizio
      aValori(11) = cEstr.Fine
      aValori(12) = cEstr.Fine -(cEstr.Inizio - 1)
      ReDim aColori(0)
      Call GetColoriRiga(aColori,aPosTrovate,Iif(aValori(12) = nColpi,vbGreen,vbYellow))
      Call AddRigaTabella(aValori,aColori)
      i = i + 1
      Call AvanzamentoElab(1,CollEstrazioni.count,i)
      If ScriptInterrotto Then Exit For
   Next
   Call Messaggio("Creazione tabella in corso ...")
   Call CreaTabella()
End Sub
Function IsNumeroPresenteInLunghetta(aNumDaCercare,n)
   Dim k
  
   For k = 1 To UBound(aNumDaCercare)
      If CInt(aNumDaCercare(k)) = CInt(n) Then
         IsNumeroPresenteInLunghetta = True
         Exit For
      End If
   Next
End Function
'Sub CreaTabRiepilogo(CollAmbi,CollAmbiTot,nCasiTrov,nInizio,nFine,nRuota,nRigheMax)
'   Dim cAmboF,cAmboP
'   Dim i
'
'   Call Messaggio("Tabella riepilogo")
'
'   ' tabella presenze
'   Call Scrivi("La seguente tabella indica la frequenza degli ambi e le rispettive presenze")
'   Call Scrivi
'   ReDim aTitoli(8)
'   aTitoli(1) = "Ambo"
'   aTitoli(2) = "Presenze"
'   aTitoli(3) = "Percentuale"
'   aTitoli(4) = "Frequenza"
'   aTitoli(5) = "Freq/Pres"
'   aTitoli(6) = "Ritardo"
'   aTitoli(7) = "RitMax"
'   aTitoli(8) = "Ultima"
'
'   Call InitTabella(aTitoli,vbBlue,,,vbWhite)
'
'   ReDim aColori(8)
'   aColori(1) = vbCyan
'   aColori(2) = vbGreen
'   aColori(3) = vbYellow
'   aColori(4) = vbGreen
'   aColori(5) = RGB(255,100,100)
'   aColori(6) = RGB(255,90,90)
'   aColori(7) = RGB(255,80,80)
'   aColori(8) = RGB(255,70,70)
'
'
'   For Each cAmboF In CollAmbi
'      Set cAmboP = CollAmbiTot(cAmboF.key)
'      Call cAmboF.StatisticaAmbo(nInizio,nFine,nRuota)
'      ReDim aValori(8)
'      aValori(1) = cAmboF.NumeriString
'      aValori(2) = cAmboP.presenze
'      aValori(3) = Round(Dividi((cAmboP.presenze * 100),nCasiTrov),3) & " %"
'      aValori(4) = cAmboF.presenze
'      aValori(5) = Round(Dividi(cAmboF.presenze,cAmboP.presenze),3)
'      aValori(6) = cAmboF.Ritardo
'      aValori(7) = cAmboF.RitardoMax
'      aValori(8) = nFine - cAmboF.ritardo
'
'
'      Call AddRigaTabella(aValori,aColori)
'      i = i + 1
'      Call AvanzamentoElab(1,nRigheMax,i)
'      If ScriptInterrotto Then Exit For
'      If i = nRigheMax Then Exit For
'
'   Next
'   Call Messaggio("Creazione tabella in corso ...")
'   Call CreaTabella(,,,nRigheMax)
'End Sub
Sub CreaTabRiepilogo(CollAmbi,CollAmbiTot,nCasiTrov,nInizio,nFine,nRuota,nRigheMax)
   Dim cAmboF,cAmboP
   Dim i
   Call Messaggio("Tabella riepilogo")
   ' tabella presenze
   Call Scrivi("La seguente tabella indica la frequenza degli ambi e le rispettive presenze")
   Call Scrivi
   ReDim aTitoli(8)
   aTitoli(1) = "Ambo"
   aTitoli(2) = "Presenze"
   aTitoli(3) = "Percentuale"
   aTitoli(4) = "Frequenza"
   aTitoli(5) = "Freq/Pres"
   aTitoli(6) = "Ritardo"
   aTitoli(7) = "RitMax"
   aTitoli(8) = "Ultima"
   Call InitTabella(aTitoli,vbBlue,,,vbWhite)
   ReDim aColori(8)
   aColori(1) = vbCyan
   aColori(2) = vbGreen
   aColori(3) = vbYellow
   aColori(4) = vbGreen
   aColori(5) = RGB(255,100,100)
   aColori(6) = RGB(255,90,90)
   aColori(7) = RGB(255,80,80)
   aColori(8) = RGB(255,70,70)
   For Each cAmboP In CollAmbiTot
      Set cAmboF = CollAmbi(cAmboP.key)
      Call cAmboP.StatisticaAmbo(nInizio,nFine,nRuota)
      ReDim aValori(8)
      aValori(1) = cAmboP.NumeriString
      aValori(2) = cAmboP.presenze
      aValori(3) = Round(ProporzioneX(cAmboP.presenze,nCasiTrov,100),3) & " %"
      aValori(4) = cAmboF.presenze
      aValori(5) = Round(Dividi(cAmboF.presenze,cAmboP.presenze),3)
      aValori(6) = cAmboP.Ritardo
      aValori(7) = cAmboP.RitardoMax
      aValori(8) = nFine - cAmboP.ritardo
      Call AddRigaTabella(aValori,aColori)
      i = i + 1
      Call AvanzamentoElab(1,nRigheMax,i)
      If ScriptInterrotto Then Exit For
      If i = nRigheMax Then Exit For
   Next
   Call Messaggio("Creazione tabella in corso ...")
   Call CreaTabella()
End Sub
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 19 luglio 2025
    Bari
    70
    37
    36
    68
    01
    Cagliari
    57
    02
    64
    33
    41
    Firenze
    18
    62
    09
    05
    06
    Genova
    36
    10
    74
    37
    42
    Milano
    39
    07
    58
    23
    22
    Napoli
    18
    69
    28
    36
    40
    Palermo
    71
    66
    72
    64
    23
    Roma
    19
    64
    39
    77
    10
    Torino
    83
    63
    71
    08
    72
    Venezia
    51
    83
    26
    50
    74
    Nazionale
    89
    81
    63
    32
    03
    Estrazione Simbolotto
    Nazionale
    16
    32
    21
    19
    03
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto