My 3D to 2D graphics algorithm is being a bit slow

Question

With my VB.Net Windows Forms application, I would like to rotate and project a 3D object. The program works so far, which is why I'm reporting here and not Stack Overflow, but it's slow. I've already made two optimizations:

1.) All points that are on the back of the object, i.e. that cannot be seen, are not drawn. Understandably, this effect does not occur when I look at the hemisphere from above, and with a 90° rotation around the x-axis (side view) 50% of the points are not drawn.

2.) The calculation runs asynchronously.

2.1) Since you cannot draw in the PictureBox from another thread, I did some research. This has shown that you draw in a bitmap and assign it to the PictureBox.

3.) I have already removed the procedure that computes the Cartesian x, y and z and displays it to the user.

Overall, the program runs a little faster; but is still too slow. I would like to leave the step size when calculating the surface points for the first time at 0.5, otherwise you will see gaps. I know that results in 130,320 points on a very small area. That's why I came up with the idea not to draw the back.

What's the point? I wanted to code the creation and projection of the object myself, without 3rd party libraries. I also want to add a grid in the future, but for that the program has to be faster first.

Maybe you can help me save a few clock cycles.

Ah, and by the way: I've found that the percentages don't make 100% sense. As you can see here, 49.6% of all points are not drawn (instead of 50%) in the side view.

This is my code of the class

#Disable Warning IDE1006 ' Benennungsstile
#Disable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
#Disable Warning CA1051 ' Sichtbare Instanzfelder nicht deklarieren
#Disable Warning CA2211 ' Nicht konstante Felder dürfen nicht sichtbar sein
Imports System.Windows.Media.Media3D
Public NotInheritable Class ClassHemisphere
    Private ReadOnly enGB As New System.Globalization.CultureInfo("en-GB")
    Public Phi As UInt16
    Public Theta As UInt16
    ''' <summary>
    ''' This list contains all vectors that point from the coordinate origin to the surface.
    ''' </summary>
    Public ReadOnly List_with_all_the_vectors As New List(Of Vector3D)
    Private ReadOnly Liste_thetas As New List(Of Double)
    Public ReadOnly Liste_phis As New List(Of Double)
    ''' <summary>
    ''' The camera position on the z-axis (we look towards the +z arrow). 
    ''' </summary>
    Public Camera As Double = 1500.0
    ''' <summary>
    ''' The position of the projection window on the z-axis.
    ''' </summary>
    Public Window As Double = 700.0

    Private ReadOnly point_of_origin As New PointF(0.0F, 0.0F)
    ''' <summary>
    ''' Radius of this hemisphere
    ''' </summary>
    Private ReadOnly Radius As Double
    ''' <summary>
    ''' It is to be drawn a 2D line to the point of the set Phi and Theta.
    ''' </summary>
    Private projected_arrow As PointF
    ''' <summary>
    ''' in degrees
    ''' </summary>
    Public rotation_angle_x As Double

    Public Shared Buffer As System.Drawing.Bitmap
    Private Camera_Vector As Vector3D

    Public Sub New(ByVal radius As Double)
        Me.Radius = radius
        Camera_Vector = New Vector3D(0, 0, Camera)
        For _phi As Double = 0.0 To 359.5 Step 0.5
            For _theta As Double = 0.0 To 90.0 Step 0.5
                List_with_all_the_vectors.Add(New Vector3D(
                                                radius * Math.Cos(_phi * Math.PI / 180.0) * Math.Sin(_theta * Math.PI / 180.0),
                                                radius * Math.Sin(_phi * Math.PI / 180.0) * Math.Sin(_theta * Math.PI / 180.0),
                                                radius * Math.Cos(_theta * Math.PI / 180.0)))
                Liste_thetas.Add(_theta)
                Liste_phis.Add(_phi)
            Next
        Next
    End Sub

    Public Function getVector() As Vector3D
        Dim Value As Vector3D
        For i As Integer = 0 To List_with_all_the_vectors.Count - 1 Step 1
            If Liste_phis(i) = CDbl(Phi) AndAlso Liste_thetas(i) = CDbl(Theta) Then
                Value = List_with_all_the_vectors(i)
                Return Value
            End If
        Next
        Return Value
    End Function

    Private Shared Function Rotate_around_the_x_axis(ByVal vec As Vector3D, ByVal angle As Double) As Vector3D
        Return New Vector3D(vec.X,
                            vec.Y * Math.Cos(angle * Math.PI / 180.0) - vec.Z * Math.Sin(angle * Math.PI / 180.0),
                            vec.Y * Math.Sin(angle * Math.PI / 180.0) + vec.Z * Math.Cos(angle * Math.PI / 180.0))
    End Function

    Public Sub change_Camera_height_a_little(ByVal dz As Double)
        Camera += dz
        Camera_Vector = New Vector3D(0, 0, Camera)
    End Sub

    Public Async Function calculate_Async() As Task(Of Boolean)
        Return Await Task.Run(Function() Verarbeitung())
    End Function

    Private Function Verarbeitung() As Boolean
        Buffer = Nothing
        Dim Counter As Integer = 0
        Using _buffer As New System.Drawing.Bitmap(FormMain.PictureBox1.Size.Width, FormMain.PictureBox1.Size.Height)
            Using g As System.Drawing.Graphics = Graphics.FromImage(_buffer)
                g.TranslateTransform(CSng(_buffer.Size.Width / 2.0F), CSng(_buffer.Size.Height / 2.0F))
                g.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
                g.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
                g.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
                g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBilinear

                For i As Integer = 0 To List_with_all_the_vectors.Count - 1 Step 1

                    Dim rotated_vec As Vector3D = Rotate_around_the_x_axis(List_with_all_the_vectors(i), rotation_angle_x)

                    'Everything that is more than 90° from the camera direction (=back side) does not need to be drawn. 
                    Dim angle_view_to_a_Normal As Double = Vector3D.AngleBetween(Camera_Vector, rotated_vec)
                    If angle_view_to_a_Normal > 90.0001 Then ' 90.0001 because the precision of a ‘double’ is finite..
                        Counter += 1 ' for testing purposes
                        Continue For
                    End If


                    Dim Angle_in_degrees As Double = Vector3D.AngleBetween(rotated_vec, New Vector3D(rotated_vec.X, rotated_vec.Y, 0.0))
                    If Double.IsNaN(Angle_in_degrees) Then
                        Continue For
                    End If
                    Dim vertical_height As Double = Radius * Math.Sin(Angle_in_degrees * Math.PI / 180.0) ' Opposite cathetus
                    Dim projected_Point As New PointF(
                            CSng((Camera - Window) / (Camera - vertical_height) * rotated_vec.X),
                            CSng(-(Camera - Window) / (Camera - vertical_height) * rotated_vec.Y))
                    Using Pen_DarkBlue As New Pen(Color.FromArgb(0, 0, 122), 1.0F)
                        g.DrawLine(Pen_DarkBlue, point_of_origin, projected_Point)
                    End Using
                Next


                Dim Arrow As Vector3D = Rotate_around_the_x_axis(getVector(), rotation_angle_x)
                Dim Angle As Double = Vector3D.AngleBetween(Arrow, New Vector3D(Arrow.X, Arrow.Y, 0.0))
                Dim vertical As Double = Arrow.Length * Math.Sin(Angle * Math.PI / 180.0)
                projected_arrow = New PointF(
                                  CSng((Camera - Window) / (Camera - vertical) * Arrow.X),
                                  CSng(-(Camera - Window) / (Camera - vertical) * Arrow.Y))
                Using Pen_DarkYellow As New Pen(Color.FromArgb(122, 122, 0), 3.0F)
                    g.DrawLine(Pen_DarkYellow, point_of_origin, projected_arrow)
                End Using

                Buffer = New Bitmap(_buffer)
            End Using
        End Using
        Debug.WriteLine(Math.Round(Counter / CDbl(List_with_all_the_vectors.Count) * 100.0, 1).ToString(enGB) & " % of all the points are not drawn.")
        Return True
    End Function

