190607 c1

- Add Pilz.Drawing.Drawing3D.OpenGLFactory
- Fix small bugs in Pilz.UI.PaintingControl
This commit is contained in:
2019-06-07 20:56:19 +02:00
parent ef15e45df7
commit 2f09834fa0
65 changed files with 6670 additions and 118 deletions

View File

@@ -7,6 +7,16 @@ Namespace SimpleHistory
Private stackPast As New Stack(Of HistoryPoint)
Private stackFuture As New Stack(Of HistoryPoint)
''' <summary>
''' Gets the count of history points.
''' </summary>
''' <returns></returns>
Public ReadOnly Property ChangesCount As Boolean
Get
Return stackPast.Count
End Get
End Property
''' <summary>
''' Checks if the History has past changes.
''' </summary>

View File

@@ -0,0 +1,570 @@
Imports System.Windows.Forms
Imports OpenTK
Namespace CameraN
Public Class Camera
Public Event NeedSelectedObject(e As NeedSelectedObjectEventArgs)
'P R I V A T E F I E L D S
Private ReadOnly TAU As Single = Math.PI * 2
Private myCamMode As CameraMode = CameraMode.FLY
Private pos As New Vector3(-5000.0F, 3000.0F, 4000.0F)
Private myLookat As New Vector3(0F, 0F, 0F)
Private myFarPoint As New Vector3(0F, 0F, 0F)
Private myNearPoint As New Vector3(0F, 0F, 0F)
Private lastMouseX As Integer = -1, lastMouseY As Integer = -1
Private CamAngleX As Single = 0F, CamAngleY As Single = -(Math.PI / 2)
Private resetMouse As Boolean = True
Private orbitDistance As Single = 500.0F
Private orbitTheta As Single = 0.0F, orbitPhi As Single = 0.0F
Private currentLookDirection As LookDirection
Private lookPositions() As Vector3 = {
New Vector3(0, 12500, 0),
New Vector3(0, -12500, 0),
New Vector3(-12500, 0, 0),
New Vector3(12500, 0, 0),
New Vector3(0, 0, 12500),
New Vector3(0, 0, -12500)
}
'A U T O M A T I C P R O P E R T I E S
Public Property CamSpeedMultiplier As Single = 1
'P R O P E R T I E S
Public ReadOnly Property CamMode As CameraMode
Get
Return myCamMode
End Get
End Property
Public ReadOnly Property Yaw As Single
Get
Return CamAngleX
End Get
End Property
Public ReadOnly Property Pitch As Single
Get
Return CamAngleY
End Get
End Property
Public ReadOnly Property Yaw_Degrees As Single
Get
Return CamAngleX * (180.0F / 3.14159274F)
End Get
End Property
Public ReadOnly Property Pitch_Degrees As Single
Get
Return CamAngleY * (180.0F / 3.14159274F)
End Get
End Property
Public Property Position As Vector3
Get
Return pos
End Get
Set(value As Vector3)
pos = value
End Set
End Property
Public Property LookAt As Vector3
Get
Return myLookat
End Get
Set(value As Vector3)
myLookat = value
End Set
End Property
Public Property NearPoint As Vector3
Get
Return myNearPoint
End Get
Set(value As Vector3)
myNearPoint = value
End Set
End Property
Public Property FarPoint As Vector3
Get
Return myFarPoint
End Get
Set(value As Vector3)
myFarPoint = value
End Set
End Property
'C O N S T R U C T O R
Public Sub New()
SetRotationFromLookAt()
End Sub
'F E A T U R E S
Private Function Clampf(value As Single, min As Single, max As Single) As Single
Return If(value > max, max, If(value < min, min, value))
End Function
Private Sub OrientateCam(ang As Single, ang2 As Single)
Dim CamLX As Single = CSng(Math.Sin(ang)) * CSng(Math.Sin(-ang2))
Dim CamLY As Single = CSng(Math.Cos(ang2))
Dim CamLZ As Single = CSng(-Math.Cos(ang)) * CSng(Math.Sin(-ang2))
myLookat.X = pos.X + (-CamLX) * 100.0F
myLookat.Y = pos.Y + (-CamLY) * 100.0F
myLookat.Z = pos.Z + (-CamLZ) * 100.0F
End Sub
Private Sub OffsetCam(xAmt As Integer, yAmt As Integer, zAmt As Integer)
Dim pitch_Renamed As Double = CamAngleY - (Math.PI / 2)
Dim CamLX As Single = CSng(Math.Sin(CamAngleX)) * CSng(Math.Cos(-pitch_Renamed))
Dim CamLY As Single = CSng(Math.Sin(pitch_Renamed))
Dim CamLZ As Single = CSng(-Math.Cos(CamAngleX)) * CSng(Math.Cos(-pitch_Renamed))
pos.X = pos.X + xAmt * (CamLX) * CamSpeedMultiplier
pos.Y = pos.Y + yAmt * (CamLY) * CamSpeedMultiplier
pos.Z = pos.Z + zAmt * (CamLZ) * CamSpeedMultiplier
End Sub
Public Sub Move(y As Single, ByRef camMtx As Matrix4)
OffsetCam(0, y, 0)
OrientateCam(CamAngleX, CamAngleY)
UpdateMatrix(camMtx)
End Sub
Public Sub Move(x As Single, z As Single, ByRef camMtx As Matrix4)
UpdateCameraOffsetDirectly(x, z, camMtx)
OrientateCam(CamAngleX, CamAngleY)
UpdateMatrix(camMtx)
End Sub
Public Sub SetRotationFromLookAt()
Dim x_diff As Single = myLookat.X - pos.X
Dim y_diff As Single = myLookat.Y - pos.Y
Dim z_diff As Single = myLookat.Z - pos.Z
Dim dist As Single = CSng(Math.Sqrt(x_diff * x_diff + y_diff * y_diff + z_diff * z_diff))
If z_diff = 0 Then
z_diff = 0.001F
End If
Dim nxz_ratio As Single = -x_diff / z_diff
If z_diff < 0 Then
CamAngleX = CSng(Math.Atan(nxz_ratio) + Math.PI)
Else
CamAngleX = CSng(Math.Atan(nxz_ratio))
End If
CamAngleY = -3.1459F - (CSng(Math.Asin(y_diff / dist)) - 1.57F)
End Sub
Public Sub ResetOrbitToSelectedObject()
Dim objs As ICameraPoint() = GetSelectedObject()
If objs?.Length > 0 Then
orbitTheta = -(CalculateCenterYRotationOfObjects(objs) * (CSng(Math.PI) / 180.0F))
orbitPhi = -0.3F
orbitDistance = 1200.0F
End If
End Sub
Public Sub UpdateOrbitCamera(ByRef cameraMatrix As Matrix4)
If myCamMode = CameraMode.ORBIT Then
Dim objs As ICameraPoint() = GetSelectedObject()
If objs?.Length > 0 Then
Dim centerPos As Numerics.Vector3 = CalculateCenterPositionOfObjects(objs)
pos.X = centerPos.X + CSng(Math.Cos(orbitPhi) * -Math.Sin(orbitTheta) * orbitDistance)
pos.Y = centerPos.Y + CSng(-Math.Sin(orbitPhi) * orbitDistance)
pos.Z = centerPos.Z + CSng(Math.Cos(orbitPhi) * Math.Cos(orbitTheta) * orbitDistance)
myLookat.X = centerPos.X
myLookat.Y = centerPos.Y
myLookat.Z = centerPos.Z
UpdateMatrix(cameraMatrix)
SetRotationFromLookAt()
End If
End If
End Sub
Public Function IsOrbitCamera() As Boolean
Return myCamMode = CameraMode.ORBIT
End Function
Public Sub SetCameraMode(mode As CameraMode, ByRef cameraMatrix As Matrix4)
myCamMode = mode
If IsOrbitCamera() Then
ResetOrbitToSelectedObject()
UpdateOrbitCamera(cameraMatrix)
End If
End Sub
Public Sub SetCameraMode_LookDirection(dir As LookDirection, ByRef cameraMatrix As Matrix4)
myCamMode = CameraMode.LOOK_DIRECTION
currentLookDirection = dir
Select Case currentLookDirection
Case LookDirection.Top
pos = lookPositions(CInt(LookDirection.Top))
myLookat = New Vector3(pos.X, -25000, pos.Z - 1)
UpdateMatrix(cameraMatrix)
SetRotationFromLookAt()
Case LookDirection.Bottom
pos = lookPositions(CInt(LookDirection.Bottom))
myLookat = New Vector3(pos.X, 25000, pos.Z + 1)
UpdateMatrix(cameraMatrix)
SetRotationFromLookAt()
Case LookDirection.Left
pos = lookPositions(CInt(LookDirection.Left))
myLookat = New Vector3(25000, pos.Y, pos.Z)
UpdateMatrix(cameraMatrix)
SetRotationFromLookAt()
Case LookDirection.Right
pos = lookPositions(CInt(LookDirection.Right))
myLookat = New Vector3(-25000, pos.Y, pos.Z)
UpdateMatrix(cameraMatrix)
SetRotationFromLookAt()
Case LookDirection.Front
pos = lookPositions(CInt(LookDirection.Front))
myLookat = New Vector3(pos.X, pos.Y, -25000)
UpdateMatrix(cameraMatrix)
SetRotationFromLookAt()
Case LookDirection.Back
pos = lookPositions(CInt(LookDirection.Back))
myLookat = New Vector3(pos.X, pos.Y, 25000)
UpdateMatrix(cameraMatrix)
SetRotationFromLookAt()
End Select
End Sub
Public Sub UpdateCameraMatrixWithMouse(mouseX As Integer, mouseY As Integer, ByRef cameraMatrix As Matrix4)
If myCamMode = CameraMode.ORBIT AndAlso GetSelectedObject() IsNot Nothing Then
UpdateCameraMatrixWithMouse_ORBIT(mouseX, mouseY, cameraMatrix)
ElseIf myCamMode = CameraMode.LOOK_DIRECTION Then
UpdateCameraMatrixWithMouse_LOOK(pos, mouseX, mouseY, cameraMatrix)
Else
UpdateCameraMatrixWithMouse_FLY(mouseX, mouseY, cameraMatrix)
End If
End Sub
Public Sub UpdateCameraOffsetWithMouse(orgPos As Vector3, mouseX As Integer, mouseY As Integer, w As Integer, h As Integer, ByRef cameraMatrix As Matrix4)
If myCamMode = CameraMode.ORBIT AndAlso GetSelectedObject() IsNot Nothing Then
UpdateCameraOffsetWithMouse_ORBIT(mouseX, mouseY, cameraMatrix)
ElseIf myCamMode = CameraMode.LOOK_DIRECTION Then
UpdateCameraMatrixWithMouse_LOOK(pos, mouseX, mouseY, cameraMatrix)
Else
UpdateCameraOffsetWithMouse_FLY(orgPos, mouseX, mouseY, w, h, cameraMatrix)
End If
End Sub
Public Sub UpdateCameraMatrixWithScrollWheel(amt As Integer, ByRef cameraMatrix As Matrix4)
If myCamMode = CameraMode.ORBIT AndAlso GetSelectedObject() IsNot Nothing Then
UpdateCameraMatrixWithScrollWheel_ORBIT(amt, cameraMatrix)
ElseIf myCamMode = CameraMode.LOOK_DIRECTION Then
UpdateCameraMatrixWithScrollWheel_LOOK(amt, cameraMatrix)
Else
UpdateCameraMatrixWithScrollWheel_FLY(amt, cameraMatrix)
End If
End Sub
Private Sub UpdateCameraMatrixWithScrollWheel_FLY(amt As Integer, ByRef cameraMatrix As Matrix4)
OffsetCam(amt, amt, amt)
OrientateCam(CamAngleX, CamAngleY)
UpdateMatrix(cameraMatrix)
End Sub
Public Sub UpdateMatrix(ByRef cameraMatrix As Matrix4)
cameraMatrix = Matrix4.LookAt(pos.X, pos.Y, pos.Z, myLookat.X, myLookat.Y, myLookat.Z, 0, 1, 0)
End Sub
Private Sub UpdateCameraMatrixWithScrollWheel_LOOK(amt As Integer, ByRef cameraMatrix As Matrix4)
OffsetCam(amt, amt, amt)
OrientateCam(CamAngleX, CamAngleY)
Select Case currentLookDirection
Case LookDirection.Top
cameraMatrix = Matrix4.LookAt(pos.X, pos.Y, pos.Z, myLookat.X, myLookat.Y, myLookat.Z - 1, 0, 1, 0)
Case LookDirection.Bottom
cameraMatrix = Matrix4.LookAt(pos.X, pos.Y, pos.Z, myLookat.X, myLookat.Y, myLookat.Z + 1, 0, 1, 0)
Case Else
UpdateMatrix(cameraMatrix)
End Select
End Sub
Private Sub UpdateCameraMatrixWithMouse_LOOK(orgPos As Vector3, mouseX As Integer, mouseY As Integer, ByRef cameraMatrix As Matrix4)
If resetMouse Then
lastMouseX = mouseX
lastMouseY = mouseY
resetMouse = False
End If
Dim MousePosX As Integer = mouseX - lastMouseX
Dim MousePosY As Integer = mouseY - lastMouseY
Dim pitch_Renamed As Double = CamAngleY - (Math.PI / 2)
Dim yaw_Renamed As Double = CamAngleX - (Math.PI / 2)
Dim CamLX As Single = CSng(Math.Sin(yaw_Renamed))
Dim CamLY As Single = CSng(Math.Cos(pitch_Renamed))
Dim CamLZ As Single = CSng(-Math.Cos(yaw_Renamed))
Dim m As Single = 8.0F
Select Case currentLookDirection
Case LookDirection.Top
pos.X = orgPos.X - ((MousePosX * CamSpeedMultiplier) * (CamLX) * m) - ((MousePosY * CamSpeedMultiplier) * (CamLZ) * m)
pos.Z = orgPos.Z - ((MousePosX * CamSpeedMultiplier) * (CamLZ) * m) - ((MousePosY * CamSpeedMultiplier) * (CamLX) * m)
cameraMatrix = Matrix4.LookAt(pos.X, pos.Y, pos.Z, pos.X, pos.Y - 1000, pos.Z - 1, 0, 1, 0)
lookPositions(CInt(currentLookDirection)) = pos
Case LookDirection.Bottom
pos.X = orgPos.X - ((MousePosX * CamSpeedMultiplier) * (CamLX) * m) + ((MousePosY * CamSpeedMultiplier) * (CamLZ) * m)
pos.Z = orgPos.Z - ((MousePosX * CamSpeedMultiplier) * (CamLZ) * m) + ((MousePosY * CamSpeedMultiplier) * (CamLX) * m)
cameraMatrix = Matrix4.LookAt(pos.X, pos.Y, pos.Z, pos.X, pos.Y + 1000, pos.Z + 1, 0, 1, 0)
lookPositions(CInt(currentLookDirection)) = pos
Case LookDirection.Left
pos.X = orgPos.X - ((MousePosX * CamSpeedMultiplier) * (CamLX) * m)
pos.Y = orgPos.Y - ((MousePosY * CamSpeedMultiplier) * (-1.0F) * m)
pos.Z = orgPos.Z - ((MousePosX * CamSpeedMultiplier) * (CamLZ) * m)
cameraMatrix = Matrix4.LookAt(pos.X, pos.Y, pos.Z, pos.X + 12500, pos.Y, pos.Z, 0, 1, 0)
lookPositions(CInt(currentLookDirection)) = pos
Case LookDirection.Right
pos.X = orgPos.X - ((MousePosX * CamSpeedMultiplier) * (CamLX) * m)
pos.Y = orgPos.Y - ((MousePosY * CamSpeedMultiplier) * (-1.0F) * m)
pos.Z = orgPos.Z - ((MousePosX * CamSpeedMultiplier) * (CamLZ) * m)
cameraMatrix = Matrix4.LookAt(pos.X, pos.Y, pos.Z, pos.X - 12500, pos.Y, pos.Z, 0, 1, 0)
lookPositions(CInt(currentLookDirection)) = pos
Case LookDirection.Front
pos.X = orgPos.X - ((MousePosX * CamSpeedMultiplier) * (CamLX) * m)
pos.Y = orgPos.Y - ((MousePosY * CamSpeedMultiplier) * (-1.0F) * m)
pos.Z = orgPos.Z - ((MousePosX * CamSpeedMultiplier) * (CamLZ) * m)
cameraMatrix = Matrix4.LookAt(pos.X, pos.Y, pos.Z, pos.X, pos.Y, pos.Z - 12500, 0, 1, 0)
lookPositions(CInt(currentLookDirection)) = pos
Case LookDirection.Back
pos.X = orgPos.X - ((MousePosX * CamSpeedMultiplier) * (CamLX) * m)
pos.Y = orgPos.Y - ((MousePosY * CamSpeedMultiplier) * (-1.0F) * m)
pos.Z = orgPos.Z - ((MousePosX * CamSpeedMultiplier) * (CamLZ) * m)
cameraMatrix = Matrix4.LookAt(pos.X, pos.Y, pos.Z, pos.X, pos.Y, pos.Z + 12500, 0, 1, 0)
lookPositions(CInt(currentLookDirection)) = pos
End Select
lastMouseX = mouseX
lastMouseY = mouseY
'Console.WriteLine("CamAngleX = " + CamAngleX + ", CamAngleY = " + CamAngleY);
'setRotationFromLookAt();
End Sub
Private Sub UpdateCameraMatrixWithMouse_FLY(mouseX As Integer, mouseY As Integer, ByRef cameraMatrix As Matrix4)
If resetMouse Then
lastMouseX = mouseX
lastMouseY = mouseY
resetMouse = False
End If
Dim MousePosX As Integer = mouseX - lastMouseX
Dim MousePosY As Integer = mouseY - lastMouseY
CamAngleX = CamAngleX + (0.01F * MousePosX)
' This next part isn't neccessary, but it keeps the Yaw rotation value within [0, 2*pi] which makes debugging simpler.
If CamAngleX > TAU Then
CamAngleX -= TAU
ElseIf CamAngleX < 0 Then
CamAngleX += TAU
End If
' Lock pitch rotation within the bounds of [-3.1399.0, -0.0001], otherwise the LookAt function will snap to the
' opposite side and reverse mouse looking controls.
CamAngleY = Clampf((CamAngleY + (0.01F * MousePosY)), -3.1399F, -0.0001F)
lastMouseX = mouseX
lastMouseY = mouseY
OrientateCam(CamAngleX, CamAngleY)
UpdateMatrix(cameraMatrix)
'Console.WriteLine("CamAngleX = " + CamAngleX + ", CamAngleY = " + CamAngleY);
'setRotationFromLookAt();
End Sub
Private Sub UpdateCameraOffsetWithMouse_FLY(orgPos As Vector3, mouseX As Integer, mouseY As Integer, w As Integer, h As Integer, ByRef cameraMatrix As Matrix4)
If resetMouse Then
lastMouseX = mouseX
lastMouseY = mouseY
resetMouse = False
End If
Dim MousePosX As Integer = (-mouseX) + lastMouseX
Dim MousePosY As Integer = (-mouseY) + lastMouseY
Dim pitch_Renamed As Double = CamAngleY - (Math.PI / 2)
Dim yaw_Renamed As Double = CamAngleX - (Math.PI / 2)
Dim CamLX As Single = Math.Sin(yaw_Renamed)
Dim CamLZ As Single = -Math.Cos(yaw_Renamed)
pos.X = orgPos.X - ((MousePosX * CamSpeedMultiplier) * (CamLX) * 6.0F)
pos.Y = orgPos.Y - ((MousePosY * CamSpeedMultiplier) * (-1.0F) * 6.0F)
pos.Z = orgPos.Z - ((MousePosX * CamSpeedMultiplier) * (CamLZ) * 6.0F)
OrientateCam(CamAngleX, CamAngleY)
UpdateMatrix(cameraMatrix)
End Sub
Public Sub UpdateCameraOffsetDirectly(horz_amount As Integer, vert_amount As Integer, ByRef cameraMatrix As Matrix4)
If myCamMode = CameraMode.ORBIT Then
UpdateCameraOffsetDirectly_ORBIT(horz_amount / 5, vert_amount / 5, cameraMatrix)
Else
'Console.WriteLine(MousePosX+","+ MousePosY);
Dim pitch_Renamed As Double = CamAngleY - (Math.PI / 2)
Dim yaw_Renamed As Double = CamAngleX - (Math.PI / 2)
Dim CamLX As Single = CSng(Math.Sin(yaw_Renamed))
' float CamLY = (float)Math.Cos(pitch);
Dim CamLZ As Single = CSng(-Math.Cos(yaw_Renamed))
pos.X += ((horz_amount * CamSpeedMultiplier) * (CamLX))
pos.Y += ((vert_amount * CamSpeedMultiplier) * (-1.0F))
pos.Z += ((horz_amount * CamSpeedMultiplier) * (CamLZ))
OrientateCam(CamAngleX, CamAngleY)
UpdateMatrix(cameraMatrix)
End If
End Sub
Private Sub UpdateCameraOffsetDirectly_ORBIT(moveSpeedX As Integer, moveSpeedY As Integer, ByRef cameraMatrix As Matrix4)
Dim MousePosX As Integer = moveSpeedX
Dim MousePosY As Integer = moveSpeedY
orbitTheta += MousePosX * 0.01F * CamSpeedMultiplier
orbitPhi -= MousePosY * 0.01F * CamSpeedMultiplier
orbitPhi = Clampf(orbitPhi, -1.57F, 1.57F)
UpdateOrbitCamera(cameraMatrix)
End Sub
Private Sub UpdateCameraMatrixWithMouse_ORBIT(mouseX As Integer, mouseY As Integer, ByRef cameraMatrix As Matrix4)
UpdateCameraOffsetWithMouse_ORBIT(mouseX, mouseY, cameraMatrix)
End Sub
Private Sub UpdateCameraOffsetWithMouse_ORBIT(mouseX As Integer, mouseY As Integer, ByRef cameraMatrix As Matrix4)
If resetMouse Then
lastMouseX = mouseX
lastMouseY = mouseY
resetMouse = False
End If
Dim MousePosX As Integer = (-mouseX) + lastMouseX
Dim MousePosY As Integer = (-mouseY) + lastMouseY
orbitTheta += MousePosX * 0.01F * CamSpeedMultiplier
orbitPhi -= MousePosY * 0.01F * CamSpeedMultiplier
orbitPhi = Clampf(orbitPhi, -1.57F, 1.57F)
UpdateOrbitCamera(cameraMatrix)
lastMouseX = mouseX
lastMouseY = mouseY
End Sub
Private Sub UpdateCameraMatrixWithScrollWheel_ORBIT(amt As Integer, ByRef cameraMatrix As Matrix4)
orbitDistance -= amt
If orbitDistance < 300.0F Then
orbitDistance = 300.0F
End If
UpdateOrbitCamera(cameraMatrix)
End Sub
Public Sub ResetMouseStuff()
resetMouse = True
End Sub
Private Function CalculateCenterPositionOfObjects(objs As ICameraPoint()) As Numerics.Vector3
If objs.Length <= 1 Then
Dim obj As ICameraPoint = objs.FirstOrDefault
If obj Is Nothing Then
Return Numerics.Vector3.Zero
Else
Return New Numerics.Vector3(obj.Position.X,
obj.Position.Y,
obj.Position.Z)
End If
End If
Dim maxX As Single? = Nothing
Dim maxY As Single? = Nothing
Dim maxZ As Single? = Nothing
Dim minX As Single? = Nothing
Dim minY As Single? = Nothing
Dim minZ As Single? = Nothing
For Each obj As ICameraPoint In objs
Dim pos As Numerics.Vector3 = obj.Position
If maxX Is Nothing OrElse pos.X > maxX Then maxX = pos.X
If maxY Is Nothing OrElse pos.Y > maxY Then maxY = pos.Y
If maxZ Is Nothing OrElse pos.Z > maxZ Then maxZ = pos.Z
If minX Is Nothing OrElse pos.X < minX Then minX = pos.X
If minY Is Nothing OrElse pos.Y < minY Then minY = pos.Y
If minZ Is Nothing OrElse pos.Z < minZ Then minZ = pos.Z
Next
If maxX Is Nothing Then maxX = 0
If maxY Is Nothing Then maxY = 0
If maxZ Is Nothing Then maxZ = 0
If minX Is Nothing Then minX = 0
If minY Is Nothing Then minY = 0
If minZ Is Nothing Then minZ = 0
Dim upper As New Numerics.Vector3(maxX, maxY, maxZ)
Dim lower As New Numerics.Vector3(minX, minY, minZ)
Dim middle As Numerics.Vector3 = (upper + lower) / 2
Return middle
End Function
Private Function CalculateCenterYRotationOfObjects(objs As ICameraPoint()) As Single
If objs.Length <= 1 Then
Dim obj As ICameraPoint = objs.FirstOrDefault
If obj Is Nothing Then
Return 0
Else
Return obj.Rotation.Y
End If
End If
Dim yRot As New List(Of Single)
For Each obj As ICameraPoint In objs
yRot.Add(obj.Rotation.Y)
Next
Return yRot.Average
End Function
Private Function GetSelectedObject() As ICameraPoint()
Dim e As New NeedSelectedObjectEventArgs
RaiseEvent NeedSelectedObject(e)
Dim stopw As New Stopwatch
stopw.Start()
Do Until e.HasObjectSetted OrElse stopw.ElapsedMilliseconds > 1000
Application.DoEvents()
Loop
stopw.Stop()
Return e.Points
End Function
'C A P S E L T C L A S S E S
Public Class NeedSelectedObjectEventArgs
Inherits EventArgs
Private _HasObjectSetted As Boolean = False
Public ReadOnly Property HasObjectSetted As Boolean
Get
Return _HasObjectSetted
End Get
End Property
Private _Points As ICameraPoint() = Nothing
Public Property Points As ICameraPoint()
Get
Return _Points
End Get
Set(value As ICameraPoint())
_Points = value
_HasObjectSetted = True
End Set
End Property
End Class
End Class
End Namespace

View File

@@ -0,0 +1,9 @@
Namespace CameraN
Public Enum CameraMode
FLY = 0
ORBIT = 1
LOOK_DIRECTION = 2
End Enum
End Namespace

View File

@@ -0,0 +1,10 @@
Namespace CameraN
Public Interface ICameraPoint
Property Position As Numerics.Vector3
Property Rotation As Numerics.Vector3
End Interface
End Namespace

View File

@@ -0,0 +1,12 @@
Namespace CameraN
Public Enum LookDirection
Top
Bottom
Left
Right
Front
Back
End Enum
End Namespace

View File

@@ -0,0 +1,120 @@
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Class ModelPreview
Inherits DevComponents.DotNetBar.OfficeForm
'Form overrides dispose to clean up the component list.
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(ModelPreview))
Me.PanelEx1 = New DevComponents.DotNetBar.PanelEx()
Me.PanelEx2 = New DevComponents.DotNetBar.PanelEx()
Me.DoubleInput1 = New DevComponents.Editors.DoubleInput()
Me.LabelX1 = New DevComponents.DotNetBar.LabelX()
Me.PanelEx2.SuspendLayout()
CType(Me.DoubleInput1, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'PanelEx1
'
Me.PanelEx1.CanvasColor = System.Drawing.Color.Empty
Me.PanelEx1.ColorSchemeStyle = DevComponents.DotNetBar.eDotNetBarStyle.StyleManagerControlled
Me.PanelEx1.DisabledBackColor = System.Drawing.Color.Empty
Me.PanelEx1.Dock = System.Windows.Forms.DockStyle.Fill
Me.PanelEx1.Location = New System.Drawing.Point(0, 47)
Me.PanelEx1.Name = "PanelEx1"
Me.PanelEx1.Size = New System.Drawing.Size(880, 491)
Me.PanelEx1.Style.Alignment = System.Drawing.StringAlignment.Center
Me.PanelEx1.Style.BorderColor.ColorSchemePart = DevComponents.DotNetBar.eColorSchemePart.PanelBorder
Me.PanelEx1.Style.ForeColor.ColorSchemePart = DevComponents.DotNetBar.eColorSchemePart.PanelText
Me.PanelEx1.Style.GradientAngle = 90
Me.PanelEx1.TabIndex = 0
'
'PanelEx2
'
Me.PanelEx2.CanvasColor = System.Drawing.Color.Empty
Me.PanelEx2.ColorSchemeStyle = DevComponents.DotNetBar.eDotNetBarStyle.StyleManagerControlled
Me.PanelEx2.Controls.Add(Me.DoubleInput1)
Me.PanelEx2.Controls.Add(Me.LabelX1)
Me.PanelEx2.DisabledBackColor = System.Drawing.Color.Empty
Me.PanelEx2.Dock = System.Windows.Forms.DockStyle.Top
Me.PanelEx2.Location = New System.Drawing.Point(0, 0)
Me.PanelEx2.Name = "PanelEx2"
Me.PanelEx2.Size = New System.Drawing.Size(880, 47)
Me.PanelEx2.Style.Alignment = System.Drawing.StringAlignment.Center
Me.PanelEx2.Style.BorderColor.ColorSchemePart = DevComponents.DotNetBar.eColorSchemePart.PanelBorder
Me.PanelEx2.Style.ForeColor.ColorSchemePart = DevComponents.DotNetBar.eColorSchemePart.PanelText
Me.PanelEx2.Style.GradientAngle = 90
Me.PanelEx2.TabIndex = 7
Me.PanelEx2.Visible = False
'
'DoubleInput1
'
'
'
'
Me.DoubleInput1.BackgroundStyle.Class = "DateTimeInputBackground"
Me.DoubleInput1.BackgroundStyle.CornerType = DevComponents.DotNetBar.eCornerType.Square
Me.DoubleInput1.ButtonFreeText.Shortcut = DevComponents.DotNetBar.eShortcut.F2
Me.DoubleInput1.Increment = 1.0R
Me.DoubleInput1.Location = New System.Drawing.Point(62, 13)
Me.DoubleInput1.Name = "DoubleInput1"
Me.DoubleInput1.ShowUpDown = True
Me.DoubleInput1.Size = New System.Drawing.Size(80, 20)
Me.DoubleInput1.TabIndex = 0
'
'LabelX1
'
'
'
'
Me.LabelX1.BackgroundStyle.CornerType = DevComponents.DotNetBar.eCornerType.Square
Me.LabelX1.Location = New System.Drawing.Point(12, 12)
Me.LabelX1.Name = "LabelX1"
Me.LabelX1.Size = New System.Drawing.Size(44, 23)
Me.LabelX1.TabIndex = 1
Me.LabelX1.Text = "Scaling:"
'
'ModelPreview
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(880, 538)
Me.Controls.Add(Me.PanelEx1)
Me.Controls.Add(Me.PanelEx2)
Me.DoubleBuffered = True
Me.EnableGlass = False
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.KeyPreview = True
Me.Name = "ModelPreview"
Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
Me.Text = "ModelPreview"
Me.TopLeftCornerSize = 0
Me.TopRightCornerSize = 0
Me.PanelEx2.ResumeLayout(False)
CType(Me.DoubleInput1, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Friend WithEvents PanelEx1 As DevComponents.DotNetBar.PanelEx
Friend WithEvents PanelEx2 As DevComponents.DotNetBar.PanelEx
Friend WithEvents DoubleInput1 As DevComponents.Editors.DoubleInput
Friend WithEvents LabelX1 As DevComponents.DotNetBar.LabelX
End Class

View File

@@ -0,0 +1,13 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On

View File

@@ -0,0 +1,10 @@
<?xml version="1.0" encoding="utf-8"?>
<MyApplicationData xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<MySubMain>false</MySubMain>
<SingleInstance>false</SingleInstance>
<ShutdownMode>0</ShutdownMode>
<EnableVisualStyles>true</EnableVisualStyles>
<AuthenticationMode>0</AuthenticationMode>
<ApplicationType>1</ApplicationType>
<SaveMySettingsOnExit>true</SaveMySettingsOnExit>
</MyApplicationData>

View File

@@ -0,0 +1,35 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' Allgemeine Informationen über eine Assembly werden über die folgenden
' Attribute gesteuert. Ändern Sie diese Attributwerte, um die Informationen zu ändern,
' die einer Assembly zugeordnet sind.
' Werte der Assemblyattribute überprüfen
<Assembly: AssemblyTitle("OpenGLRenderer")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("Pilzinsel64")>
<Assembly: AssemblyProduct("OpenGLRenderer")>
<Assembly: AssemblyCopyright("Copyright © Pilzinsel64 2018")>
<Assembly: AssemblyTrademark("")>
<Assembly: ComVisible(False)>
'Die folgende GUID bestimmt die ID der Typbibliothek, wenn dieses Projekt für COM verfügbar gemacht wird.
<Assembly: Guid("03d57392-1aac-468d-b5c9-30d927e685b5")>
' Versionsinformationen für eine Assembly bestehen aus den folgenden vier Werten:
'
' Hauptversion
' Nebenversion
' Buildnummer
' Revision
'
' Sie können alle Werte angeben oder Standardwerte für die Build- und Revisionsnummern verwenden,
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.0.0.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")>

View File

@@ -0,0 +1,63 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Imports System
Namespace My.Resources
'Diese Klasse wurde von der StronglyTypedResourceBuilder automatisch generiert
'-Klasse über ein Tool wie ResGen oder Visual Studio automatisch generiert.
'Um einen Member hinzuzufügen oder zu entfernen, bearbeiten Sie die .ResX-Datei und führen dann ResGen
'mit der /str-Option erneut aus, oder Sie erstellen Ihr VS-Projekt neu.
'''<summary>
''' Eine stark typisierte Ressourcenklasse zum Suchen von lokalisierten Zeichenfolgen usw.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "15.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo
'''<summary>
''' Gibt die zwischengespeicherte ResourceManager-Instanz zurück, die von dieser Klasse verwendet wird.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If Object.ReferenceEquals(resourceMan, Nothing) Then
Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("Pilz.Drawing.Drawing3D.OpenGLFactory.Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Überschreibt die CurrentUICulture-Eigenschaft des aktuellen Threads für alle
''' Ressourcenzuordnungen, die diese stark typisierte Ressourcenklasse verwenden.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set
resourceCulture = value
End Set
End Property
End Module
End Namespace

