Novità

Una cortesia x Salvo50 o altro Scripter esperto

Matematico

Advanced Member >PLATINUM<
Buona serata a tutti, il seguente script mi dà questo errore:
Errore script!
5 - Chiamata di routine o argomento non validi
Linea :304
Colonna :12
Source : Errore di run-time di Microsoft VB Script
---------------------------------------------------------------------------------
Qusto è lo script:


Option Explicit
Class clsAmbo
Private aNum(2)
Private aCicli()
Private bUsato
Private QcicliCopertiSeUsato
Private sBit
Property Get Bit
Bit = sBit
End Property
Property Let Usato(b)
bUsato = b
End Property
Property Get Usato
Usato = bUsato
End Property
Property Let QCicli(v)
ReDim aCicli(v)
End Property
Property Get QCicliCopertiSeInUso
QCicliCopertiSeInUso = QcicliCopertiSeUsato
End Property
Property Get QuantitaCicliRapp
Dim k,q
q = 0
For k = 1 To UBound(aCicli)
If aCicli(k) <> 0 Then
q = q + 1
End If
Next
QuantitaCicliRapp = q
End Property
Sub SetFlagCiclo(id,b)
aCicli(id) = b
End Sub
Function GetFlagCiclo(id)
GetFlagCiclo = aCicli(id)
End Function
Sub SetNumero(id,v)
aNum(id) = v
End Sub
Function GetNumeriString
GetNumeriString = StringaNumeri(aNum,,True)
End Function
Sub GetNumeri(aRet)
Dim k
ReDim aRet(UBound(aNum))
For k = 1 To UBound(aNum)
aRet(k) = aNum(k)
Next
End Sub
Sub AggiornaCicliCoperti
Dim k
sBit = ""
QcicliCopertiSeUsato = QuantitaCicliRapp
For k = 1 To UBound(aCicli)
If aCicli(k) <> 0 Then
sBit = sBit & "X"
Else
sBit = sBit & " "
End If
Next
End Sub
End Class
Sub Main
Dim CollAmbi,CollAmbiTrov
Dim Inizio,Fine,nTotNelRange
Dim nLenCiclo,qCicli
Dim idCiclo,k
Dim Ruota
Dim cAmbo
Dim nTrovati
ReDim aRuote(1)
ReDim aPoste(2)
nTrovati = 0
Ruota = ScegliRuota
nLenCiclo = CInt(InputBox("Colpi di gioco","Colpi","12"))
aRuote(1) = Ruota
aPoste(2) = 1
Inizio = EstrazioneIni
Fine = EstrazioneFin
nTotNelRange =(Fine + 1) - Inizio
If nTotNelRange Mod nLenCiclo = 0 Then
qCicli = nTotNelRange /nLenCiclo
Else
qCicli =((nTotNelRange -(nTotNelRange Mod nLenCiclo)) /nLenCiclo) + 1
End If
Call InitCollAmbi(CollAmbi,qCicli)
ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
Call GestioneRicercaAmbi(qCicli,aCicli,CollAmbi,nLenCic lo,Inizio,Fine,Ruota,nTrovati)
Call GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine ,nLenCiclo,nTrovati,CollAmbi)
Call GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTr ovati)
Call GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuo te,aPoste,nLenCiclo)
End Sub
Sub GestioneRicercaAmbi(qCicli,aCicli,collAmbi,nLenCic lo,Inizio,Fine,Ruota,nTrovati)
Dim idCiclo,k
Dim cAmbo
nTrovati = 0
ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
Call InitACicli(aCicli,nLenCiclo,Inizio)
Do
For idCiclo = 1 To qCicli
If aCicli(idCiclo,2) = 0 Then
For k = aCicli(idCiclo,0) To aCicli(idCiclo,1)
Call AggiornaAmbiUsciti(collAmbi,Ruota,k,idCiclo)
Next
End If
Call AvanzamentoElab(1,qCicli,idCiclo)
If ScriptInterrotto Then Exit Sub
Next
Call GetAmboConPiuCopertura(cAmbo,collAmbi)
If Not cAmbo Is Nothing Then
nTrovati = nTrovati + 1
cAmbo.Usato = True
Call cAmbo.AggiornaCicliCoperti
For idCiclo = 1 To qCicli
If cAmbo.GetFlagCiclo(idCiclo) <> 0 Then
aCicli(idCiclo,2) = 1
End If
Next
Else
Exit Do
End If
Call Messaggio("Ambi trovati " & nTrovati)
Call AzzeraCopertura(collAmbi,qCicli)
If ScriptInterrotto Then Exit Sub
Loop While IsScoperto(aCicli,qCicli)
End Sub
Sub GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuo te,aPoste,nLenCiclo)
Dim idCiclo,k
Dim cAmbo
Call Messaggio("Analisi Giocate")
For idCiclo = 1 To qCicli
k = 0
For Each cAmbo In CollAmbi
If cAmbo.usato Then
k = k + 1
ReDim aNum(0)
Call cAmbo.GetNumeri(aNum)
Call ImpostaGiocata(k,aNum,aRuote,aPoste,nLenCiclo,2,,1 )
'Call Scrivi(StringaNumeri(aNum))
End If
Next
Call Gioca(aCicli(idCiclo,0) - 1,True)
Call AvanzamentoElab(1,qCicli,idCiclo)
If ScriptInterrotto Then Exit Sub
Next
Call ScriviResoconto
End Sub
Sub GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTr ovati)
Dim cAmbo
Dim idCiclo,k
Dim sTmp
Dim sRigaBit
Call Scrivi("Quadro copertura ambi")
ReDim aT(3 + qCicli)
aT(1) = " N. "
aT(2) = " Ambo "
aT(3) = " Cicli coperti "
For k = 1 To qCicli
aT(k + 3) = aCicli(k,0) & "-" & aCicli(k,1)
Next
Call Messaggio("Creazione tabella copertura")
Call InitTabella(aT)
ReDim aLineeBit(nTrovati)
nTrovati = 0
For Each cAmbo In CollAmbi
If cAmbo.usato Then
nTrovati = nTrovati + 1
aLineeBit(nTrovati) = cAmbo.Bit
ReDim aT(3 + qCicli)
aT(1) = nTrovati
aT(2) = cAmbo.GetNumeriString
aT(3) = cAmbo.QCicliCopertiSeInUso
For k = 1 To qCicli
aT(k + 3) = Mid(cAmbo.Bit,k,1)
Next
ReDim aColoreCelle(UBound(aT))
Call ImpostaArrayColoreCelle(aColoreCelle,aT)
Call AddRigaTabella(aT,aColoreCelle)
End If
If ScriptInterrotto Then Exit Sub
Next
sRigaBit = ""
For idCiclo = 1 To qCicli
sTmp = "-"
For k = 1 To UBound(aLineeBit)
If Mid(aLineeBit(k),idCiclo,1) = "X" Then
sTmp = "X"
Exit For
End If
Next
sRigaBit = sRigaBit & sTmp
Next
'Call Scrivi(Space(20) & sRigaBit)
ReDim aT(3 + qCicli)
For k = 1 To qCicli
aT(k + 3) = Mid(sRigaBit,k,1)
Next
ReDim aColoreCelle(UBound(aT))
Call ImpostaArrayColoreCelle(aColoreCelle,aT)
Call AddRigaTabella(aT,aColoreCelle)
Call CreaTabella
End Sub
Sub GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine ,nLenCiclo,nTrovati,Collambi)
Dim sTmp
Dim cAmbo
Call Scrivi(String(100,"."))
Call Scrivi("Ruota : " & NomeRuota(Ruota))
Call Scrivi("Periodo : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
Call Scrivi("Colpi per singolo attacco : " & nLenCiclo)
Call Scrivi("Totale attacchi : " & qCicli)
Call Scrivi
Call Scrivi(Space(20) & "Descrizione del gioco",True)
Call Scrivi("Giocando i seguenti " & nTrovati & " ambi impostando il gioco in " & nLenCiclo & " colpi di gioco")
Call Scrivi("per ogni attacco e interrompendo alla prima vincita per riprenderlo")
Call Scrivi("con l'attacco successivo previsto al termine naturale dell'attacco")
Call Scrivi("in corso si sarebbero ottenuti i seguenti risutati di gioco")
Call Scrivi("Attenzione non è detto che giocando questa serie di ambi nelle estrazioni",,,,vbRed)
Call Scrivi("successive a quelle esaminate si otttenga per certo la vincita",,,,vbRed)
Call Scrivi(String(100,"."))
Call Scrivi()
sTmp = ""
For Each cAmbo In Collambi
If cAmbo.usato Then
sTmp = sTmp &(cAmbo.GetNumeriString) & ","
End If
Next
sTmp = Left(sTmp,Len(sTmp) - 1)
Call Scrivi("Ambi in gioco : " & sTmp)
Call Scrivi(String(100,"."))
Call Scrivi()
End Sub
Sub ImpostaArrayColoreCelle(aColoreCelle,aT)
Dim k
For k = 1 To UBound(aT)
If aT(k) = "X" Then
aColoreCelle(k) = vbGreen
Else
aColoreCelle(k) = vbWhite
End If
Next
End Sub
Sub AggiornaRigheBuf(aRighe,nInizio,nFine,idCiclo)
Dim k
Dim sChr
Dim sTmp
sTmp = FormatSpace(nInizio,4,True)
For k = 1 To 4
sChr = Mid(sTmp,k,1)
Call InsCar(aRighe(k),sChr,idCiclo)
Next
sTmp = FormatSpace(nFine,4,True)
For k = 6 To 9
sChr = Mid(sTmp,k - 5,1)
Call InsCar(aRighe(k),sChr,idCiclo)
Next
End Sub
Sub InsCar(sRiga,sChr,nPos)
Dim sLeft
Dim sRight
sLeft = Left(sRiga,nPos - 1)
sRight = Mid(sRiga,nPos + 1)
sRiga = sLeft & sChr & sRight
End Sub
Function IsScoperto(aCicli,qCicli)
Dim k,b
b = False
For k = 1 To qCicli
If aCicli(k,2) = 0 Then
b = True
Exit For
End If
Next
IsScoperto = b
End Function
Sub AzzeraCopertura(CollAmbi,qCicli)
Dim cAmbo
For Each cAmbo In CollAmbi
cAmbo.qCicli = qCicli
Next
End Sub
Sub GetAmboConPiuCopertura(cAmbo,CollAmbi)
Dim cAmboTmp
Dim nMax,n
nMax = 0
For Each cAmboTmp In CollAmbi
n = cAmboTmp.QuantitaCicliRapp
If n >= nMax Then
nMax = n
Set cAmbo = cAmboTmp
End If
Next
End Sub
Sub AggiornaAmbiUsciti(CollAmbi,Ruota,idEstr,idCiclo)
Dim k,kk,s
Dim cAmbo
ReDim aNum(0)
If GetArrayNumeriRuota(idEstr,Ruota,aNum) Then
Call OrdinaMatrice(aNum,1)
For k = 1 To 4
For kk = k + 1 To 5
s = "k" & Format2(aNum(k)) & "-" & Format2(aNum(kk))
Set cAmbo = CollAmbi(s)
Call cAmbo.SetFlagCiclo(idCiclo,1)
Next
Next
End If
End Sub
Sub InitACicli(aCicli,nLenCiclo,Inizio)
Dim k
Dim nStart
nStart = Inizio
For k = 1 To UBound(aCicli)
aCicli(k,2) = 0
aCicli(k,0) = nStart
aCicli(k,1) =(nStart - 1) + nLenCiclo
nStart = aCicli(k,1) + 1
Next
End Sub
Sub InitCollAmbi(CollAmbi,qCicli)
' sistemi che generano un elevato numero di combinazioni
Dim k,e,s
Dim nClasse
ReDim aNumeri(90)
Dim aColonne
Dim cAmbo
Set CollAmbi = GetNewCollection
nClasse = 2 ' sviluppo in ambi
' inizializzo i numeri da sviluppare in questo caso 90
' ma potrebbero essere anche di meno
For k = 1 To 90
aNumeri(k) = k
Next
' sviluppo il sistema valorizzando le colonne sviluppate
aColonne = SviluppoIntegrale(aNumeri,nClasse)
' scrivo le colonne in output
For k = 1 To UBound(aColonne)
Set cAmbo = New clsAmbo
cAmbo.qCicli = qCicli
s = "k"
' ciclo per leggere la colonna k
For e = 1 To nClasse
Call cAmbo.SetNumero(e,aColonne(k,e))
s = s & Format2(aColonne(k,e)) & "-"
Next
' tolgo l'ultimo trattino
s = Left(s,Len(s) - 1)
Call CollAmbi.Add(cAmbo,s)
Next
End Sub
 

druid

Super Member >PLATINUM<
Buongiorno Matematico,
da un' occhiata veloce ci sono errori di "copiatura" del codice: per esempio alla riga 27 i caratteri <> indicano <>, e cosi' via; poi ci sono - sempre a prima vista - alcune istruzioni "staccate: se lo script si aspetta di leggere l'istruzione aRuote e trova invece "aRuo te" (con uno spazio) e' normale che dia errore.
Correggi tutti questi piccoli problemi e vedrai che lo script funziona.
Buon lavoro.
P.s: diceva Confucio: "Dai un pesce a un uomo e lo nutrirai per un giorno; insegnagli a pescare e lo nutrirai per tutta la vita.":D
 

salvo50

Advanced Member >PLATINUM PLUS<
Ciao a Tutti.

Ciao Matematico, questo è uno script di LuigiB, il quale più di una volta, ha detto che non è uno script

previsionistico, da quello che ho capito io, praticamente Luigi, ha volutamente fatto degli errori nello script,

per usarlo come test, per gli eventuali scripters che si volessero cimentare, io gli ho dato un'occhiata e non ci

ho capito niente, nonostante tutto ho cercato di capire perche si bloccava, ed ho modificato ed eliminato quelle

parti di programma che davano errore, praticamente facendo l'esempio di un dottore che visita un paziente, e si

presenta uno con una piccola ferita ad un dito, invece di medicargli il dito, gli ho tagliato la mano, con una

piccola ferita ad un braccio, gli ho fasciato pure la testa, il paziente è vivo ma se c'era un vero dottore

sarebbe stato meglio.

Lo script è funzionante, però non sò se fa quello che aveva previsto Luigi, non mi chiedere ulteriori modifiche

perche non sò come fare.


Codice:
Option Explicit
Class clsAmbo
   Private aNum(2)
   Private aCicli()
   Private bUsato
   Private QcicliCopertiSeUsato
   Private sBit
   Property Get Bit
      Bit = sBit
   End Property
   Property Let Usato(b)
      bUsato = b
   End Property
   Property Get Usato
      Usato = bUsato
   End Property
   Property Let QCicli(v)
      ReDim aCicli(v)
   End Property
   Property Get QCicliCopertiSeInUso
      QCicliCopertiSeInUso = QcicliCopertiSeUsato
   End Property
   Property Get QuantitaCicliRapp
      Dim k,q
      q = 0
      For k = 1 To UBound(aCicli)
         If aCicli(k) <> 0 Then
            q = q + 1
         End If
      Next
      QuantitaCicliRapp = q
   End Property
   Sub SetFlagCiclo(id,b)
      aCicli(id) = b
   End Sub
   Function GetFlagCiclo(id)
      GetFlagCiclo = aCicli(id)
   End Function
   Sub SetNumero(id,v)
      aNum(id) = v
   End Sub
   Function GetNumeriString
      GetNumeriString = StringaNumeri(aNum,,True)
   End Function
   Sub GetNumeri(aRet)
      Dim k
      ReDim aRet(UBound(aNum))
      For k = 1 To UBound(aNum)
         aRet(k) = aNum(k)
      Next
   End Sub
   Sub AggiornaCicliCoperti
      Dim k
      sBit = ""
      QcicliCopertiSeUsato = QuantitaCicliRapp
      For k = 1 To UBound(aCicli)
         If aCicli(k) <> 0 Then
            sBit = sBit & "X"
         Else
            sBit = sBit & " "
         End If
      Next
   End Sub
End Class
Sub Main
   Dim CollAmbi,CollAmbiTrov
   Dim Inizio,Fine,nTotNelRange
   Dim nLenCiclo,qCicli
   Dim idCiclo,k
   Dim Ruota
   Dim cAmbo
   Dim nTrovati
   ReDim aRuote(1)
   ReDim aPoste(2)
   nTrovati = 0
   Ruota = ScegliRuota
   nLenCiclo = CInt(InputBox("Colpi di gioco","Colpi","12"))
   aRuote(1) = Ruota
   aPoste(2) = 1
   Inizio = EstrazioneIni
   Fine = EstrazioneFin
   nTotNelRange =(Fine + 1) - Inizio
   If nTotNelRange Mod nLenCiclo <> 0 Then
      If MsgBox("Per ottenere un analisi sui cicli completi bisogna modificare il range di inizio , Modifico automaticamente ?") = vbYes Then
         Inizio = Inizio -(nTotNelRange Mod nLenCiclo)
         If Inizio < 0 Then
            MsgBox "Con la modifica automatica il range inizio non è valido"
         Else
            nTotNelRange =(Fine + 1) - Inizio
            MsgBox "Modifica Limite Iniziale eseguita. Si ottengono " & nTotNelRange /nLenCiclo & " cicli completi",vbInformation
         End If
      End If
   End If
   If nTotNelRange Mod nLenCiclo = 0 Then
      qCicli = nTotNelRange /nLenCiclo
   Else
      qCicli =((nTotNelRange -(nTotNelRange Mod nLenCiclo)) /nLenCiclo) + 1
   End If
   Call InitCollAmbi(CollAmbi,qCicli)
   ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
   Call GestioneRicercaAmbi(qCicli,aCicli,CollAmbi,nLenCiclo,Inizio,Fine,Ruota,nTrovati)
   Call GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine,nLenCiclo,nTrovati,CollAmbi)
   Call GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTrovati)
   Call GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuote,aPoste,nLenCiclo)
