LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Win32 specific Context.
6

7
    History :  
8
       11/09/11 - Yar - Added layers support (not tested because need Quadro or FireFX VGA)
9
       18/07/11 - Yar - Added ability of creating OpenGL ES 2.0 profile context
10
       03/12/10 - Yar - Fixed window tracking (thanks to Gabriel Corneanu)
11
       04/11/10 - DaStr - Restored Delphi5 and Delphi6 compatibility   
12
       23/08/10 - Yar - Replaced OpenGL1x to OpenGLTokens. Improved context creation.
13
       18/06/10 - Yar - Changed context sharing method for similarity to GLX
14
       06/06/10 - Yar - Moved forward context creation to DoCreateContext
15
                           make outputDevice HWND type
16
       19/05/10 - Yar - Added choice between hardware and software acceleration
17
       06/05/10 - Yar - Added vLastVendor clearing when multithreading is enabled
18
       06/04/10 - Yar - Added DoGetHandles to TGLWin32Context (thanks Rustam Asmandiarov aka Predator)
19
       28/03/10 - Yar - Added 3.3 forward context creation and eliminate memory leaks when multithreading
20
       06/03/10 - Yar - Added forward context creation in TGLWin32Context.DoActivate
21
       20/02/10 - DanB - Allow double-buffered memory viewers, if you want single
22
                            buffered, or no swapping, then change buffer options instead.
23
                            Some changes from Cardinal to the appropriate HDC /HGLRC type.
24
       15/01/10 - DaStr - Bugfixed TGLWin32Context.ChooseWGLFormat()
25
                             (BugtrackerID = 2933081) (thanks YarUndeoaker)
26
       08/01/10 - DaStr - Added more AntiAliasing modes (thanks YarUndeoaker)
27
       13/12/09 - DaStr - Modified for multithread support (thanks Controller)
28
       30/08/09 - DanB - vIgnoreContextActivationFailures renamed to
29
                            vContextActivationFailureOccurred + check removed.
30
       06/11/07 - mrqzzz - Ignore ContextActivation failure
31
                   if GLContext.vIgnoreContextActivationFailures=true
32
       15/02/07 - DaStr - Integer -> Cardinal because $R- was removed in GLScene.pas
33
       11/09/06 - NC - Added support for Multiple-Render-Target
34
       03/10/04 - NC - Added float texture support
35
       03/07/02 - EG - ChooseWGLFormat Kyro fix (Patrick Chevalley)
36
       13/03/02 - EG - aaDefault now prefers non-AA when possible
37
       03/03/02 - EG - Fixed aaNone mode (AA specifically off)
38
       01/03/02 - EG - Fixed CurrentPixelFormatIsHardwareAccelerated
39
       22/02/02 - EG - Unified ChooseWGLFormat for visual & non-visual
40
       21/02/02 - EG - AntiAliasing support *experimental* (Chris N. Strahm)
41
       05/02/02 - EG - Fixed UnTrackWindow
42
       03/02/02 - EG - Added experimental Hook-based window tracking
43
       29/01/02 - EG - Improved recovery for ICDs without pbuffer  support
44
       21/01/02 - EG - More graceful recovery for ICDs without pbuffer support
45
       07/01/02 - EG - DoCreateMemoryContext now retrieved topDC when needed
46
       15/12/01 - EG - Added support for AlphaBits
47
       30/11/01 - EG - Hardware acceleration support now detected
48
       20/11/01 - EG - New temp HWnd code for memory contexts (improved compat.)
49
       04/09/01 - EG - Added ChangeIAttrib, support for 16bits depth buffer
50
       25/08/01 - EG - Added pbuffer support and CreateMemoryContext interface
51
       24/08/01 - EG - Fixed PropagateSharedContext
52
       12/08/01 - EG - Handles management completed
53
       22/07/01 - EG - Creation (glcontext.omm)
54
    
55
}
56
unit GLWin32Context;
57

58
interface
59

60
{$I GLScene.inc}
61

62
{$IFNDEF MSWINDOWS}{$MESSAGE Error 'Unit is Windows specific'}{$ENDIF}
63

64
uses
65
  Windows,
66
  Messages,
67
  SysUtils,
68
  Classes,
69
  Forms,
70

71
   
72
  OpenGLTokens,
73
  OpenGLAdapter,
74
  GLContext,
75
  GLCrossPlatform,
76
  GLStrings,
77
  GLState,
78
 GLSLog,
79
  GLVectorGeometry;
80

81

82
const
83
  WGL_SWAP_MAIN_PLANE = $00000001;
84
  WGL_SWAP_OVERLAY1 = $00000002;
85
  WGL_SWAP_OVERLAY2 = $00000004;
86
  WGL_SWAP_OVERLAY3 = $00000008;
87
  WGL_SWAP_OVERLAY4 = $00000010;
88
  WGL_SWAP_OVERLAY5 = $00000020;
89
  WGL_SWAP_OVERLAY6 = $00000040;
90
  WGL_SWAP_OVERLAY7 = $00000080;
91
  WGL_SWAP_OVERLAY8 = $00000100;
92
  WGL_SWAP_OVERLAY9 = $00000200;
93
  WGL_SWAP_OVERLAY10 = $00000400;
94
  WGL_SWAP_OVERLAY11 = $00000800;
95
  WGL_SWAP_OVERLAY12 = $00001000;
96
  WGL_SWAP_OVERLAY13 = $00002000;
97
  WGL_SWAP_OVERLAY14 = $00004000;
98
  WGL_SWAP_OVERLAY15 = $00008000;
99
  WGL_SWAP_UNDERLAY1 = $00010000;
100
  WGL_SWAP_UNDERLAY2 = $00020000;
101
  WGL_SWAP_UNDERLAY3 = $00040000;
102
  WGL_SWAP_UNDERLAY4 = $00080000;
103
  WGL_SWAP_UNDERLAY5 = $00100000;
104
  WGL_SWAP_UNDERLAY6 = $00200000;
105
  WGL_SWAP_UNDERLAY7 = $00400000;
106
  WGL_SWAP_UNDERLAY8 = $00800000;
107
  WGL_SWAP_UNDERLAY9 = $01000000;
108
  WGL_SWAP_UNDERLAY10 = $02000000;
109
  WGL_SWAP_UNDERLAY11 = $04000000;
110
  WGL_SWAP_UNDERLAY12 = $08000000;
111
  WGL_SWAP_UNDERLAY13 = $10000000;
112
  WGL_SWAP_UNDERLAY14 = $20000000;
113
  WGL_SWAP_UNDERLAY15 = $40000000;
114

115

116
type
117

118
  // TGLWin32Context
119
  //
120
  { A context driver for standard Windows OpenGL (via MS OpenGL). }
121
  TGLWin32Context = class(TGLContext)
122
  protected
123
     
124
    FDC: HDC;
125
    FRC: HGLRC;
126
    FShareContext: TGLWin32Context;
127
    FHPBUFFER: Integer;
128
    FiAttribs: packed array of Integer;
129
    FfAttribs: packed array of Single;
130
    FLegacyContextsOnly: Boolean;
131
    FSwapBufferSupported: Boolean;
132

133
    procedure SpawnLegacyContext(aDC: HDC); // used for WGL_pixel_format soup
134
    procedure CreateOldContext(aDC: HDC); dynamic;
135
    procedure CreateNewContext(aDC: HDC); dynamic;
136

137
    procedure ClearIAttribs;
