'Chiesto da Juri, cercare in due ruote 2 ambi consecutivi ed isotopi
'con la distanza 30, in orizontale, verticale o in diagonale,
'delle 6 somme possibili tra i componenti dei 2 ambi, scartare la
'coppia dove si è verificata la distanza 30 ed anche la coppia
'speculare,alla coppia con distanza 30, eseguire le 4 somme rimaste
'e prendere solo le somme dove ce ne siano 2 uguali, scartare una delle 2
'somme uguali e sommare le tre somme rimanenti, il risultato è l'ambata,
'per gli abbinamenti, unire all'ambata ad una ad una le tre somme.
'script by Salvo50
Option Explicit
Sub Main
Dim Fin,Es,Ini,R1,R2,P1,P2,P3,P4,Clp1,E1,E2
Dim A,B,C,D,Caso,Casi,Dist,Ok,St,Distx
Dim DAB,DCD,DAC,DBD,DAD,DBC,S1,S2,S3,S4
Dim Abb1,Abb2,Abb3,Clp2,Ind,Salvo50
Dim Ambata(1),Ambo1(2),Ambo2(2),Ambo3(2),Ruote(1)
Dim Ruo(2),Posta(1),Poste(2),Quat(4),Post(4)
Posta(1) = 1
Poste(2) = 1
Post(2) = 1
Post(3) = 1
Ruote(1) = TU_
Fin = EstrazioneFin
Clp1 = InputBox("Quanti colpi vuoi giocare l'ambata?",,10)
Clp2 = InputBox("Per quanti colpi vuoi giocare gli ambi?",,10)
Dist = CInt(InputBox(" Quale distanza ",,30))
Ini = 9300
Call ScegliRange(Ini,Fin,Ini,EstrazioneFin)
For Es = Ini To Fin
Messaggio Es
AvanzamentoElab Ini,Fin,Es
Caso = 0
For R1 = 1 To 10
For R2 = R1 + 1 To 12
If R2 = 11 Then R2 = 12
Ruo(1) = R1
Ruo(2) = R2
For P1 = 1 To 4
P2 = P1 + 1
A = Estratto(Es,R1,P1) : If A > 0 Then
B = Estratto(Es,R1,P2)
C = Estratto(Es,R2,P1) : If C > 0 Then
D = Estratto(Es,R2,P2)
Ok = 0
Distx = ""
DAB = Differenza(A,B) : DAC = Differenza(A,C) : DAD = Differenza(A,D)
DBC = Differenza(B,C) : DBD = Differenza(B,D) : DCD = Differenza(C,D)
If(A <> C) And(A <> D)And(B <> C)And(B <> D)Then
If(DAB = Dist) Or(DAC = Dist) Or(DAD = Dist)Or(DBC = Dist)Or(DBD = Dist) Or(DCD = Dist) Then
If DAB = Dist Xor DCD = Dist Then
If DAB = Dist Then Distx = " Distanza " & Format2(Dist) & " tra " & Format2(A) & " e " & Format2(B)
If DCD = Dist Then Distx = " Distanza " & Format2(Dist) & " tra " & Format2(C) & " e " & Format2(D)
S1 = Fuori90(A + C)
S2 = Fuori90(A + D)
S3 = Fuori90(B + C)
S4 = Fuori90(B + D)
If(S1 = S2) Xor(S1 = S3) Xor(S1 = S4)Xor(S2 = S3)Xor(S2 = S4)Xor(S3 = S4)Then
Call SommaTotale(S1,S2,S3,S4,St,Abb1,Abb2,Abb3)
Ok = 1
End If
End If
'-----------------------------------------------------------------
If DAC = Dist Xor DBD = Dist Then
If DAC = Dist Then Distx = " Distanza " & Format2(Dist) & " tra " & Format2(A) & " e " & Format2(C)
If DBD = Dist Then Distx = " Distanza " & Format2(Dist) & " tra " & Format2(B) & " e " & Format2(D)
S1 = Fuori90(A + B)
S2 = Fuori90(A + D)
S3 = Fuori90(B + C)
S4 = Fuori90(C + D)
If(S1 = S2) Xor(S1 = S3) Xor(S1 = S4)Xor(S2 = S3)Xor(S2 = S4)Xor(S3 = S4)Then
Call SommaTotale(S1,S2,S3,S4,St,Abb1,Abb2,Abb3)
Ok = 1
End If
End If
'-----------------------------------------------------------------
If DAD = Dist Xor DBC = Dist Then
If DAD = Dist Then Distx = " Distanza " & Format2(Dist) & " tra " & Format2(A) & " e " & Format2(D)
If DBC = Dist Then Distx = " Distanza " & Format2(Dist) & " tra " & Format2(B) & " e " & Format2(C)
S1 = Fuori90(A + B)
S2 = Fuori90(A + C)
S3 = Fuori90(B + D)
S4 = Fuori90(C + D)
If(S1 = S2) Xor(S1 = S3) Xor(S1 = S4)Xor(S2 = S3)Xor(S2 = S4)Xor(S3 = S4)Then
Call SommaTotale(S1,S2,S3,S4,St,Abb1,Abb2,Abb3)
Ok = 1
End If
End If
If Ok = 1 Then
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P3 = 1 To 5
E1 = Estratto(Es,R1,P3)
If E1 = A Or E1 = B Then
Call ColoreTesto(2)
Else
Call ColoreTesto(0)
End If
Call Scrivi(Format2(E1) & " ",1,0)
Call ColoreTesto(0)
Next
Scrivi
Scrivi Space(60) &(Distx),1
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P4 = 1 To 5
E2 = Estratto(Es,R2,P4)
If E2 = C Or E2 = D Then
Call ColoreTesto(2)
Else
Call ColoreTesto(0)
End If
Call Scrivi(Format2(E2) & " ",1,0)
Call ColoreTesto(0)
Next
Scrivi
Scrivi
ColoreTesto(1)
Scrivi Space(20) & " Somme " & Format2(S1) & " " & Format2(S2) & " " & Format2(S3) & " " & Format2(S4),1
ColoreTesto 0
Scrivi
ColoreTesto 2
Scrivi " Ambata " & Format2(St),1,0
ColoreTesto 0
Scrivi " = " & Format2(Abb1) & " + " & Format2(Abb2) & " + ",1,0
Scrivi Format2(Abb3),1
Ambata(1) = St
ImpostaGiocata 1,Ambata,Ruo,Posta,Clp1,1
Ambo1(1) = St : Ambo1(2) = Abb1
ImpostaGiocata 2,Ambo1,Ruo,Poste,Clp2,2
Ambo2(1) = St : Ambo2(2) = Abb2
ImpostaGiocata 3,Ambo2,Ruo,Poste,Clp2,2
Ambo3(1) = St : Ambo3(2) = Abb3
ImpostaGiocata 4,Ambo3,Ruo,Poste,Clp2,2
Quat(1) = St : Quat(2) = Abb1
Quat(3) = Abb2 : Quat(4) = Abb3
ImpostaGiocata 5,Quat,Ruote,Post,Clp2,2
Gioca Es
End If
End If
End If
End If
End If
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi TempoTrascorso
End Sub
Function SommaTotale(S1,S2,S3,S4,St,Abb1,Abb2,Abb3)
If S1 = S2 Or S1 = S3 Or S1 = S4 Then
St = Fuori90(S2 + S3 + S4)
Abb1 = S2 : Abb2 = S3 : Abb3 = S4
End If
If S2 = S3 Or S2 = S4 Then
St = Fuori90(S1 + S3 + S4)
Abb1 = S1 : Abb2 = S3 : Abb3 = S4
End If
If S3 = S4 Then
St = Fuori90(S1 + S2 + S4)
Abb1 = S1 : Abb2 = S2 : Abb3 = S4
End If
End Function
