Richiesta script

Lady Oscar · 15 Maggio 2012

Ciao ragazzi. Ho la necessità di uno script. E' un po complesso, ma spero che possiate aiutarmi.

Volevo sapere se è possibile creare uno script che:

- Quando in due ruote, che possono essere consecutive, gemelle o diametrali, si trovano due numeri (zerati, gemelli, consecutivi), si mette in gioco fino a 4 numeri che devo
poter scegliere.
- Quando in due ruote, che posso essere consecutive, gemelle o diamatrali, l'unità del I° numero (I° ruota) è uguale all'unità del V° (II° ruota), si mette in gioco fino a 4
numeri che devo poter scegliere.
- Quando in due ruote, che posso essere consecutive, gemelle o diamatrali, l'unità del V° estratto (I° ruota) è uguale all'unità del I° estratto (II° ruota), si mette in gioco f
fino a 4 numeri che devo poter scegliere.

Chi mi aiuta in questa impresa? Grazie a chi vorra darmi una mano.

Lady Oscar · 15 Maggio 2012

Mi sa che ho esagerato nella richiesta!!! SO SCAPPATI TUTTIIIIII!

Lady Oscar · 16 Maggio 2012

Rinnovo la richiesta. Ma almeno rispondetemi. Anche un no va bene!

Mi sento alquanto invisibile.

LuigiB · 16 Maggio 2012

Ciao Lady l'ho script l'ho fatto però non è che sei stata tanto chiara non ho capito se i numeri li devi scegliere ogni volta che si verifica una condizione o se li imposti all'inizio , ad ogni modo lo script l'ho fatto in modo tale che te lo chiede ogni
volta , magari se ti serviva nell'altro modo ti aiuterrà qualcun'altro , non sentirti offesa se non lo faccio io ...

Codice:

Option Explicit
Class clsCoppiaRuote
	Public r1
	Public r2
	Public sRelazione
	Function IsPresentiZerati(idEstr,n1,n2,p1,p2)
		Dim k,q1,q2
		q1 = 0
		q2 = 0
		For k = 1 To 5
			If Estratto(idEstr,r1,k) Mod 10 = 0 Then
				q1 = q1 + 1
				n1 = Estratto(idEstr,r1,k)
				p1 = k
			End If
			If Estratto(idEstr,r2,k) Mod 10 = 0 Then
				q2 = q2 + 1
				n2 = Estratto(idEstr,r2,k)
				p2 = k
			End If
		Next
		IsPresentiZerati =(q1 = 1 And q2 = 1)
	End Function
	Function IsPresentiGemelli(idEstr,n1,n2,p1,p2)
		Dim k,q1,q2
		q1 = 0
		q2 = 0
		For k = 1 To 5
			If Gemello(Estratto(idEstr,r1,k)) Then
				q1 = q1 + 1
				n1 = Estratto(idEstr,r1,k)
				p1 = k
			End If
			If Gemello(Estratto(idEstr,r2,k)) Then
				q2 = q2 + 1
				n2 = Estratto(idEstr,r2,k)
				p2 = k
			End If
		Next
		IsPresentiGemelli =(q1 = 1 And q2 = 1)
	End Function
	Function IsPresentiConsecutivi(idEstr,n1,n2,p1,p2)
		Dim k,kk,q
		q = 0
		For k = 1 To 5
			For kk = 1 To 5
				If Estratto(idEstr,r2,kk) - Estratto(idEstr,r1,k) = 1 Then
					n1 = Estratto(idEstr,r1,k)
					n2 = Estratto(idEstr,r2,kk)
					p1 = k
					p2 = kk
					q = q + 1
				End If
			Next
		Next
		IsPresentiConsecutivi =(q = 1)
	End Function
	Function IsDecinaUguale(idEstr,pp1,pp2,n1,n2,p1,p2)
		Dim d1,d2
		n1 = Estratto(idEstr,r1,pp1)
		p1 = pp1
		n2 = Estratto(idEstr,r2,pp2)
		p2 = pp2
		d1 = Int(n1/10)
		d2 = Int(n2/10)
		IsDecinaUguale =(d1 = d2)
	End Function
