Option Explicit
'Ricerca di Estratto Isocrono (con opzione di Isotopia) su N Ruote - creato da Gam nel 2018 grazie al supporto di LuigiB, con funzione SerieCompleta
Sub Main()
Dim collRet
Dim cSC
Dim aElencoRit
Dim nSorte
Dim nClasse
Dim k,i
Dim sNumeri
Dim nRitardiTrov,idRit
Dim eIni,eFin,livArch,riga
Dim aNum(1),Att,Pos
Dim SoloIsotopi,IsoOK
SoloIsotopi = 0 ' impostare 1 per rilevare solo isotopi
nClasse = 3 ' impostare su quante ruote si deve rilevare l'estratto Isocrono
eIni = EstrazioneFin-100
eFin = EstrazioneFin
nSorte = 1 'lasciare 1, trattandosi di estratti
ReDim Iso(nClasse)
Scrivi "iDEs;Estrazione;LivArch;Iso;Ruote;Ru1;Pos;;RC1;",,0
For k = 1 To nClasse - 1
riga = riga & "Ru" &(k + 1) & ";Pos;;RC" &(k + 1) & ";RdL" &(nClasse - k) & ";"
Next
Scrivi riga & "RitMin"
riga = ""
Dim Es,R,P,X,E,N(1),SR
For livArch = 0 To 0 ' valori superiori generano la ricerca su ArchiviParalleli
For Es = eIni To eFin
Messaggio(livArch & " ---> " & Es)
Call AvanzamentoElab(eIni,eFin,Es)
ReDim Pr(90)
For R = 1 To 12 : If R = 11 Then R = 12
For P = 1 To 5
E = Estratto(Es,R,P,livArch) : Pr(E) = Pr(E) + 1
Next
Next
For X = 1 To 90 : aNum(1) = X 'Qui scegliere quali numeri analizzare 1 to 3 solo i primi 3...to 90 tutti e 90
If Pr(
= nClasse Then
k = 0
For R = 1 To 12 : If R = 11 Then R = 12
If Posizione(Es,R,X,livArch) > 0 Then
k = k + 1
ReDim Preserve aRuote(k)
aRuote(k) = R
End If
Next
Set collRet = SerieCompleta(Es + 1,eFin,aNum,nSorte,aRuote,nClasse,False,livArch)
Call OrdinaItemCollection(collRet,"RitardoMinimo",,,1)
ReDim at(3)
at(1) = "EstrInizioAnalisi"
at(2) = "Data"
at(3) = "Numeri"
For k = 1 To nClasse
If k <= 1 Then
ReDim Preserve at(UBound(at) + 2)
at(UBound(at)) = "RC" & k
at(UBound(at) - 1) = "Ru" & k
Else
ReDim Preserve at(UBound(at) + 3)
at(UBound(at) - 1) = "RC" & k
at(UBound(at) - 2) = "Ru" & k
at(UBound(at)) = "RdL" & nClasse - k + 1
End If
Next
ReDim Preserve at(UBound(at) + 1)
at(UBound(at)) = "RitardoMin"
ReDim aVT(UBound(at))
sNumeri = StringaNumeri(aNum,,True)
For Each cSC In collRet
Att = 0
ReDim aRuoteCoinv(0)
Call cSC.GetRuote(aRuoteCoinv)
nRitardiTrov = cSC.RitardiTotali
For idRit = 1 To nRitardiTrov
If cSC.GetArrayRitardiRuote(idRit,aElencoRit) Then
aVT(1) = FormattaStringa(aElencoRit(1,0) - 1,"00000")
aVT(2) = DataEstrazione(aElencoRit(1,0) - 1) & " L" & livArch
aVT(3) = sNumeri
riga = aVT(1) & " " & aVT(2) & " " & aVT(3) & " " & StringaRuote(aRuoteCoinv)
i = 3
For k = 1 To nClasse
i = i + 1
aVT(i) = SiglaRuota(aElencoRit(k,3))
If Es = EstrazioneFin Then
Pos = Posizione(Es,aRuoteCoinv(k),sNumeri,livArch)
Else
Pos = Posizione(Es,aElencoRit(k,3),sNumeri,livArch)
End If
ReDim Preserve Iso(k)
Iso(k) = Pos
If aVT(1) = EstrazioneFin Then aVT(i) = Mid(StringaRuote(aRuoteCoinv),(3*k) - 2,2)
riga = riga & " " & aVT(i) & " P" & Pos
i = i + 1
aVT(i) = aElencoRit(k,2)
If(aVT(i) + Es + 1) > EstrazioneFin Then
riga = riga & " ATT " & FormattaStringa(aVT(i) + 1,"0000")
Att = Att + 1
Else
riga = riga & " STO " & FormattaStringa(aVT(i) + 1,"0000")
End If
If k > 1 Then
i = i + 1
aVT(i) = aElencoRit(k,2) - aElencoRit(k - 1,2)
If aVT(i) <> 0 Then
riga = riga & " " & FormattaStringa(aVT(i),"0000")
Else
riga = riga & " " & "----"
End If
End If
Next
i = i + 1
aVT(i) = cSC.GetRitardoMinimoTraRuote(idRit)
If SoloIsotopi = 1 Then
IsoOK = 1
For k = 1 To nClasse - 1
If Iso(k) = Iso(k + 1) Then IsoOK = IsoOK + 1
Next
If IsoOK = nClasse Then
If Att = nClasse Then
Scrivi riga & " " & FormattaStringa(aVT(i) + 1,"0000") & " ***"
Else
If Att > 0 And Att < nClasse Then
Scrivi riga & " " & FormattaStringa(aVT(i) + 1,"0000") & " *"
Else
Scrivi riga & " " & FormattaStringa(aVT(i) + 1,"0000") & " "
End If
End If
End If
Else
If Att = nClasse Then
Scrivi riga & " " & FormattaStringa(aVT(i) + 1,"0000") & " ***"
Else
If Att > 0 And Att < nClasse Then
Scrivi riga & " " & FormattaStringa(aVT(i) + 1,"0000") & " *"
Else
Scrivi riga & " " & FormattaStringa(aVT(i) + 1,"0000") & " "
End If
End If
End If
End If
Next
Next
End If
Next
Next
Next
Scrivi TempoTrascorso
End Sub
