' ' Created by SharpDevelop. ' User: 14manvilleA ' Date: 27/09/2019 ' Time: 10:18 ' ' To change this template use Tools | Options | Coding | Edit Standard Headers. ' Imports System.Drawing Public Class View3D Protected _objects As New Dictionary(Of String, Pair(Of ICoordinates3D, Color)) Protected _bitmapimage As Bitmap = Nothing Protected _operateauto As Boolean = False Protected _width As Integer = 0 Protected _height As Integer = 0 Protected _backcolor As Color = Color.Black Public Sub New(width As Integer, height As Integer, Optional backcolor As Color = Nothing, Optional refreshafterop As Boolean = False) _width = width _height = height _operateauto = refreshafterop _bitmapimage = New Bitmap(width, height) If backcolor.IsEmpty Then _backcolor = Color.Black Else _backcolor = backcolor End If Using g As Graphics = Graphics.FromImage(_bitmapimage) g.Clear(backcolor) End Using End Sub Public ReadOnly Property getImage() As Bitmap Get Return _bitmapimage.Clone(New Rectangle(0, 0, _bitmapimage.Width, _bitmapimage.Height), _bitmapimage.PixelFormat) End Get End Property Public ReadOnly Property width() As Integer Get Return _width End Get End Property Public ReadOnly Property height() As Integer Get Return _height End Get End Property Public Property refreshAfterOperation() As Boolean Get Return _operateauto End Get Set(value As Boolean) _operateauto = value If _operateauto Then refresh() End Set End Property Public Property backgroundColor() As Color Get Return _backcolor End Get Set(value As Color) _backcolor = value If _operateauto Then refresh() End Set End Property Public Function getObject(Of t As ICoordinates3D)(name As String) As t If _objects.ContainsKey(name) Then Return _objects(name).valueA End If Return Nothing End Function Public Sub setObject(Of t As ICoordinates3D)(name As String, [object] As t) If [object] Is Nothing Then If _objects.ContainsKey(name) Then _objects.Remove(name) Else Throw New InvalidOperationException() End If Else If _objects.ContainsKey(name) Then Dim p As Pair(Of ICoordinates3D, Color) = _objects(name) p.valueA = [object] _objects(name) = p Else _objects.Add(name, New Pair(Of ICoordinates3D, Color)([object], _backcolor)) End If End If If _operateauto Then refresh() End Sub Public Function getObjectColor(name As String) As Color If _objects.ContainsKey(name) Then Return _objects(name).valueB End If Return Nothing End Function Public Sub setObjectColor(name As String, [color] As Color) If color.IsEmpty Then Throw New InvalidOperationException() Else If _objects.ContainsKey(name) Then Dim p As Pair(Of ICoordinates3D, Color) = _objects(name) p.valueB = color _objects(name) = p Else Throw New InvalidOperationException() End If End If If _operateauto Then refresh() End Sub Dim slockrf As New Object() Public Sub refresh() SyncLock slockrf render() End SyncLock End Sub Protected Sub render() Using g As Graphics = Graphics.FromImage(_bitmapimage) g.Clear(_backcolor) Dim objs As New List(Of Pair(Of ICoordinates3D, Color)) Dim objsorder As New List(Of Integer) Dim avgz As New List(Of Integer) Dim piv As New List(Of Pair(Of Integer, Single)) For q = 0 To _objects.Values.Count - 1 Dim obj As Pair(Of ICoordinates3D, Color) = _objects.Values(q) Dim cavgz As Single = 0 Dim cnt As Integer = 0 Dim array = obj.valueA.returnScaledPoints(_width, _height, 256, 128) For i = 0 To array.Length - 1 Dim z As Point3D = array(i) Dim cz As Single = z.Z cavgz += cz cnt += 1 Next cavgz /= cnt avgz.Add(cavgz) objs.Add(obj) piv.Add(New Pair(Of Integer, Single)(q, cavgz)) Next piv.Sort(New IntegerSinglePairInverseSorter()) '#DEBUG# 'Console.WriteLine("#START#") Dim array1 = piv.ToArray For i = 0 To array1.Length - 1 Dim pr As Pair(Of Integer, Single) = array1(i) objsorder.Add(pr.valueA) '#DEBUG# 'Console.WriteLine("#" & pr.valueA & ":" & pr.valueB & "#") Next '#DEBUG# 'Console.WriteLine("#FINISH#") For j As Integer = 0 To objsorder.Count - 1 Dim index As Integer = objsorder(j) Dim ps3d As Point3D() = objs(index).valueA.returnScaledPoints(_width, _height, 256, 128) Dim pnts As New List(Of PointF) For i = 0 To ps3d.Length - 1 Dim p3d As Point3D = ps3d(i) pnts.Add(New PointF(CInt(p3d.X), CInt(p3d.Y))) Next Dim points As PointF() = pnts.ToArray Using b As Brush = New SolidBrush(objs(index).valueB) g.FillPolygon(b, points) End Using Next End Using End Sub Protected Class IntegerSinglePairInverseSorter Implements IComparer(Of Pair(Of Integer, Single)) Public Function Compare(x As Pair(Of Integer, Single), y As Pair(Of Integer, Single)) As Integer Implements IComparer(Of Pair(Of Integer, Single)).Compare If x.valueB < y.valueB Then Return -1 ElseIf x.valueB > y.valueB Then Return 1 End If Return 0 End Function End Class Protected Structure Pair(Of a, b) Public valueA As a Public valueB As b Public Sub New(va As a, vb As b) valueA = va valueB = vb End Sub End Structure End Class