138
    procedure AddIAttrib(attrib, value: Integer);
139
    procedure ChangeIAttrib(attrib, newValue: Integer);
140
    procedure DropIAttrib(attrib: Integer);
141
    procedure ClearFAttribs;
142
    procedure AddFAttrib(attrib, value: Single);
143

144
    procedure DestructionEarlyWarning(sender: TObject);
145

146
    procedure ChooseWGLFormat(DC: HDC; nMaxFormats: Cardinal; piFormats:
147
      PInteger; var nNumFormats: Integer; BufferCount: integer = 1);
148
    procedure DoCreateContext(ADeviceHandle: HDC); override;
149
    procedure DoCreateMemoryContext(outputDevice: HWND; width, height:
150
      Integer; BufferCount: integer); override;
151
    function DoShareLists(aContext: TGLContext): Boolean; override;
152
    procedure DoDestroyContext; override;
153
    procedure DoActivate; override;
154
    procedure DoDeactivate; override;
155
    { DoGetHandles must be implemented in child classes,
156
       and return the display + window }
157

158
    procedure DoGetHandles(outputDevice: HWND; out XWin: HDC); virtual; abstract;
159

160
  public
161
     
162
    constructor Create; override;
163
    destructor Destroy; override;
164

165
    function IsValid: Boolean; override;
166
    procedure SwapBuffers; override;
167

168
    function RenderOutputDevice: Pointer; override;
169

170
    property DC: HDC read FDC;
171
    property RC: HGLRC read FRC;
172
  end;
173

174

175
resourcestring
176
  strForwardContextFailed = 'Can not create forward compatible context: #%X, %s';
177
  strBackwardContextFailed = 'Can not create backward compatible context: #%X, %s';
178
  strFailHWRC = 'Unable to create rendering context with hardware acceleration - down to software';
179
  strTmpRC_Created = 'Temporary rendering context created';
180
  strDriverNotSupportFRC = 'Driver not support creating of forward context';
181
  strDriverNotSupportOESRC = 'Driver not support creating of OpenGL ES 2.0 context';
182
  strDriverNotSupportDebugRC = 'Driver not support creating of debug context';
183
  strOESvsForwardRC = 'OpenGL ES 2.0 context incompatible with Forward context - flag ignored';
184
  strFRC_created = 'Forward core context seccussfuly created';
185
  strOESRC_created = 'OpenGL ES 2.0 context seccussfuly created';
186
  strPBufferRC_created = 'Backward compatible core PBuffer context successfully created';
187

188
function CreateTempWnd: HWND;
189

190
var
191
  { This boolean controls a hook-based tracking of top-level forms destruction,
192
    with the purpose of being able to properly release OpenGL contexts before
193
    they are (improperly) released by some drivers upon top-level form
194
    destruction. }
195
  vUseWindowTrackingHook: Boolean = True;
196

197
  // ------------------------------------------------------------------
198
  // ------------------------------------------------------------------
199
  // ------------------------------------------------------------------
200
implementation
201
// ------------------------------------------------------------------
202
// ------------------------------------------------------------------
203
// ------------------------------------------------------------------
204

205

206
var
207
  vTrackingCount: Integer;
208
  vTrackedHwnd: array of HWND;
209
  vTrackedEvents: array of TNotifyEvent;
210
  vTrackingHook: HHOOK;
211

212
  // TrackHookProc
213
  //
214

215
function TrackHookProc(nCode: Integer; wParam: wParam; lParam: LPARAM): Integer;
216
  stdcall;
217
var
218
  i: Integer;
219
  p: PCWPStruct;
220
begin
221
  if nCode = HC_ACTION then
222
  begin
223
    p := PCWPStruct(lParam);
224
    //   if (p.message=WM_DESTROY) or (p.message=WM_CLOSE) then begin // destroy & close variant
225
    if p.message = WM_DESTROY then
226
    begin
227
      // special care must be taken by this loop, items may go away unexpectedly
228
      i := vTrackingCount - 1;
229
      while i >= 0 do
230
      begin
231
        if IsChild(p.hwnd, vTrackedHwnd[i]) then
232
        begin
233
          // got one, send notification
234
          vTrackedEvents[i](nil);
235
        end;
236
        Dec(i);
237
        while i >= vTrackingCount do
238
          Dec(i);
239
      end;
240
    end;
241
    CallNextHookEx(vTrackingHook, nCode, wParam, lParam);
242
    Result := 0;
243
  end
244
  else
245
    Result := CallNextHookEx(vTrackingHook, nCode, wParam, lParam);
246
end;
247

248
// TrackWindow
249
//
250

251
procedure TrackWindow(h: HWND; notifyEvent: TNotifyEvent);
252
begin
253
  if not IsWindow(h) then
254
    Exit;
255
  if vTrackingCount = 0 then
256
    vTrackingHook := SetWindowsHookEx(WH_CALLWNDPROC, @TrackHookProc, 0,
257
      GetCurrentThreadID);
258
  Inc(vTrackingCount);
259
  SetLength(vTrackedHwnd, vTrackingCount);
260
  vTrackedHwnd[vTrackingCount - 1] := h;
261
  SetLength(vTrackedEvents, vTrackingCount);
262
  vTrackedEvents[vTrackingCount - 1] := notifyEvent;
263
end;
264

265
// UnTrackWindows
266
//
267

268
procedure UnTrackWindow(h: HWND);
269
var
270
  i, k: Integer;
271
begin
272
  if not IsWindow(h) then
273
    Exit;
274
  if vTrackingCount = 0 then
275
    Exit;
276
  k := 0;
277
  for i := 0 to MinInteger(vTrackingCount, Length(vTrackedHwnd)) - 1 do
278
  begin
279
    if vTrackedHwnd[i] <> h then
280
    begin
281
      if(k <> i) then
282
      begin
283
        vTrackedHwnd[k] := vTrackedHwnd[i];
284
        vTrackedEvents[k] := vTrackedEvents[i];
285
      end;
286
      Inc(k);
287
    end
288
  end;
289
  if(k >= vTrackingCount) then exit;
290
  Dec(vTrackingCount);
291
  SetLength(vTrackedHwnd, vTrackingCount);
292
  SetLength(vTrackedEvents, vTrackingCount);
293
  if vTrackingCount = 0 then
294
    UnhookWindowsHookEx(vTrackingHook);
295
end;
296

297
var
298
  vUtilWindowClass: TWndClass = (
299
    style: 0;
300
    lpfnWndProc: @DefWindowProc;
301
    cbClsExtra: 0;
302
    cbWndExtra: 0;
303
    hInstance: 0;
304
    hIcon: 0;
305
    hCursor: 0;
306
    hbrBackground: 0;
307
    lpszMenuName: nil;
308
    lpszClassName: 'GLSUtilWindow');
309

310
  // CreateTempWnd
311
  //
312

313
function CreateTempWnd: HWND;
314
var
315
  classRegistered: Boolean;
316
  tempClass: TWndClass;
317
begin
318
  vUtilWindowClass.hInstance := HInstance;
319
  classRegistered := GetClassInfo(HInstance, vUtilWindowClass.lpszClassName,
320
    tempClass);
321
  if not classRegistered then
322
    Windows.RegisterClass(vUtilWindowClass);
323
  Result := CreateWindowEx(WS_EX_TOOLWINDOW, vUtilWindowClass.lpszClassName,
324
    '', WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil);
325
end;
326