End Class
Sub Main
	Dim coll
	Dim idEstr
	Dim clsCoppia
	Dim n1,n2,p1,p2
	Dim bEsci
	Dim nGiocata
	Dim sTestoInfo 
	
	nGiocata = 0
	Call AlimentaCoppieRuote(coll)
	For idEstr = EstrazioneIni To EstrazioneFin
		For Each clsCoppia In coll
			If clsCoppia.IsPresentiZerati(idEstr,n1,n2,p1,p2) Then
				If GiocaNumeri(idEstr,clsCoppia,"Zerati",n1,n2,p1,p2 ,sTestoInfo) Then
					Call GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo)
				Else
					If InterrompiAnalisi Then 
						bEsci = True
						Exit For
					End If
				End If
			End If
			If clsCoppia.IsPresentiGemelli(idEstr,n1,n2,p1,p2) Then
				If GiocaNumeri(idEstr,clsCoppia,"Gemelli",n1,n2,p1,p2,sTestoInfo) Then
					Call GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo)
				Else
					If InterrompiAnalisi Then 
						bEsci = True
						Exit For
					End If

				End If
			End If
			If clsCoppia.IsPresentiConsecutivi(idEstr,n1,n2,p1,p2) Then
				If GiocaNumeri(idEstr,clsCoppia,"Consecutivi",n1,n2,p1,p2,sTestoInfo) Then
					Call GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo)
				Else
					If InterrompiAnalisi Then 
						bEsci = True
						Exit For
					End If

				End If
			End If
			If clsCoppia.IsDecinaUguale(idEstr,1,5,n1,n2,p1,p2) Then
				If GiocaNumeri(idEstr,clsCoppia,"Decine uguali in pos I° e V°",n1,n2,p1,p2,sTestoInfo) Then
					Call GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo)
				Else
					If InterrompiAnalisi Then 
						bEsci = True
						Exit For
					End If

				End If
			End If
			If clsCoppia.IsDecinaUguale(idEstr,5,1,n1,n2,p1,p2) Then
				If GiocaNumeri(idEstr,clsCoppia,"Decine uguali in pos V° e 1°",n1,n2,p1,p2,sTestoInfo) Then
					Call GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo)
				Else
					If InterrompiAnalisi Then 
						bEsci = True
						Exit For
					End If

				End If
			End If
		Next
		If bEsci Then Exit For
	Next
	Call ScriviResoconto
End Sub
Sub AlimentaCoppieRuote(coll)
	Dim k
	Dim clsCoppia
	Set coll = GetNewCollection
	For k = 1 To 9 Step 2
		Set clsCoppia = New clsCoppiaRuote
		clsCoppia.sRelazione = "Consecutive"
		clsCoppia.r1 = k
		clsCoppia.r2 = k + 1
		coll.add clsCoppia
	Next
	For k = 1 To 5
		Set clsCoppia = New clsCoppiaRuote
		clsCoppia.sRelazione = "Gemelle"
		clsCoppia.r1 = k
		clsCoppia.r2 = 11 - k
		coll.add clsCoppia
	Next
	For k = 1 To 5
		Set clsCoppia = New clsCoppiaRuote
		clsCoppia.sRelazione = "Diametrali"
		clsCoppia.r1 = k
		clsCoppia.r2 = 5 + k
		coll.add clsCoppia
	Next
End Sub
Function GiocaNumeri(idEstr,clsCoppia,sCondizione,n1,n2,p1,p2 ,sTesto)
	
	sTesto = "Nell'estrazione " & GetInfoEstrazione(idEstr) & " si è verificata la condizione " & sCondizione & vbCrLf
	sTesto = sTesto & "Ruote " & SiglaRuota(clsCoppia.r1) & " - " & SiglaRuota(clsCoppia.r2) & vbCrLf
	sTesto = sTesto & "Le ruote sono " & clsCoppia.sRelazione & vbCrLf
	sTesto = sTesto & SiglaRuota(clsCoppia.r1) & " Num " & n1 & " pos " & p1 & vbCrLf
	sTesto = sTesto & SiglaRuota(clsCoppia.r2) & " Num " & n2 & " pos " & p2 & vbCrLf
	
	If MsgBox(sTesto & "Scegliere i numeri da mettere in gioco ?" ,vbQuestion + vbYesNo ) = vbYes Then
		GiocaNumeri = True
	End If
End Function
Sub GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo)
	Dim nScelti
	Dim nSorte
	Dim nColpi
	ReDim aNum(0)
	ReDim aPoste(5)
	ReDim aRuote(2)
	nColpi = 0
	nScelti = ScegliNumeri(aNum)
	If nScelti > 0 Then
		nSorte = ScegliEsito
		If nSorte <= nScelti And nSorte > 0 Then
			
			Call Scrivi (String(80 ,"="))
			Call Scrivi (sTestoInfo ,,,,vbBlue)
			Call Scrivi (String(80 ,"="))

			Call Scrivi 
			
			Do
				nColpi = Int(InputBox("Colpi di gioco","Imposta colpi",10))
			Loop While nColpi <= 0
			nGiocata = nGiocata + 1
			aPoste(nSorte) = 1
			aRuote(1) = clsCoppia.r1
			aRuote(2) = clsCoppia.r2
			Call ImpostaGiocata(nGiocata,aNum,aRuote,aPoste,nColpi,nSorte)
			Call Gioca(idEstr)
		Else
			MsgBox "La sorte selezionata non puo essere maggiore dei numeri in gioco od uguale a 0",vbExclamation
		End If
	End If
End Sub
Function InterrompiAnalisi
	
	If MsgBox("Interrompere l'analisi ?",vbQuestion + vbYesNo) = vbYes Then
		InterrompiAnalisi = True
	End If
End Function

Lady Oscar · 16 Maggio 2012

Luigiiiiiiiiiiiiiiiiii!!!! Grazie!!! Sei stato gentilissimo. So quello che fai per il forum ed è gia TANTO che tu abbia trovato il tempo per creare lo script.Grazie mille caro!

LuigiB · 16 Maggio 2012

bh comunque modificarlo è semplice .. Ciao

Lady Oscar · 16 Maggio 2012

Azz. Te pare facile!!! Lo script analizza le condizioni a prtire dal 1948

. Ho ovviato modificando la data di partenza nella barra classica di Spaziometria. Pero lo script in pratica.... verifica le condizioni.... e non mi permette di vedere l'output. In pratica... ho unito 3 metodi in uno, ma mi rendo conto che cosi è il caos (come del resto la mia testa!!!)

Sto provando a separare il tutto, ma come faccio a dirgli allo script che quando incontra una condizione, giochi automaticamente quei 4 numeri?

LuigiB · 16 Maggio 2012

ehi Lady Ricopiati lo script che avevo scambiato un 2 con un 3 ... insomma c'era un piccolo errore

LuigiB · 16 Maggio 2012

eheh dai che qualcuno ti aiuterà ... purtroppo avevo capito che doveva chiederli ogni volta.
Ciao

Lady Oscar · 16 Maggio 2012

Scusami tu! L'altro giorno sorridevo alle tue risposte ad un'utente che a quanto pare è famoso per le sue spiegazioni poco chiare!!! E oggi sto sorridendo perchè sono peggio di lui.

Grazie cmq, per aver trovato tempo da dedicarmi! Qualche buona anima la troverò.

Sono intervenuta poche volte, e di solito Blackmore correva in mio aiuto. Secondo te se grido mi sente???

Lady Oscar · 16 Maggio 2012

Ricopio subito!!!! Merci Cherie!

LuigiB · 16 Maggio 2012

Codice:

Option Explicit
Class clsCoppiaRuote
	Public r1
	Public r2
	Public sRelazione
	Function IsPresentiZerati(idEstr,n1,n2,p1,p2)
		Dim k,q1,q2
		q1 = 0
		q2 = 0
		For k = 1 To 5
			If Estratto(idEstr,r1,k) Mod 10 = 0 Then
				q1 = q1 + 1
				n1 = Estratto(idEstr,r1,k)
				p1 = k
			End If
			If Estratto(idEstr,r2,k) Mod 10 = 0 Then
				q2 = q2 + 1
				n2 = Estratto(idEstr,r2,k)
				p2 = k
			End If
		Next
		IsPresentiZerati =(q1 = 1 And q2 = 1)
	End Function
	Function IsPresentiGemelli(idEstr,n1,n2,p1,p2)
		Dim k,q1,q2
		q1 = 0
		q2 = 0
		For k = 1 To 5
			If Gemello(Estratto(idEstr,r1,k)) Then
				q1 = q1 + 1
				n1 = Estratto(idEstr,r1,k)
				p1 = k
			End If
			If Gemello(Estratto(idEstr,r2,k)) Then
				q2 = q2 + 1
				n2 = Estratto(idEstr,r2,k)
				p2 = k
			End If
		Next
		IsPresentiGemelli =(q1 = 1 And q2 = 1)
	End Function
	Function IsPresentiConsecutivi(idEstr,n1,n2,p1,p2)
		Dim k,kk,q
		q = 0
		For k = 1 To 5
			For kk = 1 To 5
				If Estratto(idEstr,r2,kk) - Estratto(idEstr,r1,k) = 1 Then
					n1 = Estratto(idEstr,r1,k)
					n2 = Estratto(idEstr,r2,kk)
					p1 = k
					p2 = kk
					q = q + 1
				End If
			Next
		Next
		IsPresentiConsecutivi =(q = 1)
	End Function
	Function IsDecinaUguale(idEstr,pp1,pp2,n1,n2,p1,p2)
		Dim d1,d2
		n1 = Estratto(idEstr,r1,pp1)
		p1 = pp1
		n2 = Estratto(idEstr,r2,pp2)
		p2 = pp2
		d1 = Int(n1/10)
		d2 = Int(n2/10)
		IsDecinaUguale =(d1 = d2)
	End Function
End Class
Sub Main
	Dim coll
	Dim idEstr
	Dim clsCoppia
	Dim n1,n2,p1,p2
	Dim bEsci
	Dim nGiocata
	Dim sTestoInfo
	Dim nScelti,nSorte , nColpi
	ReDim aNum(0)
	nScelti = ScegliNumeri(aNum)
	nSorte = ScegliEsito
	nColpi = Int (InputBox("Colpi di gioco" , ,10))
	
	nGiocata = 0
	
	If nScelti > 0 And nSorte > 0 And nColpi >0  Then
		Call AlimentaCoppieRuote(coll)
		For idEstr = EstrazioneIni To EstrazioneFin
			For Each clsCoppia In coll
				If clsCoppia.IsPresentiZerati(idEstr,n1,n2,p1,p2) Then
					If GiocaNumeri(idEstr,clsCoppia,"Zerati",n1,n2,p1,p2,sTestoInfo) Then
						Call GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo,aNum,nSorte, nColpi)
					End If
				End If
				If clsCoppia.IsPresentiGemelli(idEstr,n1,n2,p1,p2) Then
					If GiocaNumeri(idEstr,clsCoppia,"Gemelli",n1,n2,p1,p2,sTestoInfo) Then
						Call GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo,aNum,nSorte, nColpi)
					End If
				End If
				If clsCoppia.IsPresentiConsecutivi(idEstr,n1,n2,p1,p2) Then
					If GiocaNumeri(idEstr,clsCoppia,"Consecutivi",n1,n2,p1,p2,sTestoInfo) Then
						Call GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo,aNum,nSorte , nColpi)
					End If
				End If
				If clsCoppia.IsDecinaUguale(idEstr,1,5,n1,n2,p1,p2) Then
					If GiocaNumeri(idEstr,clsCoppia,"Decine uguali in pos I° e V°",n1,n2,p1,p2,sTestoInfo) Then
						Call GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo,aNum,nSorte, nColpi)
					End If
				End If
				If clsCoppia.IsDecinaUguale(idEstr,5,1,n1,n2,p1,p2) Then
					If GiocaNumeri(idEstr,clsCoppia,"Decine uguali in pos V° e 1°",n1,n2,p1,p2,sTestoInfo) Then
						Call GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo,aNum,nSorte, nColpi)
					End If
				End If
			Next
			If bEsci Then Exit For
		Next
		Call ScriviResoconto
	End If
End Sub
Sub AlimentaCoppieRuote(coll)
	Dim k
	Dim clsCoppia
	Set coll = GetNewCollection
	For k = 1 To 9 Step 3
		Set clsCoppia = New clsCoppiaRuote
		clsCoppia.sRelazione = "Consecutive"
		clsCoppia.r1 = k
		clsCoppia.r2 = k + 1
		coll.add clsCoppia
	Next
	For k = 1 To 5
		Set clsCoppia = New clsCoppiaRuote
		clsCoppia.sRelazione = "Gemelle"
		clsCoppia.r1 = k
		clsCoppia.r2 = 11 - k
		coll.add clsCoppia
	Next
	For k = 1 To 5
		Set clsCoppia = New clsCoppiaRuote
		clsCoppia.sRelazione = "Diametrali"
		clsCoppia.r1 = k
		clsCoppia.r2 = 5 + k
		coll.add clsCoppia
	Next
End Sub
Function GiocaNumeri(idEstr,clsCoppia,sCondizione,n1,n2,p1,p2,sTesto)
	sTesto = "Nell'estrazione " & GetInfoEstrazione(idEstr) & " si è verificata la condizione " & sCondizione & vbCrLf
	sTesto = sTesto & "Ruote " & SiglaRuota(clsCoppia.r1) & " - " & SiglaRuota(clsCoppia.r2) & vbCrLf
	sTesto = sTesto & "Le ruote sono " & clsCoppia.sRelazione & vbCrLf
	sTesto = sTesto & SiglaRuota(clsCoppia.r1) & " Num " & n1 & " pos " & p1 & vbCrLf
	sTesto = sTesto & SiglaRuota(clsCoppia.r2) & " Num " & n2 & " pos " & p2 & vbCrLf
	GiocaNumeri = True
End Function
Sub GestioneGioca(clsCoppia,idEstr,nGiocata,sTestoInfo,aNum,nSorte,nColpi)
	ReDim aPoste(5)
	ReDim aRuote(2)
	Call Scrivi(String(80,"="))
	Call Scrivi(sTestoInfo,,,,vbBlue)
	Call Scrivi(String(80,"="))
	Call Scrivi
	nGiocata = nGiocata + 1
	aPoste(nSorte) = 1
	aRuote(1) = clsCoppia.r1
	aRuote(2) = clsCoppia.r2
	Call ImpostaGiocata(nGiocata,aNum,aRuote,aPoste,nColpi,nSorte)
	Call Gioca(idEstr)
End Sub

Lady Oscar · 17 Maggio 2012

Buongiorno Luigi! Ho visto solo ora la tua risposta, ieri sono andata a letto con le galline !!!

Grazie per la modifica (l'anima buona eri tu

), cosi è decisamente piu semplice. Sono riuscita a modificare lo script (non mi chiedere come ho fatto che non lo so neanche io) disattivando la ricerca multipla delle condizioni ( avendo tutti i risultati insieme non riuscivo a capire nulla) volevo sapere come faccio a far verificare anche una condizione in tutte le ruote, senza fare una distinzione di queste? Mi spiego meglio, al momento lo script cerca le condizioni su ruote diametrali, gemelle, etc.... ma se volessi anche la possibilità di cercare una condizione in tutte le ruote indistintamente come se fa?

Grazie sempre!!! Sei stato davvero Special! A presto Cherie!

LuigiB · 17 Maggio 2012

ciao Lady , ma intendi dire sempre a coppie di ruote ? Cioè tutto il metodo si basa comunque su 2 coppie di ruote alla volta ...

Lady Oscar · 17 Maggio 2012

Richiesta script

Direi di si. Altrimenti diventerebbe confusionario (come me del resto). Ihihihi

LuigiB · 17 Maggio 2012

con dieci ruote si possono fare 45 coppie ... bisogna solo agire sulla sub AlimentaCoppieRuote tutto il resto dello script va gia bene... vediamo se qualcuno viene in tuo soccorso
ah ovviamente se si usano tutte le 45 coppie in esse gia sono contenute le gemelle , diametrali consecutive

Lady Oscar · 17 Maggio 2012

Soccorsoooooooooooooo!!!

Lady Oscar · 17 Maggio 2012

Richiesta script

Luigi ... ... Il soccorso scarseggia!

LuigiB · 17 Maggio 2012

eh lo so proprio per questo a suo tempo mi sono prodigato ad insegnare a programmare ..proprio perche so che i cultori del lotto una ne fanno e cento ne pensano e quindi è meglio che facciano da soli

Fare quella modifica è facile ...ho detto dove agire ... sono sicuro che qualcuno ti aiuterà abbi pazienza --

Lady Oscar · 17 Maggio 2012

Richiesta script

Mannaggia... ... Mi hai chiamato di nuovo "cultrice del lotto"!!!!
Cultrice a chi!!!

E allora mi devo rimboccare la maniche!!! Tanto al massimo non funziona!!! Ce provo io!!!

Richiesta script

Super Member >PLATINUM<

Super Member >PLATINUM<

Super Member >PLATINUM<

LuigiB

Guest

Super Member >PLATINUM<

LuigiB

Guest

Super Member >PLATINUM<

LuigiB

Guest

LuigiB

Guest

Super Member >PLATINUM<

Super Member >PLATINUM<

LuigiB

Guest

Super Member >PLATINUM<

LuigiB

Guest

Super Member >PLATINUM<

LuigiB

Guest

Super Member >PLATINUM<

Super Member >PLATINUM<

LuigiB

Guest

Super Member >PLATINUM<