End Sub
Sub GestioneRicercaAmbi(qCicli,aCicli,collAmbi,nLenCiclo,Inizio,Fine,Ruota,nTrovati)
   Dim idCiclo,k
   Dim cAmbo
   nTrovati = 0
   ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
   Call InitACicli(aCicli,nLenCiclo,Inizio)
   Do
      For idCiclo = 1 To qCicli
         If aCicli(idCiclo,2) = 0 Then
            For k = aCicli(idCiclo,0) To aCicli(idCiclo,1)
               Call AggiornaAmbiUsciti(collAmbi,Ruota,k,idCiclo)
            Next
         End If
         Call AvanzamentoElab(1,qCicli,idCiclo)
         If ScriptInterrotto Then Exit Sub
      Next
      Call GetAmboConPiuCopertura(cAmbo,collAmbi)
      If Not cAmbo Is Nothing Then
         nTrovati = nTrovati + 1
         cAmbo.Usato = True
         Call cAmbo.AggiornaCicliCoperti
         For idCiclo = 1 To qCicli
            If cAmbo.GetFlagCiclo(idCiclo) <> 0 Then
               aCicli(idCiclo,2) = 1
            End If
         Next
      Else
         Exit Do
      End If
      Call Messaggio("Ambi trovati " & nTrovati)
      Call AzzeraCopertura(collAmbi,qCicli)
      If ScriptInterrotto Then Exit Sub
   Loop While IsScoperto(aCicli,qCicli)
End Sub
Sub GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuote,aPoste,nLenCiclo)
   Dim idCiclo,k
   Dim cAmbo
   Call Messaggio("Analisi Giocate")
   For idCiclo = 1 To qCicli
      k = 0
      For Each cAmbo In CollAmbi
         If cAmbo.usato Then
            k = k + 1
            ReDim aNum(0)
            Call cAmbo.GetNumeri(aNum)
            Call ImpostaGiocata(k,aNum,aRuote,aPoste,nLenCiclo,2,,1)
            'Call Scrivi(StringaNumeri(aNum))
         End If
      Next
      Call Gioca(aCicli(idCiclo,0))
      Call AvanzamentoElab(1,qCicli,idCiclo)
      If ScriptInterrotto Then Exit Sub
   Next
   k = 0
   For Each cAmbo In CollAmbi
      If cAmbo.usato Then
         k = k + 1
         ReDim aNum(0)
         Call cAmbo.GetNumeri(aNum)
         Call ImpostaGiocata(k,aNum,aRuote,aPoste,nLenCiclo,2,,1)
         'Call Scrivi(StringaNumeri(aNum))
      End If
   Next
   Call Gioca(aCicli(qCicli,1))
   Call ScriviResoconto()
End Sub
Sub GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTrovati)
   Dim cAmbo
   Dim idCiclo,k
   Dim sTmp
   Dim sRigaBit
   Call Scrivi("Quadro copertura ambi")
   ReDim aT(3 + qCicli)
   aT(1) = " N. "
   aT(2) = " Ambo "
   aT(3) = " Cicli coperti "
   For k = 1 To qCicli
      aT(k + 3) = aCicli(k,0) & "-" & aCicli(k,1)
   Next
   Call Messaggio("Creazione tabella copertura")
   Call InitTabella(aT)
   ReDim aLineeBit(nTrovati)
   nTrovati = 0
   For Each cAmbo In CollAmbi
      If cAmbo.usato Then
         nTrovati = nTrovati + 1
         aLineeBit(nTrovati) = cAmbo.Bit
         ReDim aT(3 + qCicli)
         aT(1) = nTrovati
         aT(2) = cAmbo.GetNumeriString
         aT(3) = cAmbo.QCicliCopertiSeInUso
         For k = 1 To qCicli
            aT(k + 3) = Mid(cAmbo.Bit,k,1)
         Next
         ReDim aColoreCelle(UBound(aT))
         Call ImpostaArrayColoreCelle(aColoreCelle,aT)
         Call AddRigaTabella(aT,aColoreCelle)
      End If
      If ScriptInterrotto Then Exit Sub
   Next
   sRigaBit = ""
   For idCiclo = 1 To qCicli
      sTmp = "-"
      For k = 1 To UBound(aLineeBit)
         If Mid(aLineeBit(k),idCiclo,1) = "X" Then
            sTmp = "X"
            Exit For
         End If
      Next
      sRigaBit = sRigaBit & sTmp
   Next
   'Call Scrivi(Space(20) & sRigaBit)
   ReDim aT(3 + qCicli)
   For k = 1 To qCicli
      aT(k + 3) = Mid(sRigaBit,k,1)
   Next
   ReDim aColoreCelle(UBound(aT))
   Call ImpostaArrayColoreCelle(aColoreCelle,aT)
   Call AddRigaTabella(aT,aColoreCelle)
   Call CreaTabella
End Sub
Sub GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine,nLenCiclo,nTrovati,Collambi)
   Dim sTmp
   Dim cAmbo
   Call Scrivi(String(100,"."))
   Call Scrivi("Ruota                     : " & NomeRuota(Ruota))
   Call Scrivi("Periodo                   : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
   Call Scrivi("Colpi per singolo attacco : " & nLenCiclo)
   Call Scrivi("Totale attacchi           : " & qCicli)
   Call Scrivi
   Call Scrivi(Space(20) & "Descrizione del gioco",True)
   Call Scrivi("Giocando i seguenti " & nTrovati & " ambi impostando il gioco in " & nLenCiclo & " colpi di gioco")
   Call Scrivi("per ogni attacco e interrompendo alla prima vincita per riprenderlo")
   Call Scrivi("con l'attacco successivo previsto al termine naturale dell'attacco")
   Call Scrivi("in corso si sarebbero ottenuti i seguenti risutati di gioco")
   Call Scrivi("Attenzione non è detto che giocando questa serie di ambi nelle estrazioni",,,,vbRed)
   Call Scrivi("successive a quelle esaminate si otttenga per certo la vincita",,,,vbRed)
   Call Scrivi(String(100,"."))
   Call Scrivi()
   sTmp = ""
   For Each cAmbo In Collambi
      If cAmbo.usato Then
         sTmp = sTmp &(cAmbo.GetNumeriString) & ","
      End If
   Next
   sTmp = Left(sTmp,Len(sTmp) - 1)
   Call Scrivi("Ambi in gioco  : " & sTmp)
   Call Scrivi(String(100,"."))
   Call Scrivi()
End Sub
Sub ImpostaArrayColoreCelle(aColoreCelle,aT)
   Dim k
   For k = 1 To UBound(aT)
      If aT(k) = "X" Then
         aColoreCelle(k) = vbGreen
      Else
         aColoreCelle(k) = vbWhite
      End If
   Next
End Sub
Sub AggiornaRigheBuf(aRighe,nInizio,nFine,idCiclo)
   Dim k
   Dim sChr
   Dim sTmp
   sTmp = FormatSpace(nInizio,4,True)
   For k = 1 To 4
      sChr = Mid(sTmp,k,1)
      Call InsCar(aRighe(k),sChr,idCiclo)
   Next
   sTmp = FormatSpace(nFine,4,True)
   For k = 6 To 9
      sChr = Mid(sTmp,k - 5,1)
      Call InsCar(aRighe(k),sChr,idCiclo)
   Next
End Sub
Sub InsCar(sRiga,sChr,nPos)
   Dim sLeft
   Dim sRight
   sLeft = Left(sRiga,nPos - 1)
   sRight = Mid(sRiga,nPos + 1)
   sRiga = sLeft & sChr & sRight
End Sub
Function IsScoperto(aCicli,qCicli)
   Dim k,b
   b = False
   For k = 1 To qCicli
      If aCicli(k,2) = 0 Then
         b = True
         Exit For
      End If
   Next
   IsScoperto = b
End Function
Sub AzzeraCopertura(CollAmbi,qCicli)
   Dim cAmbo
   For Each cAmbo In CollAmbi
      cAmbo.qCicli = qCicli
   Next
End Sub
Sub GetAmboConPiuCopertura(cAmbo,CollAmbi)
   Dim cAmboTmp
   Dim nMax,n
   nMax = 0
   For Each cAmboTmp In CollAmbi
      n = cAmboTmp.QuantitaCicliRapp
      If n >= nMax Then
         nMax = n
         Set cAmbo = cAmboTmp
      End If
   Next
End Sub
Sub AggiornaAmbiUsciti(CollAmbi,Ruota,idEstr,idCiclo)
   Dim k,kk,s
   Dim cAmbo
   ReDim aNum(0)
   If GetArrayNumeriRuota(idEstr,Ruota,aNum) Then
      Call OrdinaMatrice(aNum,1)
      For k = 1 To 4
         For kk = k + 1 To 5
            s = "k" & Format2(aNum(k)) & "-" & Format2(aNum(kk))
            Set cAmbo = CollAmbi(20)
            Call cAmbo.SetFlagCiclo(idCiclo,1)
         Next
      Next
   End If
End Sub
Sub InitACicli(aCicli,nLenCiclo,Inizio)
   Dim k
   Dim nStart
   nStart = Inizio
   For k = 1 To UBound(aCicli)
      aCicli(k,2) = 0
      aCicli(k,0) = nStart
      aCicli(k,1) =(nStart - 1) + nLenCiclo
      nStart = aCicli(k,1) + 1
   Next
End Sub
Sub InitCollAmbi(CollAmbi,qCicli)
   ' sistemi che generano un elevato numero di combinazioni
   Dim k,e,s
   Dim nClasse
   ReDim aNumeri(90)
   Dim aColonne
   Dim cAmbo
   Set CollAmbi = GetNewCollection
   nClasse = 2 ' sviluppo in ambi
   ' inizializzo i numeri da sviluppare in questo caso 90
   ' ma potrebbero essere anche di meno
   For k = 1 To 90
      aNumeri(k) = k
   Next
   ' sviluppo il sistema valorizzando le colonne sviluppate
   aColonne = SviluppoIntegrale(aNumeri,nClasse)
   ' scrivo le colonne in output
   For k = 1 To UBound(aColonne)
      Set cAmbo = New clsAmbo
      cAmbo.qCicli = qCicli
      s = "k"
      ' ciclo per leggere la colonna k
      For e = 1 To nClasse
         Call cAmbo.SetNumero(e,aColonne(k,e))
         s = s & Format2(aColonne(k,e)) & "-"
      Next
      ' tolgo l'ultimo trattino
      s = Left(s,Len(s) - 1)
      Call CollAmbi.Add(cAmbo,s)
   Next
End Sub
 

Matematico

Advanced Member >PLATINUM<
Ciao salvo50, ti ringrazio comunque e in effetti la penso come te ...lo script non fà quello che dovrebbe fare, cioè una vera ricerca ciclica periodica-mensile.
 

Matematico

Advanced Member >PLATINUM<
Ciao druid, grazie x il tuo interessamento e come dicevo a salvo50 ...lo script non fà quello che dovrebbe fare, cioè una vera ricerca ciclica periodica-mensile.
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 26 marzo 2024
    Bari
    30
    51
    17
    01
    53
    Cagliari
    13
    70
    25
    68
    47
    Firenze
    28
    30
    54
    70
    88
    Genova
    67
    87
    22
    03
    62
    Milano
    22
    34
    13
    47
    24
    Napoli
    20
    72
    59
    01
    52
    Palermo
    05
    72
    65
    52
    32
    Roma
    28
    43
    75
    54
    87
    Torino
    16
    08
    17
    24
    38
    Venezia
    67
    28
    55
    60
    29
    Nazionale
    15
    69
    22
    63
    39
    Estrazione Simbolotto
    Firenze
    44
    09
    31
    22
    16
Alto