Novità

Come si richiamano le function da altri files .ls presenti nella stessa dir?

lotto_tom75

Advanced Premium Member
Cerco di spiegarmi meglio...
Sto costruendo uno script con molte righe di codice... (oltre 2000) o_O?.
Inevitabilmente per la sua corposità... ogni volta che vado a salvarne una nuova aggiunta/modifica mi da il messaggio di overflow chiudendo l'applicazione e ogni volta devo riaprire il programma e lo stesso script per poter continuare ad editarlo... ? Quindi avrei pensato di suddividerlo in tante function presenti ognuna in un rispettivo file .ls o di estensione + appropriata per poi richiamarle nel file script.ls principale... :unsure: In tal modo l'intero script "modulare e suddiviso" sarebbe molto + facile da gestire anche nella sua complessità vieppiù crescente... A tal fine qualcuno/a saprebbe darmi qualche idea e codice di implementazione delle function di esempio? Grazie a tutti coloro che hanno capito cosa intendo e che mi risponderanno ? ? :)
 
Ultima modifica:
Ciao .
Tom forse ti riferisci alla funzione includi?

Ciao grandissimo :) , non so come si chiami o come si possa fare. Ad ogni modo si.. vorrei poter includere le varie function spezzettando lo script principale in tanti relativi sotto files "richiamabili" dal file .ls che li contenga tutti sotto forma di leggerissimo file principale appunto...

Cercando di fare uno schema strutturale vorrei poter fare essenzialmente questo:

In una stessa cartella vorrei mettere:

fileprincipale.ls
che contenga: i vari richiami delle varie function
es. function1 , function2 ecc...

e

i vari relativi files delle function:

file_function1.ls
file_function2.ls


ecc...

In tal modo credo che sarebbe tutto leggerissimo e gestibilissimo :)
 
Ultima modifica:
Se non ricordo male, luigib ne aveva spiegato in qualche thread qualche anno fa

Mi paresi deve fare riferimento alle Collection una volta registrate in qualche cartella, poi negli script si potevano richiamare o includere
 
Ancora non so come richiamare le singole funzioni per poter "splittare" uno script molto lungo... :unsure: ma per chi interessasse e ancora non avesse già pensato questa soluzione "alternativa" io ho risolto temporaneamente così per quanto riguarda il problema di creare ed editare script molto lunghi superiori alle 1800 righe di codice... come quello mio di esempio in img sottostante...

quandosisuperale1800righeca.jpg

Praticamente edito lo script in word e poi lo incollo nella sezione script di editing del programma e salvo il tutto. Così facendo l'errore overflow appare solo una volta. Se avete suggerimenti molto meno "barocchi" ed empirici :D rispetto al mio sono tutto orecchi o in questo caso meglio dire... tutto occhi... Un saluto a tutti/e e Good Saturday :)
 
Ciao tom se più tardi riesco ti posto un un'esempio della funzione includi .
A mio avviso la soluzione migliore è ottimizzare il codice.
Se il codice non è segreto prova a postare una funzione scritta da te e vediamo se riusciamo ad ottimizzarla.
Lo sai qui ci sono tanti bravi programmatori amatoriali.
Non postare parte del codice come tuo solito ???
Post la funzione completa altrimenti non si risolve il problema.
Ciao a dopo.
 
Ciao tom se più tardi riesco ti posto un un'esempio della funzione includi .
A mio avviso la soluzione migliore è ottimizzare il codice.
Se il codice non è segreto prova a postare una funzione scritta da te e vediamo se riusciamo ad ottimizzarla.
Lo sai qui ci sono tanti bravi programmatori amatoriali.
Non postare parte del codice come tuo solito ???
Post la funzione completa altrimenti non si risolve il problema.
Ciao a dopo.

Ok... ???

Il code sottostante commentando le call tabella da 2 a 12 è funzionante ma in quello definitivo vi saranno appunto 12 tabelle dinamiche di sviluppo. Senza le altre 11 tabelle non fa quello per cui è stato progettato ma sviluppa e verifica parte della formazione dinamica ridotta necessaria allo scopo di filtrazione e riduzione finale. C'è anche del codice extra che non è attivo nello script quello riguardante grafico incmax ecc... che per quanto riguarda questo script non serve è non è richiamato in alcuna riga... In pratica sarebbe interessante poter richiamare tutte le function in cascata "TabellaOrdinata", "TabellaOrdinataSeconda" ecc... con appositi include appunto potendo alleggerire in tal modo notevolmente lo script principale che le richiama.

Codice:
‘SPACCA RUOTE :-D  by lotto_tom75 script x cercare di rintracciare ambo secco
'su ruota fissa in pochi colpi. :-D

'Nessuna Certezza Solo Pochissima Probabilità



Class clsLunghetta
Private aNumeri
Private mInizio,mFine,aRuote,mSorte
Private mClasse
Private aElencoRit
Private aIdEstrElencoRit
Private aElencoIncrRitMax
Private aIdEstrIncrRitMax
Private aRitardiAllIncremento
Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza
Private mIncrRitardoMaxSto,mStrIncRitSto
Public Property Get iNumIncrementi
iNumIncrementi = UBound(aElencoIncrRitMax)
End Property
Public Property Get IncrRitMaxSto
IncrRitMaxSto = mIncrRitardoMaxSto
End Property
Public Property Get strIncRitMaxSto
strIncRitMaxSto = mStrIncRitSto
End Property
Public Property Get Ritardo
Ritardo = mRitardo
End Property
Public Property Get RitardoMax
RitardoMax = mRitardoMax
End Property
Public Property Get IncrRitMax
IncrRitMax = mIncrRitMax
End Property
Public Property Get Frequenza
Frequenza = mFrequenza
End Property
Public Property Get LunghettaString
LunghettaString = StringaNumeri(aNumeri)
End Property

Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco)
mInizio = RangeInizio
mFine = RangeFine
aRuote = vetRuote
mSorte = SorteInGioco
Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
Call AlimentaVettoreIncrRitMax
End Sub

Sub EseguiStatistica
Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
End Sub

Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
Dim k
If IsArray(sLunghetta) Then
ReDim aNumeri(UBound(sLunghetta))
For k = 1 To UBound(sLunghetta)
aNumeri(k) = sLunghetta(k)
Next
Else
Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
End If
mClasse = UBound(aNumeri)
End Sub

Private Sub AlimentaVettoreIncrRitMax
Dim nRitMax,nIncr,nId,k
nId = 0
ReDim aElencoIncrRitMax(0)
ReDim aIdEstrIncrRitMax(0)
ReDim aRitardiAllIncremento(0)

aElencoIncrRitMax(0) = aElencoRit(1) '<<< inserito il primo valore correttamente!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  :-)
For k = 1 To UBound(aElencoRit)
If aElencoRit(k) > nRitMax Then
If nRitMax > 0 Then
nIncr = aElencoRit(k) - nRitMax
nId = nId + 1
ReDim Preserve aElencoIncrRitMax(nId)
aElencoIncrRitMax(nId) = nIncr
ReDim Preserve aIdEstrIncrRitMax(nId)
aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
ReDim Preserve aRitardiAllIncremento(nId)
aRitardiAllIncremento(nId) = aElencoRit(k)
End If
nRitMax = aElencoRit(k)
End If
Next
mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
End Sub