327
// ------------------
328
// ------------------ TGLWin32Context ------------------
329
// ------------------
330

331
  // Create
332
  //
333

334
constructor TGLWin32Context.Create;
335
begin
336
  inherited Create;
337
  ClearIAttribs;
338
  ClearFAttribs;
339
end;
340

341
// Destroy
342
//
343

344
destructor TGLWin32Context.Destroy;
345
begin
346
  inherited Destroy;
347
end;
348

349
// SetupPalette
350
//
351

352
function SetupPalette(DC: HDC; PFD: TPixelFormatDescriptor): HPalette;
353
var
354
  nColors, I: Integer;
355
  LogPalette: TMaxLogPalette;
356
  RedMask, GreenMask, BlueMask: Byte;
357
begin
358
  nColors := 1 shl Pfd.cColorBits;
359
  LogPalette.palVersion := $300;
360
  LogPalette.palNumEntries := nColors;
361
  RedMask := (1 shl Pfd.cRedBits) - 1;
362
  GreenMask := (1 shl Pfd.cGreenBits) - 1;
363
  BlueMask := (1 shl Pfd.cBlueBits) - 1;
364
  with LogPalette, PFD do
365
    for I := 0 to nColors - 1 do
366
    begin
367
      palPalEntry[I].peRed := (((I shr cRedShift) and RedMask) * 255) div
368
        RedMask;
369
      palPalEntry[I].peGreen := (((I shr cGreenShift) and GreenMask) * 255) div
370
        GreenMask;
371
      palPalEntry[I].peBlue := (((I shr cBlueShift) and BlueMask) * 255) div
372
        BlueMask;
373
      palPalEntry[I].peFlags := 0;
374
    end;
375

376
  Result := CreatePalette(PLogPalette(@LogPalette)^);
377
  if Result <> 0 then
378
  begin
379
    SelectPalette(DC, Result, False);
380
    RealizePalette(DC);
381
  end
382
  else
383
    RaiseLastOSError;
384
end;
385

386
// ClearIAttribs
387
//
388

389
procedure TGLWin32Context.ClearIAttribs;
390
begin
391
  SetLength(FiAttribs, 1);
392
  FiAttribs[0] := 0;
393
end;
394

395
// AddIAttrib
396
//
397

398
procedure TGLWin32Context.AddIAttrib(attrib, value: Integer);
399
var
400
  n: Integer;
401
begin
402
  n := Length(FiAttribs);
403
  SetLength(FiAttribs, n + 2);
404
  FiAttribs[n - 1] := attrib;
405
  FiAttribs[n] := value;
406
  FiAttribs[n + 1] := 0;
407
end;
408

409
// ChangeIAttrib
410
//
411

412
procedure TGLWin32Context.ChangeIAttrib(attrib, newValue: Integer);
413
var
414
  i: Integer;
415
begin
416
  i := 0;
417
  while i < Length(FiAttribs) do
418
  begin
419
    if FiAttribs[i] = attrib then
420
    begin
421
      FiAttribs[i + 1] := newValue;
422
      Exit;
423
    end;
424
    Inc(i, 2);
425
  end;
426
  AddIAttrib(attrib, newValue);
427
end;
428

429
// DropIAttrib
430
//
431

432
procedure TGLWin32Context.DropIAttrib(attrib: Integer);
433
var
434
  i: Integer;
435
begin
436
  i := 0;
437
  while i < Length(FiAttribs) do
438
  begin
439
    if FiAttribs[i] = attrib then
440
    begin
441
      Inc(i, 2);
442
      while i < Length(FiAttribs) do
443
      begin
444
        FiAttribs[i - 2] := FiAttribs[i];
445
        Inc(i);
446
      end;
447
      SetLength(FiAttribs, Length(FiAttribs) - 2);
448
      Exit;
449
    end;
450
    Inc(i, 2);
451
  end;
452
end;
453

454
// ClearFAttribs
455
//
456

457
procedure TGLWin32Context.ClearFAttribs;
458
begin
459
  SetLength(FfAttribs, 1);
460
  FfAttribs[0] := 0;
461
end;
462

463
// AddFAttrib
464
//
465

466
procedure TGLWin32Context.AddFAttrib(attrib, value: Single);
467
var
468
  n: Integer;
469
begin
470
  n := Length(FfAttribs);
471
  SetLength(FfAttribs, n + 2);
472
  FfAttribs[n - 1] := attrib;
473
  FfAttribs[n] := value;
474
  FfAttribs[n + 1] := 0;
475
end;
476

477
// DestructionEarlyWarning
478
//
479

480
procedure TGLWin32Context.DestructionEarlyWarning(sender: TObject);
481
begin
482
  if IsValid then
483
    DestroyContext;
484
end;
485

486
// ChooseWGLFormat
487
//
488
procedure TGLWin32Context.ChooseWGLFormat(DC: HDC; nMaxFormats: Cardinal; piFormats:
489
  PInteger; var nNumFormats: Integer; BufferCount: integer);
490
const
491
  cAAToSamples: array[aaNone..csa16xHQ] of Integer =
492
    (1, 2, 2, 4, 4, 6, 8, 16, 8, 8, 16, 16);
493
  cCSAAToSamples: array[csa8x..csa16xHQ] of Integer = (4, 8, 4, 8);
494

495
  procedure ChoosePixelFormat;
496
  begin
497
    if not FGL.WChoosePixelFormatARB(DC, @FiAttribs[0], @FfAttribs[0],
498
      32, PGLint(piFormats), @nNumFormats) then
499
      nNumFormats := 0;
500
  end;
501

502
var
503
  float: boolean;
504
  aa: TGLAntiAliasing;
505
begin
506
  // request hardware acceleration
507
  case FAcceleration of
508
    chaUnknown: AddIAttrib(WGL_ACCELERATION_ARB, WGL_GENERIC_ACCELERATION_ARB);
509
    chaHardware: AddIAttrib(WGL_ACCELERATION_ARB, WGL_FULL_ACCELERATION_ARB);
510
    chaSoftware: AddIAttrib(WGL_ACCELERATION_ARB, WGL_NO_ACCELERATION_ARB);
511
  end;
512

513
  float := (ColorBits = 64) or (ColorBits = 128); // float_type
514

515
  if float then
516
  begin // float_type
517
    if GL.W_ATI_pixel_format_float then
518
    begin // NV40 uses ATI_float, with linear filtering
519
      AddIAttrib(WGL_PIXEL_TYPE_ARB, WGL_TYPE_RGBA_FLOAT_ATI);
520
    end
521
    else
522
    begin
523
      AddIAttrib(WGL_PIXEL_TYPE_ARB, WGL_TYPE_RGBA_ARB);
524
      AddIAttrib(WGL_FLOAT_COMPONENTS_NV, GL_TRUE);
525
    end;
526
  end;
527

528
  if BufferCount > 1 then
529
    // 1 front buffer + (BufferCount-1) aux buffers
530
    AddIAttrib(WGL_AUX_BUFFERS_ARB, BufferCount - 1);
531

532
  AddIAttrib(WGL_COLOR_BITS_ARB, ColorBits);
533
  if AlphaBits > 0 then
534
    AddIAttrib(WGL_ALPHA_BITS_ARB, AlphaBits);
535
  AddIAttrib(WGL_DEPTH_BITS_ARB, DepthBits);
536
  if StencilBits > 0 then
537
    AddIAttrib(WGL_STENCIL_BITS_ARB, StencilBits);
