Seven34
Messages postés1Date d'inscriptionmercredi 16 juin 2004StatutMembreDernière intervention25 juin 2007
-
25 juin 2007 à 15:41
cs_michel67650
Messages postés3Date d'inscriptionsamedi 16 janvier 2010StatutMembreDernière intervention17 octobre 2012
-
17 oct. 2012 à 10:05
Bonjour,
Je suis parti d'une source de Patrice Terrier écrit en C#, que j'ai adapté en VB. Dans le code j'ai supprimé tous les appels à GDImage.dll, en ne laissant que les commandes OPENGL.
Hélas je n'arrice pas à afficher le chart dans la form. Je ne sais pas pourquoi. parmis vous, y-aurait-il quelqu'un d'assez callé en OpenGL pour trouver le problème?
Merci d'avance.
Voici le code en VB
Option Explicit
Private Type THISCHART
ChartNumber As Integer
ChartSeries As Integer
Radius As GLfloat
xoff As GLfloat
yoff As GLfloat
zoff As GLfloat
xrot As GLfloat
yrot As GLfloat
xCpy As GLfloat
yCpy As GLfloat
xDown As Integer
yDown As Integer
ListIndex As Integer
End Type
Private hGLcontrol As Long
Private Chart As THISCHART
Private quadObj As Long
Private ChartSeries As Integer
Private ChartNumber As Integer
Private ChartItem() As Long
Private Zoom As Single
Private Sub Form_Load()
Dim k As Long
Dim i As Long
Dim j As Long
Dim Value As Single
Dim LightDiffuse(3) As Single
Dim LightAmbient(3) As Single
Dim LightPosition(3) As Single
Dim yRange As Single
ChartSeries = 7
ChartNumber = 4
ReDim ChartItem(ChartSeries * ChartNumber) As Long
'//Create the OpenGL control
If SetupPixelFormat(Form2.hDC) = False Then
Exit Sub
End If
If CreateViewGLContext(Form2.hDC) = False Then
Exit Sub
End If
Call GLU.gluDisk(quadObj, 0#, Chart.Radius, 32, 32)
Call GL.glTranslatef(0#, 0#, Value)
Call GLU.gluDisk(quadObj, 0#, Chart.Radius, 32, 32)
Call GL.glTranslatef(0#, 0#, -Value)
Call GL.glRotatef(90#, 1#, 0#, 0#) '
Call GL.glEndList
Next
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim k As Integer
Call GL.glDeleteLists(1, 1)
For k = 1 To UBound(ChartItem)
Call GL.glDeleteLists(ChartItem(k), k + 1)
Next
If quadObj <> 0 Then
GLU.gluDeleteQuadric quadObj
quadObj = 0
End If
If WGL.wglGetCurrentContext() <> 0 Then
WGL.wglMakeCurrent Form2.hDC, 0
End If
If hGLcontrol <> 0 Then
WGL.wglDeleteContext hGLcontrol
hGLcontrol = 0
End If
End Sub
Private Sub Timer1_Timer()
If hGLcontrol <> 0 Then
Call RenderOpenGL
End If
End Sub
Private Sub DrawAxis(ByVal x As Single, ByVal y As Single, ByVal z As Single)
Dim a As Long
Dim COLOR1(3) As Single
Dim COLOR2(3) As Single
Dim COLOR3(3) As Single
Chart.ChartSeries = 7
Chart.ChartNumber = 4
End Sub
Private Sub RenderOpenGL()
Dim k As Long
Dim i As Long
Dim j As Long
Dim Color(3) As Single
'// Switch back to default color
Call GL.glColor3f(1#, 1#, 1#)
Call GL.glClear(GL.GL_COLOR_BUFFER_BIT Or GL.GL_DEPTH_BUFFER_BIT)
Call GL.glLoadIdentity
'// ***************
'// Draw chart
'// ***************
Zoom = 50
glScalef Zoom, Zoom, Zoom
Call GL.glTranslatef(Chart.xoff, Chart.yoff, Chart.zoff)
Call GL.glRotatef(Chart.xrot, 1#, 0#, 0#)
Call GL.glRotatef(Chart.yrot, 0#, 1#, 0#)
'//Draw the XYZ grid
Call GL.glLineWidth(1#)
Call GL.glCallList(Chart.ListIndex)
'//Shall we use the texture mode
Call GL.glDisable(GL.GL_TEXTURE_2D)
k = 0
Call GL.glTranslatef(Chart.Radius + 0.5, 0#, Chart.Radius + 0.5)
For i = 1 To Chart.ChartNumber
'// Set color for the chart serie
Select Case i Case 1: Color(0) 255: Color(1) 255: Color(2) = 255: Color(3) = 255 Case 2: Color(0) 220: Color(1) 0: Color(2) = 255: Color(3) = 0 Case 3: Color(0) 200: Color(1) 0: Color(2) = 0: Color(3) = 255 Case 4: Color(0) 192: Color(1) 255: Color(2) = 0: Color(3) = 0
End Select
Call GL.glColor4fv(Color(0))
For j = 1 To Chart.ChartSeries
k = k + 1
Call GL.glCallList(ChartItem(k))
Call GL.glTranslatef(2# * Chart.Radius, 0#, 0#)
Next
Call GL.glTranslatef(-2# * Chart.Radius * Chart.ChartSeries, 0#, 2# * Chart.Radius + 0.5)
Next
'// Make sure to restore the texture mode
Call GL.glEnable(GL.GL_TEXTURE_2D)
'//Draw the scene
Call SwapBuffers(Form2.hDC)
End Sub
Private Function CreateViewGLContext(ByVal hDC As Long) As Boolean
hGLcontrol = WGL.wglCreateContext(hDC)
If hGLcontrol = 0 Then
CreateViewGLContext = False
Exit Function
End If
If WGL.wglMakeCurrent(hDC, hGLcontrol) = 0 Then
CreateViewGLContext = False
Exit Function
End If
CreateViewGLContext = True
End Function
Private Function SetupPixelFormat(ByVal hDC As Long) As Boolean
Dim PixelDesc As PIXELFORMATDESCRIPTOR
Dim PixelFormat As Integer
PixelDesc.iLayerType = PFD_MAIN_PLANE
PixelDesc.iPixelType = PFD_TYPE_RGBA
PixelFormat = ChoosePixelFormat(hDC, PixelDesc)
If PixelFormat = 0 Then
PixelFormat = 1 '// par défaut on force l'index à 1
If DescribePixelFormat(hDC, PixelFormat, Len(PixelDesc), PixelDesc) = 0 Then
SetupPixelFormat = False
Exit Function
End If
End If
If SetPixelFormat(hDC, PixelFormat, PixelDesc) = 0 Then
SetupPixelFormat = False
Exit Function
End If
cs_michel67650
Messages postés3Date d'inscriptionsamedi 16 janvier 2010StatutMembreDernière intervention17 octobre 2012 17 oct. 2012 à 10:05
Bonjour,
Je cherche un exemple en vbnet pour lire un ficher STL (CAO) dans un picturebox en OPENGL.
En vb6, sans souci mais je cherche une personne qui l'aurais deja fait en VB9/VB10.
Merci
Michel67650
