Ruotare un dodecaedro in una DrawingArea

Mostreremo un possibile codice per disegnare e ruotare un Dodecaedro con facce pentagonali intorno ai suoi assi X, Y e Z in una DrawingArea".

Nell'esempio che segue sarà possibile aumentare o diminuire la dimensione del disegno del Dodecaedro, cliccando rispettivamente sui tasti "+" e "-" della tastiera.

Private angleX As Float        ' Angolo di rotazione sull'asse X
Private angleY As Float        ' Angolo di rotazione sull'asse Y
Private Zoom As Float = 150    ' Fattore di ingrandimento
Private Vertices As Object[]   ' Lista di vertici 3D (Float[])
Private Faces As Object[]      ' Lista di facce (ogni faccia è un array di 5 indici)


Public Sub Form_Open()

' Impostazioni iniziali della finestra:
 Me.Title = "Dodecaedro rotante con facce pentagonali"
 Me.Move(0, 0, Screen.AvailableWidth, Screen.AvailableHeight)
 Me.Arrangement = Arrange.Fill

' Inizializza gli array:
 Vertices = New Object[]
 Faces = New Object[]

' Sezione aurea e valori derivati per la costruzione del dodecaedro:
 Dim phi As Float = (1 + Sqr(5)) / 2
 Dim a As Float = 1
 Dim b As Float = 1 / phi

' === 20 Vertici del dodecaedro ===
' I vertici sono scelti in modo simmetrico e disposti con coordinate note:
 Vertices.Push([ a,  a,  a])     '  0
 Vertices.Push([ a,  a, -a])     '  1
 Vertices.Push([ a, -a,  a])     '  2
 Vertices.Push([ a, -a, -a])     '  3
 Vertices.Push([-a,  a,  a])     '  4
 Vertices.Push([-a,  a, -a])     '  5
 Vertices.Push([-a, -a,  a])     '  6
 Vertices.Push([-a, -a, -a])     '  7
 Vertices.Push([ 0,  b,  phi])   '  8
 Vertices.Push([ 0,  b, -phi])   '  9
 Vertices.Push([ 0, -b,  phi])   ' 10
 Vertices.Push([ 0, -b, -phi])   ' 11
 Vertices.Push([ b,  phi, 0])    ' 12
 Vertices.Push([ b, -phi, 0])    ' 13
 Vertices.Push([-b, phi, 0])     ' 14
 Vertices.Push([-b, -phi, 0])    ' 15
 Vertices.Push([ phi, 0,  b])    ' 16
 Vertices.Push([ phi, 0, -b])    ' 17
 Vertices.Push([-phi, 0,  b])    ' 18
 Vertices.Push([-phi, 0, -b])    ' 19

' === 12 Facce pentagonali, ognuna con 5 indici di vertici ===
' L'ordine dei vertici garantisce facce chiuse, senza incroci:
 Faces.Push([0, 8, 10, 2, 16])
 Faces.Push([0, 16, 17, 1, 12])
 Faces.Push([0, 12, 14, 4, 8])
 Faces.Push([8, 4, 18, 6, 10])
 Faces.Push([10, 6, 15, 13, 2])
 Faces.Push([2, 13, 3, 17, 16])
 Faces.Push([1, 17, 3, 11, 9])
 Faces.Push([1, 9, 5, 14, 12])
 Faces.Push([4, 14, 5, 19, 18])
 Faces.Push([6, 18, 19, 7, 15])
 Faces.Push([3, 13, 15, 7, 11])
 Faces.Push([5, 9, 11, 7, 19])

 Timer1.Delay = 16
 Timer1.Start

End


Public Sub Timer1_Timer()

' Aggiorna gli angoli di rotazione:
 angleX += 0.02
 angleY += 0.015

 DrawingArea1.Refresh

End


Public Sub DrawingArea1_Draw()

' Centro della DrawingArea:
 Dim w As Integer = DrawingArea1.W
 Dim h As Integer = DrawingArea1.H
 Dim cx As Float = w / 2
 Dim cy As Float = h / 2

' Array dei punti proiettati 2D:
 Dim points As Object[] = New Object[]

' Sfondo bianco:
 Paint.FillRect(0, 0, w, h, Color.White)

' Proiezione 3D → 2D per ciascun vertice:
 For Each v As Float[] In Vertices
   Dim x, y, z As Float
   x = v[0]
   y = v[1]
   z = v[2]

' Rotazione sull'asse X:
   Dim y1 As Float = y * Cos(angleX) - z * Sin(angleX)
   Dim z1 As Float = y * Sin(angleX) + z * Cos(angleX)
   y = y1
   z = z1

' Rotazione sull'asse Y:
   Dim x1 As Float = x * Cos(angleY) + z * Sin(angleY)
   z1 = -x * Sin(angleY) + z * Cos(angleY)
   x = x1
   z = z1

' Proiezione prospettica (evita divisione per zero):
   If (z + 3) < 0.1 Then Continue

   Dim scale As Float = Zoom / (z + 3)
   Dim sx As Float = cx + x * scale
   Dim sy As Float = cy - y * scale

   points.Push([sx, sy])
 Next

' Disegna ogni faccia (5 lati chiusi):
 Paint.Brush = Paint.Color(Color.Black)
 For Each f As Integer[] In Faces
   Dim i As Integer
   For i = 0 To f.Count - 1
     Dim p1 As Float[] = points[f[i]]
     Dim p2 As Float[] = points[(f[(i + 1) Mod f.Count])]
     Paint.MoveTo(p1[0], p1[1])
     Paint.LineTo(p2[0], p2[1])
     Paint.Stroke
   Next
 Next

 Paint.Endù

End


Public Sub Form_KeyPress()

Select Case Key.Code
  Case Key["+"]
   Zoom = Min(Zoom + 25, 1000)
 Case Key["-"]
   Zoom = Max(Zoom - 25, 25)
 End Select

 DrawingArea1.Refresh

End