538
  if AccumBits > 0 then
539
    AddIAttrib(WGL_ACCUM_BITS_ARB, AccumBits);
540
  if AuxBuffers > 0 then
541
    AddIAttrib(WGL_AUX_BUFFERS_ARB, AuxBuffers);
542
  if (AntiAliasing <> aaDefault) and GL.W_ARB_multisample then
543
  begin
544
    if AntiAliasing = aaNone then
545
      AddIAttrib(WGL_SAMPLE_BUFFERS_ARB, GL_FALSE)
546
    else
547
    begin
548
      AddIAttrib(WGL_SAMPLE_BUFFERS_ARB, GL_TRUE);
549
      AddIAttrib(WGL_SAMPLES_ARB, cAAToSamples[AntiAliasing]);
550
      if (AntiAliasing >= csa8x) and (AntiAliasing <= csa16xHQ) then
551
        AddIAttrib(WGL_COLOR_SAMPLES_NV, cCSAAToSamples[AntiAliasing]);
552
    end;
553

554
  end;
555

556
  ClearFAttribs;
557
  ChoosePixelFormat;
558
  if (nNumFormats = 0) and (DepthBits >= 32) then
559
  begin
560
    // couldn't find 32+ bits depth buffer, 24 bits one available?
561
    ChangeIAttrib(WGL_DEPTH_BITS_ARB, 24);
562
    ChoosePixelFormat;
563
  end;
564
  if (nNumFormats = 0) and (DepthBits >= 24) then
565
  begin
566
    // couldn't find 24+ bits depth buffer, 16 bits one available?
567
    ChangeIAttrib(WGL_DEPTH_BITS_ARB, 16);
568
    ChoosePixelFormat;
569
  end;
570
  if (nNumFormats = 0) and (ColorBits >= 24) then
571
  begin
572
    // couldn't find 24+ bits color buffer, 16 bits one available?
573
    ChangeIAttrib(WGL_COLOR_BITS_ARB, 16);
574
    ChoosePixelFormat;
575
  end;
576
  if (nNumFormats = 0) and (AntiAliasing <> aaDefault) then
577
  begin
578
    // Restore DepthBits
579
    ChangeIAttrib(WGL_DEPTH_BITS_ARB, DepthBits);
580
    if (AntiAliasing >= csa8x) and (AntiAliasing <= csa16xHQ) then
581
    begin
582
      DropIAttrib(WGL_COLOR_SAMPLES_NV);
583
      case AntiAliasing of
584
        csa8x, csa8xHQ: AntiAliasing := aa8x;
585
        csa16x, csa16xHQ: AntiAliasing := aa16x;
586
      end;
587
      ChangeIAttrib(WGL_SAMPLES_ARB, cAAToSamples[AntiAliasing]);
588
    end;
589
    ChoosePixelFormat;
590

591
    if nNumFormats = 0 then
592
    begin
593
      aa := AntiAliasing;
594
      repeat
595
        Dec(aa);
596
        if aa = aaNone then
597
        begin
598
          // couldn't find AA buffer, try without
599
          DropIAttrib(WGL_SAMPLE_BUFFERS_ARB);
600
          DropIAttrib(WGL_SAMPLES_ARB);
601
          ChoosePixelFormat;
602
          break;
603
        end;
604
        ChangeIAttrib(WGL_SAMPLES_ARB, cAAToSamples[aa]);
605
        ChoosePixelFormat;
606
      until nNumFormats <> 0;
607
      AntiAliasing := aa;
608
    end;
609
  end;
610
  // Check DepthBits again
611
  if (nNumFormats = 0) and (DepthBits >= 32) then
612
  begin
613
    // couldn't find 32+ bits depth buffer, 24 bits one available?
614
    ChangeIAttrib(WGL_DEPTH_BITS_ARB, 24);
615
    ChoosePixelFormat;
616
  end;
617
  if (nNumFormats = 0) and (DepthBits >= 24) then
618
  begin
619
    // couldn't find 24+ bits depth buffer, 16 bits one available?
620
    ChangeIAttrib(WGL_DEPTH_BITS_ARB, 16);
621
    ChoosePixelFormat;
622
  end;
623
  if (nNumFormats = 0) and (ColorBits >= 24) then
624
  begin
625
    // couldn't find 24+ bits color buffer, 16 bits one available?
626
    ChangeIAttrib(WGL_COLOR_BITS_ARB, 16);
627
    ChoosePixelFormat;
628
  end;
629
  if nNumFormats = 0 then
630
  begin
631
    // ok, last attempt: no AA, restored depth and color,
632
    // relaxed hardware-acceleration request
633
    ChangeIAttrib(WGL_COLOR_BITS_ARB, ColorBits);
634
    ChangeIAttrib(WGL_DEPTH_BITS_ARB, DepthBits);
635
    DropIAttrib(WGL_ACCELERATION_ARB);
636
    ChoosePixelFormat;
637
  end;
638
end;
639

640
procedure TGLWin32Context.CreateOldContext(aDC: HDC);
641
begin
642
  if not FLegacyContextsOnly then
643
  begin
644
    case Layer of
645
      clUnderlay2: FRC := wglCreateLayerContext(aDC, -2);
646
      clUnderlay1: FRC := wglCreateLayerContext(aDC, -1);
647
      clMainPlane: FRC := wglCreateContext(aDC);
648
      clOverlay1: FRC := wglCreateLayerContext(aDC, 1);
649
      clOverlay2: FRC := wglCreateLayerContext(aDC, 2);
650
    end;
651
  end
652
  else
653
    FRC := wglCreateContext(aDC);
654

655
  if FRC = 0 then
656
    RaiseLastOSError;
657
  FDC := aDC;
658

659
  if not wglMakeCurrent(FDC, FRC) then
660
    raise EGLContext.Create(Format(strContextActivationFailed,
661
      [GetLastError, SysErrorMessage(GetLastError)]));
662

663
  if not FLegacyContextsOnly then
664
  begin
665
    if Assigned(FShareContext) and (FShareContext.RC <> 0) then
666
    begin
667
      if not wglShareLists(FShareContext.RC, FRC) then
668
      {$IFDEF GLS_LOGGING}
669
        GLSLogger.LogWarning(strFailedToShare)
670
      {$ENDIF}
671
      else
672
      begin
673
        FSharedContexts.Add(FShareContext);
674
        PropagateSharedContext;
675
      end;
676
    end;
677
    FGL.DebugMode := False;
678
    FGL.Initialize;
679
    MakeGLCurrent;
680
    // If we are using AntiAliasing, adjust filtering hints
681
    if AntiAliasing in [aa2xHQ, aa4xHQ, csa8xHQ, csa16xHQ] then
682
      // Hint for nVidia HQ modes (Quincunx etc.)
683
      GLStates.MultisampleFilterHint := hintNicest
684
    else
685
      GLStates.MultisampleFilterHint := hintDontCare;
686

687
    if rcoDebug in Options then
688
      GLSLogger.LogWarning(strDriverNotSupportDebugRC);
689
    if rcoOGL_ES in Options then
690
      GLSLogger.LogWarning(strDriverNotSupportOESRC);
691
    if GLStates.ForwardContext then
692
      GLSLogger.LogWarning(strDriverNotSupportFRC);
693
    GLStates.ForwardContext := False;
694
  end
695
  else
696
    GLSLogger.LogInfo(strTmpRC_Created);
697
end;
698

699
procedure TGLWin32Context.CreateNewContext(aDC: HDC);
700
var
701
  bSuccess, bOES: Boolean;
702
begin
703
  bSuccess := False;
704
  bOES := False;
705

706
  try
707
    ClearIAttribs;
708
    // Initialize forward context
709
    if GLStates.ForwardContext then
710
    begin
711
      if FGL.VERSION_4_2 then
712
      begin
713
        AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 4);
714
        AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 2);
715
      end
716
      else if FGL.VERSION_4_1 then
717
      begin
718
        AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 4);
719
        AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 1);
720
      end
721
      else if FGL.VERSION_4_0 then
722
      begin
723
        AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 4);
724
        AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 0);
725
      end
726
      else if FGL.VERSION_3_3 then
727
      begin
728
        AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 3);
729
        AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 3);
730
      end
731
      else if FGL.VERSION_3_2 then
732
      begin
733
        AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 3);
734
        AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 2);
735
      end
736
      else if FGL.VERSION_3_1 then
737
      begin
738
        AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 3);
739
        AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 1);
740
      end
741
      else if FGL.VERSION_3_0 then
742
      begin
743
        AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 3);
744
        AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 0);
745
      end
746
      else
747
        Abort;
748
      AddIAttrib(WGL_CONTEXT_FLAGS_ARB, WGL_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB);
749
      if rcoOGL_ES in Options then
750
        GLSLogger.LogWarning(strOESvsForwardRC);
751
    end
752
    else if rcoOGL_ES in Options then
753
    begin
754
      if FGL.W_EXT_create_context_es2_profile then
755
      begin
756
        AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 2);
757
        AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 0);
758
        AddIAttrib(WGL_CONTEXT_FLAGS_ARB, WGL_CONTEXT_ES2_PROFILE_BIT_EXT);
759
        bOES := True;
760
      end
761
      else
762
        GLSLogger.LogError(strDriverNotSupportOESRC);
763
    end;
764

765
    if rcoDebug in Options then
766
    begin
767
      AddIAttrib(WGL_CONTEXT_FLAGS_ARB, WGL_CONTEXT_DEBUG_BIT_ARB);
768
      FGL.DebugMode := True;
769
    end;
770

771
    case Layer of
772
      clUnderlay2: AddIAttrib(WGL_CONTEXT_LAYER_PLANE_ARB, -2);
773
      clUnderlay1: AddIAttrib(WGL_CONTEXT_LAYER_PLANE_ARB, -1);
774
      clOverlay1: AddIAttrib(WGL_CONTEXT_LAYER_PLANE_ARB, 1);
775
      clOverlay2: AddIAttrib(WGL_CONTEXT_LAYER_PLANE_ARB, 2);
776
    end;
777

778
    FRC := 0;
779
    if Assigned(FShareContext) then
780
    begin
781
      FRC := FGL.WCreateContextAttribsARB(aDC, FShareContext.RC, @FiAttribs[0]);
782
      if FRC <> 0 then
783
      begin
784
        FSharedContexts.Add(FShareContext);
785
        PropagateSharedContext;
786
      end
787
      else
788
        GLSLogger.LogWarning(strFailedToShare)
789
    end;
790

791
    if FRC = 0 then
792
    begin
793
      FRC := FGL.WCreateContextAttribsARB(aDC, 0, @FiAttribs[0]);
794
      if FRC = 0 then
795
      begin
796
        if GLStates.ForwardContext then
797
          GLSLogger.LogErrorFmt(strForwardContextFailed,
798
            [GetLastError, SysErrorMessage(GetLastError)])
799
        else
800
          GLSLogger.LogErrorFmt(strBackwardContextFailed,
801
            [GetLastError, SysErrorMessage(GetLastError)]);
802
        Abort;
803
      end;
804
    end;
805

806
    FDC := aDC;
807

808
    if not wglMakeCurrent(FDC, FRC) then
809
    begin
810
      GLSLogger.LogErrorFmt(strContextActivationFailed,
811
        [GetLastError, SysErrorMessage(GetLastError)]);
812
      Abort;
813
    end;
814

815
    FGL.Initialize;
816
    MakeGLCurrent;
817
    // If we are using AntiAliasing, adjust filtering hints
818
    if AntiAliasing in [aa2xHQ, aa4xHQ, csa8xHQ, csa16xHQ] then
819
      // Hint for nVidia HQ modes (Quincunx etc.)
820
      GLStates.MultisampleFilterHint := hintNicest
821
    else
822
      GLStates.MultisampleFilterHint := hintDontCare;
823

824
    if GLStates.ForwardContext then
825
      GLSLogger.LogInfo(strFRC_created);
826
    if bOES then
827
      GLSLogger.LogInfo(strOESRC_created);
828
    bSuccess := True;
829
  finally
830
    GLStates.ForwardContext := GLStates.ForwardContext and bSuccess;
831
    PipelineTransformation.LoadMatricesEnabled := not GLStates.ForwardContext;
832
  end;
833
end;
834

835
// DoCreateContext
836
//
837

838
procedure TGLWin32Context.DoCreateContext(ADeviceHandle: HDC);
839
const
840
  cMemoryDCs = [OBJ_MEMDC, OBJ_METADC, OBJ_ENHMETADC];
841
  cBoolToInt: array[False..True] of Integer = (GL_FALSE, GL_TRUE);
842
  cLayerToSet: array[TGLContextLayer] of Byte = (32, 16, 0, 1, 2);
843
var
844
  pfDescriptor: TPixelFormatDescriptor;
845
  pixelFormat, nbFormats, softwarePixelFormat: Integer;
846
  aType: DWORD;
847
  iFormats: array[0..31] of Integer;
848
  tempWnd: HWND;
849
  tempDC: HDC;
850
  localDC: HDC;
851
  localRC: HGLRC;
852
  sharedRC: TGLWin32Context;
853

854
  function CurrentPixelFormatIsHardwareAccelerated: Boolean;
855
  var
856
    localPFD: TPixelFormatDescriptor;
857
  begin
858
    Result := False;
859
    if pixelFormat = 0 then
860
      Exit;
861
    with localPFD do
862
    begin
863
      nSize := SizeOf(localPFD);
864
      nVersion := 1;
865
    end;
866
    DescribePixelFormat(ADeviceHandle, pixelFormat, SizeOf(localPFD), localPFD);
867
    Result := ((localPFD.dwFlags and PFD_GENERIC_FORMAT) = 0);
868
  end;
869

870
var
871
  i, iAttrib, iValue: Integer;
872
begin
873

874
  DoGetHandles(HWND(ADeviceHandle), ADeviceHandle);
875

876
  if vUseWindowTrackingHook and not FLegacyContextsOnly then
877
    TrackWindow(WindowFromDC(ADeviceHandle), DestructionEarlyWarning);
878

879
  // Just in case it didn't happen already.
880
  if not InitOpenGL then
881
    RaiseLastOSError;
882

883
  // Prepare PFD
884
  FillChar(pfDescriptor, SizeOf(pfDescriptor), 0);
885
  with PFDescriptor do
886
  begin
887
    nSize := SizeOf(PFDescriptor);
888
    nVersion := 1;
889
    dwFlags := PFD_SUPPORT_OPENGL;
890
    aType := GetObjectType(ADeviceHandle);
891
    if aType = 0 then
892
      RaiseLastOSError;
893
    if aType in cMemoryDCs then
894
      dwFlags := dwFlags or PFD_DRAW_TO_BITMAP
895
    else
896
      dwFlags := dwFlags or PFD_DRAW_TO_WINDOW;
897
    if rcoDoubleBuffered in Options then
898
      dwFlags := dwFlags or PFD_DOUBLEBUFFER;
899
    if rcoStereo in Options then
900
      dwFlags := dwFlags or PFD_STEREO;
901
    iPixelType := PFD_TYPE_RGBA;
902
    cColorBits := ColorBits;
903
    cDepthBits := DepthBits;
904
    cStencilBits := StencilBits;
905
    cAccumBits := AccumBits;
906
    cAlphaBits := AlphaBits;
907
    cAuxBuffers := AuxBuffers;
908
    case Layer of
909
      clUnderlay2, clUnderlay1: iLayerType := Byte(PFD_UNDERLAY_PLANE);
910
      clMainPlane: iLayerType := PFD_MAIN_PLANE;
911
      clOverlay1, clOverlay2: iLayerType := PFD_OVERLAY_PLANE;
912
    end;
913
    bReserved := cLayerToSet[Layer];
914
    if Layer <> clMainPlane then
915
      dwFlags := dwFlags or PFD_SWAP_LAYER_BUFFERS;
916

917
  end;
918
  pixelFormat := 0;
919

920
  // WGL_ARB_pixel_format is used if available
921
  //
922
  if not (IsMesaGL or FLegacyContextsOnly or (aType in cMemoryDCs)) then
923
  begin
924
    // the WGL mechanism is a little awkward: we first create a dummy context
925
    // on the TOP-level DC (ie. screen), to retrieve our pixelformat, create
926
    // our stuff, etc.
927
    tempWnd := CreateTempWnd;
928
    tempDC := GetDC(tempWnd);
929
    localDC := 0;
930
    localRC := 0;
931
    try
932
      SpawnLegacyContext(tempDC);
933
      try
934
        DoActivate;
935
        try
936
          FGL.ClearError;
937
          if FGL.W_ARB_pixel_format then
938
          begin
939
            // New pixel format selection via wglChoosePixelFormatARB
940
            ClearIAttribs;
941
            AddIAttrib(WGL_DRAW_TO_WINDOW_ARB, GL_TRUE);
942
            AddIAttrib(WGL_STEREO_ARB, cBoolToInt[rcoStereo in Options]);
943
            AddIAttrib(WGL_DOUBLE_BUFFER_ARB, cBoolToInt[rcoDoubleBuffered in
944
              Options]);
945

946
            ChooseWGLFormat(ADeviceHandle, 32, @iFormats, nbFormats);
947
            if nbFormats > 0 then
948
            begin
949
              if FGL.W_ARB_multisample and (AntiAliasing in [aaNone, aaDefault]) then
950
              begin
951
                // Pick first non AntiAliased for aaDefault and aaNone modes
952
                iAttrib := WGL_SAMPLE_BUFFERS_ARB;
953
                for i := 0 to nbFormats - 1 do
954
                begin
955
                  pixelFormat := iFormats[i];
956
                  iValue := GL_FALSE;
957
                  FGL.WGetPixelFormatAttribivARB(ADeviceHandle, pixelFormat, 0, 1,
958
                    @iAttrib, @iValue);
959
                  if iValue = GL_FALSE then
960
                    Break;
961
                end;
962
              end
963
              else
964
                pixelFormat := iFormats[0];
965
              if GetPixelFormat(ADeviceHandle) <> pixelFormat then
966
              begin
967
                if not SetPixelFormat(ADeviceHandle, pixelFormat, @PFDescriptor) then
968
                  RaiseLastOSError;
969
              end;
970
            end;
971
          end;
972
        finally
973
          DoDeactivate;
974
        end;
975
      finally
976
        sharedRC := FShareContext;
977
        DoDestroyContext;
978
        FShareContext := sharedRC;
979
        GLSLogger.LogInfo('Temporary rendering context destroyed');
980
      end;
981
    finally
982
      ReleaseDC(0, tempDC);
983
      DestroyWindow(tempWnd);
984
      FDC := localDC;
985
      FRC := localRC;
986
    end;
987
  end;
988

989
  if pixelFormat = 0 then
990
  begin
991
    // Legacy pixel format selection
992
    pixelFormat := ChoosePixelFormat(ADeviceHandle, @PFDescriptor);
993
    if (not (aType in cMemoryDCs)) and (not
994
      CurrentPixelFormatIsHardwareAccelerated) then
995
    begin
996
      softwarePixelFormat := pixelFormat;
997
      pixelFormat := 0;
998
    end
999
    else
1000
      softwarePixelFormat := 0;
1001
    if pixelFormat = 0 then
1002
    begin
1003
      // Failed on default params, try with 16 bits depth buffer
1004
      PFDescriptor.cDepthBits := 16;
1005
      pixelFormat := ChoosePixelFormat(ADeviceHandle, @PFDescriptor);
1006
      if not CurrentPixelFormatIsHardwareAccelerated then
1007
        pixelFormat := 0;
1008
      if pixelFormat = 0 then
1009
      begin
1010
        // Failed, try with 16 bits color buffer
1011
        PFDescriptor.cColorBits := 16;
1012
        pixelFormat := ChoosePixelFormat(ADeviceHandle, @PFDescriptor);
1013
      end;
1014
      if not CurrentPixelFormatIsHardwareAccelerated then
1015
      begin
1016
        // Fallback to original, should be supported by software
1017
        pixelFormat := softwarePixelFormat;
1018
      end;
1019
      if pixelFormat = 0 then
1020
        RaiseLastOSError;
1021
    end;
1022
  end;
1023

1024
  if GetPixelFormat(ADeviceHandle) <> pixelFormat then
1025
  begin
1026
    if not SetPixelFormat(ADeviceHandle, pixelFormat, @PFDescriptor) then
1027
      RaiseLastOSError;
1028
  end;
1029

1030
  // Check the properties we just set.
1031
  DescribePixelFormat(ADeviceHandle, pixelFormat, SizeOf(PFDescriptor), PFDescriptor);
1032
  with PFDescriptor do
1033
  begin
1034
    if (dwFlags and PFD_NEED_PALETTE) <> 0 then
1035
      SetupPalette(ADeviceHandle, PFDescriptor);
1036
    FSwapBufferSupported := (dwFlags and PFD_SWAP_LAYER_BUFFERS) <> 0;
1037
    if bReserved = 0 then
1038
      FLayer := clMainPlane;
1039
  end;
1040

1041
  if not FLegacyContextsOnly then
1042
  begin
1043
    if ((pfDescriptor.dwFlags and PFD_GENERIC_FORMAT) > 0)
1044
      and (FAcceleration = chaHardware) then
1045
    begin
1046
      FAcceleration := chaSoftware;
1047
      GLSLogger.LogWarning(strFailHWRC);
1048
    end;
1049
  end;
1050

1051
  if not FLegacyContextsOnly
1052
    and FGL.W_ARB_create_context
1053
    and (FAcceleration = chaHardware) then
1054
    CreateNewContext(ADeviceHandle)
1055
  else
1056
    CreateOldContext(ADeviceHandle);
1057

1058
  if not FLegacyContextsOnly then
1059
  begin
1060
    // Share identifiers with other context if it deffined
1061
    if (ServiceContext <> nil) and (Self <> ServiceContext) then
1062
    begin
1063
      if wglShareLists(TGLWin32Context(ServiceContext).FRC, FRC) then
