188 lines
6.5 KiB
VB.net
188 lines
6.5 KiB
VB.net
'
|
|
' 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 |