[OpenGL] problème de picking + affichage

Signaler
Messages postés
31
Date d'inscription
mercredi 25 août 2004
Statut
Membre
Dernière intervention
29 mai 2005
-
Messages postés
2
Date d'inscription
mardi 10 mai 2005
Statut
Membre
Dernière intervention
10 mai 2005
-
Salut à tous, je travaille actuellement sur un soft gérant un parc informatique. Le parc est représenté en 3D (par des sphères etc...)et j'aimerai savoir comment faire pour que lorsque l'on clique sur un élément le nom de celui-ci s'affiche. A l'origine j'affichais mon parc en 3D dans la Form elle-même mais finalement j'ai voulu l'afficher dans une PictureBox (pour des raisons de propriétés) et du coup le logiciel ne m'affiche plus rien... Je suis débutant en OpenGL et je ne comprends pas trop comment celà est arrivé (vu que l'affichage marchait avant).

Donc, en clair, j'aimerai que vous regardiez dans mon code pourquoi "ça ne s'affiche pas" et surtout comment faire pour afficher le nom de l'élément sélectionné.

Merci d'avance pour vos réponses, voici le code :


Code:,
----

Option Explicit
'/******************************Module*Header******************************
'FUNCTION: simple demo of the basics of opengl
' - gl setup, resize, and drawing
'AUTHOR: edx - edx@hk.super.net, Feb 98
'HISTORY: -
'/*************************************************************************
Const WORLD_LIST = 1 'Variables
Const WORLD_WARNING = 2 'pour
Const SEL_LIST = 3
Private m_fieldOfView As Double 'la
Private m_NearPlane As Double 'création
Private m_FarPlane As Double 'du
Private m_AspectRatio As Double 'monde
Dim m_hGLRC& 'OpenGL

Dim Xv, Yv, Zv, devx, devy 'point de vue + angle de vue
Dim pX, pY, pZ! 'placement des éléments
Dim Xmouse, ymouse 'point de la souris
Dim DeplMouse As Boolean 'deplacement de la souris
Dim ParX, ParY, ParZ As Double 'position du parent
Dim Xsel, Ysel, Zsel 'position du curseur
Dim SelMode As Boolean 'Mode navigation ou selection
Dim SelMode2 As Boolean 'Mode navigation 2 (par OpenGL)
Public Selected As String 'Nom de l'élément sélectionné
Dim DeplaceMode As Boolean 'Mode de déplacement d'éléments
Dim DeplaceSelected As String 'Nom de l'objet à déplacer

Public Function Initialize() As Boolean
Dim pfd As PIXELFORMATDESCRIPTOR
Dim R&, pos!(0 To 3)

'Initialisation du mode OpenGL
pfd.nSize = Len(pfd)
pfd.nVersion = 1
pfd.dwFlags = PFD_SUPPORT_OPENGL Or PFD_DRAW_TO_WINDOW Or PFD_DOUBLEBUFFER Or PFD_TYPE_RGBA
pfd.iPixelType = PFD_TYPE_RGBA
pfd.cColorBits = 24
pfd.cDepthBits = 16
pfd.iLayerType = PFD_MAIN_PLANE
R = ChoosePixelFormat(Picture1.hDC, pfd)
If R = 0 Then
MsgBox "ChoosePixelFormat failed"
Exit Function
End If
R = SetPixelFormat(Picture1.hDC, R, pfd)

m_hGLRC = wglCreateContext(Picture1.hDC)
wglMakeCurrent Picture1.hDC, m_hGLRC
glClearColor 0, 0, 0, 1

glClearDepth 1
glEnable GL_DEPTH_TEST
'color
glEnable glcColorMaterial
glColorMaterial faceFront, GL_AMBIENT_AND_DIFFUSE
'lighting
glEnable GL_LIGHTING
glEnable glcLight0
'move lightpos(0) 10: pos(1) 10: pos(2) = 10: pos(3) = 1
glLightfv ltLight0, lpmPosition, pos(0)pos(0) -1: pos(1) -1: pos(2) = -1
glLightfv ltLight0, lpmSpotDirection, pos(0)
glLightfv ltLight0, lpmSpotCutoff, 90
glLightfv ltLight0, lpmSpotExponent, 1
'viewport
m_AspectRatio = 0.5
m_FarPlane = 200
m_NearPlane = 0.5
m_fieldOfView = 45
'
Create3dFont Picture1.hDC, ARIAL36, "Arial", 36, FW_BOLD, 0, vbWhite
'Create3dFont picture1.hdc, TIMES36, "Times New Roman", 36, FW_BOLD, 0, vbWhite

DrawWorld
Initialize = True
End Function

Public Sub DrawWorld()
Dim obj&, obj2&
Dim CouleurAlert
Dim Compteur As Integer

'----------------------------------------------------------------------------------- Module de création de la modélisation 3D ------------------------------------------------------------------------------------------------------------------------------------------------------------------

Adodc1.Refresh
CouleurAlert = &HFF
glPushMatrix
glNewList WORLD_WARNING, GL_COMPILE
obj2 = gluNewQuadric

'Affichage du curseur de sélection
If DeplaceMode = False Then
glTranslatef Xsel, Ysel, Zsel
glColor3f 1, 1, 0
gluSphere obj2, 1, 4, 4
glTranslatef Xsel * -1, Ysel * -1, Zsel * -1
Else
glTranslatef Int(Xsel), Int(Ysel), Int(Zsel)
glColor3f 1, 1, 0
gluSphere obj2, 1, 4, 4
glTranslatef Int(Xsel) * -1, Int(Ysel) * -1, Int(Zsel) * -1
End If

glEndList

glNewList WORLD_LIST, GL_COMPILE
obj = gluNewQuadric

'Création des objets du monde
'Poste local
glTranslatef 0, -0.5, 0
glColor3f 0, 1, 1
glRotatef -90, 1, 0, 0
gluCylinder obj, 1, 0, 1.4, 16, 16
glRotatef 90, 1, 0, 0
glTranslatef 0, 0.5, 0
DrawText ARIAL36, "Poste_local", -2.5, 1.2, 0, &HFFFF00

'Indicateur d'erreurIf FormR01.Text8.text "Erreur" And FormR01.AlarmOption.Checked True Then
CouleurAlert = FormR01.Text8.ForeColor
glTranslatef 0, 5, 0
DrawText ARIAL36, "ERREUR!", -2, 0, 0, CouleurAlert
glTranslatef 0, -5, 0
End If

'Création des éléments
Compteur = 0
While Not Adodc1.Recordset.EOF

glPushName Compteur

Compteur = Compteur + 1
With Adodc1.Recordset

If .Fields("X") <> 0 Or .Fields("Y") <> 0 Or .Fields("Z") <> 0 Then

'Translation au point de l'objet
glTranslatef .Fields("X"), .Fields("Y"), .Fields("Z")

'Forme en fonction de son type
If Adodc1.Recordset.Fields("Type") = "Poste" Then
glColor3f 0, 0, 2
gluSphere obj, 1, 4, 2
End If

If Adodc1.Recordset.Fields("Type") = "Serveur" Then
glColor3f 1, 0.5, 1
gluSphere obj, 1, 16, 16
End If

If Adodc1.Recordset.Fields("Type") = "Routeur" Then
glColor3f 1, 1, 0
glTranslatef 0, -1, 0
glRotatef -90, 1, 0, 0
gluCylinder obj, 0.5, 0.5, 2, 16, 16
glRotatef 90, 1, 0, 0
glTranslatef 0, 1, 0
End If

'Affichage de l'élément en cours de test
If Adodc1.Recordset.Fields("Nom") = FormR01.jggb.text Then
glColor3f 0, 1, 0
gluSphere obj, 1.2, 4, 4
End If

'Couleur en fonction de son état sur le nom

If SelMode = False Then
If Adodc1.Recordset.Fields("Etat") = "Vivant" Then
DrawText ARIAL36, Adodc1.Recordset.Fields("Nom"), -3, 1.2, 0, &HFF00
Else
DrawText ARIAL36, Adodc1.Recordset.Fields("Nom"), -3, 1.2, 0, CouleurAlert
End If
Else
If Abs(.Fields("X") - Xsel) <= 2 And Abs(.Fields("Y") - Ysel) <= 2 And Abs(.Fields("Z") - Zsel) <= 2 Then
DrawText ARIAL36, Adodc1.Recordset.Fields("Nom"), -3, 1.2, 0, &HFFFFFF
Selected = .Fields("Nom")
Else
If Adodc1.Recordset.Fields("Etat") = "Vivant" Then
DrawText ARIAL36, Adodc1.Recordset.Fields("Nom"), -3, 1.2, 0, &HFF00
Else
DrawText ARIAL36, Adodc1.Recordset.Fields("Nom"), -3, 1.2, 0, CouleurAlert
End If
End If
End If

'Retour au point 0 0 0
glTranslatef .Fields("X") * -1, .Fields("Y") * -1, .Fields("Z") * -1

'Recherche des coordonnées du parent
SetParentName Adodc1.Recordset.Fields("Parent")

'Affichage du lien réseau
glColor3f 2, 2, 2
glBegin GL_QUADS
glVertex3d .Fields("X") - 0.1, .Fields("Y"), .Fields("Z")
glVertex3d .Fields("X") + 0.1, .Fields("Y"), .Fields("Z")
glVertex3d ParX + 0.2, ParY, ParZ
glVertex3d ParX - 0.2, ParY, ParZ

glVertex3d .Fields("X"), .Fields("Y") - 0.1, .Fields("Z")
glVertex3d .Fields("X"), .Fields("Y") + 0.1, .Fields("Z")
glVertex3d ParX, ParY + 0.2, ParZ
glVertex3d ParX, ParY - 0.2, ParZ
glEnd

End If

End With

Adodc1.Recordset.MoveNext
Wend

glEndList
glPopMatrix

glPopName

If SelMode2 = True Then SwapBuffers Picture1.hDC
End Sub

Private Sub AjoutElementItem_Click()
FormR14.Show 1
Unload FormR14
Adodc1.Refresh
End Sub

Private Sub DeplacerElementItem_Click()
If Selected <> "" Then
If DeplaceMode = False Then
DeplaceMode = True
Text5.text = "Déplacer:" & Selected
DeplaceSelected = Selected
Else
Adodc3.RecordSource = "select * from structuresdata where nom='" & DeplaceSelected & "' and idindex='" & FormR01.Text2.text & "'"
Adodc3.Refresh
With Adodc3.Recordset
.Fields("X") = Int(Xsel)
.Fields("Y") = Int(Ysel)
.Fields("Z") = Int(Zsel)
.Update
End With
Xsel = Int(Xsel)
Ysel = Int(Ysel)
Zsel = Int(Zsel)
DeplaceMode = False
Text5.text = "Mode sélection"
Adodc1.Refresh
End If
End If
End Sub

Private Sub Form_Load()
'Initialisation
Adodc1.RecordSource = FormR01.Adodc2.RecordSource
Adodc1.Refresh
SelMode = False

Xv = GetSetting("GestionClientV2", "Network3D", "Xv", 0)
Yv = GetSetting("GestionClientV2", "Network3D", "Yv", 5)
Zv = GetSetting("GestionClientV2", "Network3D", "Zv", 20)
devx = GetSetting("GestionClientV2", "Network3D", "devx", -3.14 / 2)
devy = GetSetting("GestionClientV2", "Network3D", "devy", 1.74)
Xsel = 0
Ysel = 0
Zsel = 0

Text5.text = "Mode navigation"

Me.WindowState = vbMaximized

Initialize

End Sub

Private Sub Picture1_KeyPress(KeyAscii As Integer)
'Déplacement dans le monde
Debug.Print KeyAscii
If KeyAscii = Asc("a") Then
Zv = Zv - 1
End If
If KeyAscii = Asc("q") Then
Zv = Zv + 1
End If
If KeyAscii = Asc("w") Then
Xv = Xv - 1
End If
If KeyAscii = Asc("x") Then
Xv = Xv + 1
End If
If KeyAscii = Asc("z") Then
Yv = Yv + 1
End If
If KeyAscii = Asc("s") Then
Yv = Yv - 1
End If
If KeyAscii = Asc("e") Then
glEnable glcLight0
End If
If KeyAscii = Asc("d") Then
glDisable glcLight0
End If
If KeyAscii = Asc("r") Then
DrawWorld
End If
If KeyAscii = Asc("c") Then
devx = devx + 0.1
End If
If KeyAscii = Asc("v") Then
devx = devx - 0.1
End If
If KeyAscii = Asc("t") Then
devy = devy + 0.1
End If
If KeyAscii = Asc("g") Then
devy = devy - 0.1
End IfIf KeyAscii Asc(" ") And DeplaceMode False Then
SelMode2 = Not SelMode2
If SelMode2 = False Then
Text5.text = "Mode navigation"
Else
Text5.text = "Mode sélection"
End If

End If

Display
End Sub

Private Sub Picture1_MouseDown(button As Integer, Shift As Integer, X As Single, Y As Single)
Xmouse = X
ymouse = Y

End Sub

Private Sub Picture1_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
If SelMode2 = True Then

Dim Hits As Long, i As Integer, Idx As Integer
Dim SelectBuf(0 To 511) As Long
Dim NameNos As Integer, MinZ As Double
Dim viewport(0 To 3) As Long

'Mode = GL_SELECT

'Debut de la selection...
wglMakeCurrent Picture1.hDC, m_hGLRC
glSelectBuffer 512, SelectBuf(0)
glGetIntegerv GL_VIEWPORT, viewport(0)
glRenderMode GL_SELECT ' init le mode de rendu pour selection
glInitNames
glMatrixMode GL_PROJECTION
glPushMatrix 'save Original Projection Matrix
glLoadIdentity
gluPickMatrix X, viewport(3) - Y, 1, 1, viewport(0) 'Get Area around Mouse pointer
gluPerspective 35!, viewport(2) / viewport(3), 1!, 100!
glMatrixMode GL_MODELVIEW

Display 'Creation du rendu en mode GL_SELECT

glMatrixMode GL_PROJECTION
glPopMatrix
glMatrixMode GL_MODELVIEW
' glFlush
'Mode = GL_RENDER

Hits = glRenderMode(GL_RENDER) 'Get no. of Hits

If Not (Hits = 0) Then
MinZ = 2147483647 'init minZ to a big value
Idx = 0
Selected = 0 'Nothing is selected yet

'To understand Follwing For Loop Remember Selection Buffer's Record Format:
' Rec1: | SelectBuf(0) | SelectBuf(1) | SelectBuf(2) | SelectBuf( 3... 3+NameNos) |
' | No. of Names for the Hit | Minimum depth | Maximum depth | Names for the Hit (can be 0 to ...) |
' ...Next Record and So on!
' Rec2: |SelectBuf(0 + 3 + NameNos)| So on...
For i = 1 To Hits
NameNos = SelectBuf(Idx)
If (SelectBuf(Idx + 1) < MinZ) And (NameNos > 0) Then 'If a named object is closer to screen then...
MinZ = SelectBuf(Idx + 1)
Selected = SelectBuf(Idx + 3) 'there is only one Name/Hit in the way we render
End If
Idx = Idx + 3 + NameNos
Next i
If Selected = 0 Then
Picture1_Paint 'if hits r no good clear view
End If
Else 'if Not Hits =0
If Selected > 0 Then 'if last time around there was a hit then
Selected = 0
Picture1_Paint 'clear view
Else
Selected = 0
End If
End If
Picture1.ToolTipText = Selected 'Update ToolTip
Me.Caption = Selected

Exit Sub

End If

If button = 1 Then
If SelMode = False Then
Xv = Xv - (X - Xmouse) / 100
Yv = Yv + (Y - ymouse) / 100
Xmouse = X
ymouse = Y
Else
Xsel = Xsel + (X - Xmouse) / 10
Ysel = Ysel - (Y - ymouse) / 10
Xmouse = X
ymouse = Y
DrawWorld
End If
End If

If button = 2 Then
If SelMode = False Then
devx = devx + (X - Xmouse) / 1000
devy = devy + (Y - ymouse) / 1000
Xmouse = X
ymouse = Y
Else
Zsel = Zsel + (Y - ymouse) / 10
ymouse = Y
DrawWorld
End If
End If

If button = 3 Then
If SelMode = False Then
Text5.text = "Mode navigation"
Else
Text5.text = "Mode sélection"
End If
End If

If button = 4 Then
If SelMode = False Then
Zv = Zv + (Y - ymouse) / 100
Xmouse = X
ymouse = Y
Else
If Selected <> "" Then
FormR13.Show 1
Unload FormR13
End If
End If
End If

If button <> 0 Then
Debug.Print button
Display
End If

Text2.text = "X:" & X & " - Y:" & Y
Text6.text = "Xs:" & Format(Xsel, "0.00") & " - Ys:" & Format(Ysel, "0.00") & " - Zs:" & Format(Zsel, "0.00")

End Sub

Private Sub Picture1_MouseUp(button As Integer, Shift As Integer, X As Single, Y As Single)
DeplMouse = False
End Sub

Private Sub Picture1_Paint()
Display
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If m_hGLRC <> 0 Then
wglMakeCurrent 0, 0
wglDeleteContext m_hGLRC
End If

End Sub

Private Sub Form_Resize()
Picture1.height = Me.ScaleHeight - 37
Picture1.Width = Me.ScaleWidth - 16

Static W&, H&
Dim w1&, h1&
w1 = ScaleWidth
h1 = ScaleHeight
OnSize w1, h1
If w1 <= W And h1 <= H Then Display 'force a repaintW w1: H h1
End Sub

Private Sub Form_Unload(Cancel As Integer)
If m_hGLRC <> 0 Then
wglMakeCurrent 0, 0
wglDeleteContext m_hGLRC
End If
End Sub

Public Sub Display()
Static Busy As Boolean
If Busy Then Exit Sub
Busy = True
glClear clrColorBufferBit Or clrDepthBufferBit
glPushMatrix
gluLookAt Xv, Yv, Zv, Xv + Cos(devx) * 5, Yv + Cos(devy) * 5, Zv + Sin(devx) * 5, 0, 1, 0 'Sin(devx) * 5 - Sin(devy) * 5
glCallList WORLD_LIST
If SelMode = True Then glCallList WORLD_WARNING
glPopMatrix
glFinish
SwapBuffers Picture1.hDC
Busy = False
End Sub

'Adjusts the viewport to match the window size.
Public Sub OnSize(ByVal W&, ByVal H&)If H 0 Then H 1
m_AspectRatio = W / H
glViewport 0, 0, W, H
SetViewPort
End Sub

Private Sub SetViewPort()
Dim W&, H&
Dim X#, Y#, Z#

glMatrixMode mmProjection
glLoadIdentity
gluPerspective m_fieldOfView, _
m_AspectRatio, _
m_NearPlane, _
m_FarPlane
glMatrixMode mmModelView
glLoadIdentity
End Sub

Private Sub InaccListItem_Click()
FormR11.Show 1
Unload FormR11
End Sub

Private Sub ListCoordItem_Click()
FormR12.Show 1
Unload FormR12
End Sub

Private Sub PrintItem_Click()
CD1.ShowSave
If SaveBMP_RP(CD1.Filename, Me.ScaleWidth, Me.ScaleHeight) Then
End If
End Sub

Private Sub ResetItem_Click()
Xv = 0
Yv = 5
Zv = 20
devx = -3.14 / 2
devy = 1.74
DrawWorld
Display
End Sub

Private Sub RetourItem_Click()
SaveSetting "GestionClientV2", "Network3D", "Xv", Xv
SaveSetting "GestionClientV2", "Network3D", "Yv", Yv
SaveSetting "GestionClientV2", "Network3D", "Zv", Zv
SaveSetting "GestionClientV2", "Network3D", "devx", devx
SaveSetting "GestionClientV2", "Network3D", "devy", devy

Me.Hide
End Sub

Private Sub Timer1_Timer()
DrawWorld
Display
Text1.text = "x=" & Format(Xv, "0.00") & ",y=" & Format(Yv, "0.00") & ",z=" & Format(Zv, "0.00") & Chr$(13) & Chr$(10)
Text3.text = "ah=" & Format(devx, "0.00") & ",av=" & Format(devy, "0.00")
Text4.text = "Xz:" & Format((Xv + Cos(devx) * 5), "0.00") & " - Yz:" & Format((Yv + Cos(devy) * 5), "0.00") & " - Zz:" & Format((Zv + Sin(devx) * 5), "0.00")
'Xv + Cos(devx) * 5, Yv + Cos(devy) * 5, Zv + Sin(devx) * 5 - Sin(devy) * 5
End Sub

Public Sub SetView(Xt, Yt, Zt)
Xv = Xt
Yv = Yt
Zv = Zt
devx = -3.14 / 2
devy = 1.93
DrawWorld
Display
End Sub

Private Sub SetParentName(ParentName As String)
Adodc2.RecordSource = "select * from structuresdata where idindex='" & FormR01.Text2.text & "' and Nom='" & ParentName & "'"
Adodc2.Refresh

If ParentName = "Poste local" Then
ParX = 0
ParY = 0
ParZ = 0
Else
ParX = Adodc2.Recordset.Fields("X")
ParY = Adodc2.Recordset.Fields("Y")
ParZ = Adodc2.Recordset.Fields("Z")
End If
End Sub

2 réponses

Messages postés
2
Date d'inscription
mardi 10 mai 2005
Statut
Membre
Dernière intervention
10 mai 2005

Bonjour

La fonction gluPickMatrix permet de sélectionner des objets dessinés avec un carré ou un rectangle. Je voudrais utiliser un "polygone" et demander à OPENGL d'extraire les objets dans le polygone.

Est-ce possible et comment ?

SVP me répondre à "[mailto:denisdurocher1@sympatico.ca denisdurocher1@sympatico.ca]"
Messages postés
2
Date d'inscription
mardi 10 mai 2005
Statut
Membre
Dernière intervention
10 mai 2005

Merci !