1064
      begin
1065
        FSharedContexts.Add(ServiceContext);
1066
        PropagateSharedContext;
1067
      end
1068
      else
1069
        GLSLogger.LogWarning('DoCreateContext - Failed to share contexts with resource context');
1070
    end;
1071
  end;
1072
end;
1073

1074
// SpawnLegacyContext
1075
//
1076

1077
procedure TGLWin32Context.SpawnLegacyContext(aDC: HDC);
1078
begin
1079
  try
1080
    FLegacyContextsOnly := True;
1081
    try
1082
      DoCreateContext(aDC);
1083
    finally
1084
      FLegacyContextsOnly := False;
1085
    end;
1086
  except
1087
    on E: Exception do
1088
    begin
1089
      raise Exception.Create(strUnableToCreateLegacyContext + #13#10
1090
        + E.ClassName + ': ' + E.Message);
1091
    end;
1092
  end;
1093
end;
1094

1095
// DoCreateMemoryContext
1096
//
1097

1098
procedure TGLWin32Context.DoCreateMemoryContext(outputDevice: HWND; width,
1099
  height: Integer; BufferCount: integer);
1100
var
1101
  nbFormats: Integer;
1102
  iFormats: array[0..31] of Integer;
1103
  iPBufferAttribs: array[0..0] of Integer;
1104
  localHPBuffer: Integer;
1105
  localRC: HGLRC;
1106
  localDC, tempDC: HDC;
1107
  tempWnd: HWND;
1108
  shareRC: TGLWin32Context;
1109
  pfDescriptor: TPixelFormatDescriptor;
1110
  bOES: Boolean;
1111
begin
1112
  localHPBuffer := 0;
1113
  localDC := 0;
1114
  localRC := 0;
1115
  bOES := False;
1116
  // the WGL mechanism is a little awkward: we first create a dummy context
1117
  // on the TOP-level DC (ie. screen), to retrieve our pixelformat, create
1118
  // our stuff, etc.
1119
  tempWnd := CreateTempWnd;
1120
  tempDC := GetDC(tempWnd);
1121
  try
1122
    SpawnLegacyContext(tempDC);
1123
    try
1124
      DoActivate;
1125
      try
1126
        FGL.ClearError;
1127
        if FGL.W_ARB_pixel_format and FGL.W_ARB_pbuffer then
1128
        begin
1129
          ClearIAttribs;
1130
          AddIAttrib(WGL_DRAW_TO_PBUFFER_ARB, 1);
1131
          ChooseWGLFormat(tempDC, 32, @iFormats, nbFormats, BufferCount);
1132
          if nbFormats = 0 then
1133
            raise
1134
              EPBuffer.Create('Format not supported for pbuffer operation.');
1135
          iPBufferAttribs[0] := 0;
1136

1137
          localHPBuffer := FGL.WCreatePbufferARB(tempDC, iFormats[0], width,
1138
            height,
1139
            @iPBufferAttribs[0]);
1140
          if localHPBuffer = 0 then
1141
            raise EPBuffer.Create('Unabled to create pbuffer.');
1142
          try
1143
            localDC := FGL.WGetPbufferDCARB(localHPBuffer);
1144
            if localDC = 0 then
1145
              raise EPBuffer.Create('Unabled to create pbuffer''s DC.');
1146
            try
1147
              if FGL.W_ARB_create_context then
1148
              begin
1149
                // Modern creation style
1150
                ClearIAttribs;
1151
                // Initialize forward context
1152
                if GLStates.ForwardContext then
1153
                begin
1154
                  if FGL.VERSION_4_2 then
1155
                  begin
1156
                    AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 4);
1157
                    AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 2);
1158
                  end
1159
                  else if FGL.VERSION_4_1 then
1160
                  begin
1161
                    AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 4);
1162
                    AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 1);
1163
                  end
1164
                  else if FGL.VERSION_4_0 then
1165
                  begin
1166
                    AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 4);
1167
                    AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 0);
1168
                  end
1169
                  else if FGL.VERSION_3_3 then
1170
                  begin
1171
                    AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 3);
1172
                    AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 3);
1173
                  end
1174
                  else if FGL.VERSION_3_2 then
1175
                  begin
1176
                    AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 3);
1177
                    AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 2);
1178
                  end
1179
                  else if FGL.VERSION_3_1 then
1180
                  begin
1181
                    AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 3);
1182
                    AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 1);
1183
                  end
1184
                  else if FGL.VERSION_3_0 then
1185
                  begin
1186
                    AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 3);
1187
                    AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 0);
1188
                  end
1189
                  else
1190
                    Abort;
1191
                  AddIAttrib(WGL_CONTEXT_FLAGS_ARB, WGL_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB);
1192
                  if rcoOGL_ES in Options then
1193
                    GLSLogger.LogWarning(strOESvsForwardRC);
1194
                end
1195
                else if rcoOGL_ES in Options then
1196
                begin
1197
                  if FGL.W_EXT_create_context_es2_profile then
1198
                  begin
1199
                    AddIAttrib(WGL_CONTEXT_MAJOR_VERSION_ARB, 2);
1200
                    AddIAttrib(WGL_CONTEXT_MINOR_VERSION_ARB, 0);
1201
                    AddIAttrib(WGL_CONTEXT_FLAGS_ARB, WGL_CONTEXT_ES2_PROFILE_BIT_EXT);
1202
                  end
1203
                  else
1204
                    GLSLogger.LogError(strDriverNotSupportOESRC);
1205
                end;
1206

1207
                if rcoDebug in Options then
1208
                begin
1209
                  AddIAttrib(WGL_CONTEXT_FLAGS_ARB, WGL_CONTEXT_DEBUG_BIT_ARB);
1210
                  FGL.DebugMode := True;
1211
                end;
1212

1213
                case Layer of
1214
                  clUnderlay2: AddIAttrib(WGL_CONTEXT_LAYER_PLANE_ARB, -2);
1215
                  clUnderlay1: AddIAttrib(WGL_CONTEXT_LAYER_PLANE_ARB, -1);
1216
                  clOverlay1: AddIAttrib(WGL_CONTEXT_LAYER_PLANE_ARB, 1);
1217
                  clOverlay2: AddIAttrib(WGL_CONTEXT_LAYER_PLANE_ARB, 2);
1218
                end;
1219

1220
                localRC := FGL.WCreateContextAttribsARB(localDC, 0, @FiAttribs[0]);
1221
                if localRC = 0 then
1222
               {$IFDEF GLS_LOGGING}
1223
                begin
1224
                  if GLStates.ForwardContext then
1225
                    GLSLogger.LogErrorFmt(strForwardContextFailed,
1226
                      [GetLastError, SysErrorMessage(GetLastError)])
1227
                  else
1228
                    GLSLogger.LogErrorFmt(strBackwardContextFailed,
1229
                      [GetLastError, SysErrorMessage(GetLastError)]);
1230
                  Abort;
1231
                end;
1232
               {$ELSE}
1233
                  raise Exception.Create('Unabled to create pbuffer''s RC.');
1234
               {$ENDIF}
1235
              end
1236
              else
1237
              begin
1238
                // Old creation style
1239
                localRC := wglCreateContext(localDC);
1240
                if localRC = 0 then
1241
                begin
1242
                  GLSLogger.LogErrorFmt(strBackwardContextFailed,
1243
                    [GetLastError, SysErrorMessage(GetLastError)]);
1244
                  Abort;