View File

@@ -0,0 +1,117 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>

View File

@@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "15.9.0.0"), _
Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Partial Friend NotInheritable Class MySettings
Inherits Global.System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings()),MySettings)
#Region "Automatische My.Settings-Speicherfunktion"
#If _MyType = "WindowsForms" Then
Private Shared addedHandler As Boolean
Private Shared addedHandlerLockObject As New Object
<Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Private Shared Sub AutoSaveSettings(sender As Global.System.Object, e As Global.System.EventArgs)
If My.Application.SaveMySettingsOnExit Then
My.Settings.Save()
End If
End Sub
#End If
#End Region
Public Shared ReadOnly Property [Default]() As MySettings
Get
#If _MyType = "WindowsForms" Then
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
#End If
Return defaultInstance
End Get
End Property
End Class
End Namespace
Namespace My
<Global.Microsoft.VisualBasic.HideModuleNameAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Module MySettingsProperty
<Global.System.ComponentModel.Design.HelpKeywordAttribute("My.Settings")> _
Friend ReadOnly Property Settings() As Global.Pilz.Drawing.Drawing3D.OpenGLFactory.My.MySettings
Get
Return Global.Pilz.Drawing.Drawing3D.OpenGLFactory.My.MySettings.Default
End Get
End Property
End Module
End Namespace

View File

@@ -0,0 +1,7 @@
<?xml version='1.0' encoding='utf-8'?>
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles>
<Profile Name="(Default)" />
</Profiles>
<Settings />
</SettingsFile>

View File

@@ -0,0 +1,25 @@
<configuration>
<dllmap os="linux" dll="opengl32.dll" target="libGL.so.1"/>
<dllmap os="linux" dll="glu32.dll" target="libGLU.so.1"/>
<dllmap os="linux" dll="openal32.dll" target="libopenal.so.1"/>
<dllmap os="linux" dll="alut.dll" target="libalut.so.0"/>
<dllmap os="linux" dll="opencl.dll" target="libOpenCL.so"/>
<dllmap os="linux" dll="libX11" target="libX11.so.6"/>
<dllmap os="linux" dll="libXi" target="libXi.so.6"/>
<dllmap os="linux" dll="SDL2.dll" target="libSDL2-2.0.so.0"/>
<dllmap os="osx" dll="opengl32.dll" target="/System/Library/Frameworks/OpenGL.framework/OpenGL"/>
<dllmap os="osx" dll="openal32.dll" target="/System/Library/Frameworks/OpenAL.framework/OpenAL" />
<dllmap os="osx" dll="alut.dll" target="/System/Library/Frameworks/OpenAL.framework/OpenAL" />
<dllmap os="osx" dll="libGLES.dll" target="/System/Library/Frameworks/OpenGLES.framework/OpenGLES" />
<dllmap os="osx" dll="libGLESv1_CM.dll" target="/System/Library/Frameworks/OpenGLES.framework/OpenGLES" />
<dllmap os="osx" dll="libGLESv2.dll" target="/System/Library/Frameworks/OpenGLES.framework/OpenGLES" />
<dllmap os="osx" dll="opencl.dll" target="/System/Library/Frameworks/OpenCL.framework/OpenCL"/>
<dllmap os="osx" dll="SDL2.dll" target="libSDL2.dylib"/>
<!-- XQuartz compatibility (X11 on Mac) -->
<dllmap os="osx" dll="libGL.so.1" target="/usr/X11/lib/libGL.dylib"/>
<dllmap os="osx" dll="libX11" target="/usr/X11/lib/libX11.dylib"/>
<dllmap os="osx" dll="libXcursor.so.1" target="/usr/X11/lib/libXcursor.dylib"/>
<dllmap os="osx" dll="libXi" target="/usr/X11/lib/libXi.dylib"/>
<dllmap os="osx" dll="libXinerama" target="/usr/X11/lib/libXinerama.dylib"/>
<dllmap os="osx" dll="libXrandr.so.2" target="/usr/X11/lib/libXrandr.dylib"/>
</configuration>

View File

@@ -0,0 +1,142 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="15.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProjectGuid>{5E9F0B0A-F7B8-49A9-80FC-6DFE0D44CC84}</ProjectGuid>
<OutputType>Library</OutputType>
<RootNamespace>Pilz.Drawing.Drawing3D.OpenGLFactory</RootNamespace>
<AssemblyName>Pilz.Drawing.Drawing3D.OpenGLFactory</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Windows</MyType>
<TargetFrameworkVersion>v4.5</TargetFrameworkVersion>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>Pilz.Drawing.Drawing3D.OpenGLFactory.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>Pilz.Drawing.Drawing3D.OpenGLFactory.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup>
<OptionExplicit>On</OptionExplicit>
</PropertyGroup>
<PropertyGroup>
<OptionCompare>Binary</OptionCompare>
</PropertyGroup>
<PropertyGroup>
<OptionStrict>Off</OptionStrict>
</PropertyGroup>
<PropertyGroup>
<OptionInfer>On</OptionInfer>
</PropertyGroup>
<ItemGroup>
<Reference Include="OpenTK, Version=3.0.1.0, Culture=neutral, PublicKeyToken=bad199fe84eb3df4, processorArchitecture=MSIL">
<HintPath>..\packages\OpenTK.3.0.1\lib\net20\OpenTK.dll</HintPath>
</Reference>
<Reference Include="OpenTK.GLControl, Version=3.0.1.0, Culture=neutral, PublicKeyToken=bad199fe84eb3df4, processorArchitecture=MSIL">
<HintPath>..\packages\OpenTK.GLControl.3.0.1\lib\net20\OpenTK.GLControl.dll</HintPath>
</Reference>
<Reference Include="PresentationCore" />
<Reference Include="System" />
<Reference Include="System.Data" />
<Reference Include="System.Drawing" />
<Reference Include="System.Numerics" />
<Reference Include="System.Numerics.Vectors, Version=4.1.4.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a, processorArchitecture=MSIL">
<HintPath>..\packages\System.Numerics.Vectors.4.5.0\lib\portable-net45+win8+wp8+wpa81\System.Numerics.Vectors.dll</HintPath>
</Reference>
<Reference Include="System.Windows.Forms" />
<Reference Include="System.Xml" />
<Reference Include="System.Core" />
<Reference Include="System.Xml.Linq" />
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="System.Net.Http" />
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Collections.Generic" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
<Import Include="System.Linq" />
<Import Include="System.Xml.Linq" />
<Import Include="System.Threading.Tasks" />
</ItemGroup>
<ItemGroup>
<Compile Include="Camera\Camera.vb" />
<Compile Include="Camera\CameraMode.vb" />
<Compile Include="Camera\LookDirection.vb" />
<Compile Include="Preview\ModelPreview.Designer.vb">
<DependentUpon>ModelPreview.vb</DependentUpon>
</Compile>
<Compile Include="Preview\ModelPreview.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Rendering\BoundingBox.vb" />
<Compile Include="Camera\CameraPoint.vb" />
<Compile Include="Rendering\ContentPipe.vb" />
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
</Compile>
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>Resources.resx</DependentUpon>
</Compile>
<Compile Include="My Project\Settings.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
<Compile Include="Rendering\Renderer.vb" />
<Compile Include="Rendering\RenderMode.vb" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="My Project\Resources.resx">
<Generator>VbMyResourcesResXFileCodeGenerator</Generator>
<LastGenOutput>Resources.Designer.vb</LastGenOutput>
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<SubType>Designer</SubType>
</EmbeddedResource>
<EmbeddedResource Include="Preview\ModelPreview.resx">
<DependentUpon>ModelPreview.vb</DependentUpon>
</EmbeddedResource>
</ItemGroup>
<ItemGroup>
<None Include="app.config" />
<None Include="My Project\Application.myapp">
<Generator>MyApplicationCodeGenerator</Generator>
<LastGenOutput>Application.Designer.vb</LastGenOutput>
</None>
<None Include="My Project\Settings.settings">
<Generator>SettingsSingleFileGenerator</Generator>
<CustomToolNamespace>My</CustomToolNamespace>
<LastGenOutput>Settings.Designer.vb</LastGenOutput>
</None>
<None Include="OpenTK.dll.config" />
<None Include="packages.config" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Pilz.Simple3DFileParser\Pilz.Simple3DFileParser.vbproj">
<Project>{ac955819-7910-450c-940c-7c1989483d4b}</Project>
<Name>Pilz.Simple3DFileParser</Name>
</ProjectReference>
</ItemGroup>
<ItemGroup />
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>

View File

