Quadro Estrazionale Info Utili e varie

[Mike58]

Ho letto una richiesta di avere informazioni sul quadro estrazionale circa possibili ambi di Cadenze,Decine,Simmetrico,Diametrale etc etc..
Ecco uno script con varie informazioni.

Sub Main
   Dim Nu(5),Ru(1),cad(5),dec(5),fig(5),gem(5),dia(5)
   Dim T,V
   Ini = EstrazioneFin - 10
   fin = EstrazioneFin
   For es = fin To Ini Step - 1
      Scrivi GetInfoEstrazione(es),1,,,1,3
      T = Array(T,"Ruota","Estratti","Ambo Cadenza","Ambo Decina","Ambo Figura","Tipo Fig","Gemello","NumPrimi","SommaEstratti","NumPari","NumDispari","AmboDiametrale","AmboSimm","AmboVert","DiamD")
      Call InitTabella(T,RGB(187,187,187),,3,5)
      For r = 1 To 11
         If r = 11 Then r = 12
         For p = 1 To 5
            Nu(p) = Estratto(es,r,p)
            cad(p) = Cadenza(Nu(p))
            dec(p) = Decina(Nu(p))
            fig(p) = Figura(Nu(p))
            gem(p) = Gemello(Nu(p))
            If Gemello(Nu(p)) Then ff = ff & Nu(p) & " "
            If Primo(Nu(p)) Then pp = pp & Nu(p) & " "
            da = SommaEstratti(es,r)
            If pari(Nu(p)) Then par = par + 1
            If dispari(Nu(p)) Then dis = dis + 1
            Ru(1) = r
         Next
         If NumeriRipetutiRilevatiV(cad,vetC) Then
            aa = StringaNumeri(vetC)
         Else
            aa = "--"
         End If
         If NumeriRipetutiRilevatiV(dec,vetD) Then
            bb = StringaNumeri(vetD)
         Else
            bb = "--"
         End If
         If NumeriRipetutiRilevatiV(fig,vetF) Then
            cc = StringaNumeri(vetF)
         Else
            cc = "--"
         End If
         If NumeriRipetutiRilevatiV(dia,vetDD) Then
            dd = StringaNumeri(vetF)
         Else
            dd = "--"
         End If
         For p1 = 1 To 4
            For p2 = p1 + 1 To 5
               If Cadenza(Nu(p1)) = Cadenza(Nu(p2)) Then amboCad = amboCad & Nu(p1) & "-" & Nu(p2) & "  "
               If Distanza(Nu(p1),Nu(p2)) = 45 Then ambodiamet = ambodiamet & Nu(p1) & "-" & Nu(p2) & "  "
               If Differenza(Nu(p1),Nu(p2)) = 30 Then ambosimm = ambosimm & Nu(p1) & "-" & Nu(p2) & "  "
               If(Nu(p1)) = Vert(Nu(p2)) Then ambovert = ambovert & Nu(p1) & "-" & Nu(p2) & "  "
               If(Nu(p1)) = DiametraleD(Nu(p2)) Then diaD = diaD & Nu(p1) & "-" & Nu(p2) & "  "
               If Decina(Nu(p1)) = Decina(Nu(p2)) Then amboDec = amboDec & Nu(p1) & "-" & Nu(p2) & "  "
               If Figura(Nu(p1)) = Figura(Nu(p2)) Then amboFig = amboFig & Nu(p1) & "-" & Nu(p2) & "  "
            Next
         Next
         V = Array(V,SiglaRuota(r),StringaEstratti(es,r),amboCad,amboDec,amboFig,cc,ff,pp,da,par,dis,ambodiamet,ambosimm,ambovert,diaD)
         Call AddRigaTabella(V)
         ff = ""
         pp = ""
         da = ""
         par = 0
         dis = 0
         diaD = ""
         amboCad = ""
         ambodec = ""
         amboFig = ""
         ambodiamet = ""
         ambosimm = ""
         ambovert = ""
      Next
      Call SetTableWidth ("100%")
      CreaTabella
   Next
End Sub

Ciao a tutti

 

[Xeroxs]

Come Sempre un Ottimo lavoro
Grazie per la condivisione