Richiesta script SESTINE ESAGONALI REGOLARI.

« Older Newer »

Matrixpoker1

Posted on 1/11/2021, 09:12

Junior Member

Group: Member

Posts: 15

Status: Offline

Buongiorno, cortesemente avrei una richiesta per DJ Nomade. La mia richiesta riguarda una modifica ad uno script che qualche tempo fa DJ Nomade aveva già creato e che si chiama SESTINE ESAGONALI che però io volevo modificare.
1. IL PROGRAMMA DEVE RICERCARE 4 NUMERI (2 SU UNA RUOTA E 2 SU UN' ALTRA RUOTA) CHE APPARTENGONO AD UNA DELLE 15 SESTINE ESAGONALI REGOLARI.
2. LE AMBATE SARANNO I 2 NUMERI MANCANTI DELLA SESTINA ESAGONALE REGOLARE.
3. GLI AMBI SECCHI SARANNO QUELLI CHE SI FORMERANNO UNENDO LE AMBATE AI 4 NUMERI DI RICERCA QUINDI IN TOTALE SARANNO 8 AMBI SECCHI (4 CON UNA AMBATA E 4 CON L' ALTRA AMBATA).
4.LA QUARTINA PER AMBO SARA'QUELLA FORMATA CON I 4 NUMERI DI RICERCA.

IN TOTALE IL PROGRAMMA TROVA DA METTERE IN GIOCO (SULLE 2 RUOTE DOVE SONO STATI TROVATI I 4 NUMERI) 2 AMBATE, 8 AMBI SECCHI E UNA QUARTINA PER AMBO DA METTERE IN GIOCO PER MASSIMO 10 COLPI DI GIOCO.

GRAZIE IN ANTICIPO.

DjNomade

Posted on 1/12/2021, 21:02

Senior Member

Group: Moderator

Posts: 10,994

Location: MARCHE

Status: Offline

Credo sia cosi'
Ciauz

SPOILER (clicca per visualizzare)

'SESTINA ESAGONALE
ColoreTesto 1 :Scrivi String(47,32)&"SESTINA ESAGONALE",1
Scrivi
Scrivi String(47,32)&"Listato adattato da DjNomade",1
ColoreTesto 0
Sub main()
Dim ruota(10),ruote(10)
Dim numeri2(10),amb(6),numeri4(10)
Dim nu(6)
Dim posta(5)

Dim poste(5)

posta(1) = 1
posta(2) = 1
poste(2) = 2

rs=InputBox("quante estrazioni vuoi controllare? ","controllo estrazioni",30)
xx=InputBox("quante estrazioni a ritroso vuoi controllare? ","controllo a ritroso ",0)
k=InputBox ("per quanti colpi?","colpi di gioco",13)
ini=EstrazioneFin-rs
fin=EstrazioneFin
For es=ini To EstrazioneFin
Messaggio "elab. estr. ["&(es)&"] di " & DataEstrazione (es,1)

For r1=1 To 12 'con nz
If r1=11 Then r1=12
For p1=1 To 4
For p2=p1+1 To 5
a=Estratto(es,r1,p1)
b=Estratto(es,r1,p2)
If Distanza(a,b)=15 Or Distanza (a,b)=30 Or Distanza (a,b)=45 Then

For y=0 To xx 'contr. estr.
ex=es-y
For r2=1 To 12 'con nz
If r2=11 Then r2=12

For p3=1 To 4
For p4=p3+1 To 5
c=Estratto(ex,r2,p3)
d=Estratto(ex,r2,p4)
If (ex=es And r2<r1)Or (ex<es And (r1<>r2 Or r1=r2)) Then
'If p1=p3 And p2=p4 Then 'iso

If ((r1=1 And r2=2)Or (r1=2 And r2=1))_
Or ((r1=3 And r2=4)Or (r1=4 And r2=3))_
Or ((r1=5 And r2=6)Or (r1=6 And r2=5))_
Or ((r1=7 And r2=8)Or (r1=8 And r2=7))_
Or ((r1=9 And r2=10)Or (r1=10 And r2=9))_
Or ((r1=1 And r2=6)Or (r1=6 And r2=1))_
Or ((r1=2 And r2=7)Or (r1=7 And r2=2))_
Or ((r1=3 And r2=8)Or (r1=8 And r2=3))_
Or ((r1=4 And r2=9)Or (r1=9 And r2=4))_
Or ((r1=5 And r2=10)Or (r1=10 And r2=5))_
Or ((r1=1 And r2=10)Or (r1=10 And r2=1))_
Or ((r1=2 And r2=9)Or (r1=9 And r2=2))_
Or ((r1=3 And r2=8)Or (r1=8 And r2=3))_
Or ((r1=4 And r2=7)Or (r1=7 And r2=4))_
Or ((r1=5 And r2=6)Or (r1=6 And r2=5))Or r1=r2 Then

If Distanza(c,d)=15 Or Distanza (c,d)=30 Or Distanza (c,d)=45 Then
If (c<>a And c<>b And d<>a And d<>b) Then
If (Distanza(a,c)=15 Or Distanza (a,c)=30 Or Distanza (a,c)=45) And _
(Distanza(b,c)=15 Or Distanza (b,c)=30 Or Distanza (b,c)=45) Then

nu(1)=a
nu(2)=Fuori90(a+15)
nu(3)=Fuori90(a+30)
nu(4)=Fuori90(a+45)
nu(5)=Fuori90(a+60)
nu(6)=Fuori90(a+75)

For i=1 To 6
If nu(i)=a Or nu(i)=b Or nu(i)=c Or nu(i)=d Then
nu(i)=0
End If
Next

casi=casi+1:Scrivi String(68,"-")&" caso n° "&(casi),1
Scrivi DataEstrazione(ex,1)&" [ "&SiglaRuota(r2)&" - "&stringaestratti(ex,r2)&_
" ] ambo sestina esag. [ "&format2(c)&"."&format2(d)&" ] "&(p3)&"^/"&(p4)&" pos.",1
Scrivi DataEstrazione(es,1)&" [ "&SiglaRuota(r1)&" - "&stringaestratti(es,r1)&_
" ] ambo sestina esag. [ "&format2(a)&"."&format2(b)&" ] "&(p1)&"^/"&(p2)&"^ pos.",1
ColoreTesto 2
If p1=p3 And p2=p4 Then Scrivi" ESTRATTI ISOTOPI",1
If (r1=1 And r2=2)Or (r1=2 And r2=1) Then Scrivi" RUOTE CONSECUTIVE",1
If (r1=3 And r2=4)Or (r1=4 And r2=3) Then Scrivi" RUOTE CONSECUTIVE",1
If (r1=5 And r2=6)Or (r1=6 And r2=5) Then Scrivi" RUOTE CONSECUTIVE",1
If (r1=7 And r2=8)Or (r1=8 And r2=7) Then Scrivi" RUOTE CONSECUTIVE",1
If (r1=9 And r2=10)Or (r1=10 And r2=9) Then Scrivi" RUOTE CONSECUTIVE",1
If Distanza(r1,r2)=5 And r1<11 And r2<11 Then Scrivi" RUOTE DIAMETRALI",1
If r1+r2=11 Then Scrivi" RUOTE GEMELLE",1
ColoreTesto 1
OrdinaMatrice nu,-1
Scrivi "numeri a completare la sestina esagonale [ "&format2(nu(1))&"."&format2(nu(2))&" ]",1
Scrivi

amb(1)=nu(1)
amb(2)=nu(2)

ruote(1) = r1

ruote(2) = r2

numeri2(1) = amb(1)
numeri2(2) = amb(2)
ImpostaGiocata 1,numeri2,ruote,posta,k
numeri2(1) = amb(1)
numeri2(2) = a
ImpostaGiocata 2,numeri2,ruote,poste,k
numeri2(1) = amb(1)
numeri2(2) = b
ImpostaGiocata 3,numeri2,ruote,poste,k
numeri2(1) = amb(1)
numeri2(2) = c
ImpostaGiocata 4,numeri2,ruote,poste,k
numeri2(1) = amb(1)
numeri2(2) = d
ImpostaGiocata 5,numeri2,ruote,poste,k
numeri2(1) = amb(2)
numeri2(2) = a
ImpostaGiocata 6,numeri2,ruote,poste,k
numeri2(1) = amb(2)
numeri2(2) = b
ImpostaGiocata 7,numeri2,ruote,poste,k
numeri2(1) = amb(2)
numeri2(2) = c
ImpostaGiocata 8,numeri2,ruote,poste,k
numeri2(1) = amb(2)
numeri2(2) = d
ImpostaGiocata 9,numeri2,ruote,poste,k
numeri4(1) = a
numeri4(2) = b
numeri4(3) = c
numeri4(4) = d
ImpostaGiocata 10,numeri4,ruote,poste,k

Gioca es
End If
End If
End If
End If
End If
Next
Next
Next
Next
End If
Next
Next
Next
Next

ScriviResoconto
ColoreTesto 1 :Scrivi String(47,32)&"SESTINA ESAGONALE",1
Scrivi
Scrivi String(47,32)&"Listato adattato da DjNomade",1

Scrivi String(47,"=")&" da un listato di franco florindi",1
ColoreTesto 0
End Sub

1 replies since 1/11/2021, 09:12 55 views