IL PROCEDIMENTO S-91 FABARRI

'PROGETTO - IL PROCEDIMENTO S.91 - BY FABARRI
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim fin,es,esq,clp,col,esqcol,idestr,clp2
Dim posta(2),ruote(3),ambo1(2),ambo2(2),ruota(2)
Dim p1,p2,p3,p4,r1,r2,caso,casi,quat(4),poste(4)
Dim estra,estrb,estrc,estrd,somma1,somma2
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9313)
clp = InputBox("Per quanti colpi vuoi giocare l'ambo?",,7)
clp2 = InputBox("Per quanti colpi vuoi giocare la quartina?",,8)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,10))
'posta(1) = 1
posta(2) = 1
poste(2) = 1
poste(3) = 1
'poste(4) = 1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
Messaggio es
AvanzamentoElab esq,esqcol,es
caso = 0
For r1 = 1 To 9
For p1 = 1 To 4
p2 = p1 + 1
estra = Estratto(es,r1,p1)
estrb = Estratto(es,r1,p2)
somma1 = Fuori90(estra + estrb)
For r2 = r1 + 1 To 10
For p3 = 1 To 4
p4 = p3 + 1
estrc = Estratto(es,r2,p3)
estrd = Estratto(es,r2,p4)
somma2 = Fuori90(estrc + estrd)
If(somma1 + somma2) = 91 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(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1),2
Scrivi Space(35) & Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2),2
Scrivi
ColoreTesto 1
Scrivi " Coppia consecutiva ruota " & Left(NomeRuota(r1),2) & " " & Format2(estra) & Space(1) & Format2(estrb)
ColoreTesto 2
Scrivi " Coppia consecutiva ruota " & Left(NomeRuota(r2),2) & " " & Format2(estrc) & Space(1) & Format2(estrd)
ColoreTesto 0
Scrivi
ruota(1) = r1
ruota(2) = r2
ruote(1) = r1
ruote(2) = r2
ruote(3) = TU_
ambo1(1) = estra
ambo1(2) = estrb
ImpostaGiocata 1,ambo1,ruote,posta,clp
ambo2(1) = estrc
ambo2(2) = estrd
ImpostaGiocata 2,ambo2,ruote,posta,clp
quat(1) = estra
quat(2) = estrb
quat(3) = estrc
quat(4) = estrd
EliminaRipetuti quat
ImpostaGiocata 3,quat,ruota,poste,clp2
Gioca es
End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub