Novità

Per Rosanna...

ciao Questa versione Gestisce a richiesta o le ruote da Ba a Ve oppure quelle da Ba a Nz

Codice: 
Option Explicit
Class clsCoppia
	Private m_idEstr
	Private aNum
	Private aRuote
	Private m_RitardoRaggiunto
	Private m_Esito
	Private m_Estratti
	Private m_IdEstrEsito
	Private m_aRuoteEsito
	Private m_idEstrTabAna
	Private m_Sfaldata
	Private m_TipoAnalisi
	Sub Class_Initialize
		' codice
		ReDim aNum(0)
		ReDim aRuote(0)
		ReDim m_aRuoteEsito(0)
	End Sub
	Sub Class_Terminate
		' codice
	End Sub
	Public Property Let TipoAnalisi(v)
		m_TipoAnalisi = v
	End Property
	Public Property Get TipoAnalisi
		TipoAnalisi = m_TipoAnalisi
	End Property
	Public Property Let IdEstrTabAna(v)
		m_idEstrTabAna = v
	End Property
	Public Property Get IdEstrTabAna
		IdEstrTabAna = m_idEstrTabAna
	End Property
	Public Property Get Sfaldata
		Sfaldata = m_Sfaldata
	End Property
	Public Property Get RitardoRaggiunto
		RitardoRaggiunto = m_RitardoRaggiunto
	End Property
	Public Property Get Esito
		Esito = m_Esito
	End Property
	Public Property Get Estratti
		Estratti = m_Estratti
	End Property
	Public Property Get idEstr
		idEstr = m_idEstr
	End Property
	Public Property Get IdEstrEsito
		IdEstrEsito = m_IdEstrEsito
	End Property
	Public Property Let idEstr(NewValue)
		m_idEstr = NewValue
	End Property
	Sub SetNumeri(aNumeri)
		aNum = aNumeri
		' scrivere il codice
	End Sub
	Sub GetNumeri(aNumeri)
		aNumeri = aNum
		' scrivere il codice
	End Sub
	Sub SetRuote(aRt)
		aRuote = aRt
		' scrivere il codice
	End Sub
	Sub GetRuote(aRt)
		aRt = aRuote
		' scrivere il codice
	End Sub
	Function GetRuoteInteressateStr
		Dim s,k
		Dim nRuota
		s = ""
		For k = 1 To UBound(aRuote)
			nRuota = Iif(aRuote(k) = 11,12,aRuote(k))
			s = s & SiglaRuota(nRuota) & "."
		Next
		If s <> "" Then
			s = Left(s,Len(s) - 1)
		End If
		GetRuoteInteressateStr = s
	End Function
	Function GetRuoteEsitoStr
		Dim s,k
		Dim nRuota
		s = ""
		For k = 1 To UBound(m_aRuoteEsito)
			nRuota = Iif(m_aRuoteEsito(k) = 11,12,m_aRuoteEsito(k))
			s = s & SiglaRuota(nRuota) & "."
		Next
		If s <> "" Then
			s = Left(s,Len(s) - 1)
		End If
		GetRuoteEsitoStr = s
	End Function
	Function GetNumeriString
		GetNumeriString = StringaNumeri(aNum,,True)
	End Function
	Sub CalcolaRitardo
		Dim sEsitoA,nColpiA,sEstrattiA,IdEstrEsitoA,aRuoteEsitoA,bSfaldA
		Dim sEsitoB,nColpiB,sEstrattiB,IdEstrEsitoB,aRuoteEsitoB,bSfaldB
		Dim sEsito,nColpi,sEstratti,IdEstrEsito,aRuoteEsito,bSfald
		Dim k
		If m_TipoAnalisi = 0 Then ' un estratto qualsiasi su una delle ruote
			ReDim aRt(UBound(aRuote))
			For k = 1 To UBound(aRuote)
				aRt(k) = Iif(aRuote(k) = 11,12,aRuote(k))
			Next
			m_Sfaldata = VerificaEsito(aNum,aRt,m_idEstrTabAna,1,,,sEsito,nColpi,sEstratti,IdEstrEsito,aRuoteEsito)
		ElseIf m_TipoAnalisi = 1 Then ' un estratto sulla ruota di origine
			ReDim aRt(1)
			ReDim aN(1)
			aRt(1) = Iif(aRuote(1) = 11,12,aRuote(1))
			aN(1) = aNum(1)
			bSfaldA = VerificaEsito(aN,aRt,m_idEstrTabAna,1,,,sEsitoA,nColpiA,sEstrattiA,IdEstrEsitoA,aRuoteEsitoA)
			aRt(1) = Iif(aRuote(2) = 11,12,aRuote(2))
			aN(1) = aNum(2)
			bSfaldB = VerificaEsito(aN,aRt,m_idEstrTabAna,1,,,sEsitoB,nColpiB,sEstrattiB,IdEstrEsitoB,aRuoteEsitoB)
			If bSfaldA Or bSfaldB Then m_Sfaldata = True
			If nColpiA <= nColpiB Then
				nColpi = nColpiA
				sEsito = sEsitoA
				nColpi = nColpiA
				sEstratti = sEstrattiA
				IdEstrEsito = IdEstrEsitoA
			Else
				nColpi = nColpiB
				sEsito = sEsitoB
				nColpi = nColpiB
				sEstratti = sEstrattiB
				IdEstrEsito = IdEstrEsitoB
			End If
		ElseIf m_TipoAnalisi = 2 Then ' un estratto sulla ruota opposta a quella di origine
			ReDim aRt(1)
			ReDim aN(1)
			aRt(1) = Iif(aRuote(1) = 11,12,aRuote(1))
			aN(1) = aNum(2)
			bSfaldA = VerificaEsito(aN,aRt,m_idEstrTabAna,1,,,sEsitoA,nColpiA,sEstrattiA,IdEstrEsitoA,aRuoteEsitoA)
			aRt(1) = Iif(aRuote(2) = 11,12,aRuote(2))
			aN(1) = aNum(1)
			bSfaldB = VerificaEsito(aN,aRt,m_idEstrTabAna,1,,,sEsitoB,nColpiB,sEstrattiB,IdEstrEsitoB,aRuoteEsitoB)
			If bSfaldA Or bSfaldB Then m_Sfaldata = True
			If nColpiA <= nColpiB Then
				nColpi = nColpiA
				sEsito = sEsitoA
				nColpi = nColpiA
				sEstratti = sEstrattiA
				IdEstrEsito = IdEstrEsitoA
			Else
				nColpi = nColpiB
				sEsito = sEsitoB
				nColpi = nColpiB
				sEstratti = sEstrattiB
				IdEstrEsito = IdEstrEsitoB
			End If
		End If
		m_Esito = sEsito
		m_RitardoRaggiunto = nColpi
		m_Estratti = sEstratti
		m_IdEstrEsito = IdEstrEsito
		m_aRuoteEsito = aRuoteEsito
	End Sub
End Class
Sub Main
	Dim Inizio,Fine,idEstr,i,r,nRuota
	Dim sRuote
	Dim CollCasi,clsCaso
	Dim nTipoAnalisi
	Dim nTipoOutput
	Dim nLimiteRuote 
	Dim nPosMax
	
	nTipoAnalisi = ScegliTipoAnalisi
	nTipoOutput = ScegliTipoOutput
	nLimiteRuote = ScegliLimiteRuote
	nPosMax = nLimiteRuote * 5
	
	ReDim aTabAna(220,55)
	Inizio = EstrazioneIni
	Fine = EstrazioneFin
	Set CollCasi = GetNewCollection
	For idEstr = Inizio To Fine
		Messaggio "Analisi TabAnalitico Estrazione " & idEstr
		'Call GetTabAnalitico(aTabAna,idEstr)
		Call AddRigaTabAnalitico(aTabAna,idEstr)
		Call CercaAmbi(aTabAna,idEstr,CollCasi,nPosMax ,nLimiteRuote )
		Call AvanzamentoElab(Inizio,Fine,idEstr)
		If ScriptInterrotto Then Exit Sub
	Next
	If nTipoOutput = 0 Then
		For r = 1 To nLimiteRuote
			nRuota = Iif(r =11,12 ,r)
			sRuote = SiglaRuota(nRuota) & "." & SiglaRuota(FuoriX(nRuota+ 1 ,CInt(nLimiteRuote)))
			
			ReDim aT(8)
			Call GetTitoliTb(aT)
			Call InitTabella(aT)
			i = 0
			For Each clsCaso In CollCasi
				If clsCaso.GetRuoteInteressateStr = sRuote Then
					i = i + 1
					Messaggio "Analisi casi trovati su " & sRuote & i
					clsCaso.TipoAnalisi = nTipoAnalisi
					Call clsCaso.CalcolaRitardo
					aT(1) = clsCaso.GetNumeriString
					aT(2) = clsCaso.GetRuoteInteressateStr
					aT(3) = GetInfoEstrazione(clsCaso.idEstr)
					aT(4) = GetInfoEstrazione(clsCaso.IdEstrTabAna)
					aT(5) = clsCaso.RitardoRaggiunto
					aT(6) = clsCaso.Esito
					aT(7) = clsCaso.Estratti
					aT(8) = GetInfoEstrazione(clsCaso.IdEstrEsito)
					If clsCaso.Sfaldata Then
						Call AddRigaTabella(aT)
					Else
						Call AddRigaTabella(aT,vbGreen)
					End If
					If ScriptInterrotto Then Exit For
				End If
			Next
			Call AvanzamentoElab(1,11,r)
			If ScriptInterrotto Then Exit For
			Call Scrivi(sRuote,True,,,,4)
			Call CreaTabella(5,- 1)
		Next
	Else
		ReDim aT(8)
		Call GetTitoliTb(aT)

		Call InitTabella(aT)
		i = 0
		For Each clsCaso In CollCasi
			i = i + 1
			Messaggio "Analisi casi trovati su " & sRuote & i
			clsCaso.TipoAnalisi = nTipoAnalisi
			Call clsCaso.CalcolaRitardo
			aT(1) = clsCaso.GetNumeriString
			aT(2) = clsCaso.GetRuoteInteressateStr
			aT(3) = GetInfoEstrazione(clsCaso.idEstr)
			aT(4) = GetInfoEstrazione(clsCaso.IdEstrTabAna)
			aT(5) = clsCaso.RitardoRaggiunto
			aT(6) = clsCaso.Esito
			aT(7) = clsCaso.Estratti
			aT(8) = GetInfoEstrazione(clsCaso.IdEstrEsito)
			If clsCaso.Sfaldata Then
				Call AddRigaTabella(aT)
			Else
				Call AddRigaTabella(aT,vbGreen)
			End If
			Call AvanzamentoElab(i,CollCasi.count,r)
			If ScriptInterrotto Then Exit For
		Next
		Call Scrivi(sRuote,True,,,,4)
		Call CreaTabella(5,- 1)
	End If
End Sub
Sub GetTitoliTb(aT)
	ReDim aT(8)
	aT(1) = "Ambo isocrono"
	aT(2) = "Ruote"
	aT(3) = "Estrazione"
	aT(4) = "UltimaEstrTabAna"
	aT(5) = "CadutoDopoColpi"
	aT(6) = "Esito"
	aT(7) = "Numeri"
	aT(8) = "Estrazione Esito"
End Sub
Function ScegliTipoAnalisi
	ReDim aVoci(2)
	aVoci(0) = "Un estratto qualsiasi su una delle 2 ruote"
	aVoci(1) = "Un estratto qualsiasi sulla ruota di origine"
	aVoci(2) = "Un estratto qualsiasi sulla ruota opposta a quella di origine"
	ScegliTipoAnalisi = ScegliOpzioneMenu(aVoci,0,"Tipo Analisi")
End Function
Function ScegliTipoOutput
	ReDim aVoci(1)
	aVoci(0) = "Diviso per ruote"
	aVoci(1) = "Ordinato per colpi di caduta"
	ScegliTipoOutput = ScegliOpzioneMenu(aVoci,0,"Tipo Output")
End Function
Function ScegliLimiteRuote
	Dim i
	ReDim aVoci(1)
	aVoci(0) = "Da Bari a Nazionale"
	aVoci(1) = "Da Bari a Venezia"
	i = ScegliOpzioneMenu(aVoci,0,"Gestione Ruote")
	If i =0 Then
		ScegliLimiteRuote = 11
	Else
		ScegliLimiteRuote = 10
	End If	
End Function

Sub AddRigaTabAnalitico(aTabAna,idEstr)
	Dim k,j,c,e,ee,r,nElim,nMax,nPosInizio
	nMax = UBound(aTabAna)
	' shifto le righe di una verso l'altro
	For k = 2 To nMax
		For j = 1 To 55
			aTabAna(k - 1,j) = aTabAna(k,j)
		Next
	Next
	' aggiungo l'estrazione corrente nell'ultima riga
	c = 0
	For k = 1 To 12
		If k <> 11 Then
			ReDim aEstratti(0)
			Call GetArrayNumeriRuota(idEstr,k,aEstratti)
			For j = 1 To 5
				c = c + 1
				aTabAna(nMax,c) = aEstratti(j)
			Next
		End If
	Next
	' cancello i numeri usciti nell'estrazione corrente
	For r = 1 To 11
		nElim = 0
		nPosInizio =(r - 1) * 5
		For k = nMax - 1 To 1 Step - 1
			For e = 1 To 5
				For ee = 1 To 5
					If aTabAna(nMax,nPosInizio + e) = aTabAna(k,nPosInizio + ee) Then
						aTabAna(k,nPosInizio + ee) = 0
						nElim = nElim + 1
						Exit For
					End If
				Next
			Next
			If nElim = 5 Then Exit For
		Next
	Next
