diff --git a/components/opengl/glgtkglxcontext.pas b/components/opengl/glgtkglxcontext.pas index 80e8c32734..f37c2cc88a 100644 --- a/components/opengl/glgtkglxcontext.pas +++ b/components/opengl/glgtkglxcontext.pas @@ -85,6 +85,7 @@ type MajorVersion: Cardinal; MinorVersion: Cardinal; MultiSampling: Cardinal; + ContextFlags: Cardinal; end; function GTK_TYPE_GL_AREA: TGtkType; @@ -109,10 +110,10 @@ function gdk_x11_get_default_screen:gint;cdecl;external; procedure LOpenGLViewport(Left, Top, Width, Height: integer); procedure LOpenGLSwapBuffers(Handle: HWND); function LOpenGLMakeCurrent(Handle: HWND): boolean; -function LOpenGLReleaseContext(Handle: HWND): boolean; +function LOpenGLReleaseContext({%H-}Handle: HWND): boolean; function LOpenGLCreateContext(AWinControl: TWinControl; WSPrivate: TWSPrivateClass; SharedControl: TWinControl; - DoubleBuffered, RGBA: boolean; + DoubleBuffered, RGBA, DebugContext: boolean; const RedBits, GreenBits, BlueBits, MajorVersion, MinorVersion, MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal; const AParams: TCreateParams): HWND; @@ -595,7 +596,7 @@ begin Result:=PGtkWidget(gl_area); end; -function CustomXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl; +function CustomXErrorHandler({%H-}para1:PDisplay; para2:PXErrorEvent):cint;cdecl; begin if para2^.error_code=8 then begin raise Exception.Create('A BadMatch X error occured. Most likely the requested OpenGL version is invalid.'); @@ -623,7 +624,7 @@ var GLXContext: TGLXContext; i: Integer; { Used with glXCreateContextAttribsARB to select 3.X and above context } - Context3X: array [0..4] of Integer; + Context3X: array [0..6] of Integer; begin Result:=nil; @@ -679,7 +680,9 @@ begin Context3X[1]:=Attribs.MajorVersion; Context3X[2]:=GLX_CONTEXT_MINOR_VERSION_ARB; Context3X[3]:=Attribs.MinorVersion; - Context3X[4]:=None; + Context3X[4]:=GLX_CONTEXT_FLAGS_ARB; + Context3X[5]:=Attribs.ContextFlags; + Context3X[6]:=None; if (ShareList<>nil) then begin GLXContext:=glXCreateContextAttribsARB(XDisplay, FBConfig, PrivateShareList^.glxcontext, true, @@ -846,7 +849,7 @@ end; function LOpenGLCreateContextCore(AWinControl: TWinControl; WSPrivate: TWSPrivateClass; SharedControl: TWinControl; - DoubleBuffered, RGBA: boolean; + DoubleBuffered, RGBA, DebugContext: boolean; const RedBits, GreenBits, BlueBits, MajorVersion, MinorVersion, MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal; const AParams: TCreateParams): HWND; @@ -863,6 +866,12 @@ begin BlueBits,AlphaBits,DepthBits,StencilBits,AUXBuffers); Attribs.MajorVersion:=MajorVersion; Attribs.MinorVersion:=MinorVersion; + + // fill in context flags + Attribs.ContextFlags:=0; + if DebugContext then + Attribs.ContextFlags:=Attribs.ContextFlags or GLX_CONTEXT_DEBUG_BIT_ARB; + if MultiSampling>1 then begin Attribs.MultiSampling:=MultiSampling; end else begin @@ -893,7 +902,7 @@ end; function LOpenGLCreateContext(AWinControl: TWinControl; WSPrivate: TWSPrivateClass; SharedControl: TWinControl; - DoubleBuffered, RGBA: boolean; + DoubleBuffered, RGBA, DebugContext: boolean; const RedBits, GreenBits, BlueBits, MajorVersion, MinorVersion, MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal; const AParams: TCreateParams): HWND; @@ -909,7 +918,7 @@ begin {$ENDIF} try Result := LOpenGLCreateContextCore(AWinControl, WSPrivate, SharedControl, - DoubleBuffered, RGBA, RedBits, GreenBits, BlueBits, MajorVersion, + DoubleBuffered, RGBA, DebugContext, RedBits, GreenBits, BlueBits, MajorVersion, MinorVersion, MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers, AParams); except @@ -918,14 +927,14 @@ begin {$ENDIF} { retry without MultiSampling } Result := LOpenGLCreateContextCore(AWinControl, WSPrivate, SharedControl, - DoubleBuffered, RGBA, RedBits, GreenBits, BlueBits, MajorVersion, + DoubleBuffered, RGBA, DebugContext, RedBits, GreenBits, BlueBits, MajorVersion, MinorVersion, 1, AlphaBits, DepthBits, StencilBits, AUXBuffers, AParams); end; end else begin { no multi-sampling requested (or GLX_ARB_multisample not available), just pass to LOpenGLCreateContextCore } Result := LOpenGLCreateContextCore(AWinControl, WSPrivate, SharedControl, - DoubleBuffered, RGBA, RedBits, GreenBits, BlueBits, MajorVersion, + DoubleBuffered, RGBA, DebugContext, RedBits, GreenBits, BlueBits, MajorVersion, MinorVersion, MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers, AParams); end; diff --git a/components/opengl/openglcontext.pas b/components/opengl/openglcontext.pas index 1c74e08d17..6d7f3cfdb5 100644 --- a/components/opengl/openglcontext.pas +++ b/components/opengl/openglcontext.pas @@ -38,6 +38,7 @@ unit OpenGLContext; {$DEFINE UsesModernGL} {$DEFINE HasRGBA} {$DEFINE HasRGBBits} + {$DEFINE HasDebugContext} {$DEFINE OpenGLTargetDefined} {$ENDIF} {$ENDIF} @@ -118,6 +119,7 @@ type private FAutoResizeViewport: boolean; FCanvas: TCanvas; // only valid at designtime + FDebugContext: boolean; FDoubleBuffered: boolean; FFrameDiffTime: integer; FOnMakeCurrent: TOpenGlCtrlMakeCurrentEvent; @@ -135,6 +137,7 @@ type FSharingOpenGlControls: TList; function GetSharingControls(Index: integer): TCustomOpenGLControl; procedure SetAutoResizeViewport(const AValue: boolean); + procedure SetDebugContext(AValue: boolean); procedure SetDoubleBuffered(const AValue: boolean); procedure SetOpenGLMajorVersion(AValue: Cardinal); procedure SetOpenGLMinorVersion(AValue: Cardinal); @@ -179,6 +182,7 @@ type property AutoResizeViewport: boolean read FAutoResizeViewport write SetAutoResizeViewport default false; property DoubleBuffered: boolean read FDoubleBuffered write SetDoubleBuffered default true; + property DebugContext: boolean read FDebugContext write SetDebugContext default false; // create context with debugging enabled. Requires OpenGLMajorVersion! property RGBA: boolean read FRGBA write SetRGBA default true; {$IFDEF HasRGBBits} property RedBits: Cardinal read FRedBits write SetRedBits default 8; @@ -300,6 +304,13 @@ begin LOpenGLViewport(0,0,Width,Height); end; +procedure TCustomOpenGLControl.SetDebugContext(AValue: boolean); +begin + if FDebugContext=AValue then Exit; + FDebugContext:=AValue; + OpenGLAttributesChanged; +end; + procedure TCustomOpenGLControl.SetDoubleBuffered(const AValue: boolean); begin if FDoubleBuffered=AValue then exit; @@ -632,6 +643,9 @@ begin {$IFDEF HasRGBA} AttrControl.RGBA, {$ENDIF} + {$IFDEF HasDebugContext} + AttrControl.DebugContext, + {$ENDIF} {$IFDEF HasRGBBits} AttrControl.RedBits, AttrControl.GreenBits,