Ruotare un oloide in una DrawingArea

Di seguito mostriamo un possibile codice, per disegnare e far ruotare automaticamente un Oloide su una DrawingArea.

Private Const R As Float = 100.0
Private Const N As Integer = 100
Private angle As Float    ' Angolo di rotazione (in radianti)


Public Sub Form_Open()

 With Me
   .Center
   .Resizable = False
   .Width = 640
   .Height = 640
 End With

 With DrawingArea1
   .X = 0
   .Y = 0
   .W = Me.W
   .H = Me.H
   .Background = Color.White
 End With

' 30 ms = ~33 FPS
 Timer1.Delay = 30
 Timer1.Start

End


Public Sub Timer1_Timer()

' Incrementa l’angolo:
 angle += 0.02 ' Incrementa l’angolo

 If angle > 2 * Pi Then angle -= 2 * Pi
 DrawingArea1.Refresh

End


Public Sub DrawingArea1_Draw()

 Dim u, v As Float
 Dim x, y, z As Float
 Dim px, py As Float
 Dim cx, cy As Float
 Dim i, j As Integer
 Dim depthColor As Integer

' Centra il disegno dell'Oloide:
 cx = DrawingArea1.Width / 2
 cy = DrawingArea1.Height / 2

' L'oloide verrà creato da una molteplicità di piccoli punti a forma di rettangolo:
 Paint.FillRect(0, 0, DrawingArea1.Width, DrawingArea1.Height, Color.White)

 Paint.AntiAlias = True
 Paint.LineWidth = 1

 For i = 0 To N
   u = i / N
   For j = 0 To N
     v = j / N

' Parametrizzazione dell’oloide:
     x = (1 - 2 * u) * R * Cos(Pi * v)
     y = (1 - 2 * u) * R * Sin(Pi * v)
     z = 2 * R * u * Sqr(1 - (Sin(Pi * v)) ^ 2)

' Rotazione attorno all’asse Y (animazione):
     Dim xRot, zRot As Float
     xRot = x * Cos(angle) + z * Sin(angle)
     zRot = -x * Sin(angle) + z * Cos(angle)

' Proiezione isometrica:
     px = cx + (xRot - y) * 0.5
     py = cy - (xRot + y) * 0.3 + zRot * 0.7

' Colore sfumato in base alla profondità:
     depthColor = Clamp(100 + Int(zRot), 0, 255)

' Disegna un punto (piccolo rettangolo).
' L'oloide verrà creato da una molteplicità di piccoli punti a forma di rettangolo:
     Paint.FillRect(px, py, 2, 2, Color.RGB(depthColor, depthColor, 200))
   Next
 Next

 Paint.End

End


Public Sub Form_Resize()

 DrawingArea1.Refresh

End


Private Function Clamp(Value As Integer, MinVal As Integer, MaxVal As Integer) As Integer

 If Value < MinVal Then Return MinVal
 If Value > MaxVal Then Return MaxVal
 Return Value

End