@@ -0,0 +1,42 @@
Namespace PreviewN
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Class ModelPreview
Inherits System.Windows.Forms.Form
'Form overrides dispose to clean up the component list.
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(ModelPreview))
Me.SuspendLayout()
'
'ModelPreview
'
Me.ClientSize = New System.Drawing.Size(880, 538)
Me.DoubleBuffered = True
Me.Name = "ModelPreview"
Me.Text = "ModelPreview"
Me.ResumeLayout(False)
End Sub
End Class
End Namespace

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,341 @@
Imports System.Drawing
Imports System.Windows.Forms
Imports Pilz.Drawing.Drawing3D.OpenGLFactory.CameraN
Imports Pilz.Drawing.Drawing3D.OpenGLFactory.RenderingN
Imports OpenTK
Imports OpenTK.Graphics.OpenGL
Imports Pilz.S3DFileParser
Imports Point = System.Drawing.Point
Namespace PreviewN
Public Class ModelPreview
Public Event WandUpdateView()
Private WithEvents glControl1 As GLControl
Private WithEvents MyCamera As New Camera
Private ProjMatrix As Matrix4 = Nothing
Private FOV As Single = 1.048F
Private camMtx As Matrix4 = Matrix4.Identity
Private savedCamPos As New Vector3
Private _isMouseDown As Boolean = False
Private myPressedKeys As New List(Of Keys)
Private isDeactivated As Boolean = False
Private ReadOnly myModels As New Dictionary(Of Object3D, Renderer)
Public Property RenderWhenWindowsIsInactive As Boolean = False
Public Property EnableCameraControlling As Boolean = True
Public Property Scaling As Single = 500.0F
Public Property ClearColor As Color = Color.CornflowerBlue
Public ReadOnly Property PressedKeys As IReadOnlyList(Of Keys)
Get
Return myPressedKeys
End Get
End Property
Public ReadOnly Property Camera As Camera
Get
Return MyCamera
End Get
End Property
Public ReadOnly Property CameraMatrix As Matrix4
Get
Return camMtx
End Get
End Property
Public ReadOnly Property Models As IReadOnlyDictionary(Of Object3D, Renderer)
Get
Return myModels
End Get
End Property
Private ReadOnly Property IsStrgPressed As Boolean
Get
Return myPressedKeys.Contains(Keys.ControlKey)
End Get
End Property
Private ReadOnly Property IsShiftPressed As Boolean
Get
Return myPressedKeys.Contains(Keys.ShiftKey)
End Get
End Property
Public Property IsMouseDown As Boolean
Get
Return _isMouseDown
End Get
Set(value As Boolean)
_isMouseDown = value
glControl1.Refresh()
End Set
End Property
Public Sub New()
Me.New({}, 1.0F)
End Sub
Public Sub New(obj As Object3D)
Me.New(obj, 1.0F)
End Sub
Public Sub New(obj As Object3D, scale As Single)
Me.New({obj}, scale)
End Sub
Public Sub New(objs As Object3D(), scale As Single)
Me.SuspendLayout()
InitializeComponent()
DoubleBuffered = True
'glControl1
Me.glControl1 = New GLControl
Me.glControl1.BackColor = Color.Black
Me.glControl1.Location = New Point(0, 0)
Me.glControl1.MinimumSize = New Size(600, 120)
Me.glControl1.Name = "glControl1"
Me.glControl1.Anchor = AnchorStyles.Left Or AnchorStyles.Top Or AnchorStyles.Right Or AnchorStyles.Bottom
Me.glControl1.Location = New Point(0, 0)
Me.glControl1.Size = Me.ClientSize
Me.glControl1.TabIndex = 0
Me.glControl1.TabStop = False
Me.glControl1.VSync = False
Me.Controls.Add(Me.glControl1)
Me.ResumeLayout(False)
AddHandler Windows.Media.CompositionTarget.Rendering, AddressOf CompositionTarget_Rendering
Scaling = scale
'Toolkit.Init()
glControl1.CreateControl()
AddHandler glControl1.MouseWheel, AddressOf glControl1_Wheel
ProjMatrix = Matrix4.CreatePerspectiveFieldOfView(FOV, glControl1.Width / glControl1.Height, 100.0F, 100000.0F)
glControl1.Enabled = False
MyCamera.SetCameraMode(CameraMode.FLY, camMtx)
MyCamera.UpdateMatrix(camMtx)
Me.ResumeLayout()
For Each obj As Object3D In objs
AddModel(obj)
Next
End Sub
Public Sub UpdateOrbitCamera()
If Camera.IsOrbitCamera Then
Camera.UpdateOrbitCamera(camMtx)
End If
End Sub
Public Sub UpdateView()
glControl1.Invalidate()
'glControl1.Update()
End Sub
Public Function AddModel(obj As Object3D) As Renderer
Dim rndr As New Renderer(obj)
AddModel(rndr)
Return rndr
End Function
Public Sub AddModel(rndr As Renderer)
myModels.Add(rndr.Model, rndr)
End Sub
Public Sub HandlesOnShown(sender As Object, e As EventArgs) Handles MyBase.Shown
glControl1.Enabled = True
RenderModels()
glControl1.Invalidate()
End Sub
Public Sub RenderModels()
For Each rndr As Renderer In myModels.Values
RenderModel(rndr)
Next
End Sub
Public Sub RenderModel(rndr As Renderer)
If myModels.Values.Contains(rndr) Then
rndr.ModelScaling = Scaling
rndr.RenderModel()
End If
End Sub
Private Sub glControl1_Load(sender As Object, e As EventArgs) Handles glControl1.Load
GL.Enable(EnableCap.Blend)
GL.BlendFunc(BlendingFactor.SrcAlpha, BlendingFactor.OneMinusSrcAlpha)
GL.Enable(EnableCap.DepthTest)
GL.DepthFunc(DepthFunction.Lequal)
GL.Enable(EnableCap.Texture2D)
GL.Enable(EnableCap.AlphaTest)
GL.AlphaFunc(AlphaFunction.Gequal, 0.5F)
GL.Enable(EnableCap.CullFace)
End Sub
Public Sub HandlesOnActivated(sender As Object, e As EventArgs) Handles Me.Activated
If isDeactivated Then
isDeactivated = False
End If
End Sub
Public Sub HandlesOnDeactivate(sender As Object, e As EventArgs) Handles Me.Deactivate
isDeactivated = True
End Sub
Private Sub CompositionTarget_Rendering(sender As Object, e As EventArgs)
If Not isDeactivated OrElse RenderWhenWindowsIsInactive Then
RaiseEvent WandUpdateView()
glControl1.Invalidate()
End If
End Sub
Public Sub HandlesOnPaint(sender As Object, e As PaintEventArgs) Handles glControl1.Paint
If EnableCameraControlling Then
MoveCameraViaWASDQE()
End If
GL.ClearColor(ClearColor)
GL.Clear(ClearBufferMask.ColorBufferBit Or ClearBufferMask.DepthBufferBit)
GL.MatrixMode(MatrixMode.Projection)
GL.LoadMatrix(ProjMatrix)
GL.MatrixMode(MatrixMode.Modelview)
GL.LoadMatrix(camMtx)
For Each rndr As Renderer In myModels.Values
If rndr.HasRendered Then
rndr.DrawModel(RenderMode.FillOutline)
End If
Next
glControl1.SwapBuffers()
'If Not IsMouseDown AndAlso obj3d IsNot Nothing Then
' e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
' e.Graphics.DrawString(GetModelInfoAsString, New Font(FontFamily.GenericSerif, 10), New SolidBrush(Panel1.ForeColor), New Drawing.Point(10, 10))
'End If
End Sub
Private Function GetModelInfoAsString() As String
Dim matsCount As Long = 0
Dim facesCount As Long = 0
Dim vertsCount As Long = 0
Dim vcCount As Long = 0
Dim uvCount As Long = 0
For Each obj3d As Object3D In myModels.Keys
matsCount += obj3d.Materials.Count
For Each m As Mesh In obj3d.Meshes
vertsCount += m.Vertices.Count
facesCount += m.Faces.Count
vcCount += m.VertexColors.Count
uvCount += m.UVs.Count
Next
Next
Return String.Format("Materials:{0}{1}
Faces:{0}{0}{2}
Vertices:{0}{3}
Vertex Colors{0}{4}
UVs:{0}{0}{5}",
vbTab, matsCount, facesCount, vertsCount, vcCount, uvCount)
End Function
Private Sub glControl1_Resize(sender As Object, e As EventArgs) Handles glControl1.Resize
glControl1.Context.Update(glControl1.WindowInfo)
GL.Viewport(0, 0, glControl1.Width, glControl1.Height)
ProjMatrix = Matrix4.CreatePerspectiveFieldOfView(FOV, glControl1.Width / glControl1.Height, 100.0F, 100000.0F)
glControl1.Invalidate()
End Sub
Private Sub glControl1_Wheel(sender As Object, e As MouseEventArgs)
MyCamera.ResetMouseStuff()
MyCamera.UpdateCameraMatrixWithScrollWheel(CInt(Math.Truncate(e.Delta * (If(IsShiftPressed, 3.5F, 1.5F)))), camMtx)
savedCamPos = MyCamera.Position
glControl1.Invalidate()
End Sub
Private Sub glControl1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles glControl1.MouseDown
IsMouseDown = True
savedCamPos = MyCamera.Position
End Sub
Private Sub glControl1_MouseLeave(ByVal sender As Object, ByVal e As EventArgs) Handles glControl1.MouseLeave, glControl1.MouseUp
MyCamera.ResetMouseStuff()
IsMouseDown = False
End Sub
Private Sub glControl1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles glControl1.MouseMove
If IsMouseDown AndAlso e.Button = MouseButtons.Left Then
If IsShiftPressed Then
MyCamera.UpdateCameraOffsetWithMouse(savedCamPos, e.X, e.Y, glControl1.Width, glControl1.Height, camMtx)
Else
MyCamera.UpdateCameraMatrixWithMouse(e.X, e.Y, camMtx)
End If
glControl1.Invalidate()
End If
End Sub
Public Sub HandlesOnKeyDown(sender As Object, e As KeyEventArgs) Handles glControl1.KeyDown
If Not myPressedKeys.Contains(e.KeyCode) Then myPressedKeys.Add(e.KeyCode)
End Sub
Public Sub HandlesOnKeyUp(sender As Object, e As KeyEventArgs) Handles MyBase.KeyUp
If myPressedKeys.Contains(e.KeyCode) Then myPressedKeys.Remove(e.KeyCode)
End Sub
Public Sub MoveCameraViaWASDQE()
Dim moveSpeed As Integer = Convert.ToInt32(Math.Round((If(IsShiftPressed, 60, 30)) * (MyCamera.CamSpeedMultiplier), 0))
Dim allowCamMove As Boolean = Not (IsMouseDown AndAlso IsShiftPressed)
For Each k As Keys In myPressedKeys
If allowCamMove Then
Select Case k
Case Keys.W
'camera.Move(moveSpeed, moveSpeed, camMtx)
MyCamera.UpdateCameraMatrixWithScrollWheel(moveSpeed, camMtx)
savedCamPos = MyCamera.Position
Case Keys.S
'camera.Move(-moveSpeed, -moveSpeed, camMtx)
MyCamera.UpdateCameraMatrixWithScrollWheel(-moveSpeed, camMtx)
savedCamPos = MyCamera.Position
Case Keys.A
'camera.Move(-moveSpeed, 0, camMtx)
MyCamera.UpdateCameraOffsetDirectly(-moveSpeed, 0, camMtx)
Case Keys.D
'camera.Move(moveSpeed, 0, camMtx)
MyCamera.UpdateCameraOffsetDirectly(moveSpeed, 0, camMtx)
Case Keys.E
'camera.Move(0, -moveSpeed, camMtx)
MyCamera.UpdateCameraOffsetDirectly(0, -moveSpeed, camMtx)
Case Keys.Q
'camera.Move(0, moveSpeed, camMtx)
MyCamera.UpdateCameraOffsetDirectly(0, moveSpeed, camMtx)
End Select
End If
Next
End Sub
Private Sub Camera_NeedSelectedObject(e As Camera.NeedSelectedObjectEventArgs) Handles MyCamera.NeedSelectedObject
e.Points = Nothing
End Sub
Private Sub ModelPreview_FormDisposed(sender As Object, e As EventArgs) Handles Me.Disposed
For Each rndr As Renderer In myModels.Values
rndr.ReleaseBuffers()
Next
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,105 @@
Imports System.Drawing
Imports OpenTK
Imports OpenTK.Graphics.OpenGL
Namespace RenderingN
Public Class BoundingBox
Public Shared Sub DrawSolid(scale As System.Numerics.Vector3, rot As System.Numerics.Quaternion, pos As System.Numerics.Vector3, color As Color, upper As System.Numerics.Vector3, lower As System.Numerics.Vector3)
GL.Disable(EnableCap.Blend)
GL.Disable(EnableCap.Texture2D)
GL.Disable(EnableCap.AlphaTest)
GL.PushMatrix()
GL.Translate(pos.X, pos.Y, pos.Z)
GL.Rotate(rot.X, 1, 0, 0)
GL.Rotate(rot.Y, 0, 1, 0)
GL.Rotate(rot.Z, 0, 0, 1)
GL.Scale(scale.X, scale.Y, scale.Z)
GL.Begin(PrimitiveType.Quads)
GL.Color4(color)
GL.Vertex3(upper.X, upper.Y, lower.Z) ' Top-right of top face
GL.Vertex3(lower.X, upper.Y, lower.Z) ' Top-left of top face
GL.Vertex3(lower.X, upper.Y, upper.Z) ' Bottom-left of top face
GL.Vertex3(upper.X, upper.Y, upper.Z) ' Bottom-right of top face
GL.Vertex3(upper.X, lower.Y, lower.Z) ' Top-right of bottom face
GL.Vertex3(lower.X, lower.Y, lower.Z) ' Top-left of bottom face
GL.Vertex3(lower.X, lower.Y, upper.Z) ' Bottom-left of bottom face
GL.Vertex3(upper.X, lower.Y, upper.Z) ' Bottom-right of bottom face
GL.Vertex3(upper.X, upper.Y, upper.Z) ' Top-Right of front face
GL.Vertex3(lower.X, upper.Y, upper.Z) ' Top-left of front face
GL.Vertex3(lower.X, lower.Y, upper.Z) ' Bottom-left of front face
GL.Vertex3(upper.X, lower.Y, upper.Z) ' Bottom-right of front face
GL.Vertex3(upper.X, lower.Y, lower.Z) ' Bottom-Left of back face
GL.Vertex3(lower.X, lower.Y, lower.Z) ' Bottom-Right of back face
GL.Vertex3(lower.X, upper.Y, lower.Z) ' Top-Right of back face
GL.Vertex3(upper.X, upper.Y, lower.Z) ' Top-Left of back face
GL.Vertex3(lower.X, upper.Y, upper.Z) ' Top-Right of left face
GL.Vertex3(lower.X, upper.Y, lower.Z) ' Top-Left of left face
GL.Vertex3(lower.X, lower.Y, lower.Z) ' Bottom-Left of left face
GL.Vertex3(lower.X, lower.Y, upper.Z) ' Bottom-Right of left face
GL.Vertex3(upper.X, upper.Y, upper.Z) ' Top-Right of left face
GL.Vertex3(upper.X, upper.Y, lower.Z) ' Top-Left of left face
GL.Vertex3(upper.X, lower.Y, lower.Z) ' Bottom-Left of left face
GL.Vertex3(upper.X, lower.Y, upper.Z) ' Bottom-Right of left face
GL.Color4(Color.White)
GL.End()
GL.PopMatrix()
GL.Enable(EnableCap.Blend)
GL.Enable(EnableCap.Texture2D)
GL.Enable(EnableCap.AlphaTest)
End Sub
Public Shared Sub Draw(scale As Numerics.Vector3, rot As Numerics.Quaternion, pos As Numerics.Vector3, color As Color, upper As Numerics.Vector3, lower As Numerics.Vector3)
GL.Disable(EnableCap.Blend)
GL.Disable(EnableCap.Texture2D)
GL.Disable(EnableCap.AlphaTest)
GL.PushMatrix()
GL.Translate(pos.X, pos.Y, pos.Z)
GL.Rotate(rot.X, 1, 0, 0)
GL.Rotate(rot.Y, 0, 1, 0)
GL.Rotate(rot.Z, 0, 0, 1)
GL.Scale(scale.X, scale.Y, scale.Z)
GL.Begin(PrimitiveType.LineLoop)
GL.Color4(color)
GL.Vertex3(upper.X, upper.Y, lower.Z) ' 1
GL.Vertex3(lower.X, upper.Y, lower.Z) ' 2
GL.Vertex3(lower.X, upper.Y, upper.Z) ' 3
GL.Vertex3(upper.X, upper.Y, lower.Z) ' 1
GL.Vertex3(upper.X, upper.Y, upper.Z) ' 4
GL.Vertex3(lower.X, upper.Y, upper.Z) ' 3
GL.Vertex3(lower.X, lower.Y, upper.Z) ' 7
GL.Vertex3(lower.X, lower.Y, lower.Z) ' 6
GL.Vertex3(upper.X, lower.Y, lower.Z) ' 5
GL.Vertex3(lower.X, lower.Y, upper.Z) ' 7
GL.Vertex3(upper.X, lower.Y, upper.Z) ' 8
GL.Vertex3(upper.X, lower.Y, lower.Z) ' 5
GL.Vertex3(lower.X, upper.Y, lower.Z) ' 2
GL.Vertex3(lower.X, lower.Y, lower.Z) ' 6
GL.Vertex3(lower.X, upper.Y, upper.Z) ' 3
GL.Vertex3(upper.X, lower.Y, upper.Z) ' 8
GL.Vertex3(upper.X, upper.Y, upper.Z) ' 4
GL.Vertex3(upper.X, lower.Y, lower.Z) ' 5
GL.Color4(Color.White)
GL.End()
GL.PopMatrix()
GL.Enable(EnableCap.Blend)
GL.Enable(EnableCap.Texture2D)
GL.Enable(EnableCap.AlphaTest)
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,33 @@
Imports System
Imports OpenTK
Imports OpenTK.Graphics.OpenGL
Imports System.Drawing
Imports System.Drawing.Imaging
Namespace RenderingN
Public Class ContentPipe
Public Shared Function LoadTexture(filepath As String) As Integer
Dim bitmap As New Bitmap(filepath)
Return LoadTexture(bitmap)
End Function
Public Shared Function LoadTexture(bitmap As Bitmap) As Integer
Dim id As Integer = GL.GenTexture()
LoadTexture(bitmap, id)
Return id
End Function
Public Shared Sub LoadTexture(bitmap As Bitmap, id As Integer)
Dim bmpData As BitmapData = bitmap.LockBits(New Rectangle(0, 0, bitmap.Width, bitmap.Height), ImageLockMode.ReadOnly, Imaging.PixelFormat.Format32bppArgb)
GL.BindTexture(TextureTarget.Texture2D, id)
GL.TexImage2D(TextureTarget.Texture2D, 0, PixelInternalFormat.Rgba, bitmap.Width, bitmap.Height, 0, OpenTK.Graphics.OpenGL.PixelFormat.Bgra, PixelType.UnsignedByte, bmpData.Scan0)
bitmap.UnlockBits(bmpData)
GL.TexParameter(TextureTarget.Texture2D, TextureParameterName.TextureMinFilter, CInt(Math.Truncate(TextureMinFilter.Linear)))
GL.TexParameter(TextureTarget.Texture2D, TextureParameterName.TextureMagFilter, CInt(Math.Truncate(TextureMagFilter.Linear)))
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,10 @@
Namespace RenderingN
Public Enum RenderMode As Byte
None = &H0
Fill = &H1
Outline = &H2
FillOutline = Fill Or Outline
End Enum
End Namespace

View File

@@ -0,0 +1,456 @@
Imports System.Drawing
Imports System.Threading
Imports System.Windows.Forms
Imports OpenTK
Imports OpenTK.Graphics.OpenGL
Imports Pilz.S3DFileParser
Namespace RenderingN
Public Class Renderer
Private obj3d As Object3D
Private dicTextureIDs As New Dictionary(Of Image, Integer)
Private dicColorIDs As New Dictionary(Of Color, Integer)
Private emptyTexture As Bitmap = Nothing
Private lineTexture As Bitmap = Nothing
Private selectedLineTexture As Bitmap = Nothing
Public Property ModelScaling As Single = 1.0F
Public ReadOnly Property HasRendered As Boolean = False
Public ReadOnly Property SelectedElements As List(Of Object)
Private ReadOnly Property VertexBuffers As New Dictionary(Of Mesh, Integer)
Private ReadOnly Property IndicesBuffers As New Dictionary(Of Mesh, List(Of Integer))
Private ReadOnly Property UVBuffers As New Dictionary(Of Mesh, Integer)
Private ReadOnly Property VertexColorBuffers As New Dictionary(Of Mesh, Integer)
Private ReadOnly Property NormalBuffers As New Dictionary(Of Mesh, Integer)
Public ReadOnly Property Model As Object3D
Get
Return obj3d
End Get
End Property
Public Sub New(obj3d As Object3D)
Me.obj3d = obj3d.ToOneMesh
'Set Texture used for faces without texture
emptyTexture = ColorToTexture(Color.LightGray)
'Set Texture used for lines
lineTexture = ColorToTexture(Color.Black)
'Set Texture used for lines of selected faces
selectedLineTexture = ColorToTexture(Color.Orange)
End Sub
Private Function ColorToTexture(color As Color) As Image
Dim tex As New Bitmap(1, 1)
tex.SetPixel(0, 0, color)
Return tex
End Function
''' <summary>
''' Updates the Data of a Vertex in the buffer.
''' </summary>
''' <param name="m">The Mesh where the Vertex is listed.</param>
''' <param name="v">The Vertex to update.</param>
Public Sub UpdateVertexData(m As Mesh, v As Vertex)
GL.BindBuffer(BufferTarget.ArrayBuffer, VertexBuffers(m))
GL.BufferSubData(BufferTarget.ArrayBuffer, CType(m.Vertices.IndexOf(v) * Vector3.SizeInBytes, IntPtr), Vector3.SizeInBytes, New Vector3(v.X, v.Y, v.Z))
End Sub
''' <summary>
''' Updates the Data of a Normal in the buffer.
''' </summary>
''' <param name="m">The Mesh where the Vertex is listed.</param>
''' <param name="n">The Normal to update.</param>
Public Sub UpdateNormalData(m As Mesh, n As Normal)
GL.BindBuffer(BufferTarget.ArrayBuffer, NormalBuffers(m))
GL.BufferSubData(BufferTarget.ArrayBuffer, CType(m.Normals.IndexOf(n) * Vector3.SizeInBytes, IntPtr), Vector3.SizeInBytes, New Vector3(n.X, n.Y, n.Z))
End Sub
''' <summary>
''' Updates the Data of a Vertex Color in the buffer.
''' </summary>
''' <param name="m">The Mesh where the Vertex is listed.</param>
''' <param name="vc">The Vertex Color to update.</param>
Public Sub UpdateVertexColorData(m As Mesh, vc As VertexColor)
GL.BindBuffer(BufferTarget.ArrayBuffer, VertexColorBuffers(m))
GL.BufferSubData(BufferTarget.ArrayBuffer, CType(m.VertexColors.IndexOf(vc) * Vector4.SizeInBytes, IntPtr), Vector4.SizeInBytes, New Vector4(vc.R, vc.G, vc.B, vc.A))
End Sub
''' <summary>
''' Updates the Data of a UV in the buffer.
''' </summary>
''' <param name="m">The Mesh where the Vertex is listed.</param>
''' <param name="uv">The UV to update.</param>
Public Sub UpdateUVData(m As Mesh, uv As UV)
GL.BindBuffer(BufferTarget.ArrayBuffer, UVBuffers(m))
GL.BufferSubData(BufferTarget.ArrayBuffer, CType(m.UVs.IndexOf(uv) * Vector2.SizeInBytes, IntPtr), Vector2.SizeInBytes, New Vector2(uv.U, uv.V))
End Sub
''' <summary>
''' Updates the indicies of a face in the buffer.
''' </summary>
''' <param name="m">The Mesh where the Vertex is listed.</param>
''' <param name="f">The Face to update.</param>
Public Sub UpdateFaceIndicies(m As Mesh, f As Face)
Dim faceIndex As Integer = m.Faces.IndexOf(f)
Dim uintlen As Byte = Len(New UInteger)
Dim indicies As New Vector3(m.Vertices.IndexOf(f.Points(0).Vertex),
m.Vertices.IndexOf(f.Points(1).Vertex),
m.Vertices.IndexOf(f.Points(2).Vertex))
GL.BindBuffer(BufferTarget.ArrayBuffer, IndicesBuffers(m)(faceIndex))
GL.BufferSubData(BufferTarget.ArrayBuffer, CType(uintlen * faceIndex, IntPtr), uintlen, indicies)
End Sub
''' <summary>
''' Replace an Image with a new one.
''' </summary>
''' <param name="oldImage"></param>
''' <param name="newImage"></param>
Public Sub UpdateTexture(oldImage As Image, newImage As Image)
If dicTextureIDs.ContainsKey(oldImage) Then
Dim id As Integer = dicTextureIDs(oldImage)
dicTextureIDs.Remove(oldImage)
dicTextureIDs.Add(newImage, id)
ContentPipe.LoadTexture(newImage, id)
End If
End Sub
''' <summary>
''' Updates an Image.
''' </summary>
''' <param name="image"></param>
Public Sub UpdateTexture(image As Image)
If dicTextureIDs.ContainsKey(image) Then
ContentPipe.LoadTexture(dicTextureIDs(image))
End If
End Sub
''' <summary>
''' Creates the Buffers and store the requied Data.
''' </summary>
Public Sub RenderModel()
ReleaseBuffers()
For Each mesh As Mesh In obj3d.Meshes
Dim nibo As New List(Of Integer)
Dim enablecols As Boolean = mesh.VertexColors.Count > 0
Dim enablenorms As Boolean = (Not enablecols) AndAlso mesh.Normals.Count > 0
Dim verts As New List(Of Vector3)
Dim uvs As New List(Of Vector2)
Dim cols As New List(Of Vector4)
Dim norms As New List(Of Vector3)
Dim curvi As ULong = 0
IndicesBuffers.Add(mesh, nibo)
For i As Integer = 0 To mesh.Faces.Count - 1
With mesh.Faces(i)
Dim indices As New List(Of UInteger)
For Each p As S3DFileParser.Point In .Points
indices.Add(curvi)
curvi += 1
If verts IsNot Nothing Then
verts.Add(New Vector3(p.Vertex.X, p.Vertex.Y, p.Vertex.Z))
Else
verts.Add(New Vector3(0, 0, 0))
End If
If p.UV IsNot Nothing Then
uvs.Add(New Vector2(p.UV.U, p.UV.V))
Else
uvs.Add(New Vector2(0, 0))
End If
If enablecols AndAlso p.VertexColor IsNot Nothing Then
cols.Add(New Vector4(p.VertexColor.R, p.VertexColor.G, p.VertexColor.B, p.VertexColor.A))
Else
cols.Add(New Vector4(1, 1, 1, 1))
End If
If enablenorms AndAlso p.Normal IsNot Nothing Then
norms.Add(New Vector3(p.Normal.X, p.Normal.Y, p.Normal.Z))
Else
norms.Add(New Vector3(1, 1, 1))
End If
Next
nibo.Add(GL.GenBuffer)
GL.BindBuffer(BufferTarget.ElementArrayBuffer, nibo(i))
GL.BufferData(
BufferTarget.ElementArrayBuffer,
CType(Len(New UInteger) * indices.Count, IntPtr),
indices.ToArray,
BufferUsageHint.StaticDraw)
If .Material?.Image IsNot Nothing Then
If Not dicTextureIDs.ContainsKey(.Material.Image) Then
dicTextureIDs.Add(.Material.Image, ContentPipe.LoadTexture(.Material.Image))
End If
ElseIf .Material?.Color IsNot Nothing Then
If Not dicColorIDs.ContainsKey(.Material.Color) Then
dicColorIDs.Add(.Material.Color, ContentPipe.LoadTexture(ColorToTexture(.Material.Color)))
End If
Else
If Not dicTextureIDs.ContainsKey(emptyTexture) Then
dicTextureIDs.Add(emptyTexture, ContentPipe.LoadTexture(emptyTexture))
End If
End If
End With
Next
Dim nvbo As Integer = GL.GenBuffer
VertexBuffers.Add(mesh, nvbo)
GL.BindBuffer(BufferTarget.ArrayBuffer, nvbo)
GL.BufferData(
BufferTarget.ArrayBuffer,
CType(Vector3.SizeInBytes * verts.Count, IntPtr),
verts.ToArray,
BufferUsageHint.StaticDraw
)
Dim ntbo As Integer = GL.GenBuffer
UVBuffers.Add(mesh, ntbo)
GL.BindBuffer(BufferTarget.ArrayBuffer, ntbo)
GL.BufferData(
BufferTarget.ArrayBuffer,
CType(Vector2.SizeInBytes * uvs.Count, IntPtr),
uvs.ToArray,
BufferUsageHint.StaticDraw
)
If enablecols Then
Dim ncbo As Integer = GL.GenBuffer
VertexColorBuffers.Add(mesh, ncbo)
GL.BindBuffer(BufferTarget.ArrayBuffer, ncbo)
GL.BufferData(
BufferTarget.ArrayBuffer,
CType(Vector4.SizeInBytes * cols.Count, IntPtr),
cols.ToArray,
BufferUsageHint.StaticDraw
)
End If
If enablenorms Then
Dim nnbo As Integer = GL.GenBuffer
NormalBuffers.Add(mesh, nnbo)
GL.BindBuffer(BufferTarget.ArrayBuffer, nnbo)
GL.BufferData(
BufferTarget.ArrayBuffer,
CType(Vector3.SizeInBytes * norms.Count, IntPtr),
norms.ToArray,
BufferUsageHint.StaticDraw
)
End If
Next
If Not dicTextureIDs.ContainsKey(lineTexture) Then
dicTextureIDs.Add(lineTexture, ContentPipe.LoadTexture(lineTexture))
End If
_HasRendered = True
End Sub
Public Sub DrawModel(mode As RenderMode)
DrawModel(mode, Vector3.Zero, Quaternion.Identity, New Vector3(ModelScaling, ModelScaling, ModelScaling))
End Sub
Public Sub DrawModel(mode As RenderMode, pos As Vector3, rot As Quaternion)
DrawModel(mode, pos, rot, New Vector3(ModelScaling, ModelScaling, ModelScaling))
End Sub
Public Sub DrawModel(mode As RenderMode, pos As Vector3, rot As Quaternion, scale As Vector3)
If mode = RenderMode.None Then Return
If Not _HasRendered Then Return
GL.PushMatrix()
GL.Translate(pos.X, pos.Y, pos.Z)
GL.Rotate(rot.X, 1, 0, 0)
GL.Rotate(rot.Y, 0, 1, 0)
GL.Rotate(rot.Z, 0, 0, 1)
GL.Scale(scale) 'GL.Scale(scale.X, scale.Y, scale.Z)
GL.EnableClientState(ArrayCap.VertexArray)
GL.EnableClientState(ArrayCap.TextureCoordArray)
For Each mesh As Mesh In obj3d.Meshes
If VertexColorBuffers.ContainsKey(mesh) Then
GL.EnableClientState(ArrayCap.ColorArray)
ElseIf NormalBuffers.ContainsKey(mesh) Then
GL.EnableClientState(ArrayCap.NormalArray)
End If
GL.BindBuffer(BufferTarget.ArrayBuffer, VertexBuffers(mesh))
GL.VertexPointer(3, VertexPointerType.Float, 0, IntPtr.Zero)
GL.BindBuffer(BufferTarget.ArrayBuffer, UVBuffers(mesh))
GL.TexCoordPointer(2, TexCoordPointerType.Float, 0, IntPtr.Zero)
If VertexColorBuffers.ContainsKey(mesh) Then
GL.BindBuffer(BufferTarget.ArrayBuffer, VertexColorBuffers(mesh))
GL.ColorPointer(4, ColorPointerType.Float, 0, IntPtr.Zero)
ElseIf NormalBuffers.ContainsKey(mesh) Then
GL.BindBuffer(BufferTarget.ArrayBuffer, NormalBuffers(mesh))
GL.NormalPointer(NormalPointerType.Float, 0, IntPtr.Zero)
End If
For i As Integer = 0 To mesh.Faces.Count - 1
Dim l As Face = mesh.Faces(i)
GL.BindBuffer(BufferTarget.ElementArrayBuffer, IndicesBuffers(mesh)(i))
Dim texID As Integer
Dim isEmptyTexture As Boolean = l.Material?.Image Is Nothing
Dim isEmptyColor As Boolean = l.Material?.Color Is Nothing
If (mode And RenderMode.Fill) = RenderMode.Fill Then
texID = If(isEmptyTexture, If(isEmptyColor, dicTextureIDs(emptyTexture), dicColorIDs(l.Material.Color)), dicTextureIDs(l.Material.Image))
GL.BindTexture(TextureTarget.Texture2D, texID)
If Not isEmptyTexture Then
GL.TexParameter(TextureTarget.Texture2D, TextureParameterName.TextureWrapT, l.Material.Wrap.X)
GL.TexParameter(TextureTarget.Texture2D, TextureParameterName.TextureWrapS, l.Material.Wrap.Y)
End If
GL.PolygonMode(MaterialFace.FrontAndBack, PolygonMode.Fill)
GL.DrawElements(PrimitiveType.Triangles, l.Points.Count,
DrawElementsType.UnsignedInt, IntPtr.Zero)
End If
If (mode And RenderMode.Outline) = RenderMode.Outline Then
If (mode And RenderMode.Fill) = RenderMode.Fill Then
texID = dicTextureIDs(lineTexture)
GL.BindTexture(TextureTarget.Texture2D, texID)
Else
texID = If(isEmptyTexture, If(isEmptyColor, dicTextureIDs(emptyTexture), dicColorIDs(l.Material.Color)), dicTextureIDs(l.Material.Image))
GL.BindTexture(TextureTarget.Texture2D, texID)
If Not isEmptyTexture Then
GL.TexParameter(TextureTarget.Texture2D, TextureParameterName.TextureWrapT, l.Material.Wrap.X)
GL.TexParameter(TextureTarget.Texture2D, TextureParameterName.TextureWrapS, l.Material.Wrap.Y)
End If
End If
GL.PolygonMode(MaterialFace.FrontAndBack, PolygonMode.Line)
GL.DrawElements(PrimitiveType.Triangles, l.Points.Count,
DrawElementsType.UnsignedInt, IntPtr.Zero)
End If
Next
GL.PolygonMode(MaterialFace.FrontAndBack, PolygonMode.Fill) 'Reset for RenderEngineOld
If VertexColorBuffers.ContainsKey(mesh) Then
GL.DisableClientState(ArrayCap.ColorArray)
ElseIf NormalBuffers.ContainsKey(mesh) Then
GL.DisableClientState(ArrayCap.NormalArray)
End If
Next
GL.DisableClientState(ArrayCap.VertexArray)
GL.DisableClientState(ArrayCap.TextureCoordArray)
GL.PopMatrix()
End Sub
Public Sub DrawFacePicking()
DrawFacePicking(Vector3.Zero, Quaternion.Identity, New Vector3(ModelScaling, ModelScaling, ModelScaling))
End Sub
Public Sub DrawFacePicking(pos As Vector3, rot As Quaternion)
DrawFacePicking(pos, rot, New Vector3(ModelScaling, ModelScaling, ModelScaling))
End Sub
Public Sub DrawFacePicking(pos As Vector3, rot As Quaternion, scale As Vector3)
If Not _HasRendered Then Return
GL.PushMatrix()
GL.Translate(pos.X, pos.Y, pos.Z)
GL.Rotate(rot.X, 1, 0, 0)
GL.Rotate(rot.Y, 0, 1, 0)
GL.Rotate(rot.Z, 0, 0, 1)
GL.Scale(scale)
GL.EnableClientState(ArrayCap.VertexArray)
For iMesh As Integer = 0 To obj3d.Meshes.Count - 1
Dim mesh As Mesh = obj3d.Meshes(iMesh)
GL.BindBuffer(BufferTarget.ArrayBuffer, VertexBuffers(mesh))
GL.VertexPointer(3, VertexPointerType.Float, 0, IntPtr.Zero)
For iFace As Integer = 0 To mesh.Faces.Count - 1
Dim l As Face = mesh.Faces(iFace)
GL.BindBuffer(BufferTarget.ElementArrayBuffer, IndicesBuffers(mesh)(iFace))
GL.Color4(Color.FromArgb(&H20000000 + (iMesh << 16) + iFace)) 'Color: "2f ff xx xx" -> where 'f' = mesh index and where 'x' is face index
GL.PolygonMode(MaterialFace.FrontAndBack, PolygonMode.Fill)
GL.DrawElements(PrimitiveType.Triangles, l.Points.Count,
DrawElementsType.UnsignedInt, IntPtr.Zero)
Next
GL.PolygonMode(MaterialFace.FrontAndBack, PolygonMode.Fill)
Next
GL.DisableClientState(ArrayCap.VertexArray)
GL.PopMatrix()
End Sub
Public Sub ReleaseBuffers()
If Not HasRendered Then Return
For Each kvp As KeyValuePair(Of Mesh, Integer) In VertexBuffers
GL.DeleteBuffer(kvp.Value)
Next
VertexBuffers.Clear()
For Each kvp As KeyValuePair(Of Mesh, Integer) In UVBuffers
GL.DeleteBuffer(kvp.Value)
Next
UVBuffers.Clear()
For Each kvp As KeyValuePair(Of Mesh, Integer) In VertexColorBuffers
GL.DeleteBuffer(kvp.Value)
Next
VertexColorBuffers.Clear()
For Each kvp As KeyValuePair(Of Mesh, Integer) In NormalBuffers
GL.DeleteBuffer(kvp.Value)
Next
NormalBuffers.Clear()
For Each kvp As KeyValuePair(Of Mesh, List(Of Integer)) In IndicesBuffers
For Each i As Integer In kvp.Value
GL.DeleteBuffer(i)
Next
kvp.Value.Clear()
Next
IndicesBuffers.Clear()
For Each kvp As KeyValuePair(Of Image, Integer) In dicTextureIDs
GL.DeleteBuffer(kvp.Value)
Next
dicTextureIDs.Clear()
For Each kvp As KeyValuePair(Of Color, Integer) In dicColorIDs
GL.DeleteBuffer(kvp.Value)
Next
dicColorIDs.Clear()
_HasRendered = False
End Sub
Protected Overrides Sub Finalize()
'ReleaseBuffers()
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,11 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<runtime>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly>
<assemblyIdentity name="OpenTK" publicKeyToken="bad199fe84eb3df4" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-2.0.0.0" newVersion="2.0.0.0" />
</dependentAssembly>
</assemblyBinding>
</runtime>
</configuration>

View File

@@ -0,0 +1,6 @@
<?xml version="1.0" encoding="utf-8"?>
<packages>
<package id="OpenTK" version="3.0.1" targetFramework="net45" />
<package id="OpenTK.GLControl" version="3.0.1" targetFramework="net45" />
<package id="System.Numerics.Vectors" version="4.5.0" targetFramework="net45" />
</packages>

View File

@@ -4,8 +4,8 @@ Imports Pilz.Threading
Public Class ManagedPipeServer : Inherits ManagedPipe
'Pro Verbindung(sanfrage) wird ein Client-Objekt generiert, das den Datenaustausch dieser Verbindung abwickelt
Private _Clients As New List(Of ManagedPipeClient)
'Pro Verbindung (Anfrage) wird ein Client-Objekt generiert, das den Datenaustausch dieser Verbindung abwickelt
Public ReadOnly Property Clients As New List(Of ManagedPipeClient)
Private ReadOnly pipeName As String = ""
Private ReadOnly maxNumbersOfServerInstances As Integer
Private numberOfStartedServerInstances As Integer = 0
@@ -70,22 +70,16 @@ Public Class ManagedPipeServer : Inherits ManagedPipe
OnStatusMessage(e)
End Sub
#End Region '_Clients-Ereignisverarbeitung
#End Region
Public Overrides Function SendAsnyc(bytes() As Byte) As Task
Return Task.Run(Sub() Send(bytes))
End Function
Public Overrides Sub Send(data As Byte())
Console.WriteLine("Sending Data ...")
'OnRetriveData(New DataEventargs(data)) ' anzeigen
For Each client As ManagedPipeClient In _Clients ' an alle versenden
For Each client As ManagedPipeClient In _Clients 'an alle versenden
client.Send(data)
Next
Console.WriteLine("Data send!")
End Sub
Protected Overrides Sub Dispose(ByVal disposing As Boolean)

View File

@@ -128,7 +128,7 @@
<ItemGroup>
<ProjectReference Include="..\Pilz.Threading\Pilz.Threading.vbproj">
<Project>{d9c8655e-4f1c-4348-a51c-ab00fd9a14bb}</Project>
<Name>CrossThreads</Name>
<Name>Pilz.Threading</Name>
</ProjectReference>
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />

View File

@@ -0,0 +1,185 @@
using System;
using System.Collections.Generic;
using System.IO;
using System.Reflection;
using System.Runtime.CompilerServices;
using System.Text;
using System.Xml;
namespace Pilz.LicenseHelper
{
public static class AsposeModifyInMemory
{
private static string AsposeList = "Aspose.3D.dll, Aspose.BarCode.dll, Aspose.BarCode.Compact.dll, Aspose.BarCode.WPF.dll, Aspose.Cells.GridDesktop.dll, Aspose.Cells.GridWeb.dll, Aspose.CAD.dll, Aspose.Cells.dll, Aspose.Diagram.dll, Aspose.Email.dll, Aspose.Imaging.dll, Aspose.Note.dll, Aspose.OCR.dll, Aspose.Pdf.dll, Aspose.Slides.dll, Aspose.Tasks.dll, Aspose.Words.dll";
public static void ActivateMemoryPatching()
{
Assembly[] arr = AppDomain.CurrentDomain.GetAssemblies();
foreach (Assembly assembly in arr)
{
if (AsposeList.IndexOf(assembly.FullName.Split(',')[0] + ".dll") != -1)
ActivateForAssembly(assembly);
}
AppDomain.CurrentDomain.AssemblyLoad += new AssemblyLoadEventHandler(ActivateOnLoad);
}
private static void ActivateOnLoad(object sender, AssemblyLoadEventArgs e)
{
if (AsposeList.IndexOf(e.LoadedAssembly.FullName.Split(',')[0] + ".dll") != -1)
ActivateForAssembly(e.LoadedAssembly);
}
private static void ActivateForAssembly(Assembly assembly)
{
MethodInfo miLicensed1 = typeof(AsposeModifyInMemory).GetMethod("InvokeMe1", BindingFlags.NonPublic | BindingFlags.Static);
MethodInfo miLicensed2 = typeof(AsposeModifyInMemory).GetMethod("InvokeMe2", BindingFlags.NonPublic | BindingFlags.Static);
MethodInfo miEvaluation = null;
Dictionary<string, MethodInfo> miDict = new Dictionary<string, MethodInfo>()
{
{"System.DateTime" , miLicensed1},
{"System.Xml.XmlElement", miLicensed2}
};
Type[] arrType = null;
bool isFound = false;
int nCount = 0;
try
{
arrType = assembly.GetTypes();
}
catch (ReflectionTypeLoadException err)
{
arrType = err.Types;
}
foreach (Type type in arrType)
{
if (isFound) break;
if (type == null) continue;
MethodInfo[] arrMInfo = type.GetMethods(BindingFlags.NonPublic | BindingFlags.Static);
foreach (MethodInfo info in arrMInfo)
{
if (isFound) break;
try
{
string strMethod = info.ToString();
if ((strMethod.IndexOf("(System.Xml.XmlElement, System.String)") > 0) && (miDict.ContainsKey(info.ReturnType.ToString())))
{
miEvaluation = info;
MemoryPatching(miEvaluation, miDict[miEvaluation.ReturnType.ToString()]);
nCount++;
if ((assembly.FullName.IndexOf("Aspose.3D") != -1) && (nCount == 2))
{
isFound = true;
break;
}
}
}
catch
{
throw new InvalidOperationException("MemoryPatching for \"" + assembly.FullName + "\" failed !");
}
}
}
String[] aParts = assembly.FullName.Split(',');
string fName = aParts[0];
if (fName.IndexOf("Aspose.BarCode.") != -1)
fName = "Aspose.BarCode";
else if (fName.IndexOf("Aspose.3D") != -1)
fName = "Aspose.ThreeD";
try
{
Type type2 = assembly.GetType(fName + ".License");
MethodInfo mi = type2.GetMethod("SetLicense", new Type[] { typeof(Stream) });
string LData = "PD94bWwgdmVyc2lvbj0iMS4wIiBlbmNvZGluZz0idXRmLTgiPz4KPExpY2Vuc2U+CiAgPERhdGE+CiAgICA8TGljZW5zZWRUbz5MaWNlbnNlZTwvTGljZW5zZWRUbz4KICAgIDxFbWFpbFRvPmxpY2Vuc2VlQGVtYWlsLmNvbTwvRW1haWxUbz4KICAgIDxMaWNlbnNlVHlwZT5EZXZlbG9wZXIgT0VNPC9MaWNlbnNlVHlwZT4KICAgIDxMaWNlbnNlTm90ZT5MaW1pdGVkIHRvIDEwMDAgZGV2ZWxvcGVyLCB1bmxpbWl0ZWQgcGh5c2ljYWwgbG9jYXRpb25zPC9MaWNlbnNlTm90ZT4KICAgIDxPcmRlcklEPjc4NDM3ODU3Nzg1PC9PcmRlcklEPgogICAgPFVzZXJJRD4xMTk3ODkyNDM3OTwvVXNlcklEPgogICAgPE9FTT5UaGlzIGlzIGEgcmVkaXN0cmlidXRhYmxlIGxpY2Vuc2U8L09FTT4KICAgIDxQcm9kdWN0cz4KICAgICAgPFByb2R1Y3Q+QXNwb3NlLlRvdGFsIFByb2R1Y3QgRmFtaWx5PC9Qcm9kdWN0PgogICAgPC9Qcm9kdWN0cz4KICAgIDxFZGl0aW9uVHlwZT5FbnRlcnByaXNlPC9FZGl0aW9uVHlwZT4KICAgIDxTZXJpYWxOdW1iZXI+e0YyQjk3MDQ1LTFCMjktNEIzRi1CRDUzLTYwMUVGRkExNUFBOX08L1NlcmlhbE51bWJlcj4KICAgIDxTdWJzY3JpcHRpb25FeHBpcnk+MjA5OTEyMzE8L1N1YnNjcmlwdGlvbkV4cGlyeT4KICAgIDxMaWNlbnNlVmVyc2lvbj4zLjA8L0xpY2Vuc2VWZXJzaW9uPgogIDwvRGF0YT4KICA8U2lnbmF0dXJlPlFYTndiM05sTGxSdmRHRnNJRkJ5YjJSMVkzUWdSbUZ0YVd4NTwvU2lnbmF0dXJlPgo8L0xpY2Vuc2U+";
Stream stream = new MemoryStream(Convert.FromBase64String(LData));
stream.Seek(0, SeekOrigin.Begin);
mi.Invoke(Activator.CreateInstance(type2, null), new Stream[] { stream });
}
catch
{
throw new InvalidOperationException("SetLicense for \"" + assembly.FullName + "\" failed !");
}
}
private static DateTime InvokeMe1(XmlElement element, string name)
{
return DateTime.MaxValue;
}
private static XmlElement InvokeMe2(XmlElement element, string name)
{
if (element.LocalName == "License")
{
string License64 = "PERhdGE+PExpY2Vuc2VkVG8+R3JvdXBEb2NzPC9MaWNlbnNlZFRvPjxMaWNlbnNlVHlwZT5TaXRlIE9FTTwvTGljZW5zZVR5cGU+PExpY2Vuc2VOb3RlPkxpbWl0ZWQgdG8gMTAgZGV2ZWxvcGVyczwvTGljZW5zZU5vdGU+PE9yZGVySUQ+MTMwNzI0MDQwODQ5PC9PcmRlcklEPjxPRU0+VGhpcyBpcyBhIHJlZGlzdHJpYnV0YWJsZSBsaWNlbnNlPC9PRU0+PFByb2R1Y3RzPjxQcm9kdWN0PkFzcG9zZS5Ub3RhbDwvUHJvZHVjdD48L1Byb2R1Y3RzPjxFZGl0aW9uVHlwZT5FbnRlcnByaXNlPC9FZGl0aW9uVHlwZT48U2VyaWFsTnVtYmVyPjliNTc5NTAxLTUyNjEtNDIyMC04NjcwLWZjMmQ4Y2NkZDkwYzwvU2VyaWFsTnVtYmVyPjxTdWJzY3JpcHRpb25FeHBpcnk+MjAxNDA3MjQ8L1N1YnNjcmlwdGlvbkV4cGlyeT48TGljZW5zZVZlcnNpb24+Mi4yPC9MaWNlbnNlVmVyc2lvbj48L0RhdGE+PFNpZ25hdHVyZT5udFpocmRoL3I0QS81ZFpsU2dWYnhac0hYSFBxSjZ5UVVYa0RvaW4vS2lVZWhUUWZET0lQdHdzUlR2NmRTUVplOVdXekNnV3RGdkdROWpmR2QySmF4YUQvbkx1ZEk2R0VVajhqeVhUMG4vbWRrMEF1WVZNYlBXRjJYd3dSTnFlTmRrblYyQjhrZVFwbDJ2RzZVbnhxS2J6VVFxS2Rhc1pzZ2w1Q0xqSFVEWms9PC9TaWduYXR1cmU+";
element.InnerXml = new UTF8Encoding().GetString(Convert.FromBase64String(License64));
}
if (element.LocalName == "BlackList")
{
string BlackList64 = "PERhdGE+PC9EYXRhPjxTaWduYXR1cmU+cUJwMEx1cEVoM1ZnOWJjeS8vbUVXUk9KRWZmczRlY25iTHQxYlNhanU2NjY5RHlad09FakJ1eEdBdVBxS1hyd0x5bmZ5VWplYUNGQ0QxSkh2RVUxVUl5eXJOTnBSMXc2NXJIOUFyUCtFbE1lVCtIQkZ4NFMzckFVMnd6dkxPZnhGeU9DQ0dGQ2UraTdiSHlGQk44WHp6R1UwdGRPMGR1RTFoRTQ5M1RNY3pRPTwvU2lnbmF0dXJlPg==";
element.InnerXml = new UTF8Encoding().GetString(Convert.FromBase64String(BlackList64));
}
XmlNodeList elementsByTagName = element.GetElementsByTagName(name);
if (elementsByTagName.Count <= 0)
{
return null;
}
return (XmlElement)elementsByTagName[0];
}
private static unsafe void MemoryPatching(MethodBase miEvaluation, MethodBase miLicensed)
{
IntPtr IntPtrEval = GetMemoryAddress(miEvaluation);
IntPtr IntPtrLicensed = GetMemoryAddress(miLicensed);
if (IntPtr.Size == 8)
*((long*)IntPtrEval.ToPointer()) = *((long*)IntPtrLicensed.ToPointer());
else
*((int*)IntPtrEval.ToPointer()) = *((int*)IntPtrLicensed.ToPointer());
}
private static unsafe IntPtr GetMemoryAddress(MethodBase mb)
{
RuntimeHelpers.PrepareMethod(mb.MethodHandle);
if ((Environment.Version.Major >= 4) || ((Environment.Version.Major == 2) && (Environment.Version.MinorRevision >= 3053)))
{
return new IntPtr(((int*)mb.MethodHandle.Value.ToPointer() + 2));
}
UInt64* location = (UInt64*)(mb.MethodHandle.Value.ToPointer());
int index = (int)(((*location) >> 32) & 0xFF);
if (IntPtr.Size == 8)
{
ulong* classStart = (ulong*)mb.DeclaringType.TypeHandle.Value.ToPointer();
ulong* address = classStart + index + 10;
return new IntPtr(address);
}
else
{
uint* classStart = (uint*)mb.DeclaringType.TypeHandle.Value.ToPointer();
uint* address = classStart + index + 10;
return new IntPtr(address);
}
}
}
}

View File

@@ -0,0 +1,49 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="15.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProjectGuid>{67593FF7-C1D1-4529-98C4-61CBD0615F08}</ProjectGuid>
<OutputType>Library</OutputType>
<AppDesignerFolder>Properties</AppDesignerFolder>
<RootNamespace>Pilz.LicenseHelper</RootNamespace>
<AssemblyName>Pilz.LicenseHelper</AssemblyName>
<TargetFrameworkVersion>v4.5</TargetFrameworkVersion>
<FileAlignment>512</FileAlignment>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<Optimize>false</Optimize>
<OutputPath>bin\Debug\</OutputPath>
<DefineConstants>DEBUG;TRACE</DefineConstants>
<ErrorReport>prompt</ErrorReport>
<WarningLevel>4</WarningLevel>
<AllowUnsafeBlocks>true</AllowUnsafeBlocks>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DefineConstants>TRACE</DefineConstants>
<ErrorReport>prompt</ErrorReport>
<WarningLevel>4</WarningLevel>
<AllowUnsafeBlocks>true</AllowUnsafeBlocks>
</PropertyGroup>
<ItemGroup>
<Reference Include="System" />
<Reference Include="System.Core" />
<Reference Include="System.Xml.Linq" />
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="Microsoft.CSharp" />
<Reference Include="System.Data" />
<Reference Include="System.Net.Http" />
<Reference Include="System.Xml" />
</ItemGroup>
<ItemGroup>
<Compile Include="AsposeModifyInMemory.cs" />
<Compile Include="Properties\AssemblyInfo.cs" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.CSharp.targets" />
</Project>

View File

@@ -0,0 +1,36 @@
using System.Reflection;
using System.Runtime.CompilerServices;
using System.Runtime.InteropServices;
// Allgemeine Informationen über eine Assembly werden über die folgenden
// Attribute gesteuert. Ändern Sie diese Attributwerte, um die Informationen zu ändern,
// die einer Assembly zugeordnet sind.
[assembly: AssemblyTitle("LicenseHelper")]
[assembly: AssemblyDescription("")]
[assembly: AssemblyConfiguration("")]
[assembly: AssemblyCompany("DRSN")]
[assembly: AssemblyProduct("LicenseHelper")]
[assembly: AssemblyCopyright("Copyright © DRSN 2018")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]
// Durch Festlegen von ComVisible auf FALSE werden die Typen in dieser Assembly
// für COM-Komponenten unsichtbar. Wenn Sie auf einen Typ in dieser Assembly von
// COM aus zugreifen müssen, sollten Sie das ComVisible-Attribut für diesen Typ auf "True" festlegen.
[assembly: ComVisible(false)]
// Die folgende GUID bestimmt die ID der Typbibliothek, wenn dieses Projekt für COM verfügbar gemacht wird
[assembly: Guid("67593ff7-c1d1-4529-98c4-61cbd0615f08")]
// Versionsinformationen für eine Assembly bestehen aus den folgenden vier Werten:
//
// Hauptversion
// Nebenversion
// Buildnummer
// Revision
//
// Sie können alle Werte angeben oder Standardwerte für die Build- und Revisionsnummern verwenden,
// indem Sie "*" wie unten gezeigt eingeben:
// [assembly: AssemblyVersion("1.0.*")]
[assembly: AssemblyVersion("1.0.0.0")]
[assembly: AssemblyFileVersion("1.0.0.0")]

View File

@@ -0,0 +1,6 @@
<?xml version="1.0" encoding="utf-8" ?>
<configuration>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5" />
</startup>
</configuration>

View File

@@ -0,0 +1,250 @@
Imports System.Globalization
Imports System.IO
Imports System.Threading
Imports Aspose.ThreeD
Imports Aspose.ThreeD.Entities
Imports Aspose.ThreeD.Formats
Imports Aspose.ThreeD.Shading
Imports Aspose.ThreeD.Utilities
Namespace Aspose3DModule
Public Class Aspose3DLoader
Private Shared hasActivatedMemoryPatching As Boolean = False
Private Shared Sub ActivateMemoryPatching()
If Not hasActivatedMemoryPatching Then
LicenseHelper.AsposeModifyInMemory.ActivateMemoryPatching()
hasActivatedMemoryPatching = True
End If
End Sub
Public Shared Function FromFile(fileName As String, LoadMaterials As Boolean, UpAxis As UpAxis) As Object3D
ActivateMemoryPatching()
'Create new Model
Dim obj3d As New Object3D
'Create new temporary CultureInfo
Dim curThread As Thread = Thread.CurrentThread
Dim curCultInfo As CultureInfo = curThread.CurrentCulture
Dim newCultInfo As New CultureInfo(curCultInfo.Name)
newCultInfo.NumberFormat.NumberDecimalSeparator = "."
newCultInfo.NumberFormat.PercentDecimalSeparator = "."
newCultInfo.NumberFormat.CurrencyDecimalSeparator = "."
newCultInfo.NumberFormat.NumberGroupSeparator = ","
newCultInfo.NumberFormat.PercentGroupSeparator = ","
newCultInfo.NumberFormat.CurrencyGroupSeparator = ","
curThread.CurrentCulture = newCultInfo
'Load Model from file
Dim scene As New Scene(fileName)
'Reset Cultur-Info
curThread.CurrentCulture = curCultInfo
'Triangulate the Model
PolygonModifier.Triangulate(scene)
'Create Dictionary for Materials
Dim dicMaterials As New Dictionary(Of Aspose.ThreeD.Shading.Material, Material)
'Create List of all avaiable Map-States
Dim MapNames As String() = {Aspose.ThreeD.Shading.Material.MapDiffuse, Aspose.ThreeD.Shading.Material.MapAmbient, Aspose.ThreeD.Shading.Material.MapSpecular, Aspose.ThreeD.Shading.Material.MapEmissive, Aspose.ThreeD.Shading.Material.MapNormal}
Dim ColorNames As String() = {"DiffuseColor", "AmbientColor", "SpecularColor", "EmissiveColor"}
For Each node As Node In scene.RootNode.ChildNodes
'Add new Materials, if not added
For Each mat As Aspose.ThreeD.Shading.Material In node.Materials
If Not dicMaterials.ContainsKey(mat) Then
'Create new Material
Dim newMat As New Material
'Get TextureBase
Dim texBase As TextureBase = Nothing
Dim curmnindex As Byte = 0
Do While texBase Is Nothing AndAlso curmnindex < MapNames.Length
texBase = mat.GetTexture(MapNames(curmnindex))
curmnindex += 1
Loop
If texBase IsNot Nothing Then
If LoadMaterials Then
'Get Texture Image
Dim imgFile As String = texBase.GetPropertyValue("FileName")
imgFile = imgFile.Replace("/", "\")
'Load and set Image
If imgFile <> "" Then
Dim fs As New FileStream(imgFile, FileMode.Open, FileAccess.Read)
newMat.Image = Image.FromStream(fs)
fs.Close()
End If
End If
End If
'Get Texture Color
Dim texcol As Vector3? = Nothing
Dim curcnindex As Byte = 0
Do While texcol Is Nothing AndAlso curcnindex < ColorNames.Length
texcol = mat.GetPropertyValue(ColorNames(curcnindex))
curcnindex += 1
Loop
If texcol IsNot Nothing Then
newMat.Color = Color.FromArgb(texcol?.x, texcol?.y, texcol?.z)
End If
'Add Material to Object3D
obj3d.Materials.Add(mat.Name, newMat)
'Add Dictionary-Entry
dicMaterials.Add(mat, newMat)
End If
Next
'Get Aspose-Mesh
Dim curMesh As Entities.Mesh = node.GetEntity(Of Entities.Mesh)
If curMesh IsNot Nothing Then
'Create new Mesh
Dim newMesh As New Mesh
'Create Vertices
For Each vert As Vector4 In curMesh.ControlPoints
'Create new Vertex
Dim newVert As New Vertex
'Set Vertex Data
newVert.X = vert.x
newVert.Y = vert.y
newVert.Z = vert.z
'Add new Vertex
newMesh.Vertices.Add(newVert)
Next
'Create Normals
Dim veNormals As VertexElementNormal = curMesh.GetElement(VertexElementType.Normal)
If veNormals IsNot Nothing Then
For Each n As Vector4 In veNormals.Data
'Create new Normal
Dim newNormal As New Normal
'Set Normal Data
newNormal.X = n.x
newNormal.Y = n.y
newNormal.Z = n.z
'Add new Normal
newMesh.Normals.Add(newNormal)
Next
End If
'Create Normals
Dim veUVs As VertexElementUV = curMesh.GetElement(VertexElementType.UV)
If veUVs IsNot Nothing Then
For Each uv As Vector4 In veUVs.Data
'Create new UV
Dim newUV As New UV
'Set UV Data
newUV.U = uv.x
newUV.V = uv.y
'Add new UV
newMesh.UVs.Add(newUV)
Next
End If
'Create Normals
Dim veVertexColor As VertexElementVertexColor = curMesh.GetElement(VertexElementType.VertexColor)
If veVertexColor IsNot Nothing Then
For Each n As Vector4 In veVertexColor.Data
'Create new Normal
Dim newVC As New VertexColor
'Set Normal Data
newVC.R = n.x
newVC.G = n.y
newVC.B = n.z
newVC.A = n.w
'Add new Normal
newMesh.VertexColors.Add(newVC)
Next
End If
'Get Material-Indicies
Dim veMaterials As VertexElementMaterial = curMesh.GetElement(VertexElementType.Material)
'Definde Index for VertexElement.Indicies
Dim veIndex As Integer = 0
'Build Polygones
For iPoly = 0 To curMesh.Polygons.Count - 1
'Get current Polygon
Dim poly As Integer() = curMesh.Polygons(iPoly)
'Create new Face
Dim f As New Face
'Set Texture, if avaiable
If veMaterials IsNot Nothing Then
f.Material = dicMaterials(node.Materials(veMaterials.Indices(iPoly)))
ElseIf node.Material IsNot Nothing Then
f.Material = dicMaterials(node.Material)
End If
For Each index As Integer In poly
'Create new Point
Dim p As New Point
'Set Vertex
p.Vertex = newMesh.Vertices(index)
'Set Normal
If veNormals IsNot Nothing Then
p.Normal = newMesh.Normals(veNormals.Indices(veIndex))
End If
'Set UV
If veUVs IsNot Nothing Then
p.UV = newMesh.UVs(veUVs.Indices(veIndex))
End If
'Set Vertex Color
If veVertexColor IsNot Nothing Then
p.VertexColor = newMesh.VertexColors(veVertexColor.Indices(veIndex))
End If
'Add new Point
f.Points.Add(p)
'Increment VertexElementIndicies-Index
veIndex += 1
Next
'Add new Face
newMesh.Faces.Add(f)
Next
'Add new Mesh
obj3d.Meshes.Add(newMesh)
End If
Next
'Return the new Object3D
Return obj3d
End Function
End Class
End Namespace

View File

@@ -0,0 +1,391 @@
Imports System.IO
Imports Assimp
Imports Assimp.Unmanaged
Namespace AssimpModule
Public Class AssimpLoader
Public Shared PathToAssimpLib32 As String = "Assimp32.dll"
Public Shared PathToAssimpLib64 As String = "Assimp64.dll"
Friend Shared Sub LoadAssimpLibs()
If Not AssimpLibrary.Instance.IsLibraryLoaded Then
AssimpLibrary.Instance.LoadLibrary(PathToAssimpLib32, PathToAssimpLib64)
End If
End Sub
Public Shared Function FromFile(fileName As String, LoadMaterials As Boolean, UpAxis As UpAxis) As Object3D
Dim LoadedImages As New Dictionary(Of String, Image)
Dim newObj As New Object3D
Dim daeMdl As Scene = Nothing
Dim ac As New AssimpContext
Dim channelIndicies As New Dictionary(Of Material, Integer)
daeMdl = ac.ImportFile(fileName, PostProcessPreset.TargetRealTimeMaximumQuality Or PostProcessSteps.Triangulate)
For Each et As EmbeddedTexture In daeMdl.Textures
If et.HasCompressedData Then
Dim newMat As New Material
Dim ms As New MemoryStream(et.CompressedData)
newMat.Image = Image.FromStream(ms)
ms.Close()
newObj.Materials.Add("tex_" & daeMdl.Textures.IndexOf(et), newMat)
End If
Next
For Each mat As Assimp.Material In daeMdl.Materials
Dim newMat As New Material
Dim texSlot As TextureSlot? = Nothing
Dim col4d As Color4D? = Nothing
newMat.Opacity = mat.Opacity
Select Case True
Case mat.HasTextureNormal
texSlot = mat.TextureNormal
Case mat.HasTextureDiffuse
texSlot = mat.TextureDiffuse
Case mat.HasTextureAmbient
texSlot = mat.TextureAmbient
Case mat.HasTextureSpecular
texSlot = mat.TextureSpecular
End Select
Select Case True
Case mat.HasColorDiffuse
col4d = mat.ColorDiffuse
Case mat.HasColorAmbient
col4d = mat.ColorAmbient
Case mat.HasColorSpecular
col4d = mat.ColorSpecular
End Select
If texSlot IsNot Nothing Then
Dim filePath As String = texSlot.Value.FilePath
If LoadMaterials Then
If filePath <> "" Then
Dim combiPath As String = Path.Combine(Path.GetDirectoryName(fileName), filePath)
If File.Exists(combiPath) Then
newMat.Image = LoadImage(combiPath, LoadedImages)
ElseIf File.Exists(filePath) Then
newMat.Image = LoadImage(filePath, LoadedImages)
End If
ElseIf texSlot.Value.TextureIndex > -1 AndAlso daeMdl.Textures.Count > texSlot.Value.TextureIndex Then
Dim et As EmbeddedTexture = daeMdl.Textures(texSlot.Value.TextureIndex)
If et.HasCompressedData Then
Dim ms As New MemoryStream(et.CompressedData)
newMat.Image = Image.FromStream(ms)
ms.Close()
End If
End If
End If
channelIndicies.Add(newMat, texSlot.Value.UVIndex)
End If
If col4d IsNot Nothing Then
newMat.Color = Color.FromArgb(col4d.Value.R * 255, col4d.Value.G * 255, col4d.Value.B * 255)
End If
newObj.Materials.Add(mat.Name, newMat)
Next
Dim newMesh As New Mesh
newObj.Meshes.Add(newMesh)
Dim dicVertices As New Dictionary(Of Vector3D, Vertex)
Dim dicNormals As New Dictionary(Of Vector3D, Normal)
Dim dicUVs As New Dictionary(Of Vector3D, UV)
Dim dicVertexColors As New Dictionary(Of Color4D, VertexColor)
For Each m As Assimp.Mesh In daeMdl.Meshes
Dim curMat As Material
If m.MaterialIndex > -1 AndAlso newObj.Materials.Count > m.MaterialIndex Then
curMat = newObj.Materials.ElementAt(m.MaterialIndex).Value
Else
curMat = Nothing
End If
For Each n As Vector3D In m.Normals
If Not dicNormals.ContainsKey(n) Then
Dim newNormal As New Normal
Select Case UpAxis
Case UpAxis.Y
newNormal.X = n.X
newNormal.Y = n.Y
newNormal.Z = n.Z
Case UpAxis.Z
newNormal.X = n.Y
newNormal.Y = n.Z
newNormal.Z = n.X
End Select
newMesh.Normals.Add(newNormal)
dicNormals.Add(n, newNormal)
End If
Next
For Each v As Vector3D In m.Vertices
If Not dicVertices.ContainsKey(v) Then
Dim newVert As New Vertex
Select Case UpAxis
Case UpAxis.Y
newVert.X = v.X
newVert.Y = v.Y
newVert.Z = v.Z
Case UpAxis.Z
newVert.X = v.Y
newVert.Y = v.Z
newVert.Z = v.X
End Select
newMesh.Vertices.Add(newVert)
dicVertices.Add(v, newVert)
End If
Next
For Each uvList As List(Of Vector3D) In m.TextureCoordinateChannels
For Each uv As Vector3D In uvList
If Not dicUVs.ContainsKey(uv) Then
Dim newUV As New UV
newUV.U = uv.X
newUV.V = uv.Y
newMesh.UVs.Add(newUV)
dicUVs.Add(uv, newUV)
End If
Next
Next
For Each vcList As List(Of Color4D) In m.VertexColorChannels
For Each vc As Color4D In vcList
If Not dicVertexColors.ContainsKey(vc) Then
Dim newVC As New VertexColor
newVC.R = vc.R
newVC.G = vc.G
newVC.B = vc.B
newVC.A = vc.A
newMesh.VertexColors.Add(newVC)
dicVertexColors.Add(vc, newVC)
End If
Next
Next
For Each f As Assimp.Face In m.Faces
If f.HasIndices Then
Dim newFace As New Face With {.Material = curMat}
For Each index As Integer In f.Indices
If index > -1 Then
Dim newPoint As New Point
If m.HasVertices Then
newPoint.Vertex = dicVertices(m.Vertices(index))
End If
If m.HasNormals Then
newPoint.Normal = dicNormals(m.Normals(index))
End If
If curMat IsNot Nothing AndAlso channelIndicies.ContainsKey(curMat) Then
Dim tkey As Integer = channelIndicies(curMat)
If m.HasTextureCoords(tkey) Then
newPoint.UV = dicUVs(m.TextureCoordinateChannels(tkey)(index))
End If
If m.HasVertexColors(tkey) Then
newPoint.VertexColor = dicVertexColors(m.VertexColorChannels(tkey)(index))
End If
End If
newFace.Points.Add(newPoint)
End If
Next
If newFace.Points.Count = 3 Then
newMesh.Faces.Add(newFace)
End If
End If
Next
Next
Return newObj
End Function
Public Shared Sub ToFile(fileName As String, obj As Object3D)
Dim mdl As New Scene
Dim dicMatIndex As New Dictionary(Of Material, Integer)
Dim texDir As String = ""
If obj.Materials.Count > 0 Then
texDir = Path.Combine(Path.GetDirectoryName(fileName), Path.GetFileNameWithoutExtension(fileName))
If Not Directory.Exists(texDir) Then
Directory.CreateDirectory(texDir)
End If
End If
For Each kvp As KeyValuePair(Of String, Material) In obj.Materials
Dim mat As New Assimp.Material
mat.Name = If(kvp.Key <> "", kvp.Key, "_" & mdl.Materials.Count)
mat.Opacity = mat.Opacity
Dim texslot As New TextureSlot
texslot.TextureIndex = mdl.Textures.Count
texslot.TextureType = TextureType.Diffuse
texslot.UVIndex = 0
Dim ms As New MemoryStream
kvp.Value.Image.Save(ms, Imaging.ImageFormat.Png)
'Dim tex As New EmbeddedTexture("png", ms.GetBuffer)
ms.Close()
If kvp.Value.Image IsNot Nothing Then
texslot.FilePath = Path.Combine(texDir, mat.Name & ".png")
File.WriteAllBytes(texslot.FilePath, ms.GetBuffer)
End If
'mdl.Textures.Add(tex)
mat.AddMaterialTexture(texslot)
mdl.Materials.Add(mat)
If kvp.Value.Color IsNot Nothing Then
With kvp.Value.Color.Value
mat.ColorDiffuse = New Color4D(.R / 255, .G / 255, .B / 255, 1)
End With
End If
dicMatIndex.Add(kvp.Value, mdl.Materials.Count - 1)
Next
Dim dicTexMesh As New Dictionary(Of Material, Assimp.Mesh)
Dim dicMeshDicVertIndex As New Dictionary(Of Assimp.Mesh, Dictionary(Of Vertex, Integer))
Dim dicCounter As New Dictionary(Of Assimp.Mesh, Integer)
For Each mesh As Mesh In obj.Meshes
For Each f As Face In mesh.Faces
Dim m As Assimp.Mesh
If dicTexMesh.ContainsKey(f.Material) Then
m = dicTexMesh(f.Material)
Else
m = New Assimp.Mesh("Mesh_" & mdl.MeshCount + 1)
m.PrimitiveType = PrimitiveType.Triangle
If dicMatIndex.ContainsKey(f.Material) Then
m.MaterialIndex = dicMatIndex(f.Material)
End If
mdl.Meshes.Add(m)
dicTexMesh.Add(f.Material, m)
dicMeshDicVertIndex.Add(m, New Dictionary(Of Vertex, Integer))
dicCounter.Add(m, 0)
End If
Dim newFace As New Assimp.Face
For Each p As Point In f.Points
newFace.Indices.Add(dicCounter(m))
If p.Vertex IsNot Nothing Then
Dim vert As New Vector3D
vert.X = p.Vertex.X
vert.Y = p.Vertex.Y
vert.Z = p.Vertex.Z
m.Vertices.Add(vert)
Else
m.Vertices.Add(New Vector3D(0, 0, 0))
End If
If p.Normal IsNot Nothing Then
Dim norm As New Vector3D
norm.X = p.Normal.X
norm.Y = p.Normal.Y
norm.Z = p.Normal.Z
m.Normals.Add(norm)
Else
m.Normals.Add(New Vector3D(0, 0, 0))
End If
'If p.UV IsNot Nothing Then
' Dim uv As New Vector3D
' uv.X = p.UV.U
' uv.Y = p.UV.V
' m.TextureCoordinateChannels(0).Add(uv)
'Else
' m.TextureCoordinateChannels(0).Add(New Vector3D(0, 0, 0))
'End If
'If p.VertexColor IsNot Nothing Then
' Dim vc As New Color4D
' vc.R = p.VertexColor.R
' vc.G = p.VertexColor.G
' vc.B = p.VertexColor.B
' vc.A = p.VertexColor.A
' m.VertexColorChannels(0).Add(vc)
'Else
' m.VertexColorChannels(0).Add(New Color4D(0, 0, 0, 0))
'End If
dicCounter(m) += 1
Next
m.Faces.Add(newFace)
Next
Next
'Add Root Node
mdl.RootNode = New Node(Path.GetFileName(fileName))
'Add Mesh Indicies
For i As Integer = 0 To mdl.MeshCount - 1
mdl.RootNode.MeshIndices.Add(i)
Next
Dim ac As New AssimpContext
Dim formatID As String = ""
Dim myExt As String = Path.GetExtension(fileName).ToLower.Substring(1)
For Each efd As ExportFormatDescription In ac.GetSupportedExportFormats
If myExt = efd.FileExtension Then
formatID = efd.FormatId
Exit For
End If
Next
ac.ExportFile(mdl, fileName, formatID)
End Sub
Private Shared Function LoadImage(fileName As String, loadedImages As Dictionary(Of String, Image)) As Image
If File.Exists(fileName) Then
If loadedImages.ContainsKey(fileName) Then
Return loadedImages(fileName)
Else
Dim fs As New FileStream(fileName, FileMode.Open, FileAccess.Read)
Dim img As Image = Image.FromStream(fs)
fs.Close()
For Each kvp In loadedImages
If IsTheSameAs(img, kvp.Value) Then
Return kvp.Value
End If
Next
loadedImages.Add(fileName, img)
Return img
End If
End If
Return Nothing
End Function
End Class
End Namespace

View File

@@ -0,0 +1,391 @@
Imports System.Globalization
Imports System.IO
Imports System.Threading
Imports Pilz.S3DFileParser.Exceptions
Namespace ObjModule
Public Class ObjFile
Public Shared Function FromFile(FileName As String, LoadMaterials As Boolean, UpAxis As UpAxis) As Object3D
Dim curThread As Thread = Thread.CurrentThread
Dim curCultInfo As CultureInfo = curThread.CurrentCulture
Dim newCultInfo As New CultureInfo(curCultInfo.Name)
newCultInfo.NumberFormat.NumberDecimalSeparator = "."
newCultInfo.NumberFormat.PercentDecimalSeparator = "."
newCultInfo.NumberFormat.CurrencyDecimalSeparator = "."
newCultInfo.NumberFormat.NumberGroupSeparator = ","
newCultInfo.NumberFormat.PercentGroupSeparator = ","
newCultInfo.NumberFormat.CurrencyGroupSeparator = ","
curThread.CurrentCulture = newCultInfo
Dim newObj As New Object3D
Dim newMesh As New Mesh
Dim curObjPath As String = Path.GetDirectoryName(FileName)
Dim mtllibs As New Dictionary(Of String, MaterialLib)
Dim curMaterialLib As MaterialLib = Nothing
Dim curMaterial As Material = Nothing
Dim srObj As New StreamReader(FileName, Text.Encoding.ASCII)
Dim line As String = ""
Do Until srObj.EndOfStream
line = srObj.ReadLine.Trim
If line <> "" Then
Select Case True
Case line.StartsWith("mtllib ")
Dim name As String = line.Substring(7)
If Not mtllibs.ContainsKey(name) Then
Dim mtlfile As String = Path.Combine(curObjPath, name)
If Not File.Exists(mtlfile) Then Throw New MaterialException("Material Library not found!")
Dim newmtl As New MaterialLib
newmtl.FromFile(mtlfile, LoadMaterials)
mtllibs.Add(name, newmtl)
curMaterialLib = newmtl
For Each kvp As KeyValuePair(Of String, Material) In curMaterialLib.Materials
If Not newObj.Materials.ContainsKey(kvp.Key) Then newObj.Materials.Add(kvp.Key, kvp.Value)
Next
Else
curMaterialLib = mtllibs(name)
End If
Case line.StartsWith("usemtl ")
curMaterial = curMaterialLib.Materials(line.Substring(7))
Case line.StartsWith("v ")
If line.Contains("nan") Then line = line.Replace("nan", "0")
Dim splitXYZ() As String = line.Substring(2).Split(" "c)
Dim tX As Double = Convert.ToDouble(splitXYZ(0))
Dim tY As Double = Convert.ToDouble(splitXYZ(1))
Dim tZ As Double = Convert.ToDouble(splitXYZ(2))
Dim v As New Vertex
Select Case UpAxis
Case UpAxis.Y
v.X = tX
v.Y = tY
v.Z = tZ
Case UpAxis.Z
v.X = tY
v.Y = tZ
v.Z = tX
End Select
newMesh.Vertices.Add(v)
Case line.StartsWith("vt ")
Dim uvstr() As String = line.Substring(3).Split(" "c)
Dim uv As New UV With {
.U = Convert.ToSingle(uvstr(0)),
.V = Convert.ToSingle(uvstr(1))}
newMesh.UVs.Add(uv)
Case line.StartsWith("vn ")
Dim splitXYZ() As String = line.Substring(3).Split(" "c)
Dim tX As Single = Convert.ToSingle(splitXYZ(0))
Dim tY As Single = Convert.ToSingle(splitXYZ(1))
Dim tZ As Single = Convert.ToSingle(splitXYZ(2))
Dim n As New Normal
Select Case UpAxis
Case UpAxis.Y
n.X = tX
n.Y = tY
n.Z = tZ
Case UpAxis.Z
n.X = tZ
n.Y = tY
n.Z = tX
End Select
newMesh.Normals.Add(n)
Case line.StartsWith("vc ")
Dim splitRGB() As String = line.Substring(3).Split(" "c)
Dim tX As Single = Convert.ToSingle(splitRGB(0))
Dim tY As Single = Convert.ToSingle(splitRGB(1))
Dim tZ As Single = Convert.ToSingle(splitRGB(2))
Dim vc As New VertexColor
Select Case UpAxis
Case UpAxis.Y
vc.R = tX
vc.G = tY
vc.B = tZ
Case UpAxis.Z
vc.R = tY
vc.G = tZ
vc.B = tX
End Select
newMesh.VertexColors.Add(vc)
Case line.StartsWith("f ")
Dim tri As New Face With {.Material = curMaterial}
For Each xyz As String In line.Substring(2).Split(" "c)
xyz = xyz.Trim
If xyz = "" Then Continue For
Dim splitsub() As String = Nothing
Dim p As New Point
Select Case True
Case xyz.Contains("/")
splitsub = xyz.Split("/"c)
Case xyz.Contains("\")
splitsub = xyz.Split("\"c)
Case Else
splitsub = {0, 0, 0}
End Select
Dim v1 As String = splitsub(0)
Dim v2 As String = splitsub(1)
Dim v3 As String = splitsub(2)
If v1 <> "" Then
p.Vertex = newMesh.Vertices(Convert.ToInt32(v1) - 1)
End If
If v2 <> "" Then
p.UV = newMesh.UVs(Convert.ToInt32(v2) - 1)
Else
Dim newUV As New UV With {.U = 0, .V = 0}
p.UV = newUV
newMesh.UVs.Add(newUV)
End If
If v3 <> "" Then
p.Normal = newMesh.Normals(Convert.ToInt32(v3) - 1)
End If
If splitsub.Count > 3 Then
Dim v4 As String = splitsub(3)
If v4 <> "" Then p.VertexColor = newMesh.VertexColors(Convert.ToInt32(v4) - 1)
End If
tri.Points.Add(p)
Next
newMesh.Faces.Add(tri)
End Select
End If
Loop
newObj.Meshes.Add(newMesh)
curThread.CurrentCulture = curCultInfo
srObj.Close()
Return newObj
End Function
Public Shared Sub ToFile(FileName As String, obj As Object3D)
Dim fs As New FileStream(FileName, FileMode.Create, FileAccess.ReadWrite)
Dim sw As New StreamWriter(fs, Text.Encoding.ASCII)
If obj.Materials.Count > 0 Then
Dim mtlName As String = Path.GetFileNameWithoutExtension(FileName) & ".mtl"
Dim mtlFile As String = Path.Combine(Path.GetDirectoryName(FileName), mtlName)
sw.WriteLine($"mtllib {mtlName}")
MaterialLib.ToFile(mtlFile, obj)
End If
Dim curVertCount As Integer = 1
Dim curUVCount As Integer = 1
Dim curNormCount As Integer = 1
Dim curVertColCount As Integer = 1
For Each m As Mesh In obj.Meshes
For Each vert As Vertex In m.Vertices
sw.WriteLine($"v {vert.X.ToString.Replace(",", ".")} {vert.Y.ToString.Replace(",", ".")} {vert.Z.ToString.Replace(",", ".")}")
Next
For Each uv As UV In m.UVs
sw.WriteLine($"vt {uv.U.ToString.Replace(",", ".")} {uv.V.ToString.Replace(",", ".")}")
Next
For Each norm As Normal In m.Normals
sw.WriteLine($"vn {norm.X.ToString.Replace(",", ".")} {norm.Y.ToString.Replace(",", ".")} {norm.Z.ToString.Replace(",", ".")}")
Next
For Each vertcol As VertexColor In m.VertexColors
sw.WriteLine($"vc {vertcol.R.ToString.Replace(",", ".")} {vertcol.G.ToString.Replace(",", ".")} {vertcol.B.ToString.Replace(",", ".")}")
Next
Dim curMtl As Material = Nothing
For Each f As Face In m.Faces
If curMtl IsNot f.Material Then
curMtl = f.Material
sw.WriteLine($"usemtl _{GetIndexOfMaterialInList(obj, curMtl)}")
End If
sw.Write("f")
For Each p As Point In f.Points
sw.Write(" ")
sw.Write(curVertCount + m.Vertices.IndexOf(p.Vertex))
sw.Write("/")
If p.UV IsNot Nothing Then sw.Write(curUVCount + m.UVs.IndexOf(p.UV))
sw.Write("/")
If p.Normal IsNot Nothing Then sw.Write(curNormCount + m.Normals.IndexOf(p.Normal))
If m.VertexColors.Count > 0 Then
sw.Write("/")
If p.VertexColor IsNot Nothing Then sw.Write(curVertColCount + m.VertexColors.IndexOf(p.VertexColor))
End If
Next
sw.WriteLine()
Next
curVertCount += m.Vertices.Count
curUVCount += m.UVs.Count
curNormCount += m.Normals.Count
curVertColCount += m.VertexColors.Count
Next
sw.Flush()
fs.Close()
End Sub
Public Shared Function GetIndexOfMaterialInList(obj As Object3D, matToFind As Material) As Integer
For Index As Integer = 0 To obj.Materials.Count - 1
If obj.Materials.ElementAt(Index).Value.Equals(matToFind) Then
Return Index
End If
Next
Return -1
End Function
End Class
Public Class MaterialLib
Public ReadOnly Property Materials As New Dictionary(Of String, Material)
Private ReadOnly LoadedImages As New Dictionary(Of String, Image)
Public Sub FromFile(fileName As String, LoadMaterials As Boolean)
LoadedImages.Clear()
Dim curMatLibPath As String = Path.GetDirectoryName(fileName)
Dim curMat As Material = Nothing
Dim curName As String = ""
Dim srMtl As New StreamReader(fileName, Text.Encoding.ASCII)
Dim line As String = ""
Do Until srMtl.EndOfStream
line = srMtl.ReadLine
Select Case True
Case line.StartsWith("newmtl ")
curMat = New Material
curName = line.Substring(7)
Materials.Add(curName, curMat)
Case line.ToLower.StartsWith("kd ")
Dim splitColor() As String = line.Substring(3).Split(" "c)
Dim col As Color = Color.FromArgb(
Convert.ToSingle(Math.Round(255 * splitColor(0))),
Convert.ToSingle(Math.Round(255 * splitColor(1))),
Convert.ToSingle(Math.Round(255 * splitColor(2))))
curMat.Color = col
Case line.ToLower.StartsWith("d ")
curMat.Opacity = Convert.ToSingle(line.Substring(2))
Case line.ToLower.StartsWith("tr ")
curMat.Opacity = 1 - Convert.ToSingle(line.Substring(2))
Case line.ToLower.StartsWith("map_kd ")
If LoadMaterials Then
Dim mtlpath As String = line.Substring(7)
Dim combipath As String = Path.Combine(curMatLibPath, line.Substring(7))
Dim imgfile As String
If File.Exists(combipath) Then
imgfile = combipath
ElseIf File.Exists(line.Substring(7)) Then
imgfile = mtlpath
Else
imgfile = ""
End If
If imgfile <> "" Then
If LoadedImages.ContainsKey(imgfile) Then
curMat.Image = LoadedImages(imgfile)
Else
Dim fs As New FileStream(imgfile, FileMode.Open, FileAccess.Read)
curMat.Image = Image.FromStream(fs)
fs.Close()
Dim imgExists As Boolean = False
For Each kvp In LoadedImages
If Not imgExists AndAlso IsTheSameAs(kvp.Value, curMat.Image) Then
curMat.Image = kvp.Value
imgExists = True
End If
Next
If Not imgExists Then
LoadedImages.Add(imgfile, curMat.Image)
End If
End If
End If
End If
End Select
Loop
srMtl.Close()
End Sub
Public Shared Sub ToFile(fileName As String, obj As Object3D)
Dim fs As New FileStream(fileName, FileMode.Create, FileAccess.ReadWrite)
Dim sw As New StreamWriter(fs, Text.Encoding.ASCII)
Dim imgDirName As String = Path.GetFileNameWithoutExtension(fileName)
Dim imgDirFull As String = Path.Combine(Path.GetDirectoryName(fileName), Path.GetFileNameWithoutExtension(fileName))
For Each kvp As KeyValuePair(Of String, Material) In obj.Materials
Dim mat As Material = kvp.Value
Dim name As String = "_" & ObjFile.GetIndexOfMaterialInList(obj, mat)
sw.WriteLine($"newmtl {name}")
If mat.Color IsNot Nothing Then
sw.WriteLine($"kd {mat.Color.Value.R.ToString.Replace(",", ".")} {mat.Color.Value.G.ToString.Replace(",", ".")} {mat.Color.Value.B.ToString.Replace(",", ".")}")
End If
If mat.Opacity IsNot Nothing Then
sw.WriteLine($"d {mat.Opacity.Value.ToString.Replace(",", ".")}")
End If
If mat.Image IsNot Nothing Then
Dim imgFile As String = name & ".png"
If Not Directory.Exists(imgDirFull) Then Directory.CreateDirectory(imgDirFull)
mat.Image.Save(Path.Combine(imgDirFull, imgFile), Imaging.ImageFormat.Png)
sw.WriteLine($"map_kd {Path.Combine(imgDirName, imgFile)}")
End If
Next
sw.Flush()
fs.Close()
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,5 @@
Public Class Face
Public ReadOnly Property Points As New List(Of Point)
Public Property Material As Material = Nothing
Public Property Tag As Object = Nothing
End Class

View File

@@ -0,0 +1,6 @@
Public Interface IToObject3D
Function ToObject3D() As Object3D
Function ToObject3DAsync() As Task(Of Object3D)
End Interface

View File

@@ -0,0 +1,25 @@
Imports System.Numerics
Public Class Material
Implements IComparable
Public Property Image As Image = Nothing
Public Property Color As Color? = Nothing
Public Property Opacity As Single? = Nothing
Public Property Wrap As New Vector2(10497, 10497)
Public Property Scale As New Vector2(1.0F, 1.0F)
Public Property Tag As Object = Nothing
Public Function CompareTo(obj As Object) As Integer Implements IComparable.CompareTo
If obj IsNot Nothing Then
If obj Is Me Then
Return 0
Else
Return -1
End If
Else
Return 1
End If
End Function
End Class

View File

@@ -0,0 +1,41 @@
Imports System.Numerics
Public Class Mesh
Public ReadOnly Property Vertices As New List(Of Vertex)
Public ReadOnly Property Normals As New List(Of Normal)
Public ReadOnly Property UVs As New List(Of UV)
Public ReadOnly Property VertexColors As New List(Of VertexColor)
Public ReadOnly Property Faces As New List(Of Face)
Friend Function GetCenterModelAvg() As Vector3
Dim avgX As Integer = 0
Dim avgY As Integer = 0
Dim avgZ As Integer = 0
For Each v As Vertex In Vertices
avgX += v.X
avgY += v.Y
avgZ += v.Z
Next
Return New Vector3(avgX, avgY, avgZ)
End Function
Public Sub CenterModel()
Dim avg As Vector3 = GetCenterModelAvg()
avg /= New Vector3(Vertices.Count)
CenterModel(avg)
End Sub
Public Sub CenterModel(avg As Vector3)
For Each v As Vertex In Vertices
v.X -= avg.X
v.Y -= avg.Y
v.Z -= avg.Z
Next
End Sub
End Class

View File

@@ -0,0 +1,11 @@
Imports System.Numerics
Public Class ModelBoundaries
Public ReadOnly Upper As Vector3
Public ReadOnly Lower As Vector3
Public Sub New(upper As Vector3, lower As Vector3)
Me.Upper = upper
Me.Lower = lower
End Sub
End Class

View File

@@ -0,0 +1,5 @@
Public Class Normal
Public Property X As Single = 0
Public Property Y As Single = 0
Public Property Z As Single = 0
End Class

View File

@@ -0,0 +1,200 @@
Imports System.IO
Imports System.Numerics
Public Class Object3D
Public ReadOnly Property Meshes As New List(Of Mesh)
Public ReadOnly Property Materials As New Dictionary(Of String, Material)
Public Property Shading As New Shading
Public Sub ScaleModel(factor As Single)
For Each m As Mesh In Meshes
For Each v As Vertex In m.Vertices
v.X *= factor
v.Y *= factor
v.Z *= factor
Next
Next
End Sub
Public Sub OffsetModel(off As Vector3)
For Each m As Mesh In Meshes
For Each v As Vertex In m.Vertices
v.X += off.X
v.Y += off.Y
v.Z += off.Z
Next
Next
End Sub
Public Function GetBoundaries() As ModelBoundaries
Dim maxX As Single? = Nothing
Dim maxY As Single? = Nothing
Dim maxZ As Single? = Nothing
Dim minX As Single? = Nothing
Dim minY As Single? = Nothing
Dim minZ As Single? = Nothing
For Each m As Mesh In Meshes
For Each vert As Vertex In m.Vertices
If maxX Is Nothing OrElse vert.X > maxX Then maxX = vert.X
If maxY Is Nothing OrElse vert.Y > maxY Then maxY = vert.Y
If maxZ Is Nothing OrElse vert.Z > maxZ Then maxZ = vert.Z
If minX Is Nothing OrElse vert.X < minX Then minX = vert.X
If minY Is Nothing OrElse vert.Y < minY Then minY = vert.Y
If minZ Is Nothing OrElse vert.Z < minZ Then minZ = vert.Z
Next
Next
If maxX Is Nothing Then maxX = 0
If maxY Is Nothing Then maxY = 0
If maxZ Is Nothing Then maxZ = 0
If minX Is Nothing Then minX = 0
If minY Is Nothing Then minY = 0
If minZ Is Nothing Then minZ = 0
Return New ModelBoundaries(New Vector3(maxX, maxY, maxZ),
New Vector3(minX, minY, minZ))
End Function
Public Sub SetNullVertices()
Dim newVert As New Vertex With {.X = 0, .Y = 0, .Z = 0}
Dim nullCounter As Integer
For Each m As Mesh In Meshes
nullCounter = 0
For Each f As Face In m.Faces
For Each p As Point In f.Points
If p.Vertex Is Nothing Then
p.Vertex = newVert
nullCounter += 1
End If
Next
Next
If nullCounter > 0 Then
m.Vertices.Add(newVert)
End If
Next
End Sub
Public Sub SetNullUVs()
Dim newUV As New UV With {.U = 0, .V = 0}
Dim nullCounter As Integer
For Each m As Mesh In Meshes
nullCounter = 0
For Each f As Face In m.Faces
For Each p As Point In f.Points
If p.UV Is Nothing Then
p.UV = newUV
nullCounter += 1
End If
Next
Next
If nullCounter > 0 Then
m.UVs.Add(newUV)
End If
Next
End Sub
Public Sub SetNullNormals()
Dim newNormal As New Normal With {.X = 0, .Y = 0, .Z = 1}
Dim nullCounter As Integer
For Each m As Mesh In Meshes
nullCounter = 0
For Each f As Face In m.Faces
For Each p As Point In f.Points
If p.Normal Is Nothing Then
p.Normal = newNormal
nullCounter += 1
End If
Next
Next
If nullCounter > 0 Then
m.Normals.Add(newNormal)
End If
Next
End Sub
Public Sub RemoveUnusedMaterials()
'Dim usedMats As New List(Of Material)
'Dim unusedMats As New List(Of String)
'For Each f As Face In Faces
' If Not usedMats.Contains(f.Material) Then
' usedMats.Add(f.Material)
' End If
'Next
'For Each kvp As KeyValuePair(Of String, Material) In Materials
' If Not usedMats.Contains(kvp.Value) Then
' unusedMats.Add(kvp.Key)
' End If
'Next
'For Each k As String In unusedMats
' Materials.Remove(k)
'Next
End Sub
Public Function ToOneMesh() As Object3D
Dim newObject3D As New Object3D
Dim newMesh As New Mesh
For Each mat As KeyValuePair(Of String, Material) In Materials
newObject3D.Materials.Add(mat.Key, mat.Value)
Next
For Each m As Mesh In Meshes
For Each v As Vertex In m.Vertices
newMesh.Vertices.Add(v)
Next
For Each vc As VertexColor In m.VertexColors
newMesh.VertexColors.Add(vc)
Next
For Each n As Normal In m.Normals
newMesh.Normals.Add(n)
Next
For Each uv As UV In m.UVs
newMesh.UVs.Add(uv)
Next
For Each f As Face In m.Faces
newMesh.Faces.Add(f)
Next
Next
newObject3D.Meshes.Add(newMesh)
Return newObject3D
End Function
Public Sub CenterModel()
Dim avg As Vector3 = Vector3.Zero
Dim vertsCount As ULong = 0
For Each m As Mesh In Meshes
avg += m.GetCenterModelAvg
vertsCount += m.Vertices.Count
Next
avg /= vertsCount
CenterModel(avg)
End Sub
Public Sub CenterModel(avg As Vector3)
For Each m As Mesh In Meshes
m.CenterModel(avg)
Next
End Sub
End Class

View File

@@ -0,0 +1,6 @@
Public Class Point
Public Property Vertex As Vertex = Nothing
Public Property UV As UV = Nothing
Public Property VertexColor As VertexColor = Nothing
Public Property Normal As Normal = Nothing
End Class

View File

@@ -0,0 +1,5 @@
Public Class Shading
Public Property AmbientColor As Color = Color.FromArgb(&HFFFFFFFF)
Public Property DiffuseColor As Color = Color.FromArgb(&HFF7F7F7F)
Public Property DiffusePosition As Vertex = Nothing
End Class

View File

@@ -0,0 +1,4 @@
Public Class UV
Public Property U As Single = 0
Public Property V As Single = 0
End Class

View File

@@ -0,0 +1,4 @@
Public Enum UpAxis
Y
Z
End Enum

View File

@@ -0,0 +1,5 @@
Public Class Vertex
Public Property X As Double = 0
Public Property Y As Double = 0
Public Property Z As Double = 0
End Class

View File

@@ -0,0 +1,6 @@
Public Class VertexColor
Public Property R As Single = 1
Public Property G As Single = 1
Public Property B As Single = 1
Public Property A As Single = 1
End Class

View File

@@ -0,0 +1,13 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On

View File

@@ -0,0 +1,11 @@
<?xml version="1.0" encoding="utf-8"?>
<MyApplicationData xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<MySubMain>true</MySubMain>
<MainForm>Form1</MainForm>
<SingleInstance>false</SingleInstance>
<ShutdownMode>0</ShutdownMode>
<EnableVisualStyles>true</EnableVisualStyles>
<AuthenticationMode>0</AuthenticationMode>
<ApplicationType>0</ApplicationType>
<SaveMySettingsOnExit>true</SaveMySettingsOnExit>
</MyApplicationData>

View File

@@ -0,0 +1,35 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' Allgemeine Informationen über eine Assembly werden über die folgenden
' Attribute gesteuert. Ändern Sie diese Attributwerte, um die Informationen zu ändern,
' die einer Assembly zugeordnet sind.
' Werte der Assemblyattribute überprüfen
<Assembly: AssemblyTitle("SimpleFileParser")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("Pilzinsel64")>
<Assembly: AssemblyProduct("SM64 ROM Manager")>
<Assembly: AssemblyCopyright("Copyright © Pilzinsel64 2018")>
<Assembly: AssemblyTrademark("")>
<Assembly: ComVisible(False)>
'Die folgende GUID bestimmt die ID der Typbibliothek, wenn dieses Projekt für COM verfügbar gemacht wird.
<Assembly: Guid("21610485-a96f-4808-bf2e-bbf06c65eba1")>
' Versionsinformationen für eine Assembly bestehen aus den folgenden vier Werten:
'
' Hauptversion
' Nebenversion
' Buildnummer
' Revision
'
' Sie können alle Werte angeben oder Standardwerte für die Build- und Revisionsnummern verwenden,
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.0.0.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")>

View File

@@ -0,0 +1,63 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Imports System
Namespace My.Resources
'Diese Klasse wurde von der StronglyTypedResourceBuilder automatisch generiert
'-Klasse über ein Tool wie ResGen oder Visual Studio automatisch generiert.
'Um einen Member hinzuzufügen oder zu entfernen, bearbeiten Sie die .ResX-Datei und führen dann ResGen
'mit der /str-Option erneut aus, oder Sie erstellen Ihr VS-Projekt neu.
'''<summary>
''' Eine stark typisierte Ressourcenklasse zum Suchen von lokalisierten Zeichenfolgen usw.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "15.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo
'''<summary>
''' Gibt die zwischengespeicherte ResourceManager-Instanz zurück, die von dieser Klasse verwendet wird.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If Object.ReferenceEquals(resourceMan, Nothing) Then
Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("Pilz.S3DFileParser.Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Überschreibt die CurrentUICulture-Eigenschaft des aktuellen Threads für alle
''' Ressourcenzuordnungen, die diese stark typisierte Ressourcenklasse verwenden.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set
resourceCulture = value
End Set
End Property
End Module
End Namespace

View File

@@ -0,0 +1,117 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>

View File

@@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "15.9.0.0"), _
Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Partial Friend NotInheritable Class MySettings
Inherits Global.System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings()),MySettings)
#Region "Automatische My.Settings-Speicherfunktion"
#If _MyType = "WindowsForms" Then
Private Shared addedHandler As Boolean
Private Shared addedHandlerLockObject As New Object
<Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Private Shared Sub AutoSaveSettings(sender As Global.System.Object, e As Global.System.EventArgs)
If My.Application.SaveMySettingsOnExit Then
My.Settings.Save()
End If
End Sub
#End If
#End Region
Public Shared ReadOnly Property [Default]() As MySettings
Get
#If _MyType = "WindowsForms" Then
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
#End If
Return defaultInstance
End Get
End Property
End Class
End Namespace
Namespace My
<Global.Microsoft.VisualBasic.HideModuleNameAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Module MySettingsProperty
<Global.System.ComponentModel.Design.HelpKeywordAttribute("My.Settings")> _
Friend ReadOnly Property Settings() As Global.Pilz.S3DFileParser.My.MySettings
Get
Return Global.Pilz.S3DFileParser.My.MySettings.Default
End Get
End Property
End Module
End Namespace

View File

@@ -0,0 +1,7 @@
<?xml version='1.0' encoding='utf-8'?>
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles>
<Profile Name="(Default)" />
</Profiles>
<Settings />
</SettingsFile>

View File

@@ -0,0 +1,14 @@
Namespace Exceptions
Public Class MaterialException
Inherits Exception
Public Sub New()
MyBase.New
End Sub
Public Sub New(message As String)
MyBase.New(message)
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,26 @@
Imports System.IO
Imports System.Runtime.CompilerServices
Friend Module Extensions
<Extension>
Public Function GetPropertyValue(base As Object, propertyName As String) As Object
Return base?.GetType.GetProperty(propertyName, Reflection.BindingFlags.Public Or Reflection.BindingFlags.NonPublic Or Reflection.BindingFlags.Instance Or Reflection.BindingFlags.Static)?.GetValue(base)
End Function
<Extension>
Public Function IsTheSameAs(base As Bitmap, image As Bitmap) As Boolean
If base.Size <> image.Size Then Return False
For y As Integer = 0 To base.Height - 1
For x As Integer = 0 To base.Width - 1
Dim p1 As Color = base.GetPixel(x, y)
Dim p2 As Color = image.GetPixel(x, y)
If p1 <> p2 Then Return False
Next
Next
Return True
End Function
End Module

View File

@@ -0,0 +1,144 @@
Imports System.Reflection
Imports Assimp.Unmanaged
Public Class File3DLoaderModule
Public Delegate Function LoaderAction(fileName As String, options As LoaderOptions) As Object3D
Public Delegate Sub ExporterAction(obj As Object3D, fileName As String)
Private Shared _LoaderModules As File3DLoaderModule() = Nothing
Private Shared _ExporterModules As File3DLoaderModule() = Nothing
Private ReadOnly method As [Delegate] = Nothing
Public ReadOnly Property Name As String
Public ReadOnly Property SupportedFormats As IReadOnlyDictionary(Of String, String)
Public Sub New(name As String, method As LoaderAction, supportedFormats As IReadOnlyDictionary(Of String, String))
Me.Name = name
Me.method = method
Me.SupportedFormats = supportedFormats
End Sub
Public Sub New(name As String, method As ExporterAction, supportedFormats As IReadOnlyDictionary(Of String, String))
Me.Name = name
Me.method = method
Me.SupportedFormats = supportedFormats
End Sub
Public Function InvokeAsync(obj As Object3D, fileName As String) As Task
Return Task.Run(Sub() Invoke(obj, fileName))
End Function
Public Sub Invoke(obj As Object3D, fileName As String)
method.Method.Invoke(Nothing, {obj, fileName})
End Sub
Public Function InvokeAsync(fileName As String, options As LoaderOptions) As Task(Of Object3D)
Return Task.Run(Function() Invoke(fileName, options))
End Function
Public Function Invoke(fileName As String, options As LoaderOptions) As Object3D
Return method.Method.Invoke(Nothing, {fileName, options})
End Function
Public Shared ReadOnly Property LoaderModules As File3DLoaderModule()
Get
If _LoaderModules Is Nothing Then
_LoaderModules = GetLoaderModules()
End If
Return _LoaderModules
End Get
End Property
Public Shared ReadOnly Property ExporterModules As File3DLoaderModule()
Get
If _ExporterModules Is Nothing Then
_ExporterModules = GetExporterModules()
End If
Return _ExporterModules
End Get
End Property
Private Shared Function GetLoaderModules() As File3DLoaderModule()
Dim list As New List(Of File3DLoaderModule)
list.Add(New File3DLoaderModule("Simple File Parser",
AddressOf LoadViaSimpleFileParser,
New Dictionary(Of String, String) From {{"obj", "OBJ"}}))
AssimpModule.AssimpLoader.LoadAssimpLibs()
Dim exts As New Dictionary(Of String, String)
For Each fd As Assimp.ExportFormatDescription In AssimpLibrary.Instance.GetExportFormatDescriptions
If Not exts.ContainsKey(fd.FileExtension) Then exts.Add(fd.FileExtension, fd.FormatId & " - " & fd.Description)
Next
list.Add(New File3DLoaderModule("Assimp",
AddressOf LoadViaAssimp,
exts))
list.Add(New File3DLoaderModule("Aspose.3D",
AddressOf LoadViaAspose3D,
New Dictionary(Of String, String) From {
{"obj", "OBJ"},
{"dae", "DAE"},
{"fbx", "FBX"},
{"stl", "STL"},
{"3ds", "3DS"},
{"3d", "3D"},
{"gltf", "glTF"},
{"drc", "DRC"},
{"rvm", "RVM"},
{"pdf", "PDF"},
{"x", "X"},
{"jt", "JT"},
{"dfx", "DFX"},
{"ply", "PLY"},
{"3mf", "3MF"},
{"ase", "ASE"}}))
Return list.ToArray
End Function
Private Shared Function GetExporterModules() As File3DLoaderModule()
Dim list As New List(Of File3DLoaderModule)
list.Add(New File3DLoaderModule("Simple File Parser",
AddressOf ExportViaSimpleFileParser,
New Dictionary(Of String, String) From {{"obj", "OBJ"}}))
AssimpModule.AssimpLoader.LoadAssimpLibs()
Dim exts As New Dictionary(Of String, String)
For Each fd As Assimp.ExportFormatDescription In AssimpLibrary.Instance.GetExportFormatDescriptions
If Not exts.ContainsKey(fd.FileExtension) Then exts.Add(fd.FileExtension, fd.FormatId & " - " & fd.Description)
Next
list.Add(New File3DLoaderModule("Assimp",
AddressOf ExportViaAssimp,
exts))
Return list.ToArray
End Function
Private Shared Function LoadViaSimpleFileParser(fileName As String, options As LoaderOptions) As Object3D
Return ObjModule.ObjFile.FromFile(fileName, options.LoadMaterials, options.UpAxis)
End Function
Private Shared Function LoadViaAssimp(fileName As String, options As LoaderOptions) As Object3D
AssimpModule.AssimpLoader.LoadAssimpLibs()
Return AssimpModule.AssimpLoader.FromFile(fileName, options.LoadMaterials, options.UpAxis)
End Function
Private Shared Function LoadViaAspose3D(fileName As String, options As LoaderOptions) As Object3D
Return Aspose3DModule.Aspose3DLoader.FromFile(fileName, options.LoadMaterials, options.UpAxis)
End Function
Private Shared Sub ExportViaSimpleFileParser(o As Object3D, fileName As String)
ObjModule.ObjFile.ToFile(fileName, o)
End Sub
Private Shared Sub ExportViaAssimp(o As Object3D, fileName As String)
AssimpModule.AssimpLoader.LoadAssimpLibs()
AssimpModule.AssimpLoader.ToFile(fileName, o)
End Sub
End Class

View File

@@ -0,0 +1,14 @@
Public Class LoaderOptions
Public Property LoadMaterials As Boolean = False
Public Property UpAxis As UpAxis = False
Public Sub New()
End Sub
Public Sub New(loadMaterials As Boolean, upAxis As UpAxis)
Me.LoadMaterials = loadMaterials
Me.UpAxis = upAxis
End Sub
End Class

View File

@@ -0,0 +1,154 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="15.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProjectGuid>{AC955819-7910-450C-940C-7C1989483D4B}</ProjectGuid>
<OutputType>Library</OutputType>
<StartupObject>
</StartupObject>
<RootNamespace>Pilz.S3DFileParser</RootNamespace>
<AssemblyName>Pilz.Simple3DFileParser</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Windows</MyType>
<TargetFrameworkVersion>v4.5</TargetFrameworkVersion>
<NuGetPackageImportStamp>
</NuGetPackageImportStamp>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<PlatformTarget>AnyCPU</PlatformTarget>
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>Pilz.Simple3DFileParser.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<PlatformTarget>AnyCPU</PlatformTarget>
<DebugType>pdbonly</DebugType>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>Pilz.Simple3DFileParser.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup>
<OptionExplicit>On</OptionExplicit>
</PropertyGroup>
<PropertyGroup>
<OptionCompare>Binary</OptionCompare>
</PropertyGroup>
<PropertyGroup>
<OptionStrict>Off</OptionStrict>
</PropertyGroup>
<PropertyGroup>
<OptionInfer>On</OptionInfer>
</PropertyGroup>
<ItemGroup>
<Reference Include="Aspose.3D, Version=18.4.0.0, Culture=neutral, PublicKeyToken=f071c641d0b4582b, processorArchitecture=MSIL">
<HintPath>..\packages\Aspose.3D.18.4.0\lib\net40\Aspose.3D.dll</HintPath>
</Reference>
<Reference Include="AssimpNet, Version=3.3.2.0, Culture=neutral, PublicKeyToken=0d51b391f59f42a6, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>..\Shared Libs\AssimpNet.dll</HintPath>
</Reference>
<Reference Include="ColladaSchema">
<HintPath>..\..\..\DLL's\ColladaSchema.dll</HintPath>
</Reference>
<Reference Include="System" />
<Reference Include="System.Data" />
<Reference Include="System.Deployment" />
<Reference Include="System.Drawing" />
<Reference Include="System.Numerics.Vectors, Version=4.1.4.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a, processorArchitecture=MSIL">
<HintPath>..\packages\System.Numerics.Vectors.4.5.0\lib\portable-net45+win8+wp8+wpa81\System.Numerics.Vectors.dll</HintPath>
</Reference>
<Reference Include="System.Windows.Forms" />
<Reference Include="System.Xml" />
<Reference Include="System.Core" />
<Reference Include="System.Xml.Linq" />
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="System.Net.Http" />
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Collections.Generic" />
<Import Include="System.Data" />
<Import Include="System.Drawing" />
<Import Include="System.Diagnostics" />
<Import Include="System.Windows.Forms" />
<Import Include="System.Linq" />
<Import Include="System.Xml.Linq" />
<Import Include="System.Threading.Tasks" />
</ItemGroup>
<ItemGroup>
<Compile Include="Model\Face.vb" />
<Compile Include="Model\Material.vb" />
<Compile Include="Model\Mesh.vb" />
<Compile Include="Model\ModelBoundaries.vb" />
<Compile Include="Model\Normal.vb" />
<Compile Include="Model\Point.vb" />
<Compile Include="Model\Shading.vb" />
<Compile Include="Model\UpAxis.vb" />
<Compile Include="Model\UV.vb" />
<Compile Include="Model\Vertex.vb" />
<Compile Include="Model\VertexColor.vb" />
<Compile Include="Other\LoaderModule.vb" />
<Compile Include="FileParser\Aspose3DLoader.vb" />
<Compile Include="FileParser\AssimpLoader.vb" />
<Compile Include="Other\Extensions.vb" />
<Compile Include="Model\Interfaces.vb" />
<Compile Include="Model\Object3D.vb" />
<Compile Include="Other\Exceptions.vb" />
<Compile Include="FileParser\Obj.vb" />
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
</Compile>
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>Resources.resx</DependentUpon>
</Compile>
<Compile Include="My Project\Settings.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
<Compile Include="Other\LoaderOptions.vb" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="My Project\Resources.resx">
<Generator>VbMyResourcesResXFileCodeGenerator</Generator>
<LastGenOutput>Resources.Designer.vb</LastGenOutput>
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<SubType>Designer</SubType>
</EmbeddedResource>
</ItemGroup>
<ItemGroup>
<None Include="My Project\Application.myapp">
<Generator>MyApplicationCodeGenerator</Generator>
<LastGenOutput>Application.Designer.vb</LastGenOutput>
</None>
<None Include="My Project\Settings.settings">
<Generator>SettingsSingleFileGenerator</Generator>
<CustomToolNamespace>My</CustomToolNamespace>
<LastGenOutput>Settings.Designer.vb</LastGenOutput>
</None>
<None Include="App.config" />
<None Include="packages.config" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Pilz.LicenseHelper\Pilz.LicenseHelper.csproj">
<Project>{67593ff7-c1d1-4529-98c4-61cbd0615f08}</Project>
<Name>Pilz.LicenseHelper</Name>
</ProjectReference>
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>

