The Lesson 01 in VB.NET

Started by
-1 comments, last by XcentY 11 years, 9 months ago
Since I downloaded the VB.net sample of the Lesson 01, I've checked the code and it's not a good rendering context. a Windows.forms.control embedded in a Windows.forms.form with Gdi context. no double buffer, refresh by gdi paint.

Now here is the code I've made.

First the requirements :
1) Visual Basic Express 2010
2) Csgl library

Open Visual Basic Express a start a new project Windows Application.
Name it as you like, save it and close it.

now, start a new project library class, Name it OpenGLFrame and paste the code 1 (Below see code 1)

Once you have the code, Build the library.
Then add the Windows Application Project to the actual library. (File->Add->Existing Project)
Right Click on you Windows Application Project in the project explorer and choose "Set as Startup Project"
Go to the references of this Windows Application Project and add a reference to the builded library.
Create a button on this Form and paste the code 2 for the button_on_click event (Below see code 2)

That's it smile.png

Have Fun

I don't give replies cause I'm still busy developping but I'm glad if it can help some.

CODE 1
Imports CsGL.OpenGL
Imports System.Runtime.InteropServices
Imports System.Security
Public Class OpenGLFrame
' ////////////////////////////////////////////////////////////
' /// Déclaration des Fonctions API Necessaire pour l'environnement OpenGL
' ////////////////////////////////////////////////////////////
<DllImport("gdi32.dll", EntryPoint:="SetPixelFormat", setlasterror:=True, CharSet:=CharSet.Auto, preservesig:=True)> Private Shared Function SetPixelFormat(ByVal hdc As IntPtr, ByVal format As Integer, <InAttribute(), MarshalAs(UnmanagedType.Struct)> ByRef ppfd As PIXELFORMATDESCRIPTOR) As Integer
End Function
<DllImport("gdi32.dll", EntryPoint:="DescribePixelFormat", setlasterror:=True, CharSet:=CharSet.Auto, preservesig:=True)> Private Shared Function DescribePixelFormat(ByVal hdc As IntPtr, ByVal iPixelFormat As Integer, ByVal nBytes As UInteger, <InAttribute(), MarshalAs(UnmanagedType.Struct)> ByRef ppfd As PIXELFORMATDESCRIPTOR) As Integer
End Function
<DllImport("gdi32.dll", EntryPoint:="ChoosePixelFormat", setlasterror:=True, CharSet:=CharSet.Auto, preservesig:=True)> Private Shared Function ChoosePixelFormat(ByVal hdc As IntPtr, <InAttribute(), MarshalAs(UnmanagedType.Struct)> ByRef ppfd As PIXELFORMATDESCRIPTOR) As Integer
End Function
<DllImport("gdi32.dll", EntryPoint:="SwapBuffers", setlasterror:=True, CharSet:=CharSet.Auto, preservesig:=True)> Private Shared Function SwapBuffers(ByVal param0 As IntPtr) As Integer
End Function
<DllImport("opengl32.dll", EntryPoint:="wglMakeCurrent", SetLastError:=True, CharSet:=CharSet.Auto)> Private Shared Function wglMakeCurrent(ByVal param0 As IntPtr, ByVal param1 As IntPtr) As Integer
End Function
<DllImport("opengl32.dll", EntryPoint:="wglDeleteContext", SetLastError:=True, CharSet:=CharSet.Auto, preservesig:=True)> Private Shared Function wglDeleteContext(ByVal param0 As IntPtr) As Integer
End Function
<DllImport("opengl32.dll", EntryPoint:="wglCreateContext", setlasterror:=True, CharSet:=CharSet.Auto, preservesig:=True)> Private Shared Function wglCreateContext(ByVal param0 As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", EntryPoint:="RegisterClassExA", SetLastError:=True, CharSet:=CharSet.Auto, PreserveSig:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall, BestFitMapping:=True)> Private Shared Function RegisterClassEx(<InAttribute(), MarshalAs(UnmanagedType.Struct)> ByRef lpWndClass As WNDCLASSEX) As Short
End Function
<DllImport("user32.dll", EntryPoint:="UnregisterClassA", SetLastError:=True, CharSet:=CharSet.Auto, PreserveSig:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall, BestFitMapping:=True)> Private Shared Function UnregisterClass(ByVal lpClassName As String, ByVal hInstance As IntPtr) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="ReleaseDC", setlasterror:=True, CharSet:=CharSet.Auto, preservesig:=True)> Private Shared Function ReleaseDC(ByVal hWnD As IntPtr, ByVal hDC As IntPtr) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="DestroyWindow", SetLastError:=True, CharSet:=CharSet.Auto, preservesig:=True)> Private Shared Function DestroyWindow(ByVal hWnd As IntPtr) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="AdjustWindowRectEx", setlasterror:=True, CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall), SuppressUnmanagedCodeSecurity()> Private Shared Function AdjustWindowRectEx(<InAttribute(), MarshalAs(UnmanagedType.Struct)> ByRef lprect As RECT, ByVal dwStyle As Integer, ByVal bmenu As Integer, ByVal dwExtStyle As Integer) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="CreateWindowExA", setlasterror:=True, CharSet:=CharSet.Auto, preservesig:=True)> Private Shared Function CreateWindowEx(<MarshalAs(UnmanagedType.U4)> ByVal dwExStyle As Integer, ByVal lpclassname As String, <MarshalAs(UnmanagedType.AnsiBStr)> ByVal lpWindowName As String, <MarshalAs(UnmanagedType.U4)> ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hWndParent As IntPtr, ByVal hMenu As IntPtr, ByVal hInstance As IntPtr, ByVal lParam As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", EntryPoint:="GetDC", setlasterror:=True, CharSet:=CharSet.Auto, preservesig:=True)> Private Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", EntryPoint:="ShowWindow", setlasterror:=True, CharSet:=CharSet.Auto)> Private Shared Function ShowWindow(ByVal hWnd As IntPtr, ByVal nCmDShow As Integer) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="DefWindowProcA", setlasterror:=True, CharSet:=CharSet.Auto, preservesig:=True)> Private Shared Function DefWindowProc(ByVal hwnd As IntPtr, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Long
End Function
<DllImport("user32.dll", EntryPoint:="EnumDisplaySettingsA", SetLastError:=True, CharSet:=CharSet.Auto)> Private Shared Function EnumDisplaySettings(ByVal lpDeviceName As String, ByVal lpMode As Integer, ByRef lpDevMode As DEVMODE) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="ChangeDisplaySettingsA", SetLastError:=True, CharSet:=CharSet.Auto)> Private Shared Function ChangeDisplaySettings(ByRef lpDevMode As DEVMODE, ByVal DwFlags As Integer) As Integer
End Function
' ///////////////////////////////////////////////////////////////////
' /// Déclaration des Variables Privées de la Classe
' ///////////////////////////////////////////////////////////////////
Private hDC As New IntPtr
Private hWnD As New IntPtr
Private hRC As New IntPtr
Private hInstance As Long
Private nActive As Boolean = True
Private Fullscreen As Boolean = True
Private OpenGLWindow As New WNDCLASSEX
' /////////////////////////////////////////////////////////////
' /// Déclaration Variables Event de la Classe
' /////////////////////////////////////////////////////////////
Public Event KeyPressed(ByVal KeyCode As Integer)
Public Event KeyReleased(ByVal KeyCode As Integer)
' ////////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes iPixelType
' ///////////////////////////////////////////////////////////////////////
Private Const PFD_TYPE_RGBA As Integer = 0
Private Const PFD_TYPE_COLORINDEX As Integer = 1
' //////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes dwFlags
' //////////////////////////////////////////////////////////////////////
Private Const PFD_DOUBLE_BUFFER As Integer = &H1
Private Const PFD_STEREO As Integer = &H2
Private Const PFD_DRAW_TO_WINDOW As Integer = &H4
Private Const PFD_DRAW_TO_BITMAP As Integer = &H8
Private Const PFD_SUPPORT_GDI As Integer = &H10
Private Const PFD_SUPPORT_OPENGL As Integer = &H20
Private Const PFD_GENERIC_FORMAT As Integer = &H40
Private Const PFD_NEED_PALETTE As Integer = &H80
Private Const PFD_NEED_SYSTEM_PALETTE As Integer = &H100
Private Const PFD_SWAP_EXCHANGE As Integer = &H200
Private Const PFD_SWAP_COPY As Integer = &H400
Private Const PFD_SWAP_LAYER_BUFFERS As Integer = &H800
Private Const PFD_GENERIC_ACCELERATED As Integer = &H1000
Private Const PFD_SUPPORT_DIRECTDRAW As Integer = &H2000
Private Const PFD_DIRECT3D_ACCELERATED As Integer = &H4000
Private Const PFD_SUPPORT_COMPOSITION As Integer = &H8000
Private Const PFD_DEPTH_DONTCARE As Integer = &H20000000
Private Const PFD_DOUBLE_BUFFER_DONTCARE = &H40000000
Private Const PFD_STEREO_DONTCARE = &H80000000
' //////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes iLayerType
' //////////////////////////////////////////////////////////////////////
Private Const PFD_MAIN_PLANE As Integer = 0
Private Const PFD_OVERLAY_PLANE As Integer = 1
Private Const PFD_UNDERLAY_PLANE As Integer = -1
' //////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes Style de Classe
' //////////////////////////////////////////////////////////////////////
Private Const CS_VREDRAW As Integer = &H1
Private Const CS_HREDRAW As Integer = &H2
Private Const CS_DBLCLKS As Integer = &H8
Private Const CS_OWNDC As Integer = &H20
Private Const CS_CLASSDC As Integer = &H40
Private Const CS_PARENTDC As Integer = &H80
Private Const CS_NOCLOSE As Integer = &H200
Private Const CS_SAVEBITS As Integer = &H800
Private Const CS_BYTEALIGNCLIENT As Integer = &H1000
Private Const CS_BYTEALIGNWINDOW As Integer = &H2000
Private Const CS_GLOBALCLASS As Integer = &H4000
Private Const CS_IME As Integer = &H10000
Private Const CS_DROPSHADOW As Integer = &H20000
' //////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes Style de Fenêtre
' //////////////////////////////////////////////////////////////////////
Private Const WS_OVERLAPPED As Integer = &H0
Private Const WS_MAXIMIZEBOX As Integer = &H10000
Private Const WS_MINIMIZEBOX As Integer = &H20000
Private Const WS_THICKFRAME As Integer = &H40000
Private Const WS_SYSMENU As Integer = &H80000
Private Const WS_HSCROLL As Integer = &H100000
Private Const WS_VSCROLL As Integer = &H200000
Private Const WS_DLGFRAME As Integer = &H400000
Private Const WS_BORDER As Integer = &H800000
Private Const WS_CAPTION As Integer = &HC00000
Private Const WS_MAXIMIZE As Integer = &H1000000
Private Const WS_CLIPCHILDREN As Integer = &H2000000
Private Const WS_CLIPSIBLINGS As Integer = &H4000000
Private Const WS_DISABLED As Integer = &H8000000
Private Const WS_VISIBLE As Integer = &H10000000
Private Const WS_MINIMIZE As Integer = &H20000000
Private Const WS_CHILD As Integer = &H40000000
Private Const WS_POPUP As Integer = &H80000000
Private Const WS_TABSTOP As Integer = WS_MAXIMIZEBOX
Private Const WS_GROUP As Integer = WS_MINIMIZEBOX
Private Const WS_OVERLAPPEDWINDOW As Integer = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Private Const WS_POPUPWINDOW As Integer = WS_POPUP Or WS_BORDER Or WS_SYSMENU
' ///////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes Style Etendu de Fenêtre
' ///////////////////////////////////////////////////////////////////////
Private Const WS_EX_DLGMODALFRAME As Integer = &H1
Private Const WS_EX_NOPARENTNOTIFY As Integer = &H4
Private Const WS_EX_TOPMOST As Integer = &H8
Private Const WS_EX_ACCEPTFILES As Integer = &H10
Private Const WS_EX_TRANSPARENT As Integer = &H20
Private Const WS_EX_MDICHILD As Integer = &H40
Private Const WS_EX_TOOLWINDOW As Integer = &H80
Private Const WS_EX_WINDOWEDGE As Integer = &H100
Private Const WS_EX_CLIENTEDGE As Integer = &H200
Private Const WS_EX_CONTEXTHELP As Integer = &H400
Private Const WS_EX_RIGHT As Integer = &H1000
Private Const WS_EX_LEFT As Integer = &H0
Private Const WS_EX_RTLREADING As Integer = &H2000
Private Const WS_EX_LTRREADING As Integer = &H0
Private Const WS_EX_LEFTSCROLLBAR As Integer = &H4000
Private Const WS_EX_RIGHTSCROLLBAR As Integer = &H0
Private Const WS_EX_CONTROLPARENT As Integer = &H10000
Private Const WS_EX_STATICEDGE As Integer = &H20000
Private Const WS_EX_APPWINDOW As Integer = &H40000
Private Const WS_EX_LAYERED As Integer = &H80000
Private Const WS_EX_NOINHERITLAYOUT As Integer = &H100000
Private Const WS_EX_LAYOUTRTL As Integer = &H400000
Private Const WS_EX_COMPOSITEID As Integer = &H2000000
Private Const WS_EX_NOACTIVE As Integer = &H8000000
' ////////////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes Message de Fenêtre
' ////////////////////////////////////////////////////////////////////////////
Private Const WM_CREATE As Integer = &H1
Private Const WM_DESTROY As Integer = &H2
Private Const WM_MOVE As Integer = &H3
Private Const WM_SIZE As Integer = &H5
Private Const WM_ACTIVATE As Integer = &H6
Private Const WM_SETFOCUS As Integer = &H7
Private Const WM_KILLFOCUS As Integer = &H8
Private Const WM_ENABLE As Integer = &HA
Private Const WM_PAINT As Integer = &HF
Private Const WM_CLOSE As Integer = &H10
Private Const WM_SHOWWINDOW As Integer = &H18
Private Const WM_ACTIVATEAPP As Integer = &H1C
Private Const WM_CANCELMODE As Integer = &H1F
Private Const WM_GETMINMAXINFO As Integer = &H24
Private Const WM_NCCREATE As Integer = &H81
Private Const WM_NCCALCSIZE As Integer = &H83
Private Const WM_KEYDOWN As Integer = &H100
Private Const WM_KEYUP As Integer = &H101
Private Const WM_AFXFIRST = &H360
' /////////////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes Commande de Fenêtre
' /////////////////////////////////////////////////////////////////////////////
Private Const SW_HIDE As Integer = 0
Private Const SW_NORMAL As Integer = 1
Private Const SW_SHOWMINIMIZED As Integer = 2
Private Const SW_SHOWMAXIMIZED As Integer = 3
Private Const SW_SHOWNOACTIVATE As Integer = 4
Private Const SW_SHOW As Integer = 5
Private Const SW_MINIMIZE As Integer = 6
Private Const SW_SHOWINNOACTIVE As Integer = 7
Private Const SW_SHOWNA As Integer = 8
Private Const SW_RESTORE As Integer = 9
' /////////////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes Couleur Systeme
' ////////////////////////////////////////////////////////////////////////////
Private Const COLOR_SCROLLBAR As Integer = 0
Private Const COLOR_BACKGROUND As Integer = 1
Private Const COLOR_ACTIVECAPTION As Integer = 2
Private Const COLOR_INACTIVECAPTION As Integer = 3
Private Const COLOR_MENU As Integer = 4
Private Const COLOR_WINDOW As Integer = 5
Private Const COLOR_WINDOWFRAME As Integer = 6
' ////////////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes dmFields de Display Settings
' ////////////////////////////////////////////////////////////////////////////
Private Const DM_ORIENTATION As Integer = &H1
Private Const DM_PAPERSIZE As Integer = &H2
Private Const DM_PAPERLENGTH As Integer = &H4
Private Const DM_PAPERWIDTH As Integer = &H8
Private Const DM_SCALE As Integer = &H10
Private Const DM_POSITION As Integer = &H20
Private Const DM_NUP As Integer = &H40
Private Const DM_DISPLAYORIENTATION As Integer = &H80
Private Const DM_COPIES As Integer = &H100
Private Const DM_DEFAULTSOURCE As Integer = &H200
Private Const DM_PRINTQUALITY As Integer = &H400
Private Const DM_COLOR As Integer = &H800
Private Const DM_DUPLEX As Integer = &H1000
Private Const DM_YRESOLUTION As Integer = &H2000
Private Const DM_TTOPTION As Integer = &H4000
Private Const DM_COLLATE As Integer = &H8000
Private Const DM_FORMNAME As Integer = &H10000
Private Const DM_LOGPIXELS As Integer = &H20000
Private Const DM_BITSPERPEL As Integer = &H40000
Private Const DM_PELSWIDTH As Integer = &H80000
Private Const DM_PELSHEIGHT As Integer = &H100000
Private Const DM_DISPLAYFLAGS As Integer = &H200000
Private Const DM_DISPLAYFREQUENCY As Integer = &H400000
' ////////////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes iMode de Display Settings
' ////////////////////////////////////////////////////////////////////////////
Private Const CDS_UPDATEREGISTRY As Integer = &H1
Private Const CDS_TEST As Integer = &H2
Private Const CDS_FULL_SCREEN As Integer = &H4
Private Const CDS_GLOBAL As Integer = &H8
Private Const CDS_SET_PRIMARY As Integer = &H10
Private Const CDS_VIDEOPARAMETERS As Integer = &H20
Private Const CDS_ENABLE_UNSAFE_MODES As Integer = &H100
Private Const CDS_DISABLE_UNSAFE_MODES As Integer = &H200
' ////////////////////////////////////////////////////////////////////////////
' /// Déclaration Constantes OpenGLFrame
' ////////////////////////////////////////////////////////////////////////////
Private Const OPENGLFRAME As String = "OpenGLFrame1"
' ////////////////////////////////////////////////////////////////////////////
' /// Déclaration des Variables Structurées
' ////////////////////////////////////////////////////////////////////////////
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Private Structure WNDCLASSEX
Public cbSize As UInteger
Public style As UInteger
<MarshalAs(UnmanagedType.FunctionPtr)> Public lpfnwndproc As WndProc
Public cbClsextra As Integer
Public cbWndExtra As Integer
Public hInstance As IntPtr
Public hIcon As IntPtr
Public hCursor As IntPtr
Public hbrBackground As IntPtr
Public lpszMenuName As String
Public lpszClassName As String
Public hIconSm As IntPtr
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Private Structure PIXELFORMATDESCRIPTOR
Public nSize As Short
Public nVersion As Short
Public dwFlags As Integer
Public iPixelType As Byte
Public cColorBits As Byte
Public cRedBits As Byte
Public cRedShift As Byte
Public cGreenBits As Byte
Public cGreenShift As Byte
Public cBlueBits As Byte
Public cBlueShift As Byte
Public cAlphaBits As Byte
Public cAlphaShift As Byte
Public cAccumBits As Byte
Public cAccumRedBits As Byte
Public cAccumGreenBits As Byte
Public cAccumBlueBits As Byte
Public cAccumAlphaBits As Byte
Public cDepthBits As Byte
Public cStencilBits As Byte
Public cAuxBuffers As Byte
Public iLayerType As Byte
Public bReserved As Byte
Public dwLayerMask As Integer
Public dwVisibleMask As Integer
Public dwDamageMask As Integer
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
Public Structure DEVMODE
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> _
Public dmDeviceName As String
Public dmSpecVersion As Short
Public dmDriverVersion As Short
Public dmSize As Short
Public dmDriverExtra As Short
Public dmFields As Integer
Public dmPositionX As Integer
Public dmPositionY As Integer
Public dmDisplayOrientation As Integer
Public dmDisplayFixedOutput As Integer
Public dmColor As Short
Public dmDuplex As Short
Public dmYResolution As Short
Public dmTTOption As Short
Public dmCollate As Short
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> _
Public dmFormName As String
Public dmLogPixels As Short
Public dmBitsPerPel As Short
Public dmPelsWidth As Integer
Public dmPelsHeight As Integer
Public dmDisplayFlags As Integer
Public dmDisplayFrequency As Integer
Public dmICMMethod As Integer
Public dmICMIntent As Integer
Public dmMediaType As Integer
Public dmDitherType As Integer
Public dmReserved1 As Integer
Public dmReserved2 As Integer
Public dmPanningWidth As Integer
Public dmPanningHeight As Integer
End Structure
Private Structure RECT
Public Left As Long
Public Right As Long
Public Top As Long
Public Bottom As Long
End Structure
Private Enum CDSRet As Integer
DISP_CHANGE_SUCCESSFUL = 0
DISP_CHANGE_RESTART = 1
DISP_CHANGE_FAILED = -1
DISP_CHANGE_BADMODE = -2
DISP_CHANGE_NOTUPDATED = -3
DISP_CHANGE_BADFLAGS = -4
DISP_CHANGE_BADPARAM = -5
End Enum
Public Sub New()
hInstance = Marshal.GetHINSTANCE(GetType(OpenGLFrame).Module)
If (MsgBox("Fullscreen ? ", MsgBoxStyle.YesNo) = MsgBoxResult.No) Then
Fullscreen = False
End If
If (CreateGLWindow("OpenGLFrame", 800, 600, 32, Fullscreen) = True) Then
ShowWindow(hWnD, SW_SHOW)
If (InitGL() = False) Then
KillGLWindow()
MsgBox("Impossible D'initialiser OpenGL : ERREUR FATALE", vbOK)
End If
End If
End Sub
Public Sub Quit()
KillGLWindow()
End Sub
Public ReadOnly Property Active As Boolean
Get
Active = nActive
End Get
End Property
Private Sub ReSizeGLScene(ByVal width As Integer, ByVal height As Integer)
If (height = 0) Then
height = 1
End If
GL.glViewport(0, 0, width, height)
GL.glMatrixMode(GL.GL_PROJECTION)
GL.glLoadIdentity()
GL.gluPerspective(45.0F, CDbl(width) / CDbl(height), 0.1F, 100.0F)
GL.glMatrixMode(GL.GL_MODELVIEW)
GL.glLoadIdentity()
End Sub
Private Function InitGL() As Integer
GL.glShadeModel(GL.GL_SMOOTH)
GL.glClearColor(0.0F, 0.0F, 0.0F, 0.0F)
GL.glClearDepth(1.0F)
GL.glEnable(GL.GL_DEPTH_TEST)
GL.glDepthFunc(GL.GL_LEQUAL)
GL.glHint(GL.GL_PERSPECTIVE_CORRECTION_HINT, GL.GL_NICEST)
Return True
End Function
Public Function DrawGLScene() As Integer
GL.glClear(GL.GL_COLOR_BUFFER_BIT Or GL.GL_DEPTH_BUFFER_BIT)
GL.glLoadIdentity()
' ////////////////////////////////////////////////////
' /// Ici Votre Dessin
' ////////////////////////////////////////////////////
SwapBuffers(hDC)
Return True
End Function
Private Sub KillGLWindow()
If Fullscreen = True Then
ChangeDisplaySettings(Nothing, 0)
End If
If (IsNothing(hRC) = False) Then
If (wglMakeCurrent(hDC, IntPtr.Zero) = IntPtr.Zero) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
MsgBox("Ne Peut dissocier le Contexte de Rendu et la Fenêtre : ERREUR FATALE", vbOK)
End If
If (wglDeleteContext(hRC) = IntPtr.Zero) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
MsgBox("Ne peut relâcher le Contexte de Rendu : ERREUR FATALE", vbOK)
End If
hRC = Nothing
End If
If (IsNothing(hDC) = False) Then
If (ReleaseDC(hWnD, hDC) = IntPtr.Zero) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
MsgBox("Ne peut relâcher le Contexte de Dispositif Graphique : ERREUR FATALE", vbOK)
End If
hDC = Nothing
End If
If (IsNothing(hWnD) = False) Then
If (DestroyWindow(hWnD) = IntPtr.Zero) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
MsgBox("Ne Peut Détruire la fenêtre : ERREUR FATALE", vbOK)
End If
hWnD = Nothing
End If
If (UnregisterWindowClass(OPENGLFRAME, hInstance) = False) Then
MsgBox("Ne Peut Désenregistrer la Classe : ERREUR FATALE", vbOK)
End If
hInstance = Nothing
OpenGLWindow = Nothing
End Sub
Private Function CreateGLWindow(ByVal Title As String, ByVal width As Integer, ByVal height As Integer, ByVal bits As Integer, ByVal fullscreenflag As Boolean) As Integer
Dim dwExtStyle As Integer
Dim dwStyle As Integer
Dim iPixelFormat As Integer
Dim ppfd As New PIXELFORMATDESCRIPTOR
Dim OpenGLRectangle As RECT
ppfd.nSize = Marshal.SizeOf(ppfd)
ppfd.nVersion = 1
ppfd.dwFlags = PFD_DRAW_TO_WINDOW Or PFD_SUPPORT_OPENGL Or PFD_DOUBLE_BUFFER
ppfd.iPixelType = PFD_TYPE_RGBA
ppfd.cColorBits = bits
ppfd.cRedBits = IntPtr.Zero
ppfd.cRedShift = IntPtr.Zero
ppfd.cGreenBits = IntPtr.Zero
ppfd.cGreenShift = IntPtr.Zero
ppfd.cBlueBits = IntPtr.Zero
ppfd.cBlueShift = IntPtr.Zero
ppfd.cAlphaBits = IntPtr.Zero
ppfd.cAlphaShift = IntPtr.Zero
ppfd.cAccumBits = IntPtr.Zero
ppfd.cAccumRedBits = IntPtr.Zero
ppfd.cAccumGreenBits = IntPtr.Zero
ppfd.cAccumBlueBits = IntPtr.Zero
ppfd.cAccumAlphaBits = IntPtr.Zero
ppfd.cDepthBits = 16
ppfd.cStencilBits = IntPtr.Zero
ppfd.cAuxBuffers = IntPtr.Zero
ppfd.iLayerType = PFD_MAIN_PLANE
ppfd.bReserved = IntPtr.Zero
ppfd.dwLayerMask = IntPtr.Zero
ppfd.dwVisibleMask = IntPtr.Zero
ppfd.dwDamageMask = IntPtr.Zero
OpenGLRectangle.Right = width
OpenGLRectangle.Bottom = height
OpenGLRectangle.Top = 0
OpenGLRectangle.Left = 0
Fullscreen = fullscreenflag
If (RegisterWindowClass() = False) Then
MsgBox("Impossible d'enregistrer la Classe Fenêtre : ERREUR FATALE", MsgBoxStyle.OkOnly)
Return False
Else
If Fullscreen = True Then
Dim OpenGLDEVMODE As DEVMODE = CreateDevMode()
Dim CDSRetValue As Integer
OpenGLDEVMODE.dmSize = CShort(Marshal.SizeOf(OpenGLDEVMODE))
EnumDisplaySettings(Nothing, -1, OpenGLDEVMODE)
OpenGLDEVMODE.dmBitsPerPel = bits
OpenGLDEVMODE.dmPelsWidth = width
OpenGLDEVMODE.dmPelsHeight = height
OpenGLDEVMODE.dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT
CDSRetValue = ChangeDisplaySettings(OpenGLDEVMODE, 4)
If (CDSRetValue <> IntPtr.Zero) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
MsgBox("Le Mode Full Ecran Sélectionné n'est pas supporté : " & [Enum].GetName(GetType(CDSRet), CDSRetValue), MsgBoxStyle.OkOnly)
Fullscreen = False
End If
CDSRetValue = Nothing
End If
If Fullscreen Then
dwExtStyle = WS_EX_APPWINDOW
dwStyle = WS_POPUP
Else
dwExtStyle = WS_EX_APPWINDOW Or WS_EX_WINDOWEDGE
dwStyle = WS_OVERLAPPED Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SYSMENU
End If
Dim AdjustRect As Integer
AdjustRect = AdjustWindowRectEx(OpenGLRectangle, dwStyle, False, dwExtStyle)
hWnD = CreateWindowEx(dwExtStyle, OpenGLWindow.lpszClassName, Title, dwStyle, IntPtr.Zero, IntPtr.Zero, OpenGLRectangle.Right - OpenGLRectangle.Left, OpenGLRectangle.Bottom - OpenGLRectangle.Top, IntPtr.Zero, IntPtr.Zero, hInstance, IntPtr.Zero)
OpenGLRectangle = Nothing
If (hWnD = 0) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
KillGLWindow()
MsgBox("Erreur de Création Fenêtre : ERREUR FATALE", vbOK)
Return False
Else
hDC = GetDC(hWnD)
If (hDC = 0) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
KillGLWindow()
MsgBox("Impossible de Créer le Contexte du Dispositif : ERREUR FATALE", vbOK)
Return False
Else
iPixelFormat = ChoosePixelFormat(hDC, ppfd)
If (iPixelFormat = 0) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
KillGLWindow()
MsgBox("Ne trouve pas de Format de Pixel compatible : ERREUR FATALE", vbOK)
iPixelFormat = Nothing
Return False
Else
If (SetPixelFormat(hDC, iPixelFormat, ppfd) = IntPtr.Zero) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
KillGLWindow()
MsgBox("N'arrive pas à attribuer le Format de Pixel : ERREUR FATALE", vbOK)
iPixelFormat = Nothing
ppfd = Nothing
Return False
Else
iPixelFormat = Nothing
ppfd = Nothing
hRC = wglCreateContext(hDC)
If (hRC = 0) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
KillGLWindow()
MsgBox("N'arrive pas à créer le contexte de Rendu : ERREUR FATALE", vbOK)
Return False
Else
If (wglMakeCurrent(hDC, hRC) = IntPtr.Zero) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
KillGLWindow()
MsgBox("N'arrive pas à lier le contexte de rendu au contexte du dispositif : ERREUR FATALE", vbOK)
Return False
Else
Return True
End If
End If
End If
End If
End If
End If
End If
End Function
Private Function RegisterWindowClass()
Dim OpenGLClass As IntPtr
With OpenGLWindow
.cbSize = Marshal.SizeOf(OpenGLWindow)
.style = CS_HREDRAW Or CS_VREDRAW Or CS_OWNDC
.lpfnwndproc = New WndProc(AddressOf HandleWndProc)
.cbClsextra = 0
.cbWndExtra = 0
.hInstance = hInstance
.hIcon = IntPtr.Zero
.hCursor = IntPtr.Zero
.hbrBackground = IntPtr.Zero
.lpszMenuName = vbNullString
.lpszClassName = OPENGLFRAME
.hIconSm = IntPtr.Zero
End With
OpenGLClass = RegisterClassEx(OpenGLWindow)
If (OpenGLClass = 0) Then
Debug.WriteLine("code erreur : " & Err.LastDllError)
OpenGLClass = Nothing
Return False
Else
OpenGLClass = Nothing
Return True
End If
End Function
Private Function UnregisterWindowClass(ByVal ClassName As String, ByVal Instance As Long) As Integer
If (UnregisterClass(ClassName, Instance) = IntPtr.Zero) Then
Return False
Else
Return True
End If
End Function
<UnmanagedFunctionPointer(CallingConvention.Cdecl)> Private Delegate Function WndProc(ByVal hWnd As IntPtr, ByVal msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Long
Private Function HandleWndProc(ByVal hWnd As IntPtr, ByVal msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Long
Select Case (msg)
Case WM_CREATE
Return DefWindowProc(hWnd, msg, wParam, lParam)
Case WM_SIZE
ReSizeGLScene(GetLowWord(lParam), GetHighWord(lParam))
Return 0
Case WM_ACTIVATE
If (GetHighWord(wParam) <> IntPtr.Zero) Then
nActive = False
Else
nActive = True
End If
Return 0
Case WM_CLOSE
RaiseEvent KeyReleased(27)
Return 0
Case WM_SHOWWINDOW
Return DefWindowProc(hWnd, msg, wParam, lParam)
Case WM_ACTIVATEAPP
Return DefWindowProc(hWnd, msg, wParam, lParam)
Case WM_GETMINMAXINFO
Return DefWindowProc(hWnd, msg, wParam, lParam)
Case WM_NCCREATE
Return DefWindowProc(hWnd, msg, wParam, lParam)
Case WM_NCCALCSIZE
Return DefWindowProc(hWnd, msg, wParam, lParam)
Case WM_KEYDOWN
RaiseEvent KeyPressed(wParam)
Return 0
Case WM_KEYUP
RaiseEvent KeyReleased(wParam)
Return 0
Case Else
Return DefWindowProc(hWnd, msg, wParam, lParam)
End Select
End Function
Private Function GetLowWord(ByRef pintValue As Int32) As Int32
Return pintValue And &HFFFF
End Function
Private Function GetLowWord(ByRef pudtValue As IntPtr) As Int32
Return GetLowWord(pudtValue.ToInt32)
End Function
Private Function GetHighWord(ByRef pintValue As Int32) As Int32
If (pintValue And &H80000000) = &H80000000 Then
Return ((pintValue And &H7FFF0000) \ &H10000) Or &H8000&
Else
Return (pintValue And &HFFFF0000) \ &H10000
End If
End Function
Private Shared Function CreateDevMode() As DEVMODE
Dim dm As New DEVMODE
dm.dmDeviceName = New String(New Char(32) {})
dm.dmFormName = New String(New Char(32) {})
dm.dmSize = CShort(Marshal.SizeOf(dm))
Return dm
End Function
End Class

____________________________________________________________________________________

CODE 2

Imports OpenGLFrame
Imports CsGL.OpenGL
Public NotInheritable Class TheName You Want

Private Sub YourButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles StartButton.Click
Dim MyForm As OpenGLFrame.OpenGLFrame
MyForm = New OpenGLFrame.OpenGLFrame
Me.Visible = False
AddHandler MyForm.KeyPressed, AddressOf KeyPressed
AddHandler MyForm.KeyReleased, AddressOf KeyReleased
While Not done
If (MyForm.Active = True) Then
MyForm.DrawGLScene()
End If
Application.DoEvents()
End While
MyForm.Quit()
Done = False
MyForm = Nothing
Me.Visible = True
End Sub
Private Sub KeyPressed(ByVal KeyCode As Integer)

End Sub
Private Sub KeyReleased(ByVal KeyCode As Integer)
If CInt(KeyCode) = CInt(Keys.Escape) Then
Done = True
End If
End Sub
End Class



==> when using the code TAG for posting VB.NET source, it removes the DLLImport statements, that's why I give it as plain text.

This topic is closed to new replies.

Advertisement