End Sub
Sub CercaAmbi(aTabAna,idEstr,CollCasi ,nPosMax ,nLimiteRuote)
	Dim id,nPos
	For id = 1 To UBound(aTabAna)
		For nPos = 5 To nPosMax Step 5
			If IsNumeriAdiacentiSolitari(aTabAna,id,nPos, nPosMax) Then
				Call AddCasoInColl(CollCasi,aTabAna,id,nPos,idEstr,nLimiteRuote,nPosMax)
			End If
		Next
	Next
End Sub
Function IsNumeriAdiacentiSolitari(aTabAna,id,nPos, nPosMax)
	Dim b
	Dim k,nInizio,nTrov
	b = False
	nTrov = 0
	nInizio = nPos
	For k = nInizio To nInizio - 4 Step - 1
		If aTabAna(id,k) <> 0 Then nTrov = nTrov + 1
	Next
	If nTrov = 1 And aTabAna(id,nInizio) <> 0 Then
		nTrov = 0
		nInizio = FuoriX(nPos + 1,CInt(nPosMax))
		For k = nInizio To nInizio + 4
			If aTabAna(id,k) <> 0 Then nTrov = nTrov + 1
		Next
		If nTrov = 1 And aTabAna(id,nInizio) <> 0 Then
			b = True
		End If
	End If
	IsNumeriAdiacentiSolitari = b
End Function
Sub AddCasoInColl(collCasi,aTabAna,id,nPos,idEstr ,nLimiteRuote,nPosMax)
	Dim cCoppia
	Dim sKey
	ReDim aNum(2)
	Set cCoppia = New clsCoppia
	aNum(1) = aTabAna(id,nPos)
	aNum(2) = aTabAna(id,FuoriX( nPos + 1, CInt(nPosMax)))
	If aNum(1) <> aNum(2) Then
		ReDim aRuote(2)
		aRuote(1) = nPos / 5
		aRuote(2) = FuoriX(aRuote(1) + 1,CInt(nLimiteRuote))
		cCoppia.idEstr = idEstr -(UBound(aTabAna) - id)
		cCoppia.idEstrTabAna = idEstr
		cCoppia.SetNumeri(aNum)
		cCoppia.SetRuote(aRuote)
		sKey = "k" & cCoppia.idEstr & cCoppia.GetRuoteInteressateStr
		Call AddCasoInCollEx(collCasi,cCoppia,sKey)
	End If
End Sub
Sub AddCasoInCollEx(coll,obj,sKey)
	On Error Resume Next
	Call coll.Add(obj,sKey)
	If Err <> 0 Then
		Err.Clear
	End If
End Sub
 
Ciao Luigi e grazie per questa nuova versione.
Abbiamo recuperato altri 77 eventi dalla 3950 a oggi, anche se lo storico Max è arrivato 57 mentre l'altro (gioco sulla ruota di pertinenza, è rimasto a 55.
Buona serata
 
Joe il 10 Agosto 2013 ... ha scritto:
Codice: 
DATA-RUOTE | BA CA | CA FI | FI GE | GE MI | MI NA | NA PA | PA RO | RO TO | TO VE | VE NZ | NZ BA | Rit
01.06.2013 | -- -- | -- -- [COLOR="#FF0000"]| 48.58 | -- -- | -- -- | -- -- | -- -- | -- -- | 82.20 | [/COLOR]-- -- | -- -- |  29
30.05.2013 | -- -- [COLOR="#FF0000"][/COLOR][COLOR="#FF0000"]| 69.09 | -- -- | -- -- | -- -- | -- -- | -- -- | -- -- | -- -- | 62.83 |[/COLOR] -- -- |  30

:) Joe
Clicca per espandere...


... l' Estratto 09 Cade a Cagliari (e Torino) il 13/08/2013.


... l' Estratto 82 Cade a Torino il 13/08/2013.

Secondo Colpo.

:)
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 18 gennaio 2025
    Bari
    24
    76
    02
    72
    12
    Cagliari
    21
    08
    77
    04
    17
    Firenze
    74
    84
    07
    12
    72
    Genova
    13
    07
    33
    47
    18
    Milano
    01
    34
    09
    55
    48
    Napoli
    46
    23
    25
    03
    06
    Palermo
    44
    07
    01
    46
    84
    Roma
    88
    78
    64
    74
    04
    Torino
    07
    87
    67
    38
    53
    Venezia
    31
    25
    04
    18
    02
    Nazionale
    49
    82
    59
    65
    67
    Estrazione Simbolotto
    Bari
    03
    13
    31
    23
    35
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto