Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,Clp,Es1,Salvo50
Dim R1,R2,P1,P2,P5,P6,E1,E2,Caso,Casi
Dim SAC,SBD,SAD,SBC,S1,S2,Abb
Dim Amba(1),Ambo(2)
Dim Ruo(2),Po1(1),Po2(2)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9786))
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,5))
Po1(1) = 1
Po2(2) = 1
For Es1 = Ini To FIn
Messaggio Es1
AvanzamentoElab Ini,FIn,Es1
Caso = 0
For R1 = 1 To 9
For P1 = 1 To 4
For P2 = P1 + 1 To 5
A = CInt(Estratto(Es1,R1,P1))
B = CInt(Estratto(Es1,R1,P2))
For R2 = R1 + 1 To 10
S2 = ""
If(R2 = R1 + 1) Or(R2 = RuotaDiametrale(R1))Or(R2 = RuotaGemella(R1)) Then
If R2 = R1 + 1 Then S2 = S2 & " Ruote consecutive "
If R2 = RuotaDiametrale(R1) Then S2 = S2 & " Ruote Diametrali "
If R2 = RuotaGemella(R1) Then S2 = S2 & " Ruote Gemelle "
C = CInt(Estratto(Es1,R2,P1))
D = CInt(Estratto(Es1,R2,P2))
If A > 0 And C > 0 Then
'A---B
'| |
'C---D
If A <> C And A <> D And B <> C And B <> D Then
SAC = Fuori90(A + C) : SBD = Fuori90(B + D) : SAD = Fuori90(A + D) : SBC = Fuori90(B + C)
If SAC = SBD Or SAD = SBC Then
If SAC = SBD Then S1 = SAC
If SAD = SBC Then S1 = SAD
Abb = Fuori90(A + B + C + D)
If(S1 <> Abb) And(SAC <> SAD) Then
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,2
Scrivi String(80,"*") & " Estrazione " &(Es1) & " caso " & FormattaStringa(Caso,"0000"),1,,,1
Scrivi(" Estrazione n." & Format2(Es1) & " del " & DataEstrazione(Es1)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P5 = 1 To 5
E1 = Estratto(Es1,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(Es1) & " del " & DataEstrazione(Es1)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P6 = 1 To 5
E2 = Estratto(Es1,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 Space(10) & NomeRuota(R1) & " " & NomeRuota(R2) & " " & S2,1,,,1
Scrivi Space(24) & "Almeno un gruppo di somme uguali",1,,,2
Scrivi Space(7) & "Estratti " & Space(13) & "Somme " & Space(8) & " Somme",1
Scrivi Space(7) & "Evidenz. " & Space(12) & "Verticali" & Space(5),1,0
Scrivi "Diagonali",1
Scrivi Space(8) & Format2(A) & " " & Format2(B) & Space(18) & Format2(SAC),1,0
Scrivi Space(12) & Format2(SAD),1
Scrivi Space(8) & Format2(C) & " " & Format2(D) & Space(18) & Format2(SBD),1,0
Scrivi Space(12) & Format2(SBC),1
Scrivi
Scrivi Space(8) & Format2(A) & " + " & Format2(B) & " + " & Format2(C),1,0
Scrivi " + " & Format2(D) & " = " & Format2(Abb) & " <-- Abbinamento per Ambo ",1
Ruo(1) = R1
Ruo(2) = R2
Amba(1) = S1
ImpostaGiocata 1,Amba,Ruo,Po1,Clp
Ambo(1) = S1 : Ambo(2) = Abb
ImpostaGiocata 2,Ambo,Ruo,Po2,Clp
Gioca Es1
End If
End If
End If
End If
End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub
