grivel
|
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 light
pos(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'erreur
If 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 If
If 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 repaint
W = 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
|
|