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 Imports KeyboardState = OpenTK.Input.KeyboardState Imports Keyboard = OpenTK.Input.Keyboard Imports Key = OpenTK.Input.Key Imports Color = System.Drawing.Color 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 isDeactivated As Boolean = False Private ReadOnly myModels As New Dictionary(Of Object3D, Renderer) Private WithEvents RenderTimer As New Timers.Timer(1) With {.AutoReset = True} 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 Property RenderInterval As Double Get Return renderTimer.Interval End Get Set renderTimer.Interval = Value End Set 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 Public ReadOnly Property GLControl As Control Get Return glControl1 End Get End Property Private ReadOnly Property IsStrgPressed As Boolean Get Dim state As KeyboardState = Keyboard.GetState() Return state(Key.ControlLeft) OrElse state(Key.ControlRight) End Get End Property Private ReadOnly Property IsShiftPressed As Boolean Get Dim state As KeyboardState = Keyboard.GetState() Return state(Key.ShiftLeft) OrElse state(Key.ShiftRight) 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) renderTimer.Start() 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() 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 RenderTimer_Elapsed(sender As Object, e As Timers.ElapsedEventArgs) Handles RenderTimer.Elapsed 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() End Sub 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 MoveCameraViaWASDQE() Dim moveSpeed As Integer = Convert.ToInt32(Math.Round((If(IsShiftPressed, 60, 30)) * (MyCamera.CamSpeedMultiplier), 0)) Dim allowCamMove As Boolean = Not (IsMouseDown AndAlso IsShiftPressed) If allowCamMove Then Dim state As KeyboardState = Keyboard.GetState If state(Key.W) Then 'camera.Move(moveSpeed, moveSpeed, camMtx) MyCamera.UpdateCameraMatrixWithScrollWheel(moveSpeed, camMtx) savedCamPos = MyCamera.Position End If If state(Key.S) Then 'camera.Move(-moveSpeed, -moveSpeed, camMtx) MyCamera.UpdateCameraMatrixWithScrollWheel(-moveSpeed, camMtx) savedCamPos = MyCamera.Position End If If state(Key.A) Then 'camera.Move(-moveSpeed, 0, camMtx) MyCamera.UpdateCameraOffsetDirectly(-moveSpeed, 0, camMtx) End If If state(Key.D) Then 'camera.Move(moveSpeed, 0, camMtx) MyCamera.UpdateCameraOffsetDirectly(moveSpeed, 0, camMtx) End If If state(Key.E) Then 'camera.Move(0, -moveSpeed, camMtx) MyCamera.UpdateCameraOffsetDirectly(0, -moveSpeed, camMtx) End If If state(Key.Q) Then 'camera.Move(0, moveSpeed, camMtx) MyCamera.UpdateCameraOffsetDirectly(0, moveSpeed, camMtx) End If End If 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