Option Explicit
'DESTROYER-WHEELS-v1-TOP-RIDUTTORE-AUTOMATICO-per-riduzioni-controllate-a-step-voluto-di-qualsiasi-classe-xEATQC-NLT-settembre-2019
Sub Main
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
'nNumSel = ScegliNumeri(aN)
'aN = Array(0,16,49,60)
nSorte = 5 ' ScegliEsito
'devo dinamicizzare tutte le variabili e i nomi presenti...
Dim din
For din = 78 To 66 Step - 1
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"
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) =RO_'SelRuote(aRuote)
nRuoteSel = 1 : ReDim aRuote(1) : aRuote(1) = FI_ 'SelRuote(aRuote)
nLunghetteDaTrov = 10000 ' Int(InputBox("Lunghette da trovare","Quantità lunghette",10))
ReDim Preserve aRuote(nRuoteSel)
nCicloTeo = CicloTeorico(nClasseLunghetta,nSorte,UBound(aRuote))
nMoltip = 8
nRitMax = 0' Int(InputBox(sMsg,,nCicloTeo * nMoltip))
nRitMin = 0 ' Int(InputBox(sMsg,,nCicloTeo * 3))
fin = EstrazioneFin
Ini = fin - nRitMax
If Ini <= 0 Then Ini = 1
TimeStart = Timer
Call GetLunghettePiuRitardate(aN,aRuote,nClasseLunghetta,nSorte,CollComb,EstrazioneIni,EstrazioneFin,nRitMin,nRitMax,nLunghetteDaTrov,TipoAlgo,nSuperficialita)
'Call GetLunghettePiuRitardate(aN,aRuote,EstrazioneIni,EstrazioneFin,nClasseLunghetta,nSorte,CollComb)
Call OrdinaItemCollection(CollComb,"Ritardo",,,1)
For Each cColonna In CollComb
Call StatisticaFormazioneTurbo(cColonna.aNum,aRuote,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFrq,EstrazioneIni,EstrazioneFin)
If RetRit = 0 Then
Call Scrivi((cColonna.GetStringaNum) & " - " & RetRit)
'PROVA SCRIVI FILE
Dim sfile
Dim Intestazione1
Dim reportlunghettadoc
path = ".\"
sfile = path & "file" & nClasseLunghetta & ".txt"
reportlunghettadoc = cColonna.GetStringaNum
Call ScriviFile(sfile,reportlunghettadoc,False,True) ' scrivo anche sul file preposto
Exit For
Stop
ElseIf RetRit = 1 Then
Call Scrivi((cColonna.GetStringaNum) & " - " & RetRit)
'PROVA SCRIVI FILE
'Dim sfile
'Dim Intestazione1
'Dim reportlunghettadoc
path = ".\"
sfile = path & "file" & nClasseLunghetta & ".txt"
reportlunghettadoc = cColonna.GetStringaNum
Call ScriviFile(sfile,reportlunghettadoc,False,True) ' scrivo anche sul file preposto
Exit For
Stop
'-----------------
ElseIf RetRit = 2 Then
Call Scrivi((cColonna.GetStringaNum) & " - " & RetRit)
path = ".\"
sfile = path & "file" & nClasseLunghetta & ".txt"
reportlunghettadoc = cColonna.GetStringaNum
Call ScriviFile(sfile,reportlunghettadoc,False,True) ' scrivo anche sul file preposto
Exit For
Stop
'-----------------
'-------- uno dei moduli per riconoscimento progressivo unico ra min ------
ElseIf RetRit = 3 Then
Call Scrivi((cColonna.GetStringaNum) & " - " & RetRit)
path = ".\"
sfile = path & "file" & nClasseLunghetta & ".txt"
reportlunghettadoc = cColonna.GetStringaNum
Call ScriviFile(sfile,reportlunghettadoc,False,True) ' scrivo anche sul file preposto
Exit For
Stop
'-----fine di uno dei moduli x riconoscimento progressivo unico di ra min -----------
ElseIf RetRit = 4 Then
Call Scrivi((cColonna.GetStringaNum) & " - " & RetRit)
path = ".\"
sfile = path & "file" & nClasseLunghetta & ".txt"
reportlunghettadoc = cColonna.GetStringaNum
Call ScriviFile(sfile,reportlunghettadoc,False,True) ' scrivo anche sul file preposto
Exit For
Stop
ElseIf RetRit = 5 Then
Call Scrivi((cColonna.GetStringaNum) & " - " & RetRit)
path = ".\"
sfile = path & "file" & nClasseLunghetta & ".txt"
reportlunghettadoc = cColonna.GetStringaNum
Call ScriviFile(sfile,reportlunghettadoc,False,True) ' scrivo anche sul file preposto
Exit For
Stop
ElseIf RetRit = 30 Then 'per farlo partire basta modificare questo valore impostandolo uguale al primo valore di ra min rilevato eventualmente prima con selettivo...
Call Scrivi((cColonna.GetStringaNum) & " - " & RetRit)
path = ".\"
sfile = path & "file" & nClasseLunghetta & ".txt"
reportlunghettadoc = cColonna.GetStringaNum
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
Next
'-----------------------------------------------------------------
'Call Scrivi("Tempo di elaborazione : " & FormattaSecondi(Timer - TimeStart))
CloseFileHandle(sfile)
End If
If ScriptInterrotto Then Exit For
Next 'relativo al primissimo for presente
End Sub
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
)
