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