1 {
2  *****************************************************************************
3   See the file COPYING.modifiedLGPL.txt, included in this distribution,
4   for details about the license.
5  *****************************************************************************
6 
7   Author: Mattias Gaertner
8 
9 }
10 unit GLWin32WGLContext;
11 
12 {$mode objfpc}{$H+}
13 
14 interface
15 
16 uses
17   Classes, SysUtils, LMessages, Windows, LCLProc, LCLType, gl, Forms, Controls,
18   Win32Int, WSLCLClasses, WSControls, Win32WSControls, Win32Proc, LCLMessageGlue;
19 
20 procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
21 procedure LOpenGLSwapBuffers(Handle: HWND);
LOpenGLMakeCurrentnull22 function LOpenGLMakeCurrent(Handle: HWND): boolean;
LOpenGLReleaseContextnull23 function LOpenGLReleaseContext(Handle: HWND): boolean;
LOpenGLCreateContextnull24 function LOpenGLCreateContext(AWinControl: TWinControl;
25                     WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
26                     DoubleBuffered, RGBA, DebugContext: boolean;
27                     const RedBits, GreenBits, BlueBits,
28                     MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
29                     const AParams: TCreateParams): HWND;
30 procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
31 
32 procedure InitWGL(RequireWGL_ARB_create_context : boolean);
33 procedure InitOpenGLContextGLWindowClass;
34 
35 
36 type
37   TWGLControlInfo = record
38     Window: HWND;
39     DC: HDC;
40     PixelFormat: GLUInt;
41     WGLContext: HGLRC;
42   end;
43   PWGLControlInfo = ^TWGLControlInfo;
44 
45 var
46   WGLControlInfoAtom: ATOM = 0;
47 
AllocWGLControlInfonull48 function AllocWGLControlInfo(Window: HWND): PWGLControlInfo;
DisposeWGLControlInfonull49 function DisposeWGLControlInfo(Window: HWND): boolean;
GetWGLControlInfonull50 function GetWGLControlInfo(Window: HWND): PWGLControlInfo;
51 
52 
53 const
54   WGL_SAMPLE_BUFFERS_ARB                           = $2041;
55   WGL_SAMPLES_ARB                                  = $2042;
56 
57   // WGL_ARB_pixel_format
58   WGL_NUMBER_PIXEL_FORMATS_ARB                     = $2000;
59   WGL_DRAW_TO_WINDOW_ARB                           = $2001;
60   WGL_DRAW_TO_BITMAP_ARB                           = $2002;
61   WGL_ACCELERATION_ARB                             = $2003;
62   WGL_NEED_PALETTE_ARB                             = $2004;
63   WGL_NEED_SYSTEM_PALETTE_ARB                      = $2005;
64   WGL_SWAP_LAYER_BUFFERS_ARB                       = $2006;
65   WGL_SWAP_METHOD_ARB                              = $2007;
66   WGL_NUMBER_OVERLAYS_ARB                          = $2008;
67   WGL_NUMBER_UNDERLAYS_ARB                         = $2009;
68   WGL_TRANSPARENT_ARB                              = $200A;
69   WGL_TRANSPARENT_RED_VALUE_ARB                    = $2037;
70   WGL_TRANSPARENT_GREEN_VALUE_ARB                  = $2038;
71   WGL_TRANSPARENT_BLUE_VALUE_ARB                   = $2039;
72   WGL_TRANSPARENT_ALPHA_VALUE_ARB                  = $203A;
73   WGL_TRANSPARENT_INDEX_VALUE_ARB                  = $203B;
74   WGL_SHARE_DEPTH_ARB                              = $200C;
75   WGL_SHARE_STENCIL_ARB                            = $200D;
76   WGL_SHARE_ACCUM_ARB                              = $200E;
77   WGL_SUPPORT_GDI_ARB                              = $200F;
78   WGL_SUPPORT_OPENGL_ARB                           = $2010;
79   WGL_DOUBLE_BUFFER_ARB                            = $2011;
80   WGL_STEREO_ARB                                   = $2012;
81   WGL_PIXEL_TYPE_ARB                               = $2013;
82   WGL_COLOR_BITS_ARB                               = $2014;
83   WGL_RED_BITS_ARB                                 = $2015;
84   WGL_RED_SHIFT_ARB                                = $2016;
85   WGL_GREEN_BITS_ARB                               = $2017;
86   WGL_GREEN_SHIFT_ARB                              = $2018;
87   WGL_BLUE_BITS_ARB                                = $2019;
88   WGL_BLUE_SHIFT_ARB                               = $201A;
89   WGL_ALPHA_BITS_ARB                               = $201B;
90   WGL_ALPHA_SHIFT_ARB                              = $201C;
91   WGL_ACCUM_BITS_ARB                               = $201D;
92   WGL_ACCUM_RED_BITS_ARB                           = $201E;
93   WGL_ACCUM_GREEN_BITS_ARB                         = $201F;
94   WGL_ACCUM_BLUE_BITS_ARB                          = $2020;
95   WGL_ACCUM_ALPHA_BITS_ARB                         = $2021;
96   WGL_DEPTH_BITS_ARB                               = $2022;
97   WGL_STENCIL_BITS_ARB                             = $2023;
98   WGL_AUX_BUFFERS_ARB                              = $2024;
99   WGL_NO_ACCELERATION_ARB                          = $2025;
100   WGL_GENERIC_ACCELERATION_ARB                     = $2026;
101   WGL_FULL_ACCELERATION_ARB                        = $2027;
102   WGL_SWAP_EXCHANGE_ARB                            = $2028;
103   WGL_SWAP_COPY_ARB                                = $2029;
104   WGL_SWAP_UNDEFINED_ARB                           = $202A;
105   WGL_TYPE_RGBA_ARB                                = $202B;
106   WGL_TYPE_COLORINDEX_ARB                          = $202C;
107 
108   // WGL_NV_float_buffer
109   WGL_FLOAT_COMPONENTS_NV                          = $20B0;
110   WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_R_NV         = $20B1;
111   WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RG_NV        = $20B2;
112   WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RGB_NV       = $20B3;
113   WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RGBA_NV      = $20B4;
114   WGL_TEXTURE_FLOAT_R_NV                           = $20B5;
115   WGL_TEXTURE_FLOAT_RG_NV                          = $20B6;
116   WGL_TEXTURE_FLOAT_RGB_NV                         = $20B7;
117   WGL_TEXTURE_FLOAT_RGBA_NV                        = $20B8;
118 
119   // WGL_ARB_pbuffer
120 type
121   HPBUFFERARB = Integer;
122   TGLenum = uint;
123 
124 const
125   WGL_DRAW_TO_PBUFFER_ARB                          = $202D;
126   WGL_MAX_PBUFFER_PIXELS_ARB                       = $202E;
127   WGL_MAX_PBUFFER_WIDTH_ARB                        = $202F;
128   WGL_MAX_PBUFFER_HEIGHT_ARB                       = $2030;
129   WGL_PBUFFER_LARGEST_ARB                          = $2033;
130   WGL_PBUFFER_WIDTH_ARB                            = $2034;
131   WGL_PBUFFER_HEIGHT_ARB                           = $2035;
132   WGL_PBUFFER_LOST_ARB                             = $2036;
133 
134   // WGL_ARB_buffer_region
135   WGL_FRONT_COLOR_BUFFER_BIT_ARB                   = $00000001;
136   WGL_BACK_COLOR_BUFFER_BIT_ARB                    = $00000002;
137   WGL_DEPTH_BUFFER_BIT_ARB                         = $00000004;
138   WGL_STENCIL_BUFFER_BIT_ARB                       = $00000008;
139 
140   WGL_CONTEXT_FLAGS_ARB                            = $2094;
141   WGL_CONTEXT_DEBUG_BIT_ARB                        = $0001;
142 
143 const
144   opengl32 = 'OpenGL32.dll';
145   glu32 = 'GLU32.dll';
146 
147 type
148   PWGLSwap = ^TWGLSwap;
149   _WGLSWAP = packed record
150     hdc: HDC;
151     uiFlags: UINT;
152   end;
153   TWGLSwap = _WGLSWAP;
154   WGLSWAP = _WGLSWAP;
155 
wglGetProcAddressnull156   function wglGetProcAddress(ProcName: PChar): Pointer; stdcall; external opengl32;
wglCopyContextnull157   function wglCopyContext(p1: HGLRC; p2: HGLRC; p3: Cardinal): BOOL; stdcall; external opengl32;
wglCreateContextnull158   function wglCreateContext(DC: HDC): HGLRC; stdcall; external opengl32;
wglCreateLayerContextnull159   function wglCreateLayerContext(p1: HDC; p2: Integer): HGLRC; stdcall; external opengl32;
wglDeleteContextnull160   function wglDeleteContext(p1: HGLRC): BOOL; stdcall; external opengl32;
wglDescribeLayerPlanenull161   function wglDescribeLayerPlane(p1: HDC; p2, p3: Integer; p4: Cardinal; var p5: TLayerPlaneDescriptor): BOOL; stdcall; external opengl32;
wglGetCurrentContextnull162   function wglGetCurrentContext: HGLRC; stdcall; external opengl32;
wglGetCurrentDCnull163   function wglGetCurrentDC: HDC; stdcall; external opengl32;
wglGetLayerPaletteEntriesnull164   function wglGetLayerPaletteEntries(p1: HDC; p2, p3, p4: Integer; var pcr): Integer; stdcall; external opengl32;
wglMakeCurrentnull165   function wglMakeCurrent(DC: HDC; p2: HGLRC): BOOL; stdcall; external opengl32;
wglRealizeLayerPalettenull166   function wglRealizeLayerPalette(p1: HDC; p2: Integer; p3: BOOL): BOOL; stdcall; external opengl32;
wglSetLayerPaletteEntriesnull167   function wglSetLayerPaletteEntries(p1: HDC; p2, p3, p4: Integer; var pcr): Integer; stdcall; external opengl32;
wglShareListsnull168   function wglShareLists(p1, p2: HGLRC): BOOL; stdcall; external opengl32;
wglSwapLayerBuffersnull169   function wglSwapLayerBuffers(p1: HDC; p2: Cardinal): BOOL; stdcall; external opengl32;
wglUseFontBitmapsAnull170   function wglUseFontBitmapsA(DC: HDC; p2, p3, p4: DWORD): BOOL; stdcall; external opengl32;
wglUseFontOutlinesAnull171   function wglUseFontOutlinesA (p1: HDC; p2, p3, p4: DWORD; p5, p6: Single; p7: Integer; p8: PGlyphMetricsFloat): BOOL; stdcall; external opengl32;
wglUseFontBitmapsWnull172   function wglUseFontBitmapsW(DC: HDC; p2, p3, p4: DWORD): BOOL; stdcall; external opengl32;
wglUseFontOutlinesWnull173   function wglUseFontOutlinesW (p1: HDC; p2, p3, p4: DWORD; p5, p6: Single; p7: Integer; p8: PGlyphMetricsFloat): BOOL; stdcall; external opengl32;
wglUseFontBitmapsnull174   function wglUseFontBitmaps(DC: HDC; p2, p3, p4: DWORD): BOOL; stdcall; external opengl32 name 'wglUseFontBitmapsA';
wglUseFontOutlinesnull175   function wglUseFontOutlines(p1: HDC; p2, p3, p4: DWORD; p5, p6: Single; p7: Integer; p8: PGlyphMetricsFloat): BOOL; stdcall; external opengl32 name 'wglUseFontOutlinesA';
176 
177 var
178   // WGL Extensions ----------------------------
179   WGL_EXT_swap_control: boolean;
180   WGL_ARB_multisample: boolean;
181   WGL_ARB_extensions_string: boolean;
182   WGL_ARB_pixel_format: boolean;
183   WGL_ARB_pbuffer: boolean;
184   WGL_ARB_buffer_region: boolean;
185   WGL_ATI_pixel_format_float: boolean;
186 
187 
188   // ARB wgl extensions
189   wglCreateContextAttribsARB : function (DC: HDC; hShareContext:HGLRC; attribList:PInteger ):HGLRC;stdcall;
Cnull190   wglGetExtensionsStringARB: function(DC: HDC): PChar; stdcall;
Cnull191   wglGetPixelFormatAttribivARB: function(DC: HDC; iPixelFormat, iLayerPlane: Integer; nAttributes: TGLenum;
192     const piAttributes: PGLint; piValues : PGLint) : BOOL; stdcall;
Cnull193   wglGetPixelFormatAttribfvARB: function(DC: HDC; iPixelFormat, iLayerPlane: Integer; nAttributes: TGLenum;
194     const piAttributes: PGLint; piValues: PGLFloat) : BOOL; stdcall;
Cnull195   wglChoosePixelFormatARB: function(DC: HDC; const piAttribIList: PGLint; const pfAttribFList: PGLFloat;
196     nMaxFormats: GLint; piFormats: PGLint; nNumFormats: PGLenum) : BOOL; stdcall;
Cnull197   wglCreatePbufferARB: function(DC: HDC; iPixelFormat: Integer; iWidth, iHeight : Integer;
198     const piAttribList: PGLint) : HPBUFFERARB; stdcall;
Pbuffernull199   wglGetPbufferDCARB: function(hPbuffer: HPBUFFERARB) : HDC; stdcall;
Pbuffernull200   wglReleasePbufferDCARB: function(hPbuffer: HPBUFFERARB; DC: HDC) : Integer; stdcall;
Pbuffernull201   wglDestroyPbufferARB: function(hPbuffer: HPBUFFERARB): BOOL; stdcall;
Pbuffernull202   wglQueryPbufferARB: function(hPbuffer: HPBUFFERARB; iAttribute : Integer;
203     piValue: PGLint) : BOOL; stdcall;
204 
Cnull205   wglCreateBufferRegionARB: function(DC: HDC; iLayerPlane: Integer; uType: TGLenum) : Integer; stdcall;
206   wglDeleteBufferRegionARB: procedure(hRegion: Integer); stdcall;
Regionnull207   wglSaveBufferRegionARB: function(hRegion: Integer; x, y, width, height: Integer): BOOL; stdcall;
Regionnull208   wglRestoreBufferRegionARB: function(hRegion: Integer; x, y, width, height: Integer;
209     xSrc, ySrc: Integer): BOOL; stdcall;
210 
211   // non-ARB wgl extensions
ntervalnull212   wglSwapIntervalEXT: function(interval : Integer) : BOOL; stdcall;
213   wglGetSwapIntervalEXT: function : Integer; stdcall;
214 
215 var
216   WGLInitialized: boolean = false;
217   OpenGLContextWindowClassInitialized: boolean = false;
218   OpenGLContextWindowClass: WNDCLASS;
219 
220 const
221   DefaultOpenGLContextInitAttrList: array [0..0] of LongInt = (
222     0
223     );
224 
225 implementation
226 uses glext;
227 
GLGetProcAddressnull228 function GLGetProcAddress(ProcName: PChar):Pointer;
229 begin
230   Result := wglGetProcAddress(ProcName);
231 end;
232 
233 procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
234 begin
235   glViewport(Left,Top,Width,Height);
236 end;
237 
238 procedure LOpenGLSwapBuffers(Handle: HWND);
239 var
240   Info: PWGLControlInfo;
241 begin
242   Info:=GetWGLControlInfo(Handle);
243   // don't use wglSwapLayerBuffers or wglSwapBuffers!
244   SwapBuffers(Info^.DC);
245 end;
246 
247 function LOpenGLMakeCurrent(Handle: HWND): boolean;
248 var
249   Info: PWGLControlInfo;
250 begin
251   Info:=GetWGLControlInfo(Handle);
252   Result:=wglMakeCurrent(Info^.DC,Info^.WGLContext);
253 end;
254 
255 function LOpenGLReleaseContext(Handle: HWND): boolean;
256 begin
257   Result:=wglMakeCurrent(0,0);
258 end;
259 
260 function GlWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
261     LParam: Windows.LParam): LResult; stdcall;
262 var
263   PaintMsg   : TLMPaint;
264   winctrl    : TWinControl;
265 begin
266   case Msg of
267     WM_ERASEBKGND: begin
268       Result:=0;
269     end;
270     WM_PAINT: begin
271       winctrl := GetWin32WindowInfo(Window)^.WinControl;
272       if Assigned(winctrl) then begin
273         FillChar(PaintMsg, SizeOf(PaintMsg), 0);
274         PaintMsg.Msg := LM_PAINT;
275         PaintMsg.DC := WParam;
276         DeliverMessage(winctrl, PaintMsg);
277         Result:=PaintMsg.Result;
278       end else
279         Result:=WindowProc(Window, Msg, WParam, LParam);
280     end;
281   else
282     Result:=WindowProc(Window, Msg, WParam, LParam);
283   end;
284 end;
285 
286 var
287   Temp_h_GLRc: HGLRC;
288   Temp_h_Dc: HDC;
289   Temp_h_Wnd: HWND;
290 
291 procedure LGlMsDestroyTemporaryWindow; forward;
292 
293 procedure LGlMsCreateTemporaryWindow;
294 var
295   PixelFormat: LongInt;
296   pfd: PIXELFORMATDESCRIPTOR;
297 begin
298   Temp_h_Wnd := 0;
299   Temp_h_Dc := 0;
300   Temp_h_GLRc := 0;
301 
302   try
303     { create Temp_H_wnd }
304     Temp_H_wnd := CreateWindowEx(WS_EX_APPWINDOW or WS_EX_WINDOWEDGE,
305       PChar('STATIC'),
306       PChar('temporary window for wgl'),
307       WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN,
308       0, 0, 100, 100,
309       0 { no parent window }, 0 { no menu }, hInstance,
310       nil);
311     if Temp_H_wnd=0 then
312       raise Exception.Create('LGlMsCreateTemporaryWindow CreateWindowEx failed');
313 
314     { create Temp_h_Dc }
315     Temp_h_Dc := GetDC(Temp_h_Wnd);
316     if Temp_h_Dc=0 then
317       raise Exception.Create('LGlMsCreateTemporaryWindow GetDC failed');
318 
319     { create and set PixelFormat (must support OpenGL to be able to
320       later do wglCreateContext) }
321     FillChar(pfd, SizeOf(pfd), 0);
322     with pfd do
323     begin
324       nSize := SizeOf(pfd);
325       nVersion := 1;
326       dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
327       iPixelType := PFD_TYPE_RGBA;
328       iLayerType := PFD_MAIN_PLANE;
329     end;
330     PixelFormat := ChoosePixelFormat(Temp_h_Dc, @pfd);
331     if PixelFormat = 0 then
332       raise Exception.Create('LGlMsCreateTemporaryWindow ChoosePixelFormat failed');
333 
334     if not SetPixelFormat(Temp_h_Dc, PixelFormat, @pfd) then
335       raise Exception.Create('LGlMsCreateTemporaryWindow SetPixelFormat failed');
336 
337     { create and make current Temp_h_GLRc }
338     Temp_h_GLRc := wglCreateContext(Temp_h_Dc);
339     if Temp_h_GLRc = 0 then
340       raise Exception.Create('LGlMsCreateTemporaryWindow wglCreateContext failed');
341 
342     if not wglMakeCurrent(Temp_h_Dc, Temp_h_GLRc) then
343       raise Exception.Create('LGlMsCreateTemporaryWindow wglMakeCurrent failed');
344   except
345     { make sure to finalize all partially initialized window parts }
346     LGlMsDestroyTemporaryWindow;
347     raise;
348   end;
349 end;
350 
351 procedure LGlMsDestroyTemporaryWindow;
352 begin
353   if Temp_h_GLRc <> 0 then
354   begin
355     wglMakeCurrent(Temp_h_Dc, 0);
356     wglDeleteContext(Temp_h_GLRc);
357     Temp_h_GLRc := 0;
358   end;
359 
360   if Temp_h_Dc <> 0 then
361   begin
362     ReleaseDC(Temp_h_Wnd, Temp_h_Dc);
363     Temp_h_Dc := 0;
364   end;
365 
366   if Temp_h_Wnd <> 0 then
367   begin
368     DestroyWindow(Temp_h_Wnd);
369     Temp_h_Wnd := 0;
370   end;
371 end;
372 
373 function LGlMsCreateOpenGLContextAttrList(DoubleBuffered: boolean; RGBA: boolean;
374   const RedBits, GreenBits, BlueBits, MultiSampling, AlphaBits, DepthBits,
375   StencilBits, AUXBuffers: Cardinal): PInteger;
376 var
377   p: integer;
378 
379   procedure Add(i: integer);
380   begin
381     if Result<>nil then
382       Result[p]:=i;
383     inc(p);
384   end;
385 
386   procedure CreateList;
387   begin
388     Add(WGL_DRAW_TO_WINDOW_ARB); Add(GL_TRUE);
389     Add(WGL_SUPPORT_OPENGL_ARB); Add(GL_TRUE);
390     Add(WGL_ACCELERATION_ARB); Add(WGL_FULL_ACCELERATION_ARB);
391     if DoubleBuffered then
392       begin Add(WGL_DOUBLE_BUFFER_ARB); Add(GL_TRUE); end;
393     Add(WGL_PIXEL_TYPE_ARB);
394     if RGBA then
395       Add(WGL_TYPE_RGBA_ARB)
396     else
397       Add(WGL_TYPE_COLORINDEX_ARB);
398 
399     Add(WGL_RED_BITS_ARB);  Add(RedBits);
400     Add(WGL_GREEN_BITS_ARB);  Add(GreenBits);
401     Add(WGL_BLUE_BITS_ARB);  Add(BlueBits);
402     Add(WGL_COLOR_BITS_ARB);  Add(RedBits+GreenBits+BlueBits);
403     Add(WGL_ALPHA_BITS_ARB);  Add(AlphaBits);
404     Add(WGL_DEPTH_BITS_ARB);  Add(DepthBits);
405     Add(WGL_STENCIL_BITS_ARB);  Add(StencilBits);
406     Add(WGL_AUX_BUFFERS_ARB);  Add(AUXBuffers);
407     if MultiSampling > 1 then
408     begin
409       Add(WGL_SAMPLE_BUFFERS_ARB); Add(1);
410       Add(WGL_SAMPLES_ARB);        Add(MultiSampling);
411     end;
412     Add(0); Add(0);
413   end;
414 
415 begin
416   Result:=nil;
417   p:=0;
418   CreateList;
419   GetMem(Result,SizeOf(integer)*p);
420   p:=0;
421   CreateList;
422 end;
423 
424 function LOpenGLCreateContext(AWinControl: TWinControl;
425   WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
426   DoubleBuffered, RGBA, DebugContext: boolean;
427   const RedBits, GreenBits, BlueBits,
428   MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
429   const AParams: TCreateParams): HWND;
430 var
431   Params: TCreateWindowExParams;
432   pfd: PIXELFORMATDESCRIPTOR;
433   Info, SharedInfo: PWGLControlInfo;
434 
435   ReturnedFormats: UINT;
436   VisualAttrList: PInteger;
437   VisualAttrFloat: array [0..1] of Single;
438   MsInitSuccess: WINBOOL;
439   FailReason : string;
440   attribList : array [0..2] of Integer;
441 begin
442   InitWGL( DebugContext );
443   //InitOpenGLContextGLWindowClass;
444 
445   // general initialization of Params
446   PrepareCreateWindow(AWinControl, AParams, Params);
447   // customization of Params
448   with Params do begin
449     pClassName := @ClsName;
450     WindowTitle := StrCaption;
451     SubClassWndProc := @GlWindowProc;
452   end;
453   // create window
454   FinishCreateWindow(AWinControl, Params, false);
455   Result := Params.Window;
456 
457   // create info
458   Info:=AllocWGLControlInfo(Result);
459 
460   // create device context
461   Info^.DC := GetDC(Result);
462   if Info^.DC=0 then
463     raise Exception.Create('LOpenGLCreateContext GetDC failed');
464 
465   // get pixelformat
466   FillChar(pfd,SizeOf(pfd),0);
467   with pfd do begin
468     nSize:=sizeOf(pfd);
469     nVersion:=1;
470     dwFlags:=PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL;
471     if DoubleBuffered then
472       dwFlags:=dwFlags or PFD_DOUBLEBUFFER;
473     if RGBA then
474       iPixelType:=PFD_TYPE_RGBA
475     else
476       iPixelType:=PFD_TYPE_COLORINDEX;
477     cColorBits:=RedBits+GreenBits+BlueBits; // color depth
478     cRedBits:=RedBits;
479     cGreenBits:=GreenBits;
480     cBlueBits:=BlueBits;
481     cAlphaBits:=AlphaBits;
482     cDepthBits:=DepthBits; // Z-Buffer
483     cStencilBits:=StencilBits;
484     cAuxBuffers:=AUXBuffers;
485     iLayerType:=PFD_MAIN_PLANE;
486   end;
487 
488   MsInitSuccess := false;
489   if (MultiSampling > 1) and WGL_ARB_multisample and WGL_ARB_pixel_format
490     and Assigned(wglChoosePixelFormatARB) then
491   begin
492     VisualAttrList := LGlMsCreateOpenGLContextAttrList(DoubleBuffered, RGBA,
493       RedBits, GreenBits, BlueBits, MultiSampling, AlphaBits, DepthBits,
494       StencilBits, AUXBuffers);
495     try
496       FillChar(VisualAttrFloat, SizeOf(VisualAttrFloat), 0);
497       MsInitSuccess := wglChoosePixelFormatARB(Info^.DC, PGLint(VisualAttrList),
498                          @VisualAttrFloat[0], 1, @Info^.PixelFormat, @ReturnedFormats);
499     finally FreeMem(VisualAttrList) end;
500 
501     if MsInitSuccess and (ReturnedFormats >= 1) then
502        SetPixelFormat(Info^.DC, Info^.PixelFormat, nil)
503     else
504        MsInitSuccess := false;
505   end;
506 
507   if not MsInitSuccess then
508   begin
509     Info^.PixelFormat:=ChoosePixelFormat(Info^.DC,@pfd);
510     if Info^.PixelFormat=0 then
511       raise Exception.Create('LOpenGLCreateContext ChoosePixelFormat failed');
512 
513     // set pixel format in device context
514     if not SetPixelFormat(Info^.DC,Info^.PixelFormat,@pfd) then
515       raise Exception.Create('LOpenGLCreateContext SetPixelFormat failed');
516   end;
517 
518   // create WGL context
519   Info^.WGLContext:=0;
520   if not DebugContext then
521     begin
522       Info^.WGLContext:=wglCreateContext(Info^.DC);
523       FailReason:='wglCreateContext failed';
524     end
525     else if wglCreateContextAttribsARB = nil then
526     begin
527       FailReason:='wglCreateContextAttribsARB not supported';
528     end
529     else
530     begin
531       // try to create debug context
532       attribList[0]:=WGL_CONTEXT_FLAGS_ARB;
533       attribList[1]:=WGL_CONTEXT_DEBUG_BIT_ARB;
534       attribList[2]:=0;
535       Info^.WGLContext:=wglCreateContextAttribsARB(Info^.DC, 0, @attribList);
536       FailReason:='wglCreateContextAttribsARB failed';
537     end;
538 
539   if Info^.WGLContext=0 then
540     raise Exception.CreateFmt('LOpenGLCreateContext: %s', [FailReason]);
541 
542   // share context objects
543   if Assigned(SharedControl) then begin
544     SharedInfo:=GetWGLControlInfo(SharedControl.Handle);
545     if Assigned(SharedInfo) then wglShareLists(SharedInfo^.WGLContext, Info^.WGLContext);
546   end;
547 end;
548 
549 procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
550 var
551   Info: PWGLControlInfo;
552 begin
553   if not AWinControl.HandleAllocated then exit;
554   Info:=GetWGLControlInfo(AWinControl.Handle);
555   if Info=nil then exit;
556   if wglMakeCurrent(Info^.DC,Info^.WGLContext) then begin
557     wglDeleteContext(Info^.WGLContext);
558     Info^.WGLContext:=0;
559   end;
560   if (Info^.DC<>0) then begin
561     ReleaseDC(Info^.Window,Info^.DC);
562   end;
563   DisposeWGLControlInfo(Info^.Window);
564 end;
565 
566 procedure InitWGL( RequireWGL_ARB_create_context : boolean );
567 var
568   Buffer: string;
569 
570   // Checks if the given Extension string is in Buffer.
571   function CheckExtension(const extension : String) : Boolean;
572   begin
573     Result:=(Pos(extension, Buffer)>0);
574   end;
575 
576 begin
577   if WGLInitialized then exit;
578   WGLInitialized:=true;
579 
580   try
581     { to successfully use wglGetExtensionsStringARB (to query e.g. ARB_multisample,
582       needed for MultiSampling), you need to have OpenGL context
583       already initialized. We create a temporary window for this purpose. }
584     LGlMsCreateTemporaryWindow;
585 
586     if wglGetCurrentContext() = 0 then
587       raise Exception.Create('Context is not active');
588 
589     // ARB wgl extensions
590     Pointer(wglCreateContextAttribsARB) := GLGetProcAddress('wglCreateContextAttribsARB');
591     Pointer(wglGetExtensionsStringARB) := GLGetProcAddress('wglGetExtensionsStringARB');
592     Pointer(wglGetPixelFormatAttribivARB) := GLGetProcAddress('wglGetPixelFormatAttribivARB');
593     Pointer(wglGetPixelFormatAttribfvARB) := GLGetProcAddress('wglGetPixelFormatAttribfvARB');
594     Pointer(wglChoosePixelFormatARB) := GLGetProcAddress('wglChoosePixelFormatARB');
595 
596     Pointer(wglCreatePbufferARB) := GLGetProcAddress('wglCreatePbufferARB');
597     Pointer(wglGetPbufferDCARB) := GLGetProcAddress('wglGetPbufferDCARB');
598     Pointer(wglReleasePbufferDCARB) := GLGetProcAddress('wglReleasePbufferDCARB');
599     Pointer(wglDestroyPbufferARB) := GLGetProcAddress('wglDestroyPbufferARB');
600     Pointer(wglQueryPbufferARB) := GLGetProcAddress('wglQueryPbufferARB');
601 
602     Pointer(wglCreateBufferRegionARB) := GLGetProcAddress('wglCreateBufferRegionARB');
603     Pointer(wglDeleteBufferRegionARB) := GLGetProcAddress('wglDeleteBufferRegionARB');
604     Pointer(wglSaveBufferRegionARB) := GLGetProcAddress('wglSaveBufferRegionARB');
605     Pointer(wglRestoreBufferRegionARB) := GLGetProcAddress('wglRestoreBufferRegionARB');
606 
607     // -EGG- ----------------------------
608     Pointer(wglSwapIntervalEXT) := GLGetProcAddress('wglSwapIntervalEXT');
609     Pointer(wglGetSwapIntervalEXT) := GLGetProcAddress('wglGetSwapIntervalEXT');
610 
611     // ARB wgl extensions
612     if Assigned(wglGetExtensionsStringARB) then
613     begin
614       Buffer:=wglGetExtensionsStringARB(Temp_h_Dc);
615       { Writeln('WGL extensions supported: ', Buffer); }
616     end else
617       Buffer:='';
618     WGL_ARB_multisample:=CheckExtension('WGL_ARB_multisample');
619     WGL_EXT_swap_control:=CheckExtension('WGL_EXT_swap_control');
620     WGL_ARB_buffer_region:=CheckExtension('WGL_ARB_buffer_region');
621     WGL_ARB_extensions_string:=CheckExtension('WGL_ARB_extensions_string');
622     WGL_ARB_pbuffer:=CheckExtension('WGL_ARB_pbuffer ');
623     WGL_ARB_pixel_format:=CheckExtension('WGL_ARB_pixel_format');
624     WGL_ATI_pixel_format_float:=CheckExtension('WGL_ATI_pixel_format_float');
625   except
626     on E: Exception do begin
627       DebugLn('InitWGL ',E.Message);
628     end;
629   end;
630 
631   try
632     if RequireWGL_ARB_create_context then
633     begin
634       if wglGetExtensionsStringARB = nil then
635         raise Exception.Create('InitWGL : wglGetExtensionsStringARB = nil');
636       if not CheckExtension('WGL_ARB_create_context') then
637       begin
638         raise Exception.CreateFmt('InitWGL : WGL_ARB_create_context not found. Version %s Renderer=%s'
639                                 + sLineBreak + 'Extensions found:' + sLineBreak + '%s',
640             [String(glGetString(GL_VERSION)), String(glGetString(GL_RENDERER)), Buffer]);
641       end;
642       if wglCreateContextAttribsARB = nil then
643         raise Exception.Create('InitWGL : wglCreateContextAttribsARB = nil');
644     end;
645   finally
646     LGlMsDestroyTemporaryWindow;
647   end;
648 end;
649 
650 procedure InitOpenGLContextGLWindowClass;
651 begin
652   if OpenGLContextWindowClassInitialized then exit;
653   OpenGLContextWindowClassInitialized:=true;
654   with OpenGLContextWindowClass do begin
655     style:=CS_HREDRAW or CS_VREDRAW or CS_OWNDC;// Redraw On Move, And Own DC For Window
656     lpfnWndProc  := @WindowProc;                // WndProc Handles Messages
657     cbClsExtra   := 0;                          // No Extra Window Data
658     cbWndExtra   := 0;                          // No Extra Window Data
659     hInstance    := System.HInstance;           // Set The Instance
660     hIcon        := LoadIcon(NULL, IDI_WINLOGO);// Load The Default Icon
661     hCursor      := LoadCursor(NULL, IDC_ARROW);// Load The Arrow Pointer
662     hbrBackground:= NULL;                       // No Background Required For GL
663     lpszMenuName := nil;                       // We Don't Want A Menu
664     lpszClassName:= 'LazOpenGLContext';         // Set The Class Name
665   end;
666   if RegisterClass(@OpenGLContextWindowClass)=0 then
667     raise Exception.Create('registering OpenGLContextWindowClass failed');
668 end;
669 
AllocWGLControlInfonull670 function AllocWGLControlInfo(Window: HWND): PWGLControlInfo;
671 begin
672   New(Result);
673   FillChar(Result^, sizeof(Result^), 0);
674   Result^.Window := Window;
675   if WGLControlInfoAtom=0 then
676     WGLControlInfoAtom := Windows.GlobalAddAtom('WGLControlInfo');
677   Windows.SetProp(Window, PChar(PtrUInt(WGLControlInfoAtom)), PtrUInt(Result));
678 end;
679 
DisposeWGLControlInfonull680 function DisposeWGLControlInfo(Window: HWND): boolean;
681 var
682   Info: PWGLControlInfo;
683 begin
684   Info := PWGLControlInfo(Windows.GetProp(Window,
685                                           PChar(PtrUInt(WGLControlInfoAtom))));
686   Result := Windows.RemoveProp(Window, PChar(PtrUInt(WGLControlInfoAtom)))<>0;
687   if Result then begin
688     Dispose(Info);
689   end;
690 end;
691 
GetWGLControlInfonull692 function GetWGLControlInfo(Window: HWND): PWGLControlInfo;
693 begin
694   Result:=PWGLControlInfo(Windows.GetProp(Window,
695                                           PChar(PtrUInt(WGLControlInfoAtom))));
696 end;
697 
698 end.
699 
700