Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
Il max ritardo storico di un ambo su due ruote a me risulta essere di 3086.
Per agevolare le prove con i vostri script le ruote sono ca.ro.
A dopo
vedere post successivoOption Explicit
Class clsCombinazione
Private m_UltEstUscita
Private m_Key
Private m_aNum
Private m_Classe
Private m_Index
Sub Class_Initialize
' codice
End Sub
Sub Class_Terminate
' codice
End Sub
Public Property Get Index
Index = m_Index
End Property
Public Property Let Index(NewValue)
m_Index = NewValue
End Property
Public Property Get Classe
Classe = m_Classe
End Property
Public Property Let Classe(NewValue)
m_Classe = NewValue
End Property
Public Property Get Key
Key = m_Key
End Property
Public Property Let Key(NewValue)
m_Key = NewValue
End Property
Public Property Get aNum
aNum = m_aNum
End Property
Public Property Let aNum(NewValue)
m_aNum = NewValue
End Property
Public Property Get UltEstUscita
UltEstUscita = m_UltEstUscita
End Property
Public Property Let UltEstUscita(NewValue)
m_UltEstUscita = NewValue
End Property
Function GetStringaNum
GetStringaNum = StringaNumeri(m_aNum,,True)
End Function
Function AlimentaCollLunghetta(CollLunghette,CollCombBase,nClasseLung)
Dim abNum,nClasseTmp
Dim n
ReDim aCol(0)
Dim sKey,cItem
Dim bFound,bNonAdatta
Dim aNum
Dim nNumIni,nNumAggiunto
Dim sRadice
nClasseTmp = m_Classe
abNum = ArrayNumeriToBool(m_aNum)
nNumIni = 0
sRadice = StringaNumeri(m_aNum,,True)
Do While nNumIni < 90
nNumIni = nNumIni + 1
Do While nClasseTmp < nClasseLung
bFound = False
Call Messaggio("Analisi radice " & sRadice)
bNonAdatta = True
For n = nNumIni To 90
If abNum(n) = False Then
nNumAggiunto = n
abNum(n) = True
nClasseTmp = nClasseTmp + 1
'ReDim aNum(nClasseTmp)
Call ArrayBNumToArrayNum(abNum,aNum)
Call InitSviluppoIntegrale(aNum,m_Classe)
bNonAdatta = False
Do While GetCombSviluppo(aCol)
sKey = "k" & StringaNumeri(aCol,,True)
If GetItemCollection(CollCombBase,sKey,cItem) Then
If cItem.Index > m_Index Then
bNonAdatta = True
abNum(n) = False
nClasseTmp = nClasseTmp - 1
Exit Do
End If
End If
Loop
If bNonAdatta = False Then Exit For
End If
Next
If bNonAdatta Then Exit Do
Loop
If nClasseTmp = nClasseLung Then
Dim clsL
Set clsL = New clsCombinazione
clsL.aNum = aNum
clsL.Classe = nClasseLung
clsL.UltEstUscita = m_UltEstUscita
sKey = "k" & StringaNumeri(aNum,,True)
On Error Resume Next
Call AddItemColl(CollLunghette,clsL,sKey)
nNumIni = nNumAggiunto
abNum(nNumAggiunto) = False
nClasseTmp = nClasseTmp - 1
Else
nNumIni = 90
End If
Loop
End Function
End Class
Sub Main
Dim collCombBase,CollLunghette,nSorte,aRuote,Ini,fin,sMsg,nMoltip
Dim nCicloTeo,nRitMax,nClasseLunghetta,nRuoteSel,nCombBaseTrov,nLunghetteDaTrov
Dim clsComb
Dim i
nSorte = ScegliEsito
nClasseLunghetta = ScegliClassseLunghetta
nRuoteSel = SelRuote(aRuote)
nLunghetteDaTrov = 3
ReDim Preserve aRuote(nRuoteSel)
nCicloTeo = CicloTeorico(nClasseLunghetta,nSorte,UBound(aRuote))
nMoltip = 25
sMsg = "Inserire il ritardo massimo ipotizzato per la sorte voluta nella lunghetta" & vbCrLf
sMsg = sMsg & "Il valore mostrato è il CicloTeorico per la sorte di " & nSorte
sMsg = sMsg & " su " & nClasseLunghetta & " numeri su " & nRuoteSel & " ruote moltiplicato per " & nMoltip
nRitMax = Int(InputBox(sMsg,,nCicloTeo * nMoltip))
fin = EstrazioneFin
Ini = fin - nRitMax
If Ini <= 0 Then Ini = 1
Call AlimentaCollCombUscite(collCombBase,nSorte,aRuote,Ini,fin)
Call OrdinaItemCollection(collCombBase,"UltEstUscita","Key",,1)
i = 0
For Each clsComb In collCombBase
i = i + 1
clsComb.Index = i
Next
nCombBaseTrov = collCombBase.count
Call Scrivi("Le combinazioni base (uscite nel periodo analizzato) di classe " & nSorte & " sono " & nCombBaseTrov)
Set CollLunghette = GetNewCollection
i = 0
For Each clsComb In collCombBase
Call clsComb.AlimentaCollLunghetta(CollLunghette,collCombBase,nClasseLunghetta)
'Call Scrivi(clsComb.GetStringaNum & " -- " & clsComb.UltEstUscita)
If CollLunghette.count >= nLunghetteDaTrov Then Exit For
i = i + 1
'If i > 1000 Then Exit For
Call AvanzamentoElab(1,nCombBaseTrov,i)
If ScriptInterrotto Then Exit For
Next
For Each clsComb In CollLunghette
Call Scrivi(clsComb.GetStringaNum & " -- " & clsComb.UltEstUscita & " - Rit " & RitardoCombinazioneTurbo(aRuote,clsComb.aNum,nSorte,fin))
Next
End Sub
Sub AlimentaCollCombUscite(coll,nSorteCerc,aRuote,Ini,Fin)
Dim idEstr,r,k,nCombSvil,sKey
Dim clsComb
ReDim aColonne(0)
ReDim aNum(0)
ReDim aCol(0)
nCombSvil = Combinazioni(5,nSorteCerc)
Set coll = GetNewCollection
For idEstr = Ini To Fin
For r = 1 To UBound(aRuote)
Call GetArrayNumeriRuota(idEstr,aRuote(r),aNum)
Call OrdinaMatrice(aNum,1)
Call InitSviluppoIntegrale(aNum,nSorteCerc)
Do While GetCombSviluppo(aCol)
sKey = "k" & StringaNumeri(aCol,,True)
Call GetClsComb(coll,sKey,clsComb,aCol,nSorteCerc)
clsComb.UltEstUscita = idEstr
Loop
Next
Call AvanzamentoElab(Ini,Fin,idEstr)
If ScriptInterrotto Then Exit For
Next
End Sub
Function GetClsComb(coll,sKey,clsComb,aCol,nClasse)
On Error Resume Next
Set clsComb = coll(sKey)
If Err <> 0 Then
Err.Clear
Set clsComb = New clsCombinazione
clsComb.Key = sKey
clsComb.aNum = aCol
clsComb.Classe = nClasse
Call coll.Add(clsComb,sKey)
GetClsComb = False
Else
GetClsComb = True
End If
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 GetItemCollection(Coll,sKey,cItem)
On Error Resume Next
Set cItem = Coll(sKey)
If Err <> 0 Then
Err.Clear
GetItemCollection = False
Else
GetItemCollection = True
End If
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
per errori, tolto!
ciao
Cordiali saluti
[/TD]
====================================== [TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 832"]Beppignello;n1965039 ha scritto:
[/TD]Option Explicit
Sub Main
per errori, tolto!
