Option Explicit
Class clsAmbo
Public Ruota
Public aNumeri(2)
Public aPos(2)
End Class
Sub Main
Dim Inizio,Fine
Dim k
Dim CollAmbiRuote(10)
Dim cAmbo
Dim r
Dim ColpiDiGioco
ColpiDiGioco = 10
Inizio = EstrazioneIni
Fine = EstrazioneFin
ReDim aRuoteSel(12)
ReDim abRuoteSel(12)
If ScegliRuote(aRuoteSel,abRuoteSel) >= 2 Then
If abRuoteSel(11) = 0 And abRuoteSel(12) = 0 Then
For k = Inizio To Fine
Call InitCollAmbiRuote(CollAmbiRuote)
Call AlimentaCollAmbiDistanza(k,CollAmbiRuote,9,abRuoteSel)
For r = 1 To 10
For Each cAmbo In CollAmbiRuote(r)
Call PossibileGiocata(cAmbo,k,45,r,ColpiDiGioco,abRuoteSel)
Next
If ScriptInterrotto Then Exit For
Next
If ScriptInterrotto Then Exit For
Call AvanzamentoElab(Inizio,Fine,k)
Next
Call ScriviResoconto
Else
MsgBox "Lo script non prevede ne la nazionale ne tutte",vbExclamation
End If
Else
MsgBox "Selezionare almeno 2 ruote",vbExclamation
End If
End Sub
Sub InitCollAmbiRuote(CollAmbiRuote)
Dim k
For k = 1 To UBound(CollAmbiRuote)
Set CollAmbiRuote(k) = GetNewCollection
Next
End Sub
Sub AlimentaCollAmbiDistanza(idEstr,collAmbi,DistanzaVoluta,abRuoteSel)
Dim Ruota
Dim e,ee
Dim cAmbo
For Ruota = 1 To 10
If abRuoteSel(Ruota) Then
For e = 1 To 4
For ee = e + 1 To 5
If Distanza(Estratto(idEstr,Ruota,e),Estratto(idEstr,Ruota,ee)) = DistanzaVoluta Then
Set cAmbo = New clsAmbo
cAmbo.aNumeri(1) = Estratto(idEstr,Ruota,e)
cAmbo.aPos(1) = e
cAmbo.aNumeri(2) = Estratto(idEstr,Ruota,ee)
cAmbo.aPos(2) = ee
cAmbo.Ruota = Ruota
collAmbi(Ruota).Add cAmbo
End If
Next
Next
End If
Next
End Sub
Sub PossibileGiocata(cAmbo,idEstr,DistanzaVoluta,RuotaBase,ColpiDiGioco,abRuoteSel)
Dim r,k,j
Dim N
Dim d
Dim Ambata
Dim aAbbinamentiPrinc(2)
Dim aAbbinamentiSec(3)
Dim nGioc
For r = 1 To 10
If abRuoteSel(r) Then
If r <> RuotaBase Then
N = 0
For k = 1 To 2
For j = 1 To 2
If Distanza(cAmbo.aNumeri(k),Estratto(idEstr,r,cAmbo.aPos(j))) = DistanzaVoluta Then
N = Estratto(idEstr,r,cAmbo.aPos(j))
Exit For
End If
Next
If N > 0 Then Exit For
Next
If N > 0 Then
ReDim aRett(4)
' rettangolo A---B
' | |
' | |
' D---C
If Distanza9AB(cAmbo.aNumeri(1),cAmbo.aNumeri(2)) Then
aRett(1) = cAmbo.aNumeri(1)
aRett(2) = cAmbo.aNumeri(2)
Else
aRett(1) = cAmbo.aNumeri(2)
aRett(2) = cAmbo.aNumeri(1)
End If
aRett(3) = Fuori90(aRett(2) + 36)
aRett(4) = Fuori90(aRett(3) + 9)
If N = aRett(3) Then
Ambata = aRett(4)
aAbbinamentiPrinc(1) = Fuori90(aRett(1) + 18)
aAbbinamentiPrinc(2) = Fuori90(aRett(3) + 18)
aAbbinamentiSec(1) = aRett(1)
aAbbinamentiSec(2) = aRett(2)
aAbbinamentiSec(3) = aRett(3)
ElseIf N = aRett(4) Then
Ambata = aRett(3)
aAbbinamentiPrinc(1) = Fuori90(aRett(2) + 18)
aAbbinamentiPrinc(2) = Fuori90(aRett(4) + 18)
aAbbinamentiSec(1) = aRett(1)
aAbbinamentiSec(2) = aRett(2)
aAbbinamentiSec(3) = aRett(4)
End If
ReDim aRuote(2)
aRuote(1) = RuotaBase
aRuote(2) = r
' ambata
ReDim aNumInGioco(1)
aNumInGioco(1) = Ambata
ReDim aPoste(1)
aPoste(1) = 1
nGioc = nGioc + 1
Call ImpostaGiocata(nGioc,aNumInGioco,aRuote,aPoste,ColpiDiGioco,1)
' ambi principali
ReDim aPoste(2)
aPoste(2) = 1
ReDim aNumInGioco(2)
aNumInGioco(1) = Ambata
For k = 1 To 2
nGioc = nGioc + 1
aNumInGioco(2) = aAbbinamentiPrinc(k)
Call ImpostaGiocata(nGioc,aNumInGioco,aRuote,aPoste,ColpiDiGioco,2)
Next
' ambi secondari
For k = 1 To 3
nGioc = nGioc + 1
aNumInGioco(2) = aAbbinamentiSec(k)
Call ImpostaGiocata(nGioc,aNumInGioco,aRuote,aPoste,ColpiDiGioco,2)
Next
C
Bellissimo Lavoro Complimenti.
BEN RILETTO.
