1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
| Imports OpenTK
Imports OpenTK.Graphics
Imports OpenTK.Graphics.OpenGL
Public Class Visu3D
Dim EtatBouton As Integer
Dim XPrec As Integer, YPrec As Integer
Dim AX As Double, AY As Double
Dim AXPrec As Double, AYPrec As Double
Dim PX As Single, PY As Single
Dim PXPrec As Single, PYPrec As Single
Dim PZ As Single
Dim Debut As Boolean
'Echelle et clipping :
Private PixelToClipper As Double
Private MmToClipper As Double
Private ClipperToMm As Double
Private dtx As Single
Private dty As Single
Private dtz As Single
Public Sub New()
Debut = True
InitializeComponent()
End Sub
Private Sub GlControl1_Load(sender As System.Object, e As System.EventArgs) Handles GlControl1.Load
GL.ClearColor(Color.Black)
End Sub
Public Sub Montrer()
EtatBouton = 0
Debut = True
Me.ShowDialog()
End Sub
Private Sub GlControl1_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles GlControl1.MouseDown
Dim eX As Integer, eY As Integer
eX = e.X
eY = e.Y
Select Case e.Button
Case Windows.Forms.MouseButtons.Left : EtatBouton = 1
Case Windows.Forms.MouseButtons.Right : EtatBouton = 2
Case Else : EtatBouton = 0
End Select
If EtatBouton <> 0 Then
XPrec = eX
YPrec = eY
End If
Select Case EtatBouton
Case 0
Case 1
AXPrec = AX
AYPrec = AY
Case 2
PXPrec = PX
PYPrec = PY
End Select
End Sub
Private Sub GlControl1_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles GlControl1.MouseMove
Dim DX As Integer, DY As Integer
Dim eX As Integer, eY As Integer
eX = e.X
eY = e.Y
DX = eX - XPrec
DY = eY - YPrec
Select Case EtatBouton
Case 0 'RIEN
Case 1 'ROTATION
AX = AXPrec + DX * 0.3
AY = AYPrec + DY * (-0.3)
GlControl1.Invalidate()
Case 2 'DEPLACEMENT
PX = PXPrec + DX * (0.5F)
PY = PYPrec + DY * (-0.5F)
'PZ = PZPrec + DX * (-0.5F)
GlControl1.Invalidate()
End Select
End Sub
Private Sub Visu3D_MouseWheel(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel
PZ = PZ + e.Delta * (0.05F)
GlControl1.Invalidate()
End Sub
Private Sub GlControl1_MouseUp(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles GlControl1.MouseUp
Dim eX As Integer
Dim eY As Integer
Select Case EtatBouton
Case 0
Case 1
AXPrec = AX
AYPrec = AY
Case 2
PXPrec = PX
PYPrec = PY
End Select
EtatBouton = 0
eX = e.X
eY = e.Y
End Sub
Private Sub Visu3D_ResizeEnd(sender As Object, e As System.EventArgs) Handles Me.ResizeEnd
Call Init3D() 'AX, AY, PX, PY, PZ)
End Sub
Private Sub GlControl1_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles GlControl1.Paint
If Debut Then
AX = 0
AY = 0
PX = 0
PY = 0
PZ = 0
Call Init3D()
Debut = False
Else
'ICI C'EST DEBILE : on créé toute la scène à chaque fois
'Call Init3D()
'Alors qu'il faudrait juste la déplacer si AX, AY, PX, PY, PZ changent et l'afficher
Call Aff3D()
End If
End Sub
Private Sub Aff3D()
'AX, AY se modifient avec le bouton gauche de la souris
'PX,PY se modifient avec le bouton droit de la souris
'PZ se modifie avec la molette de la souris
'Translation (PX, PY) et zoom (PZ)
GL.Translate(PX, PY, PZ)
'Rotation
GL.Rotate(AX, 0, 1, 0)
GL.Rotate(AY, 0, 0, 1)
'Comment actualiser l'affichage ???
'Ca ne fonctionne pas
GL.Flush()
End Sub
Private Sub Init3D()
GL.Clear(ClearBufferMask.ColorBufferBit)
GL.Clear(ClearBufferMask.DepthBufferBit)
Dim perspective As Matrix4 = Matrix4.CreatePerspectiveFieldOfView(1.04, CSng(GlControl1.Width / GlControl1.Height), 1, 10000) 'Setup Perspective
Dim lookat As Matrix4 = Matrix4.LookAt(0, 0, CSng((bm.Largeur + bm.Hauteur) * 0.5 / bm.UsiEchelle), 0, 0, 0, 0, 1, 0) 'Setup camera
GL.MatrixMode(MatrixMode.Projection) 'Load Perspective
GL.LoadMatrix(perspective)
GL.MatrixMode(MatrixMode.Modelview) 'Load Camera
GL.LoadIdentity()
GL.LoadMatrix(lookat)
GL.Viewport(0, 0, GlControl1.Width, GlControl1.Height) 'Size of window
GL.Enable(EnableCap.DepthTest) 'Enable correct Z Drawings
GL.DepthFunc(DepthFunction.Less) 'Enable correct Z Drawings
GL.Enable(EnableCap.CullFace) 'Backface culling
'AX, AY se modifient avec le bouton gauche de la souris
'PX,PY se modifient avec le bouton droit de la souris
'PZ se modifie avec la molette de la souris
'Translation (PX, PY) et zoom (PZ)
GL.Translate(PX, PY, PZ)
'Rotation
GL.Rotate(AX, 0, 1, 0)
GL.Rotate(AY, 0, 0, 1)
GL.Begin(BeginMode.Triangles)
'DESSIN DE LA PIECE --------------------------------------------------------
dtx = CSng(-bm.Largeur * 0.5 / bm.UsiEchelle)
dty = CSng(-bm.Hauteur * 0.5 / bm.UsiEchelle)
dtz = 0
Call E06_2_EcrireSTL() 'Cette fonction génére les triangles avec les fonctions GL.Color3 et GL.Vertex :
'GL.Color3(Color.Red)
'GL.Vertex3(x1 + dtx, y1 + dty, z1 + dtz)
'GL.Color3(Color.Red)
'GL.Vertex3(x2 + dtx, y2 + dty, z2 + dtz)
'GL.Color3(Color.Red)
'GL.Vertex3(x3 + dtx, y3 + dty, z3 + dtz)
'---------------------------------------------------------------------------
GL.End()
'Finally...
GraphicsContext.CurrentContext.VSync = True 'Caps frame rate as to not over run GPU
GlControl1.SwapBuffers() 'Takes from the 'GL' and puts into control
End Sub
End Class |
Partager