Function IsCondizioneRispettata(nIdFiltro,nQIncr,numerominimoincrementiattsto,valoreincmaxmassimo)
Dim nUpper
Dim VetRitornoN
Dim VetRitornoQ
Dim x
Select Case nIdFiltro
Case 1
IsCondizioneRispettata =("SviluppoDestroyerWheels")
End Select
End Function

Function TrasformaArrayNumVirToNumReal(iDist,bPrimaEstrFiss)
Dim k,nTotEstr,ValVirt
Dim sNumReal
sNumReal = ""
nTotEstr =((mFine - mInizio) + 1)Mod 90
ValVirt = Fuori90(nTotEstr *iDist)
For k = 1 To UBound(aNumeri)
sNumReal = sNumReal & Format2(Fuori90(aNumeri(k) + ValVirt)) & "."
Next
sNumReal = RimuoviLastChr(sNumReal,".")
TrasformaArrayNumVirToNumReal = sNumReal
End Function

Sub DisegnaGraficoIncrRitMax
Dim x,y,k
Dim nValoreMaxX,nValoreMaxY,nValoreMinX
Dim nStepX,nStepY
Dim nUpperVetIncrRit
nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
nValoreMaxY = MassimoV(aElencoRit,1)
nStepX =(nValoreMaxX -(mInizio - 1)) \10
nStepY = nValoreMaxY \10
Call PreparaGrafico("Formazione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
nUpperVetIncrRit = UBound(aElencoIncrRitMax)
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aElencoIncrRitMax(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aRitardiAllIncremento(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
Call InserisciGrafico
End Sub

End Class

Sub Main

Dim filetxtscelto
Dim contaesitipos 'contatore contenente il numero degli esiti positivi
Dim contaesitineg 'contatore contenente il numero degli esiti negativi
Dim contacasinongiocabili 'contatore contenente il numero dei casi non giocabili
Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
Dim numerominimoincrementiattsto
Dim valoreincmaxmassimo
Dim nqincr
Dim ntotlunghetteok
Dim bOk,idFiltro,qIncr
Dim bPrimaEstrFissa,nDistanza
sDir = GetDirectoryAppData & "ArchiviVirtuali\"
sFile = ScegliFileArchivioVirt(sDir)
bPrimaEstrFissa = False
If sFile <> "" Then
sFileCompleto = sDir & sFile & ".dat"
bOk = ApriFileBaseDati(sFileCompleto)
bPrimaEstrFissa = True
nDistanza = GetValoreFraSeparatori(sFile,"(",")")
Else
bOk = True
nDistanza = 0
End If
If bOk Then
Dim counterrange
Dim Inizio1,Fine1
Dim quanteestrazioniverificare
Dim nclasse
Dim Valorefinalediclassedestroyer,Valoreinizialediclassedestroyer
Dim fin
fin = EstrazioneFin
Call Scrivi
Call Scrivi("<font size=3>Data elaborazione: " & giorno(fin) & "-" & Mese(fin) & "-" & Anno(fin) & "</font>")
Call Scrivi

Dim RUOTADECISA

'Call Messaggio("Ruota di ricerca e di verifica decisa per il rilevamento del teorico ambo in pochi colpi?")
'RUOTADECISA = CInt(InputBox("Ruota di ricerca e di verifica decisa per il rilevamento del teorico ambo in pochi colpi? ",,1))
Call Messaggio("Valore INIZIALE  di CLASSE DESTROYER?")
Valoreinizialediclassedestroyer = CInt(InputBox("Quale valore di classe iniziale destroyer desideri impostare? ",,90)) 'lunghetta assoluta classe 62 x A su FIRO
Call Messaggio("Valore FINALE di CLASSE DESTROYER?")
Valorefinalediclassedestroyer = CInt(InputBox("Quale valore di classe finale destroyer desideri impostare? ",,16))
Call Messaggio("Scegli quante formazioni random sviluppare...")
ntotlunghetteok = CInt(InputBox("Quante lunghette random vuoi sviluppare? [max 10.000] ",,1))
'ntotlunghetteok = 1000
Dim fattoredimoltiplicazione
fattoredimoltiplicazione = CInt(InputBox("Vuoi aumentare il numero per il fattore di moltiplicazione? ",,1))
ntotlunghetteok = ntotlunghetteok * fattoredimoltiplicazione
Call Messaggio("Scegli quante estrazioni vuoi verificare...")
quanteestrazioniverificare = CInt(InputBox("Quante estrazioni vuoi verificare nel passato? ",,1800)) 'x provare X clp xAsu rtu
'quanteestrazioniverificare=quanteestrazioniverificare/2  'prova per ripristinare giusto numero di estrazioni da verificare senza doppioni
Dim numerocasi
Call Messaggio("Quanti CASI vuoi verificare prima che la ricerca si blocchi autonomamente? ")
numerocasi = CInt(InputBox("Quanti CASI vuoi verificare prima che la ricerca si blocchi autonomamente? ",,1))
Dim EstrazioneFinalevirtuale,EstrazioneFinalevirtualedidefault
EstrazioneFinalevirtualedidefault = EstrazioneFin '- quanteestrazioniverificare ' di default visto i numerosi esiti positivi sui 60 colpi è di 55 estrazioni
EstrazioneFinalevirtuale = CInt(InputBox("Quale estrazione finale virtuale vuoi impostare? ",,EstrazioneFinalevirtualedidefault))
Fine = EstrazioneFin
'Fine1 = EstrazioneFin - 10 ' qui si sceglie il numero di estrazioni da verificare a partire dall'ultima in archivio.
Inizio1 = EstrazioneFinalevirtuale - quanteestrazioniverificare ' qui si sceglie il numero di estrazioni da verificare a partire dall'ultima in archivio.
' CRT = COLPI - (estrazionefinalereale - estrazionenefinalevirtuale)
Call Messaggio("Scegli sorte di rilevamento lunghetta ottimale...")
Sorte = ScegliEsito(3) '<- QUI SI SCEGLIE LA SORTE DA ANALIZZARE (da 1 a 5)
'Sorte = 2
Dim RuoteSelezionate
Dim Modalitaanalisiruote,S,N
Dim RuoteSelezionatexlaverifica
ReDim aRuoteSelxverifica(12)
'ReDim aRuotetmpxverifica(1)
Dim k
ReDim aRuoteSel(12)
Call Messaggio("Scegli ruota di rilevamento lunghetta ottimale...")
'RuoteSelezionate = ScegliRuote(aRuoteSel)

ReDim RuoteSelezionate(1)
RuoteSelezionate(1) = RUOTADECISA


For k = 1 To UBound(RuoteSelezionate)
ReDim aRuotetmp(k)

aRuotetmp(k) = aRuoteSel(k)
Next
ReDim aRuoteSelxverifica(12)
Call Messaggio("Scegli ruota di verifica...")
'RuoteSelezionate = ScegliRuote(aRuoteSelxverifica)
For k = 1 To UBound(RuoteSelezionate)
ReDim aRuotetmpxverifica(k)
aRuotetmpxverifica(k) = aRuoteSelxverifica(k)
Next
Dim po(2),co
Dim Sortediverifica
Dim Valorediconfrontotemporale
Call Messaggio("Scegli colpi di verifica...")

Dim colpimaxteoricidigioco
colpimaxteoricidigioco = 30

Dim CRT 'colpi teorici rimanenti

Dim contatorecrt

CRT = 0

contatorecrt = 0 'inizializzo contatore crt




co = CInt(InputBox("Quanti colpi verificare? ",,quanteestrazioniverificare - colpimaxteoricidigioco)) ' superati i 30 colpi positivi se entro 30 estrazioni testate si avrà un caso negativo si avranno i relativi crt
Call Messaggio("Scegli sorte di verifica...")
Sortediverifica = ScegliEsito(2) '<- QUI SI SCEGLIE LA SORTE DI VERIFICA (da 1 a 5)
Dim ramindes
ramindes = CInt(InputBox("Ritardo minimo desiderato? ",,0))
Dim sFilereport
sFilereport = ".\lunghette-top.txt" ' <- qui puoi cambiare il percorso e il nome file che lo script creera come 'report
Call EliminaFile(sFilereport)

Dim contatorecasi
contatorecasi = 0

Dim cr 'contatore ruote da analizzare in automatico

For cr = 1 To 12

RUOTADECISA = cr

For counterrange = Inizio1 To EstrazioneFinalevirtualedidefault
'For k = 1 To UBound(RuoteSelezionate)
ReDim aRuotetmp(k)
aRuotetmp(k) = aRuoteSel(k)
idFiltro = GetIdFiltro
qIncr = GetQuantiIncrementi
If(counterrange > Inizio) And UBound(aRuotetmp) > 0 And Sorte > 0 And idFiltro > - 1 Then
idFiltro = 1 ' qui si sceglie per cosa attivare LO SCRIP MULTI ANALISYS POWER or NOT ad es. mettere 1 per attivare sviluppo destroyer... qui come unica scelta
qIncr = 1
Inizio = EstrazioneIni
Call Scrivi
Call Scrivi("<font size=3>Data elaborazione: " & giorno(counterrange) & "-" & Mese(counterrange) & "-" & Anno(counterrange) & "</font>" & " N. Estrazione " & counterrange)
Call Scrivi
contatorecasi = contatorecasi + 1
Call AnalisiLunghetteFromTXTconSviluppoDestroyer(Inizio,EstrazioneFinalevirtuale,aRuotetmp,Sorte,idFiltro,qIncr,counterrange,nDistanza,sFilereport,po,co,Sortediverifica,nclasse,numerominimoincrementiattsto,nqincr,valoreincmaxmassimo,ntotlunghetteok,contaesitipos,contaesitineg,contacasinongiocabili,aRuotetmpxverifica,ramindes,quanteestrazioniverificare,numerocasi,Inizio1,Valorefinalediclassedestroyer,Valoreinizialediclassedestroyer,contatorecasi,RUOTADECISA,contatorecrt)
End If
If ScriptInterrotto Then Exit For
'Call AvanzamentoElab(1,ntotlunghette,nProdotte)



If contaesitineg = 0 And contatorecasi >= colpimaxteoricidigioco Then

contatorecrt = contatorecrt + 1 'incremento contatore dei crt

End If


'Next ' ruote selezionate
Next ' x counterrange

If ScriptInterrotto  Then Exit For '

Next ' x analisi ruote

Call Scrivi("Tempo trascorso: " & TempoTrascorso)
Call CloseFileHandle(sFilereport)
End If
End Sub

Function ScegliFileArchivioVirt(sDir)
Dim i
ReDim aFile(0)
Call ElencoFileInDirectory(sDir,aFile,".dat")
aFile(0) = "Archivio reale"
i = ScegliOpzioneMenu(aFile,0,"Scegli archivio virtuale")
If i > 0 Then
ScegliFileArchivioVirt = aFile(i)
Else
ScegliFileArchivioVirt = ""
End If
End Function
Function ScegliTipoSviluppo
ReDim aVoci(4)
aVoci(1) = "Da File .txt"
aVoci(2) = "Da File .Col"
aVoci(3) = "Da Selezione Casuale"
aVoci(4) = "Da Selezione Utente"
ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1,"SelezionaSviluppo")
End Function

Function GetChrSepFromRiga(sRiga)
Dim k,schr
schr = ""
For k = 1 To Len(sRiga)
schr = Mid(sRiga,k,1)
If IsNumeric(schr) = False Then
Exit For
End If
Next
GetChrSepFromRiga = schr
End Function

Function GetIdFiltro
Dim aFiltro(1)
aFiltro(1) = "SviluppoDestroyerWheels"
End Function

Function ScriviFiltro(idFiltro)
Select Case idFiltro
Case 1
ScriviFiltro =("SviluppoDestroyerWheels")
End Select
End Function

Function GetQuantiIncrementi
End Function

Function AddLunghetta(collLunghette,clsL)
On Error Resume Next
collLunghette.Add clsL,"k" & clsL.LunghettaString
If Err = 0 Then
AddLunghetta = True
Else
AddLunghetta = False
End If
Err.Clear
End Function

Function GetValoreFraSeparatori(sFile,CharSep1,CharSep2)
Dim k
Dim i,f,sVal
i = InStr(1,sFile,CharSep1) + 1
f = InStr(i,sFile,CharSep2)
GetValoreFraSeparatori = Int(Mid(sFile,i,f - i))
End Function

Function ScegliFiletxt(sDir)
sDir = "./" '<--- SI PUO' QUESTO PERCORSO DI DEFAULT con quello che si preferisce.
' lo script leggerà... i file txt disponibili dando la possibilità all'utente di scegliere per analizzare quello che vuole
Dim i
ReDim aV(0)
Call ElencoFileInDirectory(sDir,aV,".txt")
Call Messaggio("Scegli il file txt da elaborare")
i = ScegliOpzioneMenu(aV,,"Scegli il file txt desiderato")
'For i = 1 To UBound (aV)
ScegliFiletxt = sDir & aV(i) & ".txt"
'Call Scrivi("file" & i)
Dim filetxtscelto
filetxtscelto = aV(i) & ".txt"
'Next
End Function
Dim sFiles
Dim aLunghette
Dim sFiletxt
Dim contatore
Dim i
Dim c
sFiletxt = ScegliFiletxt(sFiles)
LeggiRigheFileDiTesto sFiletxt,aLunghette

Sub AnalisiLunghetteFromTXTconSviluppoDestroyer(inizio,EstrazioneFinalevirtuale,aRuotetmp,Sorte,idFiltro,qIncr,counterrange,nDistanza,sFilereport,po,co,Sortediverifica,nclasse,numerominimoincrementiattsto,nqincr,valoreincmaxmassimo,ntotlunghetteok,contaesitipos,contaesitineg,contacasinongiocabili,aRuotetmpxverifica,ramindes,quanteestrazioniverificare,numerocasi,Inizio1,Valorefinalediclassedestroyer,Valoreinizialediclassedestroyer,contatorecasi,RUOTADECISA,Contatorecrt)
Dim sFile,aLunghette',ntotlunghette',nclasse
Dim ntotlunghette
Dim nTrov,nProdotte,sNumReal
Dim clsL,collLunghette,uLunghette
ReDim aSelNum(0)
Set collLunghette = GetNewCollection
Dim k
Call Messaggio("Lettura file di testo")
ReDim aRighe(0)
'Call LeggiRigheFileDiTesto(sFile,aRighe)
LeggiRigheFileDiTesto sFiletxt,aRighe
For k = 0 To UBound(aRighe)
If aRighe(k) <> "" Then
ReDim aSelNum(0)
'Call SplitByChar("," & aRighe(k),",",aSelNum)
Call SplitByChar("." & aRighe(k),".",aSelNum)
'Scrivi "E QUI CI ARRIVA???? " ' SI...
End If
Next

ntotlunghette = ntotlunghetteok
If ntotlunghette > 0 And Sorte > 0 And Sorte < 6 Then
nTrov = 0
nProdotte = 0
Do While ntotlunghette > 0
Set clsL = New clsLunghetta
ReDim aLunghette(nclasse)
Call GetColonnaCasuale(nclasse,aLunghette,aSelNum)
nProdotte = nProdotte + 1

Call clsL.Init(aLunghette,"",inizio,counterrange,aRuotetmp,Sorte)

Call sviluppo_destroyer(inizio,EstrazioneFinalevirtuale,aRuotetmp,Sorte,idFiltro,qIncr,counterrange,nDistanza,sFilereport,po,co,Sortediverifica,nclasse,numerominimoincrementiattsto,nqincr,valoreincmaxmassimo,ntotlunghetteok,contaesitipos,contaesitineg,contacasinongiocabili,aRuotetmpxverifica,ramindes,quanteestrazioniverificare,numerocasi,Inizio1,Valorefinalediclassedestroyer,Valoreinizialediclassedestroyer,RUOTADECISA,Contatorecrt)
'----------- ricava vettoredastringaformazione corretto-------------------
Dim filexformazionidiverifica
ReDim Valoredecisoxformazionidiverifica(0)
filexformazionidiverifica = ".\file" & Valorefinalediclassedestroyer & ".txt" ' qui si mette il nome del file con classe finale da verificare...
LeggiRigheFileDiTesto filexformazionidiverifica,Valoredecisoxformazionidiverifica
ReDim vettoredastringaformazione(0)
Dim Va
Va = "0"
vettoredastringaformazione(0) = Va
Dim STRINGAVETTORECLASSEFINALE
STRINGAVETTORECLASSEFINALE = Valoredecisoxformazionidiverifica(0)
Call SplitByChar(STRINGAVETTORECLASSEFINALE,".",vettoredastringaformazione)
Dim ar1,ar2,x
ar1 = Array("0.")
ar2 = array_push(ar1,StringaNumeri(vettoredastringaformazione))
Dim nuovastringa
'Call Scrivi("ar2 è ok? " & ar2(0) & ar2(1))
Dim vs,idx
vs = ""
For idx = 0 To UBound(ar2)
vs = vs & CStr(ar2(idx))
Next
Call SplitByChar(vs,".",vettoredastringaformazione)
For Each x In ar2
  'Call Scrivi(x)
  'Call Scrivi("<br />")
Next

If AddLunghetta(collLunghette,clsL) Then nTrov = nTrov + 1:Call ImpostaGiocata(1,vettoredastringaformazione,aRuotetmp,po,co,Sortediverifica): Call TabellaOrdinata(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt) : Call TabellaOrdinataSeconda(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt)_
: Call TabellaOrdinataTerza(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt) : Call TabellaOrdinataQuarta(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt)_
: Call TabellaOrdinataQuinta(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt)_
: Call TabellaOrdinataSesta(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt)_
: Call TabellaOrdinataSettima(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt)_
: Call TabellaOrdinataOttava(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt)_
: Call TabellaOrdinataNona(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt)_
: Call TabellaOrdinataDecima(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt)_
: Call TabellaOrdinataUndicesima(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt)_
: Call TabellaOrdinataDodicesima(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt)_
: Call Verificatutto(inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,RUOTADECISA,Contatorecrt, contatorecasi) ': counterrange = counterrange '+ 1 ' <<< E' QUESTA LA RIGA CHE FUNZIA! :)

Dim sFilesound
Dim sFileAlertEmail
Dim reportlunghettadoc
Dim esito
If nProdotte Mod 10 = 0 Then
' CRT = COLPI - (estrazionefinalereale - estrazionenefinalevirtuale)
Dim crt
crt = co -(EstrazioneFin - counterrange)

Call AvanzamentoElab(1,ntotlunghette,nProdotte)
Call DoEventsEx
If ScriptInterrotto Or counterrange = EstrazioneFin Then Exit Do 'termina ricerca al primo risultato utile...
Stop ' evidenzia solo un risultato utile per ruota per avere alla fine minor scelta e meno confusione...
'Exit Do ' provo ad uscire dall'estrazione esaminata al primo caso utile riscontrato
End If
ntotlunghette = ntotlunghette - 1
Loop

For Each clsL In collLunghette
ReDim vettoredastringaformazione(0)
Va = "0"
vettoredastringaformazione(0) = Va
Call SplitByChar(clsL.LunghettaString,".",vettoredastringaformazione)
ar1 = Array("0.")
ar2 = array_push(ar1,StringaNumeri(vettoredastringaformazione))
vs = ""
For idx = 0 To UBound(ar2)
vs = vs & CStr(ar2(idx))
Next
Call SplitByChar(vs,".",vettoredastringaformazione)
For Each x In ar2
Next
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & ntotlunghette
End If
ReDim aSelNum(0)
Set collLunghette = GetNewCollection
Call Messaggio("Lettura file di testo")
ReDim aRighe(0)
LeggiRigheFileDiTesto sFiletxt,aRighe
For k = 0 To UBound(aRighe)
If aRighe(k) <> "" Then
ReDim aSelNum(0)
Call SplitByChar("." & aRighe(k),".",aSelNum)
End If
Next
ntotlunghette = ntotlunghetteok
If ntotlunghette > 0 And nclasse >= Sorte Then
nTrov = 0
nProdotte = 0
Do While ntotlunghette > 0
Set clsL = New clsLunghetta
ReDim aLunghette(nclasse)
Call GetColonnaCasuale(nclasse,aLunghette,aSelNum)
nProdotte = nProdotte + 1
Call clsL.Init(aLunghette,"",inizio,counterrange,aRuotetmp,Sorte)
If clsL.IsCondizioneRispettata(idFiltro,qIncr,numerominimoincrementiattsto,valoreincmaxmassimo) Then
Call clsL.EseguiStatistica
ReDim vettoredastringaformazione(0)
Va = "0"
vettoredastringaformazione(0) = Va
Call SplitByChar(clsL.LunghettaString,".",vettoredastringaformazione)
ar1 = Array("0.")
ar2 = array_push(ar1,StringaNumeri(vettoredastringaformazione))
vs = ""
For idx = 0 To UBound(ar2)
vs = vs & CStr(ar2(idx))
Next
Call SplitByChar(vs,".",vettoredastringaformazione)
For Each x In ar2
Next
End If
If nProdotte Mod 10 = 0 Then
' CRT = COLPI - (estrazionefinalereale - estrazionenefinalevirtuale)
'Dim crt

crt = co -(EstrazioneFin - counterrange)

Call AvanzamentoElab(1,ntotlunghette,nProdotte)
Call DoEventsEx
If ScriptInterrotto Or counterrange = EstrazioneFin Then Exit Do 'termina ricerca al primo risultato utile...
Stop ' evidenzia solo un risultato utile per ruota per avere alla fine minor scelta e meno confusione...
'Exit Do ' provo ad uscire dall'estrazione esaminata al primo caso utile riscontrato
End If
ntotlunghette = ntotlunghette - 1
Loop

For Each clsL In collLunghette
ReDim vettoredastringaformazione(0)
'Dim Va
Va = "0"
vettoredastringaformazione(0) = Va
Call SplitByChar(clsL.LunghettaString,".",vettoredastringaformazione)
'Dim ar1,ar2,x
ar1 = Array("0.")
ar2 = array_push(ar1,StringaNumeri(vettoredastringaformazione))
vs = ""
For idx = 0 To UBound(ar2)
vs = vs & CStr(ar2(idx))
Next
Call SplitByChar(vs,".",vettoredastringaformazione)
For Each x In ar2
  'Call Scrivi(x)
  'Call Scrivi("<br />")
Next

'If ((contaesitipos+contaesitineg)=(quanteestrazioniverificare-co)) Then
'
'Exit For
'
'End If

Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & ntotlunghette
'contacasinongiocabili = contacasinongiocabili + 1
End If

'If ((contaesitipos+contaesitineg)=(quanteestrazioniverificare-co)) Then
'
'Exit
'
'End If

Scrivi
Call Scrivi("Esiti positivi: " & "<font color=green>" & contaesitipos & "</font>" & " Esiti negativi: " & "<font color=red>" & contaesitineg & "</font>" & " Casi totali  esaminati: " & contaesitipos + contaesitineg)
Scrivi

End Sub

Function sviluppo_destroyer(Inizio,EstrazioneFinalevirtuale,aRuotetmp,Sorte,idFiltro,qIncr,counterrange,nDistanza,sFilereport,po,co,Sortediverifica,nclasse,numerominimoincrementiattsto,nqincr,valoreincmaxmassimo,ntotlunghetteok,contaesitipos,contaesitineg,contacasinongiocabili,aRuotetmpxverifica,ramindes,quanteestrazioniverificare,numerocasi,Inizio1,Valorefinalediclassedestroyer,Valoreinizialediclassedestroyer,RUOTADECISA,Contatorecrt)
'PRIMA DI EFFETTUARE LA RIDUZIONE AL FINE DI AVERE RISULTATI CONGRUENTI E' NECESSARIO CANCELLARE I PRECEDENTI FILE CON LE RISULTANZE DELLE EVENTUALI ELABORAZIONI FATTE PRIMA...
'modulo cancellazione file txt delle risultanze precedenti...
Dim Fileprecedente
Dim contatxt

For contatxt = 1 To Valoreinizialediclassedestroyer - 1 '67 ' QUI SI METTE IL VALORE DI FILE corrispondente a quello base-1 (es. 67 per file base file68.txt)
Fileprecedente = "file" & contatxt & ".txt"
'prova cancellazione file txt iniziali precedenti eccetto file68.txt
If FileEsistente(Fileprecedente) Then
If FileEsistente(Fileprecedente) <> "file" & Valoreinizialediclassedestroyer & ".txt" Then ' QUI SI METTE IL FILE BASE DA NON CANCELLARE
Call EliminaFile(Fileprecedente)
End If
End If
Next
Dim nSorte,aRuote,Ini,fin,sMsg,nMoltip,nTrov,nNumSel
Dim nCicloTeo,nRitMax,nRitMin,nClasseLunghetta,nRuoteSel,nLunghetteDaTrov
Dim TimeStart
Dim k,CollComb,cColonna
Dim aN
Dim TipoAlgo
Dim RetRit,RetRitMax,RetIncrRitMax,RetFrq
Dim nSuperficialita
nTrov = 0
'Sorte = 3
nSorte = Sorte ' ScegliEsito
'Sorte = nSorte
'devo dinamicizzare tutte le variabili e i nomi presenti...
Dim din,din0
din0 = Valoreinizialediclassedestroyer '68  qui si mette il numero del file base corrispondente alla classe del gruppo numerico di base (es. 80 x file80.txt per 80ina assoluta ecc...)
'ricordarsi di mettere
For din = din0 - 1 To Valorefinalediclassedestroyer Step - 1 'din0 lo si riduce dei punti necessari fino ad individuare la prima risultanza di partenza...
nClasseLunghetta = din ' ScegliClassseLunghetta
TipoAlgo = 4
nSuperficialita = 0
Dim filesorgente
filesorgente = nClasseLunghetta + 1
Call Messaggio(filesorgente)
Dim path

'PROVA LETTURA FILE
'sfile = ScegliFile("c:\lunghette",".txt","lunghette.txt")
sFile = "file" & din + 1 & ".txt"
'Call Scrivi("file elaborato: " & sfile)
If FileEsistente(sFile) Then
Call Messaggio("Lettura file di testo")
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(sFile,aRighe)
For k = 0 To UBound(aRighe)
If aRighe(k) <> "" Then
ReDim aN(0)
'Call SplitByChar("." & aRighe(k),".",aNum)
Call SplitByChar("." & aRighe(k),".",aN)
'Call Scrivi(aRighe(k))
End If
Next
'nRuoteSel= 1 : ReDim aRuote(1) : aRuote(1) =TT_'SelRuote(aRuote)
'nRuoteSel = k : ReDim aRuote(k) : aRuote(k) = aRuotetmpxverifica(k) 'SelRuote(aRuote)
ReDim aRuote(1)

aRuote(1) = RUOTADECISA

'Dim Inizio
Dim Valoreinizioelaborazione
Dim Valorefineelaborazione
Dim Classe,i,retfreq,aNum,aretcol,RetRit1
Inizio = 1
Valoreinizioelaborazione = 1
'Valorefineelaborazione = 1000 '100 milioni di colonne
Valorefineelaborazione = ntotlunghetteok
'Scrivi "arriva qui il valore di aN? " & aN(0) & aN(1) & aN(2) & aN(3)
For i = Valoreinizioelaborazione To Valorefineelaborazione
Call GetColonnaCasuale(nClasseLunghetta,aretcol,aN)
'Call AvanzamentoElab(1,Valorefineelaborazione,i)
Call StatisticaFormazioneTurbo(aretcol,aRuote,nSorte,RetRit1,RetRitMax,RetIncrRitMax,retfreq,Inizio,fin)
' arriva anche qui altrimenti non vedrei il relativo messaggio....
Call Messaggio(SiglaRuota(aRuote(1)) & " sorte di ricerca riduzionale " & nSorte)
Dim diff
'se arriva anche qui ADESSO mi dovrebbe creare i files txt sperati...
diff = RetRitMax - RetRit1
If RetRit1 >= ramindes Then ' filtra per il valore di ra min desiderato

Call Scrivi("numeri: " & StringaNumeri(aretcol) & " Classe " & nClasseLunghetta & " riga: " & i & " - " & " rit min rilevato " & RetRit1 & " rit max rilevato " & RetRitMax & " sorte " & nSorte & " ruota " & NomeRuota(aRuote(1)) & " diff " & diff & " freq " & retfreq & " incmax " & RetIncrRitMax)
'PROVA SCRIVI FILE
Dim sFile
Dim Intestazione1
Dim reportlunghettadoc
path = ".\"
sFile = path & "file" & nClasseLunghetta & ".txt"
'reportlunghettadoc = cColonna.GetStringaNum
reportlunghettadoc = StringaNumeri(aretcol)
Call ScriviFile(sFile,reportlunghettadoc,False,True) ' scrivo anche sul file preposto
Exit For
Stop
'---------- end if e next di chiusura moduli x ra min ------------
End If
If ScriptInterrotto Then Exit For
Call AvanzamentoElab(1,Valorefineelaborazione,i)
Next
'-----------------------------------------------------------------
'Call Scrivi("Tempo di elaborazione : " & FormattaSecondi(Timer - TimeStart))
CloseFileHandle(sFile)
End If
If ScriptInterrotto Then Exit For
Call AvanzamentoElab(1,Valorefinalediclassedestroyer,din)
Next 'relativo al primissimo for presente
End Function

Function ScegliClassseLunghetta
Dim aVoci(30)
Dim k,i
For k = 2 To(2 - 1) + UBound(aVoci)
i = i + 1
aVoci(i) = k
Next
k = ScegliOpzioneMenu(aVoci,5,"Classe lunghetta")
ScegliClassseLunghetta = Int(aVoci(k))
End Function

Function SelRuote(aRuote)
Dim t,k,bTutte
bTutte = False
t = ScegliRuote(aRuote)
For k = 1 To t
If aRuote(k) = TT_ Then
bTutte = True
Exit For
End If
Next
If bTutte Then
ReDim aRuote(10)
For k = 1 To 10
aRuote(k) = k
Next
SelRuote = 10
Else
SelRuote = t
End If
End Function

Function FormattaSecondi(s)
Dim hh
Dim Mm
Dim Ss
Dim TimeStr
hh = s \ 3600
Mm =(s Mod 3600) \ 60
Ss = s -((hh * 3600) +(Mm * 60))
TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
FormattaSecondi = TimeStr
End Function

Function

Verificatutto(Inizio,counterrange,sortediverifica,vettoredastringaformazione,aruotetmp,co,nprodotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,RUOTADECISA,Contatorecrt, contatorecasi)
'Call ImpostaGiocata(1,vettoredastringaformazione,aRuotetmp,po,co,Sortediverifica)

'-----------------implementazione del VERIFICATORE per dettaglio esiti----------------------------

Dim L,T,V,Ini,fin,r,s,so,rit,max,Incr,fre,es,clp,estr,id,k,esito,sfilereport,reportlunghettadoc',contaesitipos,contaesitineg','Ru(1),k
   Ini = Inizio ' qui si sceglie l'inizio del range di verifica
   fin = counterrange ' qui si sceglie la fine dle range di verifica
   s = sortediverifica
   so = NomeSorte(s)
   L = vettoredastringaformazione

   ReDim aruotetmp(1)
   aruotetmp(1) = RUOTADECISA

   T = Array(T,"Ruota","Lunghetta","Freq","Rit.Att","Max Sto","InCr","Sorte di Verifica")
   Call InitTabella(T)
   Call StatisticaFormazioneTurbo(L,aruotetmp,s,rit,max,Incr,fre,Ini,fin)
   Dim sstringaruote
   'sstringaruote = StringaRuote(aruotetmp(1)) & StringaRuote(aruotetmp(2))
   V = Array(V,SiglaRuota(aruotetmp(1)) & " + TUTTENAZIONALE (OPZIONALE) ",StringaNumeri(L),fre,rit,max,Incr,so)
   Call AddRigaTabella(V)
   CreaTabella
   Scrivi ".............................................Verifica..........................................................................."
   For es = counterrange To counterrange + co
      Call VerificaEsitoTurbo(L,aruotetmp,es,s,1,,esito,clp,estr,id)
      If esito <> "" Then
         k = k + 1
         ReDim Preserve aRetRit(k)
         aRetRit(k) = es
         ReDim Preserve ess(k)
         ess(k) = aRetRit(k) - aRetRit(k - 1)
         Scrivi FormatSpace(k,4) & vbTab & GetInfoEstrazione(es) & vbTab,0,0
         Scrivi estr & vbTab & vbTab & FormatSpace(fin - id,4) & " > Estrazioni Trascorse < " & " Elenco Ritardi ... " & ess(k)
      End If
   Next
   Scrivi String(130,".")
   Scrivi "Tempo Trascorso : " & TempoTrascorso
Dim estrazionidiverificagiuste
estrazionidiverificagiuste = counterrange + 1
If VerificaEsito(vettoredastringaformazione,aruotetmp,estrazionidiverificagiuste,sortediverifica,co) = True Then
'Call Scrivi("lunghetta esaminata: " & clsL.LunghettaString)
Call Scrivi("ESITO di almeno " & sortediverifica & " punti <font color=green><strong>VERIFICATO</strong></font> nei " & co & " COLPI STABILITI")
Dim Infoestrazione
Infoestrazione = GetInfoEstrazione(counterrange)
'Call PlayWav("C:\silenzio.wav",1,"Esito positivo per la sorte di " & sortediverifica & " punti " & " sulle ruote " & "TUTTENAZIONALE" & " entro il colpo numero " & co & " nell'estrazione numero " & counterrange)
'Call Scrivi
contaesitipos = contaesitipos + 1
'Call Scrivi("ESITI POSITIVI: " & contaesitipos)
Else
Call Scrivi
Call Scrivi("ESITO di almeno " & sortediverifica & " punti <font color=red><strong>NON VERIFICATO</strong></font> nei " & co & " COLPI STABILITI")
Call PlayWav("C:\silenzio.wav",1,"Spiacente esito negativo per la sorte di " & sortediverifica & " punti " & " sulla ruota di " & NomeRuota(aruotetmp(1)) & " entro il colpo numero " & co & " nell'estrazione numero " & counterrange)
Call Scrivi
contaesitineg = contaesitineg + 1

Dim colpirestanti
'colpirestanti= fine quanteestrazioniverificare
colpirestanti = co -(EstrazioneFin - counterrange)

Scrivi
Call Scrivi("colpi teorici restanti " & colpirestanti)
Scrivi

'Call Scrivi("ESITI NEGATIVI: " & contaesitineg)
End If

Dim Valorecolpilimite
Valorecolpilimite =(quanteestrazioniverificare - co) + 30

If((contaesitipos + contaesitineg) = Valorecolpilimite) Then

'Call Messaggio ("------- raggiunto limite di colpi! -------")
Call PlayWav("C:\silenzio.wav",1,"Raggiunto il limite impostato di " & Valorecolpilimite -(quanteestrazioniverificare - co) & " colpi teorici ")


End If


If(contaesitineg > 0) Then

'Call Messaggio ("------- raggiunto limite di colpi! -------")
Call PlayWav("C:\silenzio.wav",1,"Rilevato caso negativo passo ad analizzare la ruota successiva… ")

RUOTADECISA = RUOTADECISA + 1

'azzero contatorecrt e contaesitineg e contaesitipos

Contatorecrt=0
contaesitipos=0
contaesitineg=0
contatorecasi=0

End If



'contacasinongiocabili = quanteestrazioniverificare -(contaesitipos + contaesitineg)
'Call Scrivi("CASI NON ESAMINATI: " & contacasinongiocabili)
End Function

Sub PlayWav(sFile,nRepeat,sTesto)
Dim oVoice,oSpFileStream
Dim k
Set oVoice = CreateObject("SAPI.SpVoice")
Set oSpFileStream = CreateObject("SAPI.SpFileStream")
For k = 1 To nRepeat
oSpFileStream.Open sFile
oVoice.SpeakStream oSpFileStream
oSpFileStream.Close
Next
oVoice.Speak sTesto
End Sub

Function array_push(arr,vars)
  ' Dimensiono le variabili interne alla funzione
  Dim k,newelem,newarrsize,elem
  ' Verifico se arr è una array
  If IsArray(arr) Then
    ' Verifico che vars non sia vuoto
    If Len(vars) > 0 Then
      ' Verifico se vars ospita una o più virgole e quindi
      ' se è uno solo o un elenco di elementi.
      ' Se è un solo elemento...
      If InStr(vars,",") = False Then
        ' Incremento di uno il numero di elementi
        newarrsize = CInt(UBound(arr) + 1)
        ReDim Preserve arr(newarrsize)
        ' Aggiungo in coda il nuovo elemento
        arr(newarrsize) = vars
      ' Se vars è un elenco di elementi...
      Else
        ' Definisco un contatore interno con valore di partenza
        ' pari al numero di elementi dell'array originale + 1
        k =(UBound(arr) + 1)
        ' Creo una array con tutti i nuovi elementi da aggiungere
        newelem = Split(vars,",")
        ' Incremento il numero di elementi per contenere quelli nuovi
        newarrsize = CInt(UBound(arr) + UBound(newelem) + 1)
        ReDim Preserve arr(newarrsize)
        ' Ciclo i nuovi elementi per aggiungerli all'array originale
        For Each elem In newelem
          arr(k) = Trim(elem)
          k = k + 1
        Next
      End If
    End If
    array_push = arr
  ' Se arr non è una array la nostra funzione restituisce false
  Else
    array_push = False
  End If
End Function

Function SelEsito
   Dim ret
   Dim aVoci
   'aVoci = Array("","1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20")
   'ret = ScegliOpzioneMenu(aVoci,2," Sviluppo per grado di presenza x punti : ")
   For ret = 1 To 1
      SelEsito = ret
      Next
End Function

Function TabellaOrdinata(Inizio,counterrange,sortediverifica,vettoredastringaformazione,aruotetmp,co,nprodotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,contatorecasi,RUOTADECISA,Contatorecrt)

Dim k
Dim Classe
Dim aCol
ReDim aNum(90)
Dim i
Dim nSorte,Fine,RetRit1,QuantitaNumeriScelti,aRuoteSel,RuoteSelezionate,RetRitMax,RetIncrRitMax,RetFreq',Inizio
Dim ColTot,Rmx,Frx,comb1,comb2,comb3,Frm
Dim contatore
contatore = 1 : Frm = 99999 : Rmm = 99999
'ReDim aNum(0)
'QuantitaNumeriScelti = ScegliNumeri(aNum)
ReDim aRuoteSel(12)
Call Scrivi
Call Scrivi("<font size=3>Data elaborazione: " & giorno(counterrange) & "-" & Mese(counterrange) & "-" & Anno(counterrange) & "</font>" & " N. Estrazione " & counterrange)
Call Scrivi
ReDim aTitoli(9)
aTitoli(1) = "Formazione"
aTitoli(2) = "Ruota"
aTitoli(3) = "Sorte"
aTitoli(4) = "Ritardo"
aTitoli(5) = "Ritardo Massimo"
aTitoli(6) = "Incremento di RItardo Massimo"
aTitoli(7) = "Frequenza"
aTitoli(8) = "Diff"
aTitoli(9) = "Counter"
Call InitTabella(aTitoli)
nSorte = 3
Classe = 15
Call Scrivi
Call Scrivi("Classe: " & Classe & " sorte: " & nSorte)
Call Scrivi
ColTot = InitSviluppoIntegrale(vettoredastringaformazione,Classe)
If ColTot > 0 Then
Do While GetCombSviluppo(aCol) = True
i = i + 1
Dim clsN
Dim Coll
Set Coll = GetNewCollection
ReDim aruote7(1)
aruote7(1) = RUOTADECISA
Call StatisticaFormazioneTurbo(aCol,aruote7,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,Inizio,counterrange)
Diff = RetRitMax - RetRit1
Set clsN = New clsRitardo
clsN.numero = StringaNumeri(aCol)
clsN.aRuote = "ruota:" & NomeRuota(aruote7(1))
clsN.nSorte = nSorte
clsN.nritardo = RetRit1
clsN.RetRitMax = RetRitMax
'clsN.RetRitIncrRitMax = RetIncrRitMax
clsN.RetFreq = RetFreq
'clsN.difforo = Diff
'clsN.contatore = contatore
Dim Diff
Diff = RetRitMax - RetRit1
Dim rapportoRARS
'rapportoRARS = RetRit1/RetRitMax
Call AvanzamentoElab(1,ColTot,i)
If(RetRit1 >= 0) Then
'Call Messaggio("Trovata!!! :) per la ruota di: " & NomeRuota(aruote7(1) & NomeRuota(aruote7(2)))) '& NomeRuota(aruote7(2)))
contatore = contatore + 1
Else
Call Messaggio("Colonna " & i)
End If
If ScriptInterrotto Then Exit Do
Coll.Add clsN,"k" & clsN.numero
For Each clsN In Coll
ReDim aValue(9)
aValue(1) = clsN.numero
aValue(2) = clsN.aRuote
aValue(3) = clsN.nSorte
aValue(4) = clsN.nritardo
aValue(5) = clsN.RetRitMax

