Introductory remarks
The purpose of this program is to rotate a
Plane strongly rotated around the z-axis with odd edges in the middle. As you can see from the values, the camera is currently 2660 units of length away from the plane, and the projection window is 1000 units of length. (Camera – window 1660)
Form1.vb
Public NotInheritable Class FormMain
Private Plane1 As PlaneInTermsOfGeometry = Nothing
Public ReadOnly Deu As New System.Globalization.CultureInfo("de-DE")
Private Sub FormMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.BackColor = Color.FromArgb(184, 176, 143)
For Each but As Button In Me.Controls.OfType(Of Button)
but.BackColor = Color.FromArgb(201, 200, 193)
Next
TextBox_Window.Text = "-1000"
Label5.Text = ""
Label6.Text = ""
End Sub
Private Sub FormMain_Shown(sender As Object, e As EventArgs) Handles MyBase.Shown
New_Plane()
End Sub
Private Sub Button_new_plane_Click(sender As Object, e As EventArgs) Handles Button_new_plane.Click
New_Plane()
End Sub
Private Async Sub New_Plane()
Using FNP As New FormCreateNewPlane
If FNP.ShowDialog(Me) <> DialogResult.OK Then
Return
End If
Plane1 = New PlaneInTermsOfGeometry(
FNP.A0x,
FNP.A0y,
FNP.A0z,
FNP.ABx,
FNP.ABy,
FNP.ABz,
FNP.ACx,
FNP.ACy,
FNP.ACz,
FNP.Enlargement)
Await Plane1.process_async()
PictureBox1.Image = Nothing
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
Label5.Text = Math.Round(Plane1.current_x_angle, 0).ToString(Deu)
Label6.Text = Math.Round(Plane1.current_z_angle, 0).ToString(Deu)
TextBox_Kamera.Text = Math.Round(Plane1.Camera, 0).ToString(Deu)
End Using
End Sub
Private Sub TextBox_Kamera_TextChanged(sender As Object, e As EventArgs) Handles TextBox_Kamera.TextChanged
If Plane1 Is Nothing Then Return
Dim Kamera As Double
If Double.TryParse(TextBox_Kamera.Text, Kamera) Then
TextBox_Kamera.ForeColor = Color.FromArgb(0, 125, 0)
Plane1.Camera = Kamera
Else
TextBox_Kamera.ForeColor = Color.Red
End If
End Sub
Private Sub TextBox_Fenster_TextChanged(sender As Object, e As EventArgs) Handles TextBox_Window.TextChanged
If Plane1 Is Nothing Then Return
Dim Fenster As Double
If Double.TryParse(TextBox_Window.Text, Fenster) Then
TextBox_Window.ForeColor = Color.FromArgb(0, 125, 0)
Plane1.Window_distance = Fenster
Else
TextBox_Window.ForeColor = Color.Red
End If
End Sub
Private Async Sub FormMain_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown
If Plane1 Is Nothing Then Return
Select Case e.KeyCode
Case Keys.W
If Plane1.current_x_angle > -90.0 Then
Plane1.change_x_angle(-1.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
Label5.Text = Math.Round(Plane1.current_x_angle, 0).ToString(Deu)
Label6.Text = Math.Round(Plane1.current_z_angle, 0).ToString(Deu)
TextBox_KOForm.Text = Plane1.Cartesian_Equation()
End If
Case Keys.S
If Plane1.current_x_angle < 90.0 Then
Plane1.change_x_angle(1.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
Label5.Text = Math.Round(Plane1.current_x_angle, 0).ToString(Deu)
Label6.Text = Math.Round(Plane1.current_z_angle, 0).ToString(Deu)
TextBox_KOForm.Text = Plane1.Cartesian_Equation()
End If
Case Keys.A
If Plane1.current_z_angle > -90.0 Then
Plane1.change_z_angle(-1.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
Label5.Text = Math.Round(Plane1.current_x_angle, 0).ToString(Deu)
Label6.Text = Math.Round(Plane1.current_z_angle, 0).ToString(Deu)
TextBox_KOForm.Text = Plane1.Cartesian_Equation()
End If
Case Keys.D
If Plane1.current_z_angle < 90.0 Then
Plane1.change_z_angle(1.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
Label5.Text = Math.Round(Plane1.current_x_angle, 0).ToString(Deu)
Label6.Text = Math.Round(Plane1.current_z_angle, 0).ToString(Deu)
TextBox_KOForm.Text = Plane1.Cartesian_Equation()
End If
Case Else
Exit Select
End Select
End Sub
Private Async Sub FormMain_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel
If Plane1 Is Nothing Then Return
If e.Delta > 0 Then
' The Camera must be in front of the window.
If (Plane1.Camera - Plane1.Window_distance) < 0.0 Then
Plane1.change_Camera_distance(20.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
End If
Else
Plane1.change_Camera_distance(-20.0)
Await Plane1.process_async()
PictureBox1.Image = Nothing
GC.Collect()
PictureBox1.Image = PlaneInTermsOfGeometry.displayedBitmap
End If
TextBox_Kamera.Text = Math.Round(Plane1.Camera, 0).ToString(Deu)
End Sub
End Class
class PlaneInTermsOfGeometry (By the way: I was politely instructed to choose a reasonable name for this class instead of just "Plane"...)
Imports System.Windows.Media.Media3D
Imports SkiaSharp
Public NotInheritable Class PlaneInTermsOfGeometry
Private Structure VA0
Public x As Double
Public y As Double
Public z As Double
End Structure
Private A0 As VA0
Private Structure VAB
Public x As Double
Public y As Double
Public z As Double
End Structure
' →
Private AB As VAB
Private Structure VAC
Public x As Double
Public y As Double
Public z As Double
End Structure
' →
Private AC As VAC
Private ReadOnly allVectors As New List(Of Vector3D)
''' <summary>
''' in degrees
''' </summary>
Public current_x_angle As Double = 0.0
''' <summary>
''' in degrees
''' </summary>
Public current_z_angle As Double = 0.0
''' <summary>
''' The picture in which is written and which is shown by the PictureBox.
''' </summary>
Public Shared displayedBitmap As System.Drawing.Bitmap
''' <summary>
''' The camera position on the y-axis (we look along the y arrow).
''' </summary>
Public Camera As Double = -2660.0
''' <summary>
''' The projection window position on the y-axis. Absolute value!
''' </summary>
Public Window_distance As Double = -1000.0
''' <summary>
''' The distance from the origin of coordinates to the x-length
''' </summary>
Private ReadOnly oneSide As Double
Private ReadOnly Grid As New List(Of Vector3D)
Public Sub New(ByVal A0x As Double,
ByVal A0y As Double,
ByVal A0z As Double,
ByVal ABx As Double,
ByVal ABy As Double,
ByVal ABz As Double,
ByVal ACx As Double,
ByVal ACy As Double,
ByVal ACz As Double,
ByVal enlarg As Double)
Me.A0.x = A0x
Me.A0.y = A0y
Me.A0.z = A0z
Me.AB.x = ABx * enlarg
Me.AB.y = ABy
Me.AB.z = ABz
Me.AC.x = ACx
Me.AC.y = ACy
Me.AC.z = ACz * enlarg
Me.oneSide = ABx * enlarg
For x As Double = -AB.x To AB.x Step 1.0
For z As Double = -AC.z To AC.z Step 2.0
allVectors.Add(New Vector3D(x, 0.0, z))
' For the grid
If CSng(x) Mod 15.0F = 0.0F Then
Grid.Add(New Vector3D(x, 0.0, z))
Else
Grid.Add(New Vector3D(0.0, 0.0, 0.0))
End If
Next
Next
End Sub
Public Sub change_Camera_distance(ByVal dy As Double)
Camera = dy
End Sub
Public Sub change_x_angle(ByVal value As Double)
current_x_angle = value
End Sub
Public Sub change_z_angle(ByVal value As Double)
current_z_angle = value
End Sub
Private Function rotate_around_x_axis(ByVal vec1 As Vector3D) As Vector3D
Return New Vector3D(
vec1.X,
vec1.Y * Math.Cos(current_x_angle * Math.PI / 180.0) - vec1.Z * Math.Sin(current_x_angle * Math.PI / 180.0),
vec1.Y * Math.Sin(current_x_angle * Math.PI / 180.0) Math.Cos(current_x_angle * Math.PI / 180.0) * vec1.Z)
End Function
Private Function rotate_around_z_axis(ByVal vec2 As Vector3D) As Vector3D
Return New Vector3D(
Math.Cos(current_z_angle * Math.PI / 180.0) * vec2.X - vec2.Y * Math.Sin(current_z_angle * Math.PI / 180.0),
Math.Sin(current_z_angle * Math.PI / 180.0) * vec2.X vec2.Y * Math.Cos(current_z_angle * Math.PI / 180.0),
vec2.Z)
End Function
Public Async Function process_async() As Task(Of Boolean)
Return Await Task.Run(Function() processing())
End Function
Private Function processing() As Boolean
displayedBitmap = Nothing
Dim i As Integer = 0
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(FormMain.PictureBox1.Size.Width \ 2, FormMain.PictureBox1.Size.Height \ 2)
Using DarkBlue As New SKPaint With {
.TextSize = 64.0F,
.IsAntialias = True,
.Color = New SKColor(0, 64, 255),
.Style = SKPaintStyle.Fill
}
Using BrightYellow As New SKPaint With {
.TextSize = 64.0F,
.IsAntialias = True,
.Color = New SKColor(255, 255, 64),
.Style = SKPaintStyle.Fill
}
For Each vec As Vector3D In allVectors
Dim rotatedVec As Vector3D = rotate_around_z_axis(rotate_around_x_axis(vec))
If rotatedVec.Y > Window_distance Then ' The object is not further back than the window (the window is not in the object). When false, don't draw!
Dim Angle_in_degrees As Double = Vector3D.AngleBetween(
rotatedVec,
New Vector3D(rotatedVec.X, 0.0, rotatedVec.Z))
If Double.IsNaN(Angle_in_degrees) Then
i = 1
Continue For
End If
' Opposite cathetus
Dim distance_to_plane As Double = oneSide * Math.Sin(Angle_in_degrees * Math.PI / 180.0)
Dim projected As New PointF(
CSng((Camera - Window_distance) / (Camera - distance_to_plane) * rotatedVec.X),
CSng(-(Camera - Window_distance) / (Camera - distance_to_plane) * rotatedVec.Z))
If Grid(i).X = 0.0 AndAlso Grid(i).Y = 0.0 AndAlso Grid(i).Z = 0.0 Then
' draw the mathematical plane
canvas.DrawPoint(projected.X, projected.Y, DarkBlue)
Else
' draw the grid (Gitternetz)
canvas.DrawPoint(projected.X, projected.Y, BrightYellow)
End If
i = 1
End If
Next
End Using
End Using
End Using
'–––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––––
' 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
Return True
End Function
'Koordinatenform
Public Function Cartesian_Equation() As String
Dim _N As Vector3D = Vector3D.CrossProduct(rotate_around_z_axis(New Vector3D(AB.x, AB.y, AB.z)), rotate_around_x_axis(New Vector3D(AC.x, AC.y, AC.z)))
Dim _xMinusA0 As String
Dim _yMinusA0 As String
Dim _zMinusA0 As String
If A0.x = 0.0 Then
_xMinusA0 = "x"
Else
_xMinusA0 = $"(x - {A0.x.ToString(FormMain.Deu)})"
End If
If A0.y = 0.0 Then
_yMinusA0 = "y"
Else
_yMinusA0 = $"(y - {A0.y.ToString(FormMain.Deu)})"
End If
If A0.z = 0.0 Then
_zMinusA0 = "z"
Else
_zMinusA0 = $"(z - {A0.z.ToString(FormMain.Deu)})"
End If
Return ($"{Math.Round(_N.X, 3).ToString(FormMain.Deu)} * {_xMinusA0} {Math.Round(_N.Y, 3).ToString(FormMain.Deu)} * {_yMinusA0} {Math.Round(_N.Z, 3).ToString(FormMain.Deu)} * {_zMinusA0}").ToString(FormMain.Deu)
End Function
End Class
For the sake of completeness, if someone wants to recreate it, here is FormNewPlane.vb to create a new plane, as shown in the first picture.
Imports Microsoft.VisualBasic.ControlChars
Public NotInheritable Class FormCreateNewPlane
Public A0x, A0y, A0z, ABx, ABy, ABz, ACx, ACy, ACz, Enlargement As Double
Private Sub FormCreateNewPlane_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.BackColor = Color.FromArgb(184, 176, 143)
For Each but As Button In Me.Controls.OfType(Of Button)
but.BackColor = Color.FromArgb(201, 200, 193)
Next
If System.IO.File.Exists(Application.StartupPath & "\Preview.png") Then
PictureBox1.Image = Image.FromFile(Application.StartupPath & "\Preview.png")
End If
'Since this is a plane that lies in the xz plane, only the text box contents that display a 1 should be changed.
Label5.Text = $"Da es hier um eine Ebene geht, die{NewLine}in der xz-Ebene liegt, sollen nur die{NewLine}Textbox-Inhalte verändert werden,{NewLine}die eine 1 anzeigen."
End Sub
Private Sub FormCreateNewPlane_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
If PictureBox1.Image IsNot Nothing Then PictureBox1.Image.Dispose()
End Sub
Private Sub ButtonOK_Click(sender As Object, e As EventArgs) Handles ButtonOK.Click
Me.DialogResult = DialogResult.OK
End Sub
Private Sub TextBoxA0x_TextChanged(sender As Object, e As EventArgs) Handles TextBoxA0x.TextChanged
If Double.TryParse(TextBoxA0x.Text, A0x) Then
TextBoxA0x.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxA0x.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxA0y_TextChanged(sender As Object, e As EventArgs) Handles TextBoxA0y.TextChanged
If Double.TryParse(TextBoxA0y.Text, A0y) Then
TextBoxA0y.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxA0y.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxA0z_TextChanged(sender As Object, e As EventArgs) Handles TextBoxA0z.TextChanged
If Double.TryParse(TextBoxA0z.Text, A0z) Then
TextBoxA0z.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxA0z.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxABx_TextChanged(sender As Object, e As EventArgs) Handles TextBoxABx.TextChanged
If Double.TryParse(TextBoxABx.Text, ABx) Then
TextBoxABx.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxABx.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxABy_TextChanged(sender As Object, e As EventArgs) Handles TextBoxABy.TextChanged
If Double.TryParse(TextBoxABy.Text, ABy) Then
TextBoxABy.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxABy.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxABz_TextChanged(sender As Object, e As EventArgs) Handles TextBoxABz.TextChanged
If Double.TryParse(TextBoxABz.Text, ABz) Then
TextBoxABz.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxABz.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxACx_TextChanged(sender As Object, e As EventArgs) Handles TextBoxACx.TextChanged
If Double.TryParse(TextBoxACx.Text, ACx) Then
TextBoxACx.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxACx.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxACy_TextChanged(sender As Object, e As EventArgs) Handles TextBoxACy.TextChanged
If Double.TryParse(TextBoxACy.Text, ACy) Then
TextBoxACy.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxACy.ForeColor = Color.Red
End If
End Sub
Private Sub TextBoxACz_TextChanged(sender As Object, e As EventArgs) Handles TextBoxACz.TextChanged
If Double.TryParse(TextBoxACz.Text, ACz) Then
TextBoxACz.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBoxACz.ForeColor = Color.Red
End If
End Sub
Private Sub TextBox_Enlarg_TextChanged(sender As Object, e As EventArgs) Handles TextBox_Enlarg.TextChanged
If Double.TryParse(TextBox_Enlarg.Text, Enlargement) Then
TextBox_Enlarg.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBox_Enlarg.ForeColor = Color.Red
End If
End Sub
Private Sub TextBox_Enlarg_KeyDown(sender As Object, e As KeyEventArgs) Handles TextBox_Enlarg.KeyDown
If e.KeyCode = Keys.Enter Then
If Double.TryParse(TextBox_Enlarg.Text, Enlargement) Then
TextBox_Enlarg.ForeColor = Color.FromArgb(0, 125, 0)
Else
TextBox_Enlarg.ForeColor = Color.Red
End If
Me.DialogResult = DialogResult.OK
End If
End Sub
Private Sub TextBox_Enlarg_KeyPress(sender As Object, e As KeyPressEventArgs) Handles TextBox_Enlarg.KeyPress
If e.KeyChar = Convert.ToChar(13) Then e.Handled = True ' This suppresses the ‘ding’ sound.
End Sub
End Class
CodePudding user response:
If you'd like to apply perspective projection
to the points, the projected
point should be something like this;
Dim projected As New PointF(
CSng((Camera - Window_distance) / (Camera - rotatedVec.Y) * rotatedVec.X),
CSng(-(Camera - Window_distance) / (Camera - rotatedVec.Y) * rotatedVec.Z))
' In short, distance_to_plane = rotatedVec.Y