End Class
#Enable Warning IDE1006 ' Benennungsstile
#Enable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
#Enable Warning CA1051 ' Sichtbare Instanzfelder nicht deklarieren
#Enable Warning CA2211 ' Nicht konstante Felder dürfen nicht sichtbar sein

And this is Form1.vb

Public NotInheritable Class FormMain
    Private ReadOnly Deu As New System.Globalization.CultureInfo("de-DE")
    Private hemisphere As ClassHemisphere
    Private program_has_finished_loading As Boolean
    Private ReadOnly DarkBlue As Color = Color.FromArgb(0, 0, 50)
    Private Sub FormMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.BackColor = Color.FromArgb(160, 176, 167)
        TextBox_phi.Text = My.Resources.zero
        TextBox_theta.Text = My.Resources.zero
    End Sub

    Private Async Sub FormMain_Shown(sender As Object, e As EventArgs) Handles MyBase.Shown
        Await Task.Run(Sub() hemisphere = New ClassHemisphere(radius:=350.0))
        program_has_finished_loading = True
        TextBox_Kamera.Text = Math.Round(hemisphere.Camera, 0).ToString(Deu)
        TextBox_Fenster.Text = Math.Round(hemisphere.Window, 0).ToString(Deu)
        Await hemisphere.calculate_Async()
        PictureBox1.Image = ClassHemisphere.Buffer
    End Sub

    Private Async Sub FormMain_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown
        Select Case e.KeyCode

            Case Keys.W

                If hemisphere.Theta > 0US Then
                    hemisphere.Theta -= 1US
                    Await hemisphere.calculate_Async()
                    PictureBox1.Image = ClassHemisphere.Buffer
                End If

            Case Keys.S

                If hemisphere.Theta < 90US Then
                    hemisphere.Theta += 1US
                    Await hemisphere.calculate_Async()
                    PictureBox1.Image = ClassHemisphere.Buffer
                End If

            Case Keys.A

                If hemisphere.Phi < 360US Then
                    hemisphere.Phi += 1US
                    Await hemisphere.calculate_Async()
                    PictureBox1.Image = ClassHemisphere.Buffer
                End If
                If hemisphere.Phi = 360US Then hemisphere.Phi = 0US

            Case Keys.D

                If hemisphere.Phi > 0US Then
                    hemisphere.Phi -= 1US
                    Await hemisphere.calculate_Async()
                    PictureBox1.Image = ClassHemisphere.Buffer
                End If

            Case Else
                Exit Select
        End Select

        TextBox_theta.Text = hemisphere.Theta.ToString(Deu).PadLeft(2, "0"c) & " °"

        TextBox_phi.Text = hemisphere.Phi.ToString(Deu).PadLeft(2, "0"c) & " °"
        GC.Collect()
    End Sub

    'Private Async Sub find_Vector()
    '    Dim found_Vector As Vector3D = Await find_Vector_Async()
    '    TextBox_x.Text = Math.Round(found_Vector.X, 3).ToString(Deu)
    '    TextBox_y.Text = Math.Round(found_Vector.Y, 3).ToString(Deu)
    '    TextBox_z.Text = Math.Round(found_Vector.Z, 3).ToString(Deu)
    'End Sub

    'Private Async Function find_Vector_Async() As Task(Of Vector3D)
    '    Return Await Task.Run(Function() hemisphere.getVector())
    'End Function

    Private Async Sub Form1_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel
        If e.Delta > 0 Then
            hemisphere.change_Camera_height_a_little(10.0)
        Else
            hemisphere.change_Camera_height_a_little(-10.0)
        End If
        Await hemisphere.calculate_Async()
        TextBox_Kamera.Text = Math.Round(hemisphere.Camera, 0).ToString(Deu)
    End Sub

    Private Sub TextBox_Kamera_TextChanged(sender As Object, e As EventArgs) Handles TextBox_Kamera.TextChanged
        If hemisphere IsNot Nothing Then
            TextBox_Kamera.ForeColor = If(Double.TryParse(TextBox_Kamera.Text, hemisphere.Camera), DarkBlue, Color.Red)
        End If
    End Sub

    Private Sub TextBox_Fenster_TextChanged(sender As Object, e As EventArgs) Handles TextBox_Fenster.TextChanged
        If hemisphere IsNot Nothing Then

            Dim successful1 As Boolean = Double.TryParse(TextBox_Kamera.Text, hemisphere.Camera)
            Dim window As Double
            Dim successful2 As Boolean = Double.TryParse(TextBox_Fenster.Text, window)

            If window >= hemisphere.Camera OrElse Not successful1 OrElse Not successful2 Then
                TextBox_Fenster.ForeColor = Color.Red
            Else
                TextBox_Fenster.ForeColor = DarkBlue
                hemisphere.Window = window
            End If
        End If
    End Sub

    Private Async Sub NumericUpDown_x_ValueChanged(sender As Object, e As EventArgs) Handles NumericUpDown_x.ValueChanged
        hemisphere.rotation_angle_x = NumericUpDown_x.Value
        Await hemisphere.calculate_Async()
        PictureBox1.Image = ClassHemisphere.Buffer
    End Sub
End Class

Answer 1

I can answer my question myself today. I let Visual Studio's own performance profiler work, and it found that most of the clock cycles (93%) are used for DrawLine. So, I was looking for a library that was faster. First, I found OpenTK, but had to find out that it is not NET compatible. Then I came across SkiaSharp. After a familiarization phase, I realized that you shouldn't use SkiaSharp's DrawLine here, but DrawPoint (Even better!) because the yellow grid is painted over when you use DrawLine.

I can click the numeric up-down at normal speed and the picture barely gets stuck (maybe a few hundredths of a millisecond); where I made the grid of the surface smaller beforehand (see step size in the code)!

Maybe SkiaSharp has a few more tricks, but for today I'm sharing this code with you guys. This is the revised class.

#Disable Warning IDE1006 ' Benennungsstile
#Disable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
#Disable Warning CA1051 ' Sichtbare Instanzfelder nicht deklarieren
#Disable Warning CA2211 ' Nicht konstante Felder dürfen nicht sichtbar sein

Imports System.Windows.Media.Media3D
Imports SkiaSharp

Public Class VecThetaPhi
    Public Vect As Vector3D
    Public Theta As Double
    Public Phi As Double
    Public GridVect As Vector3D
    Public Sub New(vec As Vector3D, the As Double, ph As Double, Grid As Vector3D)
        Vect = vec
        Theta = the
        Phi = ph
        GridVect = Grid
    End Sub
End Class

Public NotInheritable Class ClassHemisphere
    
    Public Phi As UInt16
    Public Theta As UInt16
    ''' <summary>
    ''' This list contains all vectors that point from the coordinate origin to the surface.
    ''' And the related Phi and Theta angles.
    ''' </summary>
    Private ReadOnly LstVecThetaPhi As New List(Of VecThetaPhi)

    ''' <summary>
    ''' The camera position on the z-axis (we look towards the +z arrow). 
    ''' </summary>
    Public Camera As Double = 1500.0
    ''' <summary>
    ''' The projection window position on the z-axis.
    ''' </summary>
    Public Window As Double = 700.0

    Private ReadOnly point_of_origin As New PointF(0.0F, 0.0F)
    ''' <summary>
    ''' Radius of this hemisphere
    ''' </summary>
    Private ReadOnly Radius As Double
    ''' <summary>
    ''' It is to be drawn a 2D line to the point of the set Phi and Theta.
    ''' </summary>
    Private projected_arrow As PointF
    ''' <summary>
    ''' in degrees
    ''' </summary>
    Public rotation_angle_x As Double

    Public Shared displayedBitmap As System.Drawing.Bitmap
    Public Camera_Vector As Vector3D

    Public Sub New(ByVal radius As Double)
        Me.Radius = radius
        Camera_Vector = New Vector3D(0, 0, Camera)
        For _phi As Double = 0.0 To 359.5 Step 0.25
            For _theta As Double = 0.0 To 90.0 Step 0.25
                Dim vec As New Vector3D(
                                    radius * Math.Cos(_phi * Math.PI / 180.0) * Math.Sin(_theta * Math.PI / 180.0),
                                    radius * Math.Sin(_phi * Math.PI / 180.0) * Math.Sin(_theta * Math.PI / 180.0),
                                    radius * Math.Cos(_theta * Math.PI / 180.0))

                Dim GridVec As Vector3D
                If CSng(_theta) = 15.0F OrElse CSng(_theta) = 30.0F OrElse CSng(_theta) = 45.0F OrElse CSng(_theta) = 60.0F Then
                    GridVec = New Vector3D(
                                        radius * Math.Cos(_phi * Math.PI / 180.0) * Math.Sin(_theta * Math.PI / 180.0),
                                        radius * Math.Sin(_phi * Math.PI / 180.0) * Math.Sin(_theta * Math.PI / 180.0),
                                        radius * Math.Cos(_theta * Math.PI / 180.0))
                Else
                    GridVec = New Vector3D(0R, 0R, 0R)
                End If
                LstVecThetaPhi.Add(New VecThetaPhi(vec, _theta, _phi, GridVec))
            Next
        Next
    End Sub

    Public Function getVector(ThetaValue As Double, PhiValue As Double) As Vector3D
        Dim Value As Vector3D = (From item In LstVecThetaPhi
                                 Where item.Theta = ThetaValue And item.Phi = PhiValue
                                 Select item.Vect).FirstOrDefault
        Return Value
    End Function

    Private Shared Function Rotate_around_the_x_axis(ByVal vec As Vector3D, ByVal angle As Double) As Vector3D
        Return New Vector3D(vec.X,
                            vec.Y * Math.Cos(angle * Math.PI / 180.0) - vec.Z * Math.Sin(angle * Math.PI / 180.0),
                            vec.Y * Math.Sin(angle * Math.PI / 180.0) + vec.Z * Math.Cos(angle * Math.PI / 180.0))
    End Function

    Public Sub change_Camera_height(ByVal dz As Double)
        Camera += dz
        Camera_Vector = New Vector3D(0, 0, Camera)
    End Sub

    Public Async Function calculate_Async() As Task(Of Boolean)
        Return Await Task.Run(Function() Verarbeitung())
    End Function

    Private Function Verarbeitung() As Boolean
        displayedBitmap = Nothing

        Dim imageInfo As New SKImageInfo(FormMain.PictureBox1.Size.Width, FormMain.PictureBox1.Size.Height)
        Using surface As SKSurface = SKSurface.Create(imageInfo)
            Using canvas As SKCanvas = surface.Canvas
                canvas.Translate(300.0F, 300.0F)

                Dim DarkBlue As New SKPaint With {
                    .TextSize = 64.0F,
                    .IsAntialias = True,
                    .Color = New SKColor(0, 0, 122),
                    .Style = SKPaintStyle.Fill
                }

                Dim DarkYellow As New SKPaint With {
                    .TextSize = 64.0F,
                    .IsAntialias = True,
                    .Color = New SKColor(122, 122, 0),
                    .Style = SKPaintStyle.Fill
                }

                Dim BrightYellow As New SKPaint With {
                    .TextSize = 64.0F,
                    .IsAntialias = True,
                    .Color = New SKColor(255, 255, 77),
                    .Style = SKPaintStyle.Fill
                }

                Dim Black As New SKPaint With {
                    .TextSize = 64.0F,
                    .IsAntialias = True,
                    .Color = New SKColor(0, 0, 0),
                    .Style = SKPaintStyle.Fill
                }

                For i As Integer = 0 To LstVecThetaPhi.Count - 1 Step 1

                    Dim rotated_vec As Vector3D = Rotate_around_the_x_axis(LstVecThetaPhi(i).Vect, rotation_angle_x)

                    '–––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––
                    ' Every point that is more than 90° from the camera direction (=back side) does not need to be drawn. 
                    '–––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––

                    Dim angle_view_to_a_Normal As Double = Vector3D.AngleBetween(Camera_Vector, rotated_vec)
                    If angle_view_to_a_Normal > 90.0001 Then ' 90.0001 because the precision of a ‘double’ is finite..
                        Continue For
                    End If

                    '–––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––
                    ' calculate position, projection, and draw the points.
                    '–––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––

                    Dim Angle_in_degrees As Double = Vector3D.AngleBetween(rotated_vec, New Vector3D(rotated_vec.X, rotated_vec.Y, 0.0))
                    If Double.IsNaN(Angle_in_degrees) Then
                        Continue For
                    End If
                    Dim vertical_height As Double = Radius * Math.Sin(Angle_in_degrees * Math.PI / 180.0) ' Opposite cathetus
                    Dim projected_Point As New PointF(
                            CSng((Camera - Window) / (Camera - vertical_height) * rotated_vec.X),
                            CSng(-(Camera - Window) / (Camera - vertical_height) * rotated_vec.Y))

                    If LstVecThetaPhi(i).GridVect.X = 0.0 AndAlso LstVecThetaPhi(i).GridVect.Y = 0.0 AndAlso LstVecThetaPhi(i).GridVect.Z = 0.0 Then
                        canvas.DrawPoint(projected_Point.X, projected_Point.Y, DarkBlue)
                    Else
                        Dim SKPoints1 As New SKPoint(projected_Point.X + 1.0F, projected_Point.Y + 1.0F)
                        Dim SKPoints2 As New SKPoint(projected_Point.X, projected_Point.Y)
                        Dim SKPoints3 As New SKPoint(projected_Point.X - 1.0F, projected_Point.Y - 1.0F)
                        canvas.DrawPoints(SKPointMode.Lines, {SKPoints1, SKPoints2, SKPoints3}, BrightYellow)
                    End If

                Next


                '–––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––
                ' Draw the line which is showing the set Phi and Theta.
                '–––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––

                Dim Arrow As Vector3D = Rotate_around_the_x_axis(getVector(CDbl(Me.Theta), CDbl(Me.Phi)), rotation_angle_x)
                Dim Angle As Double = Vector3D.AngleBetween(Arrow, New Vector3D(Arrow.X, Arrow.Y, 0.0))
                Dim vertical As Double = Arrow.Length * Math.Sin(Angle * Math.PI / 180.0)
                projected_arrow = New PointF(
                                  CSng((Camera - Window) / (Camera - vertical) * Arrow.X),
                                  CSng(-(Camera - Window) / (Camera - vertical) * Arrow.Y))
                canvas.DrawLine(point_of_origin.X, point_of_origin.Y, projected_arrow.X, projected_arrow.Y, DarkYellow)

                '–––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––
                ' get the data into displayedBitmap because the PictureBox is only accepting an usual System.Drawing.Bitmap.
                '–––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––

                Using image As SKImage = surface.Snapshot()
                    Using data As SKData = image.Encode(SKEncodedImageFormat.Png, 100)
                        Using mStream As New IO.MemoryStream(data.ToArray())
                            displayedBitmap = New Bitmap(mStream, False)
                        End Using
                    End Using
                End Using

            End Using
        End Using

        Return True
    End Function

End Class
#Enable Warning IDE1006 ' Benennungsstile
#Enable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
#Enable Warning CA1051 ' Sichtbare Instanzfelder nicht deklarieren
#Enable Warning CA2211 ' Nicht konstante Felder dürfen nicht sichtbar sein