1245
                end;
1246
              end;
1247

1248
            except
1249
              FGL.WReleasePBufferDCARB(localHPBuffer, localDC);
1250
              raise;
1251
            end;
1252
          except
1253
            FGL.WDestroyPBufferARB(localHPBuffer);
1254
            raise;
1255
          end;
1256
        end
1257
        else
1258
          raise EPBuffer.Create('WGL_ARB_pbuffer support required.');
1259
        FGL.CheckError;
1260
      finally
1261
        DoDeactivate;
1262
      end;
1263
    finally
1264
      shareRC := FShareContext;
1265
      DoDestroyContext;
1266
      FShareContext := shareRC;
1267
    end;
1268
  finally
1269
    ReleaseDC(0, tempDC);
1270
    DestroyWindow(tempWnd);
1271
    FHPBUFFER := localHPBuffer;
1272
    FDC := localDC;
1273
    FRC := localRC;
1274
  end;
1275

1276
  DescribePixelFormat(FDC, GetPixelFormat(FDC), SizeOf(PFDescriptor), PFDescriptor);
1277
  if ((PFDescriptor.dwFlags and PFD_GENERIC_FORMAT) > 0)
1278
    and (FAcceleration = chaHardware) then
1279
  begin
1280
    FAcceleration := chaSoftware;
1281
    GLSLogger.LogWarning(strFailHWRC);
1282
  end;
1283

1284
  Activate;
1285
  FGL.Initialize;
1286
  // If we are using AntiAliasing, adjust filtering hints
1287
  if AntiAliasing in [aa2xHQ, aa4xHQ, csa8xHQ, csa16xHQ] then
1288
    GLStates.MultisampleFilterHint := hintNicest
1289
  else if AntiAliasing in [aa2x, aa4x, csa8x, csa16x] then
1290
    GLStates.MultisampleFilterHint := hintFastest
1291
  else GLStates.MultisampleFilterHint := hintDontCare;
1292

1293
  // Specific which color buffers are to be drawn into
1294
  if BufferCount > 1 then
1295
    FGL.DrawBuffers(BufferCount, @MRT_BUFFERS);
1296

1297
  if (ServiceContext <> nil) and (Self <> ServiceContext) then
1298
  begin
1299
    if wglShareLists(TGLWin32Context(ServiceContext).FRC, FRC) then
1300
    begin
1301
      FSharedContexts.Add(ServiceContext);
1302
      PropagateSharedContext;
1303
    end
1304
    else
1305
      GLSLogger.LogWarning('DoCreateContext - Failed to share contexts with resource context');
1306
  end;
1307

1308
  if Assigned(FShareContext) and (FShareContext.RC <> 0) then
1309
  begin
1310
    if not wglShareLists(FShareContext.RC, FRC) then
1311
      GLSLogger.LogWarning(strFailedToShare)
1312
    else
1313
    begin
1314
      FSharedContexts.Add(FShareContext);
1315
      PropagateSharedContext;
1316
    end;
1317
  end;
1318

1319
  Deactivate;
1320

1321
  if GLStates.ForwardContext then
1322
    GLSLogger.LogInfo('PBuffer ' + strFRC_created);
1323
  if bOES then
1324
    GLSLogger.LogInfo('PBuffer ' + strOESRC_created);
1325
  if not (GLStates.ForwardContext or bOES) then
1326
    GLSLogger.LogInfo(strPBufferRC_created);
1327
end;
1328

1329
// DoShareLists
1330
//
1331

1332
function TGLWin32Context.DoShareLists(aContext: TGLContext): Boolean;
1333
begin
1334
  if aContext is TGLWin32Context then
1335
  begin
1336
    FShareContext := TGLWin32Context(aContext);
1337
    if FShareContext.RC <> 0 then
1338
      Result := wglShareLists(FShareContext.RC, RC)
1339
    else
1340
      Result := False;
1341
  end
1342
  else
1343
    raise Exception.Create(strIncompatibleContexts);
1344
end;
1345

1346
// DoDestroyContext
1347
//
1348

1349
procedure TGLWin32Context.DoDestroyContext;
1350
begin
1351
  if vUseWindowTrackingHook then
1352
    UnTrackWindow(WindowFromDC(FDC));
1353

1354
  if FHPBUFFER <> 0 then
1355
  begin
1356
    FGL.WReleasePbufferDCARB(FHPBuffer, FDC);
1357
    FGL.WDestroyPbufferARB(FHPBUFFER);
1358
    FHPBUFFER := 0;
1359
  end;
1360

1361
  if FRC <> 0 then
1362
    if not wglDeleteContext(FRC) then
1363
      GLSLogger.LogErrorFmt(strDeleteContextFailed,
1364
        [GetLastError, SysErrorMessage(GetLastError)]);
1365

1366
  FRC := 0;
1367
  FDC := 0;
1368
  FShareContext := nil;
1369
end;
1370

1371
// DoActivate
1372
//
1373

1374
procedure TGLWin32Context.DoActivate;
1375
begin
1376
  if not wglMakeCurrent(FDC, FRC) then
1377
  begin
1378
    GLSLogger.LogErrorFmt(strContextActivationFailed,
1379
      [GetLastError, SysErrorMessage(GetLastError)]);
1380
    Abort;
1381
  end;
1382

1383
  if not FGL.IsInitialized then
1384
    FGL.Initialize(CurrentGLContext = nil);
1385
end;
1386

1387
// Deactivate
1388
//
1389

1390
procedure TGLWin32Context.DoDeactivate;
1391
begin
1392
  if not wglMakeCurrent(0, 0) then
1393
  begin
1394
    GLSLogger.LogErrorFmt(strContextDeactivationFailed,
1395
      [GetLastError, SysErrorMessage(GetLastError)]);
1396
    Abort;
1397
  end;
1398
end;
1399

1400
// IsValid
1401
//
1402

1403
function TGLWin32Context.IsValid: Boolean;
1404
begin
1405
  Result := (FRC <> 0);
1406
end;
1407

1408
// SwapBuffers
1409
//
1410

1411
procedure TGLWin32Context.SwapBuffers;
1412
begin
1413
  if (FDC <> 0) and (rcoDoubleBuffered in Options) then
1414
    if FSwapBufferSupported then
1415
    begin
1416
      case Layer of
1417
        clUnderlay2: wglSwapLayerBuffers(FDC, WGL_SWAP_UNDERLAY2);
1418
        clUnderlay1: wglSwapLayerBuffers(FDC, WGL_SWAP_UNDERLAY1);
1419
        clMainPlane: Windows.SwapBuffers(FDC);
1420
        clOverlay1: wglSwapLayerBuffers(FDC, WGL_SWAP_OVERLAY1);
1421
        clOverlay2: wglSwapLayerBuffers(FDC, WGL_SWAP_OVERLAY2);
1422
      end;
1423
    end
1424
    else
1425
      Windows.SwapBuffers(FDC);
1426
end;
1427

1428
// RenderOutputDevice
1429
//
1430

1431
function TGLWin32Context.RenderOutputDevice: Pointer;
1432
begin
1433
  Result := Pointer(FDC);
1434
end;
1435

1436
// ------------------------------------------------------------------
1437
// ------------------------------------------------------------------
1438
// ------------------------------------------------------------------
1439
initialization
1440
  // ------------------------------------------------------------------
1441
  // ------------------------------------------------------------------
1442
  // ------------------------------------------------------------------
1443

1444

1445
end.
1446