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   Abstract:
10     TOpenGLControl is a LCL control with an opengl context.
11     It works under the following platforms:
12       - gtk with glx    : full
13       - gtk2 with glx   : full
14       - carbon with agl : full
15       - cocoa           : no
16       - windows with wgl: full
17       - wince           : no
18       - qt with glx     : no (started)
19       - fpgui with glx  : no
20       - nogui           : no
21 }
22 unit OpenGLContext;
23 
24 {$mode objfpc}{$H+}
25 
26 // choose the right backend depending on used LCL widgetset
27 {$IFDEF LCLGTK}
28   {$IFDEF Linux}
29     {$DEFINE UseGtkGLX}
30     {$DEFINE HasRGBA}
31     {$DEFINE HasRGBBits}
32     {$DEFINE OpenGLTargetDefined}
33   {$ENDIF}
34 {$ENDIF}
35 {$IFDEF LCLGTK2}
36   {$IF defined(Linux) or defined(FreeBSD)}
37     {$DEFINE UseGtk2GLX}
38     {$DEFINE UsesModernGL}
39     {$DEFINE HasRGBA}
40     {$DEFINE HasRGBBits}
41     {$DEFINE HasDebugContext}
42     {$DEFINE OpenGLTargetDefined}
43   {$ENDIF}
44 {$ENDIF}
45 {$IFDEF LCLGTK3}
46   {$IF defined(Linux) or defined(FreeBSD)}
47     {$DEFINE UseGtk3GLX}
48     {$DEFINE UsesModernGL}
49     {$DEFINE HasRGBA}
50     {$DEFINE HasRGBBits}
51     {$DEFINE HasDebugContext}
52     {$DEFINE OpenGLTargetDefined}
53   {$ENDIF}
54 {$ENDIF}
55 {$IFDEF LCLCarbon}
56   {$DEFINE UseCarbonAGL}
57   {$DEFINE HasRGBA}
58   {$DEFINE HasRGBBits}
59   {$DEFINE OpenGLTargetDefined}
60 {$ENDIF}
61 {$IFDEF LCLCocoa}
62   {$DEFINE UseCocoaNS}
63   {$DEFINE UsesModernGL}
64   {$DEFINE OpenGLTargetDefined}
65   {$DEFINE HasMacRetinaMode}
66 {$ENDIF}
67 {$IFDEF LCLWin32}
68   {$DEFINE UseWin32WGL}
69   {$DEFINE HasRGBA}
70   {$DEFINE HasRGBBits}
71   {$DEFINE HasDebugContext}
72   {$DEFINE OpenGLTargetDefined}
73 {$ENDIF}
74 {$IFDEF LCLQT}
75   {$DEFINE UseQTGLX}
76   {$DEFINE UsesModernGL}
77   {$DEFINE HasRGBA}
78   {$DEFINE HasRGBBits}
79   {$DEFINE OpenGLTargetDefined}
80 {$ENDIF}
81 {$IFDEF LCLQT5}
82   {$DEFINE UseQTGLX}
83   {$DEFINE UsesModernGL}
84   {$DEFINE HasRGBA}
85   {$DEFINE HasRGBBits}
86   {$DEFINE OpenGLTargetDefined}
87 {$ENDIF}
88 {$IFNDEF OpenGLTargetDefined}
89   {$ERROR this LCL widgetset/OS is not yet supported}
90 {$ENDIF}
91 
92 interface
93 
94 uses
95   Classes, SysUtils,
96   // LCL
97   LCLType, LCLIntf, LResources, Forms, Controls, Graphics, LMessages,
98   WSLCLClasses, WSControls,
99 {$IFDEF UseGtkGLX}
100   GLGtkGlxContext;
101 {$ENDIF}
102 {$IFDEF UseGtk2GLX}
103   GLGtkGlxContext;
104 {$ENDIF}
105 {$IFDEF UseGtk3GLX}
106   GLGtk3GlxContext;
107 {$ENDIF}
108 {$IFDEF UseCarbonAGL}
109   GLCarbonAGLContext;
110 {$ENDIF}
111 {$IFDEF UseCocoaNS}
112   GLCocoaNSContext;
113 {$ENDIF}
114 {$IFDEF UseWin32WGL}
115   GLWin32WGLContext;
116 {$ENDIF}
117 {$IFDEF UseQTGLX}
118   GLQTContext;
119 {$ENDIF}
120 
121 const
122   DefaultDepthBits = 24;
123 
124 type
125   TOpenGlCtrlMakeCurrentEvent = procedure(Sender: TObject;
126                                           var Allow: boolean) of object;
127 
128   TOpenGLControlOption = (ocoMacRetinaMode, ocoRenderAtDesignTime);
129   TOpenGLControlOptions = set of TOpenGLControlOption;
130 
131   { TCustomOpenGLControl }
132   { Sharing:
133     You can share opengl contexts. For example:
134     Assume OpenGLControl2 and OpenGLControl3 should share the same as
135     OpenGLControl1. Then set
136 
137         OpenGLControl2.SharedControl:=OpenGLControl1;
138         OpenGLControl3.SharedControl:=OpenGLControl1;
139 
140      After this OpenGLControl1.SharingControlCount will be two and
141      OpenGLControl1.SharingControls will contain OpenGLControl2 and
142      OpenGLControl3.
143     }
144 
145   TCustomOpenGLControl = class(TWinControl)
146   private
147     FAutoResizeViewport: boolean;
148     FCanvas: TCanvas; // only valid at designtime
149     FDebugContext: boolean;
150     FFrameDiffTime: integer;
151     FOnMakeCurrent: TOpenGlCtrlMakeCurrentEvent;
152     FOnPaint: TNotifyEvent;
153     FCurrentFrameTime: integer; // in msec
154     FLastFrameTime: integer; // in msec
155     fOpenGLMajorVersion: Cardinal;
156     fOpenGLMinorVersion: Cardinal;
157     FRGBA: boolean;
158     {$IFDEF HasRGBBits}
159     FRedBits, FGreenBits, FBlueBits,
160     {$ENDIF}
161     FMultiSampling, FAlphaBits, FDepthBits, FStencilBits, FAUXBuffers: Cardinal;
162     FSharedOpenGLControl: TCustomOpenGLControl;
163     FSharingOpenGlControls: TList;
164     FOptions: TOpenGLControlOptions;
GetSharingControlsnull165     function GetSharingControls(Index: integer): TCustomOpenGLControl;
166     procedure SetAutoResizeViewport(const AValue: boolean);
167     procedure SetDebugContext(AValue: boolean);
168     procedure SetOpenGLMajorVersion(AValue: Cardinal);
169     procedure SetOpenGLMinorVersion(AValue: Cardinal);
170     procedure SetOptions(AValue: TOpenGLControlOptions);
171     procedure SetRGBA(const AValue: boolean);
172     {$IFDEF HasRGBBits}
173     procedure SetRedBits(const AValue: Cardinal);
174     procedure SetGreenBits(const AValue: Cardinal);
175     procedure SetBlueBits(const AValue: Cardinal);
176     {$ENDIF}
177     procedure SetMultiSampling(const AMultiSampling: Cardinal);
178     procedure SetAlphaBits(const AValue: Cardinal);
179     procedure SetDepthBits(const AValue: Cardinal);
180     procedure SetStencilBits(const AValue: Cardinal);
181     procedure SetAUXBuffers(const AValue: Cardinal);
182     procedure SetSharedControl(const AValue: TCustomOpenGLControl);
IsOpenGLRenderAllowednull183     function IsOpenGLRenderAllowed: boolean;
184   protected
185     class procedure WSRegisterClass; override;
186     procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
187     procedure WMSize(var Message: TLMSize); message LM_SIZE;
188     procedure UpdateFrameTimeDiff;
189     procedure OpenGLAttributesChanged;
190     procedure CMDoubleBufferedChanged(var Message: TLMessage); message CM_DOUBLEBUFFEREDCHANGED;
191   public
192     constructor Create(TheOwner: TComponent); override;
193     destructor Destroy; override;
194     Procedure Paint; virtual;
195     procedure RealizeBounds; override;
196     procedure DoOnPaint; virtual;
197     procedure SwapBuffers; virtual;
MakeCurrentnull198     function MakeCurrent(SaveOldToStack: boolean = false): boolean; virtual;
ReleaseContextnull199     function ReleaseContext: boolean; virtual;
RestoreOldOpenGLControlnull200     function RestoreOldOpenGLControl: boolean;
SharingControlCountnull201     function SharingControlCount: integer;
202     property SharingControls[Index: integer]: TCustomOpenGLControl read GetSharingControls;
203     procedure Invalidate; override;
204     procedure EraseBackground(DC: HDC); override;
205   public
206     property FrameDiffTimeInMSecs: integer read FFrameDiffTime;
207     property OnMakeCurrent: TOpenGlCtrlMakeCurrentEvent read FOnMakeCurrent
208                                                        write FOnMakeCurrent;
209     property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
210     property SharedControl: TCustomOpenGLControl read FSharedOpenGLControl
211                                                  write SetSharedControl;
212     property AutoResizeViewport: boolean read FAutoResizeViewport
213                                          write SetAutoResizeViewport default false;
214     property DoubleBuffered stored True default True;
215     property ParentDoubleBuffered default False;
216     property DebugContext: boolean read FDebugContext write SetDebugContext default false; // create context with debugging enabled. Requires OpenGLMajorVersion!
217     property RGBA: boolean read FRGBA write SetRGBA default true;
218     {$IFDEF HasRGBBits}
219     property RedBits: Cardinal read FRedBits write SetRedBits default 8;
220     property GreenBits: Cardinal read FGreenBits write SetGreenBits default 8;
221     property BlueBits: Cardinal read FBlueBits write SetBlueBits default 8;
222     {$ENDIF}
223     property OpenGLMajorVersion: Cardinal read fOpenGLMajorVersion write SetOpenGLMajorVersion default 0;
224     property OpenGLMinorVersion: Cardinal read fOpenGLMinorVersion write SetOpenGLMinorVersion default 0;
225     { Number of samples per pixel, for OpenGL multi-sampling (anti-aliasing).
226 
227       Value <= 1 means that we use 1 sample per pixel, which means no anti-aliasing.
228       Higher values mean anti-aliasing. Exactly which values are supported
229       depends on GPU, common modern GPUs support values like 2 and 4.
230 
231       If this is > 1, and we will not be able to create OpenGL
232       with multi-sampling, we will fallback to normal non-multi-sampled context.
233       You can query OpenGL values GL_SAMPLE_BUFFERS_ARB and GL_SAMPLES_ARB
234       (see ARB_multisample extension) to see how many samples have been
235       actually allocated for your context. }
236     property MultiSampling: Cardinal read FMultiSampling write SetMultiSampling default 1;
237 
238     property AlphaBits: Cardinal read FAlphaBits write SetAlphaBits default 0;
239     property DepthBits: Cardinal read FDepthBits write SetDepthBits default DefaultDepthBits;
240     property StencilBits: Cardinal read FStencilBits write SetStencilBits default 0;
241     property AUXBuffers: Cardinal read FAUXBuffers write SetAUXBuffers default 0;
242     property Options: TOpenGLControlOptions read FOptions write SetOptions;
243   end;
244 
245   { TOpenGLControl }
246 
247   TOpenGLControl = class(TCustomOpenGLControl)
248   published
249     property Align;
250     property Anchors;
251     property AutoResizeViewport;
252     property BorderSpacing;
253     property Enabled;
254     {$IFDEF HasRGBBits}
255     property RedBits;
256     property GreenBits;
257     property BlueBits;
258     {$ENDIF}
259     property OpenGLMajorVersion;
260     property OpenGLMinorVersion;
261     property MultiSampling;
262     property AlphaBits;
263     property DepthBits;
264     property StencilBits;
265     property AUXBuffers;
266     property OnChangeBounds;
267     property OnClick;
268     property OnConstrainedResize;
269     property OnDblClick;
270     property OnDragDrop;
271     property OnDragOver;
272     property OnEnter;
273     property OnExit;
274     property OnKeyDown;
275     property OnKeyPress;
276     property OnKeyUp;
277     property OnMakeCurrent;
278     property OnMouseDown;
279     property OnMouseEnter;
280     property OnMouseLeave;
281     property OnMouseMove;
282     property OnMouseUp;
283     property OnMouseWheel;
284     property OnMouseWheelDown;
285     property OnMouseWheelUp;
286     property OnPaint;
287     property OnResize;
288     property OnShowHint;
289     property PopupMenu;
290     property ShowHint;
291     property Visible;
292   end;
293 
294   { TWSOpenGLControl }
295 
296   TWSOpenGLControl = class(TWSWinControl)
297   published
CreateHandlenull298     class function CreateHandle(const AWinControl: TWinControl;
299                                 const AParams: TCreateParams): HWND; override;
300     class procedure DestroyHandle(const AWinControl: TWinControl); override;
GetDoubleBufferednull301     class function GetDoubleBuffered(const AWinControl: TWinControl): Boolean; override;
302   end;
303 
304 
305 
306 procedure Register;
307 
308 
309 implementation
310 
311 {$R openglcontext.res}
312 
313 var
314   OpenGLControlStack: TList = nil;
315 
316 procedure Register;
317 begin
318   RegisterComponents('OpenGL',[TOpenGLControl]);
319 end;
320 
321 { TCustomOpenGLControl }
322 
GetSharingControlsnull323 function TCustomOpenGLControl.GetSharingControls(Index: integer
324   ): TCustomOpenGLControl;
325 begin
326   Result:=TCustomOpenGLControl(FSharingOpenGlControls[Index]);
327 end;
328 
329 procedure TCustomOpenGLControl.SetAutoResizeViewport(const AValue: boolean);
330 begin
331   if FAutoResizeViewport=AValue then exit;
332   FAutoResizeViewport:=AValue;
333   if AutoResizeViewport
334   and ([csLoading,csDestroying]*ComponentState=[])
335   and IsVisible and HandleAllocated
336   and MakeCurrent then
337     LOpenGLViewport(Handle,0,0,Width,Height);
338 end;
339 
340 procedure TCustomOpenGLControl.SetDebugContext(AValue: boolean);
341 begin
342   if FDebugContext=AValue then Exit;
343   FDebugContext:=AValue;
344   OpenGLAttributesChanged;
345 end;
346 
347 procedure TCustomOpenGLControl.CMDoubleBufferedChanged(var Message: TLMessage);
348 begin
349   inherited;
350   OpenGLAttributesChanged;
351 end;
352 
353 procedure TCustomOpenGLControl.SetOpenGLMajorVersion(AValue: Cardinal);
354 begin
355   if fOpenGLMajorVersion=AValue then Exit;
356   fOpenGLMajorVersion:=AValue;
357 end;
358 
359 procedure TCustomOpenGLControl.SetOpenGLMinorVersion(AValue: Cardinal);
360 begin
361   if fOpenGLMinorVersion=AValue then Exit;
362   fOpenGLMinorVersion:=AValue;
363 end;
364 
365 procedure TCustomOpenGLControl.SetOptions(AValue: TOpenGLControlOptions);
366 var
367   RemovedRenderAtDesignTime: boolean;
368 begin
369   if FOptions=AValue then Exit;
370 
371   RemovedRenderAtDesignTime:=
372          (ocoRenderAtDesignTime in FOptions) and
373     (not (ocoRenderAtDesignTime in AValue));
374 
375   FOptions:=AValue;
376 
377   { if you remove the flag ocoRenderAtDesignTime at design-time,
378     we need to destroy the handle. The call to OpenGLAttributesChanged
379     would not do this, so do it explicitly by calling ReCreateWnd
380     (ReCreateWnd will destroy handle, and not create new one,
381     since IsOpenGLRenderAllowed = false). }
382   if (csDesigning in ComponentState) and
383      RemovedRenderAtDesignTime and
384      HandleAllocated then
385     ReCreateWnd(Self);
386 
387   OpenGLAttributesChanged();
388 end;
389 
390 procedure TCustomOpenGLControl.SetRGBA(const AValue: boolean);
391 begin
392   if FRGBA=AValue then exit;
393   FRGBA:=AValue;
394   OpenGLAttributesChanged;
395 end;
396 
397 {$IFDEF HasRGBBits}
398 procedure TCustomOpenGLControl.SetRedBits(const AValue: Cardinal);
399 begin
400   if FRedBits=AValue then exit;
401   FRedBits:=AValue;
402   OpenGLAttributesChanged;
403 end;
404 
405 procedure TCustomOpenGLControl.SetGreenBits(const AValue: Cardinal);
406 begin
407   if FGreenBits=AValue then exit;
408   FGreenBits:=AValue;
409   OpenGLAttributesChanged;
410 end;
411 
412 procedure TCustomOpenGLControl.SetBlueBits(const AValue: Cardinal);
413 begin
414   if FBlueBits=AValue then exit;
415   FBlueBits:=AValue;
416   OpenGLAttributesChanged;
417 end;
418 {$ENDIF}
419 
420 procedure TCustomOpenGLControl.SetMultiSampling(const AMultiSampling: Cardinal);
421 begin
422   if FMultiSampling=AMultiSampling then exit;
423   FMultiSampling:=AMultiSampling;
424   OpenGLAttributesChanged;
425 end;
426 
427 procedure TCustomOpenGLControl.SetAlphaBits(const AValue: Cardinal);
428 begin
429   if FAlphaBits=AValue then exit;
430   FAlphaBits:=AValue;
431   OpenGLAttributesChanged;
432 end;
433 
434 procedure TCustomOpenGLControl.SetDepthBits(const AValue: Cardinal);
435 begin
436   if FDepthBits=AValue then exit;
437   FDepthBits:=AValue;
438   OpenGLAttributesChanged;
439 end;
440 
441 procedure TCustomOpenGLControl.SetStencilBits(const AValue: Cardinal);
442 begin
443   if FStencilBits=AValue then exit;
444   FStencilBits:=AValue;
445   OpenGLAttributesChanged;
446 end;
447 
448 procedure TCustomOpenGLControl.SetAUXBuffers(const AValue: Cardinal);
449 begin
450   if FAUXBuffers=AValue then exit;
451   FAUXBuffers:=AValue;
452   OpenGLAttributesChanged;
453 end;
454 
455 procedure TCustomOpenGLControl.SetSharedControl(
456   const AValue: TCustomOpenGLControl);
457 begin
458   if FSharedOpenGLControl=AValue then exit;
459   if AValue=Self then
460     Raise Exception.Create('A control can not be shared by itself.');
461   // unshare old
462   if (AValue<>nil) and (AValue.SharedControl<>nil) then
463     Raise Exception.Create('Target control is sharing too. A sharing control can not be shared.');
464   if FSharedOpenGLControl<>nil then
465     FSharedOpenGLControl.FSharingOpenGlControls.Remove(Self);
466   // share new
467   if (AValue<>nil) and (csDestroying in AValue.ComponentState) then
468     FSharedOpenGLControl:=nil
469   else begin
470     FSharedOpenGLControl:=AValue;
471     if (FSharedOpenGLControl<>nil) then begin
472       if FSharedOpenGLControl.FSharingOpenGlControls=nil then
473         FSharedOpenGLControl.FSharingOpenGlControls:=TList.Create;
474       FSharedOpenGLControl.FSharingOpenGlControls.Add(Self);
475     end;
476   end;
477   // recreate handle if needed
478   if HandleAllocated and IsOpenGLRenderAllowed then
479     ReCreateWnd(Self);
480 end;
481 
482 { OpenGL rendering allowed, because not in design-mode or because we
483   should render even in design-mode. }
IsOpenGLRenderAllowednull484 function TCustomOpenGLControl.IsOpenGLRenderAllowed: boolean;
485 begin
486   Result := (not (csDesigning in ComponentState)) or
487     (ocoRenderAtDesignTime in Options);
488 end;
489 
490 class procedure TCustomOpenGLControl.WSRegisterClass;
491 const
492   Registered : Boolean = False;
493 begin
494   if Registered then
495     Exit;
496   inherited WSRegisterClass;
497   RegisterWSComponent(TCustomOpenGLControl,TWSOpenGLControl);
498   Registered := True;
499 end;
500 
501 procedure TCustomOpenGLControl.WMPaint(var Message: TLMPaint);
502 begin
503   Include(FControlState, csCustomPaint);
504   inherited WMPaint(Message);
505   //debugln('TCustomGTKGLAreaControl.WMPaint A ',dbgsName(Self),' ',dbgsName(FCanvas));
506   if (not IsOpenGLRenderAllowed) and (FCanvas<>nil) then begin
507     with FCanvas do begin
508       if Message.DC <> 0 then
509         Handle := Message.DC;
510       Brush.Color:=clLtGray;
511       Pen.Color:=clRed;
512       Rectangle(0,0,Self.Width,Self.Height);
513       MoveTo(0,0);
514       LineTo(Self.Width,Self.Height);
515       MoveTo(0,Self.Height);
516       LineTo(Self.Width,0);
517       if Message.DC <> 0 then
518         Handle := 0;
519     end;
520   end else begin
521     Paint;
522   end;
523   Exclude(FControlState, csCustomPaint);
524 end;
525 
526 procedure TCustomOpenGLControl.WMSize(var Message: TLMSize);
527 begin
528   if (Message.SizeType and Size_SourceIsInterface)>0 then
529     DoOnResize;
530 end;
531 
532 procedure TCustomOpenGLControl.UpdateFrameTimeDiff;
533 begin
534   FCurrentFrameTime:=integer(GetTickCount);
535   if FLastFrameTime=0 then
536     FLastFrameTime:=FCurrentFrameTime;
537   // calculate time since last call:
538   FFrameDiffTime:=FCurrentFrameTime-FLastFrameTime;
539   // if the counter is reset restart:
540   if (FFrameDiffTime<0) then FFrameDiffTime:=1;
541   FLastFrameTime:=FCurrentFrameTime;
542 end;
543 
544 procedure TCustomOpenGLControl.OpenGLAttributesChanged;
545 begin
546   if HandleAllocated and
547     ( ([csLoading,csDestroying]*ComponentState=[]) and IsOpenGLRenderAllowed ) then
548     RecreateWnd(Self);
549 end;
550 
551 procedure TCustomOpenGLControl.EraseBackground(DC: HDC);
552 begin
553   if DC=0 then ;
554   // everything is painted, so erasing the background is not needed
555 end;
556 
557 constructor TCustomOpenGLControl.Create(TheOwner: TComponent);
558 begin
559   inherited Create(TheOwner);
560   ParentDoubleBuffered:=False;
561   FDoubleBuffered:=true;
562   FRGBA:=true;
563   {$IFDEF HasRGBBits}
564   FRedBits:=8;
565   FGreenBits:=8;
566   FBlueBits:=8;
567   {$ENDIF}
568   fOpenGLMajorVersion:=0;
569   fOpenGLMinorVersion:=0;
570   FMultiSampling:=1;
571   FDepthBits:=DefaultDepthBits;
572   ControlStyle:=ControlStyle-[csSetCaption];
573   if not IsOpenGLRenderAllowed then begin
574     FCanvas := TControlCanvas.Create;
575     TControlCanvas(FCanvas).Control := Self;
576   end else
577     FCompStyle:=csNonLCL;
578   SetInitialBounds(0, 0, 160, 90);
579 end;
580 
581 destructor TCustomOpenGLControl.Destroy;
582 begin
583   if FSharingOpenGlControls<>nil then begin
584     while SharingControlCount>0 do
585       SharingControls[SharingControlCount-1].SharedControl:=nil;
586     FreeAndNil(FSharingOpenGlControls);
587   end;
588   SharedControl:=nil;
589   if OpenGLControlStack<>nil then begin
590     OpenGLControlStack.Remove(Self);
591     if OpenGLControlStack.Count=0 then
592       FreeAndNil(OpenGLControlStack);
593   end;
594   FCanvas.Free;
595   FCanvas:=nil;
596   inherited Destroy;
597 end;
598 
599 procedure TCustomOpenGLControl.Paint;
600 begin
601   if IsVisible and HandleAllocated then begin
602     UpdateFrameTimeDiff;
603     if IsOpenGLRenderAllowed and ([csDestroying]*ComponentState=[]) then begin
604       if AutoResizeViewport then begin
605         if not MakeCurrent then exit;
606         LOpenGLViewport(Handle,0,0,Width,Height);
607       end;
608     end;
609     //LOpenGLClip(Handle);
610     DoOnPaint;
611   end;
612 end;
613 
614 procedure TCustomOpenGLControl.RealizeBounds;
615 begin
616   if IsVisible and HandleAllocated
617   and IsOpenGLRenderAllowed
618   and ([csDestroying]*ComponentState=[])
619   and AutoResizeViewport then begin
620     if MakeCurrent then
621       LOpenGLViewport(Handle,0,0,Width,Height);
622   end;
623   inherited RealizeBounds;
624 end;
625 
626 procedure TCustomOpenGLControl.DoOnPaint;
627 begin
628   if Assigned(OnPaint) then begin
629     if not MakeCurrent then exit;
630     OnPaint(Self);
631   end;
632 end;
633 
634 procedure TCustomOpenGLControl.SwapBuffers;
635 begin
636   LOpenGLSwapBuffers(Handle);
637 end;
638 
MakeCurrentnull639 function TCustomOpenGLControl.MakeCurrent(SaveOldToStack: boolean): boolean;
640 var
641   Allowed: Boolean;
642 begin
643   if not IsOpenGLRenderAllowed then exit(false);
644   if Assigned(FOnMakeCurrent) then begin
645     Allowed:=true;
646     OnMakeCurrent(Self,Allowed);
647     if not Allowed then begin
648       Result:=False;
649       exit;
650     end;
651   end;
652   // make current
653   Result:=LOpenGLMakeCurrent(Handle);
654   if Result and SaveOldToStack then begin
655     // on success push on stack
656     if OpenGLControlStack=nil then
657       OpenGLControlStack:=TList.Create;
658     OpenGLControlStack.Add(Self);
659   end;
660 end;
661 
ReleaseContextnull662 function TCustomOpenGLControl.ReleaseContext: boolean;
663 begin
664   Result:=false;
665   if not HandleAllocated then exit;
666   Result:=LOpenGLReleaseContext(Handle);
667 end;
668 
TCustomOpenGLControl.RestoreOldOpenGLControlnull669 function TCustomOpenGLControl.RestoreOldOpenGLControl: boolean;
670 var
671   RestoredControl: TCustomOpenGLControl;
672 begin
673   Result:=false;
674   // check if the current context is on stack
675   if (OpenGLControlStack=nil) or (OpenGLControlStack.Count=0) then exit;
676   // pop
677   OpenGLControlStack.Delete(OpenGLControlStack.Count-1);
678   // make old control the current control
679   if OpenGLControlStack.Count>0 then begin
680     RestoredControl:=
681       TCustomOpenGLControl(OpenGLControlStack[OpenGLControlStack.Count-1]);
682     if (not LOpenGLMakeCurrent(RestoredControl.Handle)) then
683       exit;
684   end else begin
685     FreeAndNil(OpenGLControlStack);
686   end;
687   Result:=true;
688 end;
689 
TCustomOpenGLControl.SharingControlCountnull690 function TCustomOpenGLControl.SharingControlCount: integer;
691 begin
692   if FSharingOpenGlControls=nil then
693     Result:=0
694   else
695     Result:=FSharingOpenGlControls.Count;
696 end;
697 
698 procedure TCustomOpenGLControl.Invalidate;
699 begin
700   if csCustomPaint in FControlState then exit;
701   inherited Invalidate;
702 end;
703 
704 { TWSOpenGLControl }
705 
TWSOpenGLControl.CreateHandlenull706 class function TWSOpenGLControl.CreateHandle(const AWinControl: TWinControl;
707   const AParams: TCreateParams): HWND;
708 var
709   OpenGlControl: TCustomOpenGLControl;
710   AttrControl: TCustomOpenGLControl;
711 begin
712   OpenGlControl:=AWinControl as TCustomOpenGLControl;
713   if not OpenGlControl.IsOpenGLRenderAllowed then
714   begin
715     // do not use "inherited CreateHandle", because the LCL changes the hierarchy at run time
716     Result:=TWSWinControlClass(ClassParent).CreateHandle(AWinControl,AParams);
717   end
718   else
719   begin
720     if OpenGlControl.SharedControl<>nil then
721       AttrControl:=OpenGlControl.SharedControl
722     else
723       AttrControl:=OpenGlControl;
724     Result:=LOpenGLCreateContext(OpenGlControl,WSPrivate,
725                                  OpenGlControl.SharedControl,
726                                  AttrControl.DoubleBuffered,
727                                  {$IFDEF HasMacRetinaMode}
728                                  ocoMacRetinaMode in OpenGlControl.Options,
729                                  {$ENDIF}
730                                  {$IFDEF HasRGBA}
731                                  AttrControl.RGBA,
732                                  {$ENDIF}
733                                  {$IFDEF HasDebugContext}
734                                  AttrControl.DebugContext,
735                                  {$ENDIF}
736                                  {$IFDEF HasRGBBits}
737                                  AttrControl.RedBits,
738                                  AttrControl.GreenBits,
739                                  AttrControl.BlueBits,
740                                  {$ENDIF}
741                                  {$IFDEF UsesModernGL}
742                                  AttrControl.OpenGLMajorVersion,
743                                  AttrControl.OpenGLMinorVersion,
744                                  {$ENDIF}
745                                  AttrControl.MultiSampling,
746                                  AttrControl.AlphaBits,
747                                  AttrControl.DepthBits,
748                                  AttrControl.StencilBits,
749                                  AttrControl.AUXBuffers,
750                                  AParams);
751   end;
752 end;
753 
754 class procedure TWSOpenGLControl.DestroyHandle(const AWinControl: TWinControl);
755 begin
756   LOpenGLDestroyContextInfo(AWinControl);
757   // do not use "inherited DestroyHandle", because the LCL changes the hierarchy at run time
758   TWSWinControlClass(ClassParent).DestroyHandle(AWinControl);
759 end;
760 
TWSOpenGLControl.GetDoubleBufferednull761 class function TWSOpenGLControl.GetDoubleBuffered(const AWinControl: TWinControl): Boolean;
762 begin
763   Result := False;
764   if AWinControl=nil then ;
765 end;
766 {~bk
767 initialization
768   RegisterWSComponent(TCustomOpenGLControl,TWSOpenGLControl);
769 }
770 
771 end.
772