View File

@@ -0,0 +1,5 @@
<?xml version="1.0" encoding="utf-8"?>
<packages>
<package id="Aspose.3D" version="18.4.0" targetFramework="net45" />
<package id="System.Numerics.Vectors" version="4.5.0" targetFramework="net45" />
</packages>

View File

@@ -16,15 +16,17 @@ Imports System.Windows.Forms
Public Class CrossThreadsInvokeing
Public Shared Sub RunAsync(Of T1, T2, T3)(ByVal Action As Action(Of T1, T2, T3), ByVal Arg1 As T1, ByVal Arg2 As T2, ByVal Arg3 As T3)
' Aufruf von Action.EndInvoke() gewährleisten, indem er als Callback-Argument mitgegeben wird
Action.BeginInvoke(Arg1, Arg2, Arg3, AddressOf Action.EndInvoke, Nothing)
End Sub
Public Shared Sub RunAsync(Of T1, T2)(ByVal Action As Action(Of T1, T2), ByVal Arg1 As T1, ByVal Arg2 As T2)
Action.BeginInvoke(Arg1, Arg2, AddressOf Action.EndInvoke, Nothing)
End Sub
Public Shared Sub RunAsync(Of T1)(ByVal Action As Action(Of T1), ByVal Arg1 As T1)
Action.BeginInvoke(Arg1, AddressOf Action.EndInvoke, Nothing)
End Sub
Public Shared Sub RunAsync(ByVal Action As Action)
Action.BeginInvoke(AddressOf Action.EndInvoke, Nothing)
End Sub
@@ -32,14 +34,6 @@ Public Class CrossThreadsInvokeing
Private Shared Function GuiCrossInvoke(ByVal Action As [Delegate], ByVal ParamArray Args() As Object) As Boolean
Dim frms As FormCollection = Application.OpenForms
'If frms.Count = 0 Then
' 'wenn kein Form mehr da ist, so tun, als ob das Invoking ausgeführt wäre
' Return True
'ElseIf frms(0).InvokeRequired Then
'frms(0).BeginInvoke(Action, Args)
'Return True
'End If
If frms.Count > 0 AndAlso frms(0).InvokeRequired Then
frms(0).BeginInvoke(Action, Args)
Return True
@@ -49,15 +43,17 @@ Public Class CrossThreadsInvokeing
End Function
Public Shared Sub RunGui(Of T1, T2, T3)(ByVal Action As Action(Of T1, T2, T3), ByVal Arg1 As T1, ByVal Arg2 As T2, ByVal Arg3 As T3)
'falls Invoking nicht erforderlich, die Action direkt ausführen
If Not GuiCrossInvoke(Action, Arg1, Arg2, Arg3) Then Action(Arg1, Arg2, Arg3)
End Sub
Public Shared Sub RunGui(Of T1, T2)(ByVal Action As Action(Of T1, T2), ByVal Arg1 As T1, ByVal Arg2 As T2)
If Not GuiCrossInvoke(Action, Arg1, Arg2) Then Action(Arg1, Arg2)
End Sub
Public Shared Sub RunGui(Of T1)(ByVal Action As Action(Of T1), ByVal Arg1 As T1)
If Not GuiCrossInvoke(Action, Arg1) Then Action(Arg1)
End Sub
Public Shared Sub RunGui(ByVal Action As Action)
If Not GuiCrossInvoke(Action) Then Action()
End Sub

View File

@@ -31,21 +31,33 @@ Public Class DefaultDrawMethodes
Public Shared Sub DrawPicture(e As PaintingObjectPaintEventArgs)
Dim obj As PaintingObject = e.PaintingObject
Dim objImg As Image
Dim objImgSize As Size
Dim result As RectangleF
Dim image As Bitmap
Dim zoomf As SizeF
Dim hasNoParent As Boolean = e.PaintingObject.Parent Is Nothing
Dim syncObj As Object
SyncLock e.PaintingObject.Parent
If hasNoParent Then
zoomf = New SizeF(1, 1)
Static newSyncObj As New Object
syncObj = newSyncObj
Else
zoomf = e.PaintingObject.Parent.ZoomFactor
syncObj = e.PaintingObject.Parent
End If
SyncLock syncObj
If obj?.Image Is Nothing Then Return
objImg = obj.Image
objImgSize = objImg.Size
End SyncLock
image = obj.BufferedImage
result = CalculateImageResolution(obj, objImg.Size)
result = CalculateImageResolution(obj, objImgSize, zoomf)
If obj.ImageProperties.Rotate = 90 OrElse obj.ImageProperties.Rotate = 270 Then
result = CalculateImageResolution(obj, New SizeF(objImg.Size.Height, objImg.Size.Width))
Else
result = result
result = CalculateImageResolution(obj, New SizeF(objImgSize.Height, objImgSize.Width), zoomf)
End If
If image Is Nothing Then
@@ -71,7 +83,7 @@ Public Class DefaultDrawMethodes
End If
If needRescaleImageBecauseRot Then
result = CalculateImageResolution(obj, New SizeF(objImg.Size.Height, objImg.Size.Width))
result = CalculateImageResolution(obj, New SizeF(objImgSize.Height, objImgSize.Width), zoomf)
image = DrawToNewImage(image, result.Size)
End If
@@ -79,12 +91,15 @@ Public Class DefaultDrawMethodes
End If
If image IsNot Nothing Then
SyncLock syncObj
e.Graphics.DrawImageUnscaled(image, New Rectangle(New Point(obj.Location.X + result.Location.X - e.Offset.X, obj.Location.Y + result.Location.Y - e.Offset.Y), result.Size.ToSize))
End SyncLock
End If
End Sub
Private Shared Function DrawToNewImage(image As Bitmap, newSize As SizeF) As Bitmap
Dim bmp As New Bitmap(CInt(newSize.Width), CInt(newSize.Height))
Dim bmp As New Bitmap(CInt(If(newSize.Width < 0, newSize.Width * -1, newSize.Width)),
CInt(If(newSize.Height < 0, newSize.Height * -1, newSize.Height)))
Dim gimage As Graphics = Graphics.FromImage(bmp)
gimage.SmoothingMode = SmoothingMode.HighQuality
gimage.PixelOffsetMode = PixelOffsetMode.HighQuality
@@ -103,10 +118,10 @@ Public Class DefaultDrawMethodes
e.Graphics.DrawLine(p2, no, no + obj.Size)
End Sub
Private Shared Function CalculateImageResolution(obj As PaintingObject, imageSize As SizeF) As RectangleF
Private Shared Function CalculateImageResolution(obj As PaintingObject, imageSize As SizeF, zoom As SizeF) As RectangleF
Dim result As New RectangleF
Dim objrect As New RectangleF(obj.Location, obj.Size)
Dim size As SizeF = imageSize
Dim size As SizeF = New SizeF(imageSize.Width * zoom.Width, imageSize.Height * zoom.Height)
Dim clientRectangle As RectangleF = objrect
Dim val As Single = clientRectangle.Width / size.Width

View File

@@ -107,6 +107,7 @@ Public Class PaintingControl
Set
If _ZoomFactor <> Value Then
_ZoomFactor = Value
ResetAllBufferedImages()
RaiseEvent ZoomFactorChanged(Me, New EventArgs)
End If
End Set
@@ -116,6 +117,13 @@ Public Class PaintingControl
DoubleBuffered = True
End Sub
Private Sub ResetAllBufferedImages()
For Each ob As PaintingObject In PaintingObjects
ob.ResetImageBuffer()
Next
Refresh()
End Sub
Private Sub CheckKeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown, Me.KeyUp
pressedShift = e.Shift
pressedControl = e.Control
@@ -166,6 +174,7 @@ Public Class PaintingControl
End If
Next
End If
If AutoSingleSelection Then
Dim objtosel As PaintingObject = curObjMouseDown
If objtosel?.EnableSelection Then
@@ -218,8 +227,10 @@ Public Class PaintingControl
If _IsMovingObjects Then
_IsMovingObjects = False
For Each obj As PaintingObject In GetSelectedObjects()
obj.RaiseMoved(New EventArgs)
Next
AutoArrangeToGrid()
'CalculateScrollValues()
End If
If curObjMouseDown IsNot Nothing Then
@@ -304,19 +315,18 @@ Public Class PaintingControl
End If
Next
End Sub
Private Sub UpdateObjectPositions(e As MouseEventArgs)
UpdateObjectPositions(e, GetSelectedObjects)
End Sub
Private Sub UpdateObjectPositions(e As MouseEventArgs, objs As IList(Of PaintingObject), Optional movedObjs As List(Of PaintingObject) = Nothing)
If IsResizingObjs(objs) Then Return
If movedObjs Is Nothing Then movedObjs = New List(Of PaintingObject)
Dim updateprocesses As New List(Of Task)
SuspendDrawing()
For Each obj As PaintingObject In objs
updateprocesses.Add(Task.Run(
Sub()
Dim sp As PointF = savedPos(obj)
If Not movedObjs.Contains(obj) Then
@@ -328,19 +338,15 @@ Public Class PaintingControl
UpdateObjectPositions(e, obj.PinnedObjects, movedObjs)
movedObjs.AddRange(obj.PinnedObjects.ToArray)
End If
End Sub))
Next
For Each a In updateprocesses
Do Until a.IsCompleted
Loop
Next
ResumeDrawing(False)
End Sub
Private Sub UpdateObjectPosition(e As MouseEventArgs, obj As PaintingObject, sp As PointF)
obj.Location = New Point(e.X - sp.X + Offset.X,
e.Y - sp.Y + Offset.Y)
obj.RaiseMoving(New EventArgs)
End Sub
Private Function IsResizingObjs(objs As IList(Of PaintingObject)) As Boolean
@@ -355,19 +361,25 @@ Public Class PaintingControl
End Function
Public Function GetObject(p As PointF, Optional UseExtRect As Boolean = False) As PaintingObject
For Each obj As PaintingObject In PaintingObjects
Dim val As PaintingObject = Nothing
For i As Integer = PaintingObjects.Count - 1 To 0 Step -1
Dim obj As PaintingObject = PaintingObjects(i)
If val Is Nothing Then
If UseExtRect Then
If HelpfulDrawingFunctions.IsPointInRectangle(p, obj.RectangleExtended) Then
Return obj
val = obj
End If
Else
If HelpfulDrawingFunctions.IsPointInRectangle(p, obj.Rectangle) Then
Return obj
val = obj
End If
End If
End If
Next
Return Nothing
Return val
End Function
Public Function GetObjects(p As Point) As PaintingObject()
@@ -439,46 +451,6 @@ Public Class PaintingControl
MyBase.OnPaintBackground(e)
End Sub
Private Function GetCurrentHashValue() As Integer
Dim hashes As New List(Of Integer)
hashes.AddRange({Offset.X,
Offset.Y,
Size.Width,
Size.Height})
For Each p As PaintingObject In PaintingObjects
hashes.AddRange({p.Location.X,
p.Location.Y,
p.Size.Width,
p.Size.Height,
p.DrawMethodes.Count,
p.FillColor.ToArgb,
p.OutlineColor.ToArgb,
p.SelectionColor.ToArgb,
p.TextColor.ToArgb,
p.Type,
p.Text.GetHashCode / p.Text.Length,
p.Visible,
p.VerticalTextAlignment,
p.HorizontalTextAlignment})
Next
Dim hash As Integer = 0
For Each h As Integer In hashes
Try
hash += h
Catch ex As Exception
If h <> 0 AndAlso h <> 1 Then
hash /= h
End If
End Try
Next
Return hash
End Function
Protected Overrides Sub OnPaint(e As PaintEventArgs)
'Do default Drawing Methode
MyBase.OnPaint(e)
@@ -579,6 +551,15 @@ Public Class PaintingControl
End If
End Sub
Public Function IsPinnedObject(o As PaintingObject) As Boolean
For Each obj As PaintingObject In PaintingObjects
If obj.PinnedObjects.Contains(o) Then
Return True
End If
Next
Return False
End Function
Public Sub AutoArrangeToGrid()
If GridEnabled Then
For Each obj As PaintingObject In GetSelectedObjects()

View File

@@ -47,6 +47,7 @@ Imports Newtonsoft.Json
Public Property MouseTransparency As Boolean = False
Public ReadOnly Property Layering As New PaintingObjectLayering(Me)
Public ReadOnly Property PaintingObjects As New PaintingObjectList(_Parent) With {.EnableRaisingEvents = False}
Public ReadOnly Property ErrorsAtDrawing As ULong = 0
Public Event MouseClick(sender As PaintingObject, e As MouseEventArgs)
Public Event MouseDown(sender As PaintingObject, e As MouseEventArgs)
@@ -56,6 +57,8 @@ Imports Newtonsoft.Json
Public Event Paint(sender As PaintingObject, e As PaintEventArgs)
Public Event ParentChanged(sender As PaintingObject, e As EventArgs)
Public Event VisibleChanged(sender As PaintingObject, e As EventArgs)
Public Event Moved(sender As PaintingObject, e As EventArgs)
Public Event Moving(sender As PaintingObject, e As EventArgs)
Public Sub New()
End Sub
@@ -69,21 +72,27 @@ Imports Newtonsoft.Json
Me.DrawMethodes.AddRange(drawMethodes)
End Sub
Public Sub RaiseMouseClick(e As MouseEventArgs)
Friend Sub RaiseMouseClick(e As MouseEventArgs)
RaiseEvent MouseClick(Me, e)
End Sub
Public Sub RaiseMouseDown(e As MouseEventArgs)
Friend Sub RaiseMouseDown(e As MouseEventArgs)
RaiseEvent MouseDown(Me, e)
End Sub
Public Sub RaiseMouseUp(e As MouseEventArgs)
Friend Sub RaiseMouseUp(e As MouseEventArgs)
RaiseEvent MouseUp(Me, e)
End Sub
Public Sub RaiseMouseMove(e As MouseEventArgs)
Friend Sub RaiseMouseMove(e As MouseEventArgs)
RaiseEvent MouseMove(Me, e)
End Sub
Private Sub RaisePaint(e As PaintEventArgs)
RaiseEvent Paint(Me, e)
End Sub
Friend Sub RaiseMoved(e As EventArgs)
RaiseEvent Moved(Me, e)
End Sub
Friend Sub RaiseMoving(e As EventArgs)
RaiseEvent Moving(Me, e)
End Sub
Public Property Type As PaintingObjectType
Get
@@ -376,16 +385,22 @@ Imports Newtonsoft.Json
End Set
End Property
<JsonIgnore> Public ReadOnly Property Right As Integer
<JsonIgnore> Public Property Right As Integer
Get
Return X + Width
End Get
Set(value As Integer)
X = value - Width
End Set
End Property
<JsonIgnore> Public ReadOnly Property Bottom() As Integer
<JsonIgnore> Public Property Bottom() As Integer
Get
Return Y + Height
End Get
Set(value As Integer)
Y = value - Height
End Set
End Property
Public Property EnableResize As Boolean
@@ -439,7 +454,11 @@ Imports Newtonsoft.Json
Dim poevargs As New PaintingObjectPaintEventArgs(Me, g, offset)
For Each dm As DelegateDrawPaintingObjectMethode In DrawMethodes
Try
dm?.Invoke(poevargs)
Catch ex As Exception
_ErrorsAtDrawing += 1
End Try
Next
If Selected AndAlso DrawSelectionMethode IsNot Nothing Then
@@ -454,20 +473,27 @@ Imports Newtonsoft.Json
Public Function Clone(includePinnedObject As Boolean) As Object
Dim obj As New PaintingObject
Dim t As Type = Me.GetType
Dim blackField As New List(Of String) From {
Dim metype As Type = Me.GetType
Dim blackField As String() = {
NameOf(_PinnedObjects),
NameOf(resizeEngine),
NameOf(_Parent),
NameOf(BufferedImage)
NameOf(BufferedImage),
NameOf(_ImageProperties)
}
Dim fields As FieldInfo() = t.GetFields(BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.IgnoreCase Or BindingFlags.Instance)
Dim copyFields =
Sub(source As Object, dest As Object, blackFields As String(), t As Type)
Dim fields As New List(Of FieldInfo)(t.GetFields(BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.IgnoreCase Or BindingFlags.Instance))
For Each field As FieldInfo In fields
If Not blackField.Contains(field.Name) Then
field.SetValue(obj, field.GetValue(Me))
If Not blackFields.Contains(field.Name) Then
field.SetValue(dest, field.GetValue(source))
End If
Next
End Sub
copyFields(Me, obj, blackField, metype)
copyfields(ImageProperties, obj.ImageProperties, {}, ImageProperties.GetType)
If includePinnedObject Then
obj.PinnedObjects.AddRange(PinnedObjects)

View File

@@ -95,8 +95,12 @@ Imports Pilz.Drawing
ElseIf Not mMouseDown Then
Dim eX As Integer = e.X - mObj.X + mObj.Parent.Offset.X
Dim eY As Integer = e.Y - mObj.Y + mObj.Parent.Offset.Y
Dim eXo As Integer = e.X
Dim eYo As Integer = e.Y
Dim eXwo As Integer = eXo - mObj.X
Dim eYwo As Integer = eYo - mObj.Y
Dim eX As Integer = eXwo + mObj.Parent.Offset.X
Dim eY As Integer = eYwo + mObj.Parent.Offset.Y
Dim eLocation As New Point(eX, eY)
Dim extRect As RectangleF = mObj.RectangleExtended
Dim oldRect As RectangleF = mObj.Rectangle
@@ -108,8 +112,9 @@ Imports Pilz.Drawing
newRect.Height = (extRect.Height - oldRect.Height) / 2
Dim setToNone As Boolean = False
Dim isOnTop As Boolean = mObj.Parent.GetObject(New PointF(eXo, eYo), True) Is mObj
If Enabled Then
If Enabled AndAlso isOnTop Then
Select Case True
Case HelpfulDrawingFunctions.IsPointInRectangle(eLocation, New Rectangle(newRect.X, newRect.Y, newRect.Width, newRect.Height))
mObj.Cursor = Cursors.SizeNWSE

View File

@@ -23,6 +23,12 @@ Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Pilz.Configuration", "Pilz.
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Pilz.Reflection.PluginSystem", "Pilz.Reflection.PluginSystem\Pilz.Reflection.PluginSystem.vbproj", "{F7975470-4CA3-4FAB-BB6A-A3AF3978ABB7}"
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Pilz.Drawing.Drawing3D.OpenGLFactory", "Pilz.Drawing.Drawing3D.OpenGLRenderer\Pilz.Drawing.Drawing3D.OpenGLFactory.vbproj", "{5E9F0B0A-F7B8-49A9-80FC-6DFE0D44CC84}"
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Pilz.Simple3DFileParser", "Pilz.Simple3DFileParser\Pilz.Simple3DFileParser.vbproj", "{AC955819-7910-450C-940C-7C1989483D4B}"
EndProject
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "Pilz.LicenseHelper", "Pilz.LicenseHelper\Pilz.LicenseHelper.csproj", "{67593FF7-C1D1-4529-98C4-61CBD0615F08}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
@@ -111,6 +117,30 @@ Global
{F7975470-4CA3-4FAB-BB6A-A3AF3978ABB7}.Release|Any CPU.Build.0 = Release|Any CPU
{F7975470-4CA3-4FAB-BB6A-A3AF3978ABB7}.Release|x86.ActiveCfg = Release|Any CPU
{F7975470-4CA3-4FAB-BB6A-A3AF3978ABB7}.Release|x86.Build.0 = Release|Any CPU
{5E9F0B0A-F7B8-49A9-80FC-6DFE0D44CC84}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{5E9F0B0A-F7B8-49A9-80FC-6DFE0D44CC84}.Debug|Any CPU.Build.0 = Debug|Any CPU
{5E9F0B0A-F7B8-49A9-80FC-6DFE0D44CC84}.Debug|x86.ActiveCfg = Debug|Any CPU
{5E9F0B0A-F7B8-49A9-80FC-6DFE0D44CC84}.Debug|x86.Build.0 = Debug|Any CPU
{5E9F0B0A-F7B8-49A9-80FC-6DFE0D44CC84}.Release|Any CPU.ActiveCfg = Release|Any CPU
{5E9F0B0A-F7B8-49A9-80FC-6DFE0D44CC84}.Release|Any CPU.Build.0 = Release|Any CPU
{5E9F0B0A-F7B8-49A9-80FC-6DFE0D44CC84}.Release|x86.ActiveCfg = Release|Any CPU
{5E9F0B0A-F7B8-49A9-80FC-6DFE0D44CC84}.Release|x86.Build.0 = Release|Any CPU
{AC955819-7910-450C-940C-7C1989483D4B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{AC955819-7910-450C-940C-7C1989483D4B}.Debug|Any CPU.Build.0 = Debug|Any CPU
{AC955819-7910-450C-940C-7C1989483D4B}.Debug|x86.ActiveCfg = Debug|Any CPU
{AC955819-7910-450C-940C-7C1989483D4B}.Debug|x86.Build.0 = Debug|Any CPU
{AC955819-7910-450C-940C-7C1989483D4B}.Release|Any CPU.ActiveCfg = Release|Any CPU
{AC955819-7910-450C-940C-7C1989483D4B}.Release|Any CPU.Build.0 = Release|Any CPU
{AC955819-7910-450C-940C-7C1989483D4B}.Release|x86.ActiveCfg = Release|Any CPU
{AC955819-7910-450C-940C-7C1989483D4B}.Release|x86.Build.0 = Release|Any CPU
{67593FF7-C1D1-4529-98C4-61CBD0615F08}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{67593FF7-C1D1-4529-98C4-61CBD0615F08}.Debug|Any CPU.Build.0 = Debug|Any CPU
{67593FF7-C1D1-4529-98C4-61CBD0615F08}.Debug|x86.ActiveCfg = Debug|Any CPU
{67593FF7-C1D1-4529-98C4-61CBD0615F08}.Debug|x86.Build.0 = Debug|Any CPU
{67593FF7-C1D1-4529-98C4-61CBD0615F08}.Release|Any CPU.ActiveCfg = Release|Any CPU
{67593FF7-C1D1-4529-98C4-61CBD0615F08}.Release|Any CPU.Build.0 = Release|Any CPU
{67593FF7-C1D1-4529-98C4-61CBD0615F08}.Release|x86.ActiveCfg = Release|Any CPU
{67593FF7-C1D1-4529-98C4-61CBD0615F08}.Release|x86.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE