Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,Clp,Salvo50,Es,OK,Tutte
Dim R1,R2,P1,P2,P3,P4,P5,P6,E1,E2,Caso,Casi
Dim AB90,CD90,AB05,CD05,AC90,BD90
Dim AC05,BD05,AD90,BC90,AD05,BC05
Dim Num(3),Ruo(2),Ruote(1),Posta(3)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9400))
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,15))
Tutte = CInt(InputBox(" SE VUOI FARE LA RICERCA ANCHE PER TUTTE LE RUOTE METTI 1 ALTRIMENTI UN ALTRO NUMERO",Salvo50,0))
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(17) & "Per Raimbow58 - Quadrato somma 90 - script Salvo50"& Space(17),1,,4,,3,,1
Posta(2) = 1
'Posta(3) = 1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 10
For P1 = 1 To 4
For P2 = P1 + 1 To 5
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
For R2 = R1 + 1 To 12
If R2 = 11 Then R2 = 12
For P3 = 1 To 4
For P4 = P3 + 1 To 5
C = Estratto(Es,R2,P3)
D = Estratto(Es,R2,P4)
If A > 0 And C > 0 Then
'A---B
'| |
'C---D
If A <> C And A <> D And B <> C And B <> D Then
AB90 = Fuori90(A + B) : CD90 = Fuori90(C + D) : AC90 = Fuori90(A + C)
BD90 = Fuori90(B + D) : AD90 = Fuori90(A + D) : BC90 = Fuori90(B + C)
AB05 = Distanza(A,B) : CD05 = Distanza(C,D) : AC05 = Distanza(A,C)
BD05 = Distanza(B,D) : AD05 = Distanza(A,D) : BC05 = Distanza(B,C)
If((AB90 = 90 And CD90 = 90) And((AC05 = 05 And BD05 = 05)Or((AD05 = 05 And BC05 = 05))))_
Xor((AC90 = 90 And BD90 = 90) And((AB05 = 05 And CD05 = 05)Or((AD05 = 05 And BC05 = 05))))_
Xor((AD90 = 90 And BC90 = 90) And((AB05 = 05 And CD05 = 05)Or((AC05 = 05 And BD05 = 05))))Then
OK = 0
If(AB90 = 90 And CD90 = 90) And(AC05 = 05 And BD05 = 05) Then Num(1) = Fuori90(A + C): OK = 1
If(AB90 = 90 And CD90 = 90) And(AD05 = 05 And BC05 = 05) Then Num(1) = Fuori90(A + D): OK = 1
If(AC90 = 90 And BD90 = 90) And(AB05 = 05 And CD05 = 05) Then Num(1) = Fuori90(A + B): OK = 1
If(AC90 = 90 And BD90 = 90) And(AD05 = 05 And BC05 = 05) Then Num(1) = Fuori90(A + D): OK = 1
If(AD90 = 90 And BC90 = 90) And(AB05 = 05 And CD05 = 05) Then Num(1) = Fuori90(A + B): OK = 1
If(AD90 = 90 And BC90 = 90) And(AC05 = 05 And BD05 = 05) Then Num(1) = Fuori90(A + C): OK = 1
If Num(1) <> 90 And OK = 1 Then
Num(2) = ComplAdX(Num(1)) : Num(3) = 90
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,2
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,1
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P5 = 1 To 5
E1 = Estratto(Es,R1,P5)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P6 = 1 To 5
E2 = Estratto(Es,R2,P6)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(15) & "Solo un gruppo con somme uguali a 90",1,0,,2
Scrivi Space(9) & "Solo un gruppo con Distanze = a 5",1,,,2
Scrivi Space(19) & "Somme " & Space(6) & " Somme" & Space(6) & " Somme",1,0
Scrivi Space(11) & "Distanze " & Space(3) & " Distanze ",1,0
Scrivi Space(2) & " Distanze",1
Scrivi Space(5) & "Estratti " & Space(2) & "Orizzontali" & " - ",1,0
Scrivi "Verticali - Diagonali Orizzontali - Verticali - Diagonali",1
Scrivi Space(6) & Format2(A) & " " & Format2(B) & Space(9) & Format2(AB90),1,0
Scrivi Space(11) & Format2(AC90) & Space(10) & Format2(AD90),1,0
Scrivi Space(16) & Format2(AB05) & Space(11) & Format2(AC05) & Space(10) & Format2(AD05),1
Scrivi Space(6) & Format2(C) & " " & Format2(D) & Space(9) & Format2(CD90),1,0
Scrivi Space(11) & Format2(BD90) & Space(10) & Format2(BC90),1,0
Scrivi Space(16) & Format2(CD05) & Space(11) & Format2(BD05) & Space(10) & Format2(BC05),1
Scrivi
Ruo(1) = R1 : Ruo(2) = R2 : Ruote(1) = TU_
EliminaRipetuti Num
ImpostaGiocata 1,Num,Ruo,Posta,Clp
If Tutte = 1 Then ImpostaGiocata 2,Num,Ruote,Posta,Clp
Gioca Es
End If
End If
End If
End If
Next
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
End Sub