Eurojackpot

[Zetrix]

Class clsCerchioCiclometrico
   Dim aPos(50,02) ' memorizza le coordinate relative ai 50 Numeri
   Dim aNumeri(50) ' 50 Numeri
   Private CollCorde
   Sub DisegnaCerchioCiclometricoX(aNumeri,aCorde)
      Dim nRaggio ' raggio ddel cerchio
      Dim cX,cY ' centro del cerchio x e y
      Dim Base,Altezza ' dimensioni area disegno
      Dim Angolo ' gestisce il ciclo per disegnare il cerchio
      Dim pi ' pigreco
      Dim x1,y1,x2,y2 ' coordinate generiche pr i segmenti
      Dim cLung ' distanza per stampare i gradi
      Dim k ' ciclo
      Dim n
      Dim z
      Call PicClear()
      Set CollCorde = GetNewCollection
      cLung = 2
      pi = 3.14
      Base = 150
      Altezza = 150
      nRaggio = 60
      ' preimposto le dimensioni dell'area
      Call PicSetDimensioni(Base,Altezza,Base,Altezza)
      ' calcolo il centro del cerchio
      cX = Base / 2
      cY = Altezza / 2
      Call PicCerchio(cX,cY,nRaggio)
      Angolo = 90
      n = 51
      For z = 1 To 50
         n = n - 01
         x1 = cX +((nRaggio) * Cos(- Angolo *(pi / 180)))
         y1 = cY +((nRaggio) * Sin(- Angolo *(pi / 180)))
         ' memorizzo nell'array globale le coordinate appena calcolate
         ' cosi potranno essere riusate per disegnare le corde
         aPos(n,1) = x1
         aPos(n,2) = y1
         If n Mod 2 = 00 Then
            x2 = cX +((nRaggio + cLung * 03) * Cos(- Angolo *(pi / 180)))
            y2 = cY +((nRaggio + cLung * 03) * Sin(- Angolo *(pi / 180)))
            Call PicLinea(x1,y1,x2,y2)
            x2 = cX +((nRaggio + cLung * 04) * Cos(-(Angolo + 02) *(pi / 180)))
            y2 = cY +((nRaggio + cLung * 04) * Sin(-(Angolo + 02) *(pi / 180)))
            Call PicStampaTestoRT(x2,y2,n,Angolo,,,,,10)
         Else
            ' disegno il semiraggio
            x2 = cX +((nRaggio + cLung) * Cos(- Angolo *(pi / 180)))
            y2 = cY +((nRaggio + cLung) * Sin(- Angolo *(pi / 180)))
            Call PicLinea(x1,y1,x2,y2)
            x2 = cX +((nRaggio + cLung) * Cos(-(Angolo + 02) *(pi / 180)))
            y2 = cY +((nRaggio + cLung) * Sin(-(Angolo + 02) *(pi / 180)))
            Call PicStampaTestoRT(x2,y2,n,Angolo)
         End If
         Angolo = FuoriX(90 + Int(360 -((360/50)*(n - 1))),360)
      Next
      Call DisegnaFigura(aNumeri)
      Call DisegnaDistanze(aCorde)
      Call PicEsegui
   End Sub
   Private Sub DisegnaFigura(aNum)
      Dim k
      For k = 01 To UBound(aNum)
         Call DisegnaCorda(aNum(k),aNum(FuoriX(k + 01,UBound(aNum))),vbGreen,True,False)
      Next
   End Sub
   Private Sub DisegnaDistanze(aCorde)
      Dim k
      For k = 01 To UBound(aCorde)
         Call DisegnaCorda(aCorde(k,01),aCorde(k,02),vbMagenta,True,True)
      Next
   End Sub
   Private Sub DisegnaCorda(p1,p2,colore,bDisegnaDist,bLineaTratt)
      Dim nX,nY,sDist
      If AddCorda(p1,p2) Then
         If bLineaTratt Then
            Call PicLineaTratteggiata(aPos(p1,01),aPos(p1,02),aPos(p2,01),aPos(p2,02),colore,2)
         Else
            Call PicLinea(aPos(p1,01),aPos(p1,02),aPos(p2,01),aPos(p2,02),colore,2)
         End If
         Call PicPunto(aPos(p1,01),aPos(p1,02),06,colore)
         Call PicPunto(aPos(p2,01),aPos(p2,02),06,colore)
         If bDisegnaDist Then
            If aPos(p1,01) > aPos(p2,01) Then
               nX =(aPos(p1,01) - aPos(p2,01)) / 02 + aPos(p2,01)
            Else
               nX =(aPos(p2,01) - aPos(p1,01)) / 02 + aPos(p1,01)
            End If
            If aPos(p1,02) > aPos(p2,02)Then
               nY =(aPos(p1,02) - aPos(p2,02)) / 02 + aPos(p2,02)
            Else
               nY =(aPos(p2,02) - aPos(p1,02)) / 02 + aPos(p1,02)
            End If
            Call PicCerchio(nX,nY,03,vbBlack,,True,vbYellow)
            nX = nX - 1.5
            nY = nY - 1.5
            sDist = Format2(DiffCiclometrica50(p1,p2))
            Call PicStampaTesto(nX,nY,sDist)
         End If
      End If
   End Sub
   Function DiffCiclometrica50(NumA,NumB)
      Dim r
      If NumA > NumB Then
         r = NumA - NumB
         Do While r >= 25
            r = 50 - r
         Loop
      ElseIf NumB > NumA Then
         r = NumB - NumA
         Do While r >= 25
            r = 50 - r
         Loop
      End If
      DiffCiclometrica50 = r
   End Function
   Private Function AddCorda(n01,n02)
      Dim sKey
      If n01 <= n02 Then
         sKey = "k" & Format2(n01) & Format2(n02)
      Else
         sKey = "k" & Format2(n02) & Format2(n01)
      End If
      On Error Resume Next
      CollCorde.Add sKey,sKey
      If Err = 00 Then
         AddCorda = True
      End If
   End Function
End Class
Sub Main
   Dim clsCerchio
   Dim k,qt
   Dim aCorde
   'Dim TipoEsempio
   ReDim aNum(0)
   qt = ScegliNumeri(aNum)
   Call OrdinaMatrice(aNum,1)
   qt = UBound(aNum)
   aCorde = SviluppoIntegrale(aNum,2)
   Set clsCerchio = New clsCerchioCiclometrico
   Call clsCerchio.DisegnaCerchioCiclometricoX(aNum,aCorde)
   Scrivi StringaNumeri(aNum)
End Sub
Function Dista50(numa,numb)
   Dim r
   If numa > numb Then
      r = numa - numb
      Do While r >= 25
         r = 50 - r
      Loop
   ElseIf numb > numa Then
      r = numb - numa
      Do While r >= 25
         r = 50 - r
      Loop
   End If
   Dista50 = r
End Function

ho modificato questo script per l'eurojackpot, quanto si scrivono i numeri es, 1 e 26 lo script va in crash
da cosa e dovuto questo problema..