'aValue(6) = clsN.RetRitIncrRitMax
aValue(7) = clsN.RetFreq
'aValue(8) = clsN.difforo
'aValue(9) = clsN.contatore

''''ritardo max
If aValue(4) > Rmx Then
Rmx = aValue(4)
comb1 = aValue(1)
End If

'''ritardo min
Dim Rmm,comb0

If aValue(4) < Rmm Then
Rmm = aValue(4)
comb0 = aValue(1)
End If

'''frequenza max
If aValue(7) > Frx Then
Frx = aValue(7)
comb2 = aValue(1)
End If
'''frequenza min
If aValue(7) < Frm Then
Frm = aValue(7)
comb3 = aValue(1)
End If
Call AddRigaTabella(aValue)
Next
Loop
Scrivi "Combinazione " & comb1 & " Ritardo Massimo " & Rmx,1,2,4
Scrivi "Combinazione " & comb2 & " Frequenza Massima " & Frx,1,2,4
Scrivi "Combinazione " & comb3 & " Frequenza Minima " & Frm,1,2,4
Call CreaTabella(7,2,0)

',1,2,4 'assumo che il vettore formazione da verificare sia quello con fq min
' devo prima trasformare il valore STRINGA della formazione desiderata (es. quella a rit max) in vettore...

Scrivi
Call Scrivi("<font size=5>" & comb1 & "</font>")
Scrivi

Call SplitByChar("." & comb2,".",vettoredastringaformazione)

'Call SplitByChar("." & comb0 & comb1 & comb2 & comb3,".",vettoredastringaformazione)

End If
End Function

Class clsRitardo
Dim numero
Dim nRitardo
Dim aCol
Dim aRuote
Dim nSorte
Dim RetRit1
Dim RetRitMax
Dim RetRitIncrRitMax
Dim RetFreq
Dim difforo
Dim contatore
End Class

Ciao

:D
 
Ultima modifica:
Ciao tom
Dando una letta veloce c è parte del codice che avevo scritto con Luigi, e quello andava bene.
Poi vedo delle funzioni vuote tipo incrementa quantità.

Bastava scrivere una sola funzione non tutto quel papiro
. Anche richiamando non so se ti aiuterà.
 
Ciao Tom
posto un esempio della funzione includi
allora apro uno script vuoto e salvo le funzioni utili
qui ho scritto due funzioni per la selezione del giorno, avevo letto che servivano ad un utente, magari gli torna utile
una versione alternativa non migliore di quella che aveva gia trovato con l aiuto di un altro utente.
salvo qusta pagina ProvaPeIncludere
Codice:
Option Explicit
Function SelGiornoSett
   Dim aV:aV = Array("domenica","lunedi","martedi","mercoledi","giovedi","venerdi","sabato")
   Dim St
   St = ScegliOpzioneMenu(aV,0,"Seleziona Giorno di Ricerca")
   SelGiornoSett = Left(aV(St),3)
End Function
Function GetGiorno(idEstr,idGiorno)
   Dim bRet:bRet = false
   If Left(DataEstrazione(idEstr,True),3) = idGiorno Then
      bRet = True
   End If
   GetGiorno = bRet
End Function
nella pagina principale
Codice:
Option Explicit
 Includi "GetDirectoryAppData&\script\ProvaPeIncludere.ls"
Sub Main
   
  
   Dim idGiorno
   idGiorno = SelGiornoSett
   Scrivi idGiorno
   Dim idestr
   For idestr = EstrazioneFin - 100 To EstrazioneFin
      If GetGiorno(idestr,idGiorno) Then Scrivi DataEstrazione(idestr,True)
   Next
End Sub
nello script principale richiamo le funzioni sull altro foglio
ma secondo me non è questa la soluzione migliore
prendere tanti pezzi di script per farne uno unico , non è la migliore soluzione secondo me
spero possa esserti utile
Controllate se il tutto funzia o ci sono errori di concetto o di battitura
 
Ciao Tom
posto un esempio della funzione includi
allora apro uno script vuoto e salvo le funzioni utili
qui ho scritto due funzioni per la selezione del giorno, avevo letto che servivano ad un utente, magari gli torna utile
una versione alternativa non migliore di quella che aveva gia trovato con l aiuto di un altro utente.
salvo qusta pagina ProvaPeIncludere
Codice:
Option Explicit
Function SelGiornoSett
   Dim aV:aV = Array("domenica","lunedi","martedi","mercoledi","giovedi","venerdi","sabato")
   Dim St
   St = ScegliOpzioneMenu(aV,0,"Seleziona Giorno di Ricerca")
   SelGiornoSett = Left(aV(St),3)
End Function
Function GetGiorno(idEstr,idGiorno)
   Dim bRet:bRet = false
   If Left(DataEstrazione(idEstr,True),3) = idGiorno Then
      bRet = True
   End If
   GetGiorno = bRet
End Function
nella pagina principale
Codice:
Option Explicit
Includi "GetDirectoryAppData&\script\ProvaPeIncludere.ls"
Sub Main
 

   Dim idGiorno
   idGiorno = SelGiornoSett
   Scrivi idGiorno
   Dim idestr
   For idestr = EstrazioneFin - 100 To EstrazioneFin
      If GetGiorno(idestr,idGiorno) Then Scrivi DataEstrazione(idestr,True)
   Next
End Sub
nello script principale richiamo le funzioni sull altro foglio
ma secondo me non è questa la soluzione migliore
prendere tanti pezzi di script per farne uno unico , non è la migliore soluzione secondo me
spero possa esserti utile
Controllate se il tutto funzia o ci sono errori di concetto o di battitura

Ciao mito, grazie mille. Lo provo e ti faccio sapere. Per quanto riguarda il codice sopra di esempio che ti ho postato si in parte aveva il codice dello script che vi richiesi per l'analisi incmax a te e a luigib. Ma appunto quella parte in questo specifico script si può anche cancellare in quanto nello sviluppo nuovo che vi ho fatto non viene richiamata. Per quanto riguarda lo sviluppo in sotto funzioni richiamabili dallo script principale mi aiuterebbe non poco nella gestione delle singole tabelle anche se come hai giustamente anche tu consigliato è possibile dinamicizzare lo sviluppo con solo una di esse. Questa ultima opzione però è meno "espansa" e meno gestibile rispetto quella + userr friendly di molte function ordina tabella divise in rispettivi files richiamabili da quello principale. Grazie di nuovo ilegend ?? :)
 
Avendo di nuovo questa necessità di scomporre in + funzioni uno script medio lungo mi sono imbattuto in questa nuova curiosità... ovvero sembra che nell'include non venga bene riportato il comando scrivi ne con call nè senza call... Infatti se un pezzo di codice che deve essere importato con include lo prevede... lo script principale non lo considera affatto...

es.

se un file principale.ls ha il seguente include:

Codice:
include ".\outputfinale.ls"

se outputfinale.ls contiene ad esempio:

Codice:
scrivi "ok"

oppure

Codice:
call scrivi ("ok")

il file principale con l'include non genera alcuna scritta in output :unsure:

Da cosa dipende questa mancata interpretazione della funzione scrivi richiamata con include?

👋🧑‍🍳:)
 
Io li utilizzavo per le funzioni. Ossia davano un risultato.
Es
Tempotrascorso trova ruota da idcolonna ,sceglida lista.
Ritardomedio
Gli passo dei parametri e mi danno il risultato.
Con una sub non ci ho mai provato.
Ora non apro il pc perché ho mal di testa da tutto il giorno.
Domani se non interviene qualcuno ci provo.
Notte :)
 
Con includi richiami la pagina in cui ci sono le funzioni e poi le richiami singolarmente.
Es

Includi percorso script 1
Poi richiami le funzioni che sono scritte su quel foglio.
Come stai facendo te non l ho mai utilizzato.
 
Io li utilizzavo per le funzioni. Ossia davano un risultato.
Es
Tempotrascorso trova ruota da idcolonna ,sceglida lista.
Ritardomedio
Gli passo dei parametri e mi danno il risultato.
Con una sub non ci ho mai provato.
Ora non apro il pc perché ho mal di testa da tutto il giorno.
Domani se non interviene qualcuno ci provo.
Notte :)

'notte grandissimo! :)
 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 11 gennaio 2025
    Bari
    73
    43
    01
    58
    81
    Cagliari
    69
    60
    18
    02
    10
    Firenze
    25
    32
    18
    55
    54
    Genova
    48
    05
    40
    34
    69
    Milano
    10
    07
    70
    44
    79
    Napoli
    11
    89
    01
    34
    80
    Palermo
    37
    80
    82
    44
    77
    Roma
    78
    04
    38
    39
    56
    Torino
    08
    13
    30
    27
    24
    Venezia
    56
    75
    36
    18
    70
    Nazionale
    63
    83
    19
    31
    80
    Estrazione Simbolotto
    Bari
    35
    34
    12
    23
    20
Indietro
Alto