* renamed 3rd party libs (from 'lib' to 'utils')

examples/Delphi/Delphi.cfg

@@ -33,10 +33,10 @@
 -K$00400000
 -LE"c:\zusatzprogramme\delphi 7\Projects\Bpl"
 -LN"c:\zusatzprogramme\delphi 7\Projects\Bpl"
--U"..\..;..\lib"
--O"..\..;..\lib"
--I"..\..;..\lib"
--R"..\..;..\lib"
+-U"..\..;..\utils"
+-O"..\..;..\utils"
+-I"..\..;..\utils"
+-R"..\..;..\utils"
 -w-UNSAFE_TYPE
 -w-UNSAFE_CODE
 -w-UNSAFE_CAST

examples/Delphi/Delphi.dof

@@ -94,7 +94,7 @@ OutputDir=
 UnitOutputDir=
 PackageDLLOutputDir=
 PackageDCPOutputDir=
-SearchPath=..\..;..\lib
+SearchPath=..\..;..\utils
 Packages=rtl;vcl;vclie;xmlrtl;inet;inetdbbde;inetdbxpress;vclx;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;adortl;ibxpress;vclactnband;bdertl;vclshlctrls;dclOfficeXP
 Conditionals=
 DebugSourceDirs=
@@ -134,5 +134,6 @@ Comments=
 Count=1
 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
 [HistoryLists\hlSearchPath]
-Count=1
-Item0=..\..;..\lib
+Count=2
+Item0=..\..;..\utils
+Item1=..\..;..\lib

examples/PostProcess/PostProcess.lpi

@@ -9,7 +9,6 @@
       <Title Value="PostProcess"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>
@@ -44,7 +43,6 @@
         <ComponentName Value="MainForm"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="uMainForm"/>
       </Unit1>
     </Units>
   </ProjectOptions>
@@ -56,7 +54,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="..\lib;..\.."/>
+      <OtherUnitFiles Value="..\utils;..\.."/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Linking>

examples/SimpleFreeType/SimpleFreeType.lpi

@@ -9,7 +9,6 @@
       <Title Value="SimpleFreeType"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>
@@ -44,7 +43,6 @@
         <ComponentName Value="MainForm"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="uMainForm"/>
       </Unit1>
     </Units>
   </ProjectOptions>
@@ -56,7 +54,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="..\lib;..\.."/>
+      <OtherUnitFiles Value="..\utils;..\.."/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Linking>

examples/SimpleGDI/SimpleGDI.lpi

@@ -9,7 +9,6 @@
       <Title Value="SimpleGDI"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>
@@ -44,7 +43,6 @@
         <ComponentName Value="MainForm"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="uMainForm"/>
       </Unit1>
     </Units>
   </ProjectOptions>
@@ -56,7 +54,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="..\lib;..\.."/>
+      <OtherUnitFiles Value="..\utils;..\.."/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Linking>

examples/utils/uglcContext.pas

@@ -0,0 +1,365 @@
+unit uglcContext;
+
+{ Package:      OpenGLCore
+  Prefix:       glc - OpenGL Core
+  Beschreibung: diese Unit enthält eine abstrakte Klassen-Kapselung für OpenGL Kontexte
+
+
+Abstrakte Contextklasse zum Erstellen von Renderkontexten auf Windows & Linux(bzw X11/Gtk2)
+Für aktuelle Plattform passende Klasse kann per GetPlatformClass gefunden werden.
+
+Bsp.:
+  //muss im GUI/Main-Thread aufgerufen werden:
+  pf := TglcContext.GetPlatformClass().MakePF();
+  fContext := TglcContext.GetPlatformClass().Create(MyTWinControl, PF);
+
+  //_kann_ in Background Thread abgerufen werden:
+  fContext.BuildContext();
+  [Arbeit mit dem Context]
+  fContext.CloseContext();
+
+  //im MainThread
+  FreeAndNil(fContext)
+
+
+weitere Funktionen:
+  MakePF()             erzeugt PixelFormatDescriptor mit Defaults
+  BuildContext()       baut Kontext (kann in BackgrounThread aufgerufen werden)
+  CloseContext()       gibt den Kontext frei (muss im selben Thread aufgerufen werden wie BuildContext;
+                       wird der Kontext nur im MainThread genutzt, muss CloseContext nicht explizit aufgerufen
+                       werden und wird beim zerstören des Kontext-Objekts ausgeführt)
+  Activate/Deactiveate Kontext aktiv schalten oder nicht
+  SwapBuffers          DoubleBuffering
+  SetSwapInterval      VSync
+  Share                ShareLists
+  EnableDebugOutput    GL-Debug via ARB_debug_output oder AMD_debug_output de/aktivieren
+}
+
+interface
+
+uses
+  SysUtils, Controls, dglOpenGL;
+
+const
+  GLC_CONTEXT_VERSION_UNKNOWN = -1;
+
+type
+{$IFNDEF fpc}
+  TThreadID = Cardinal;
+{$ENDIF}
+
+  TMultiSample = 1..high(byte);
+  TglcContextPixelFormatSettings = packed record
+    DoubleBuffered: boolean;
+    Stereo: boolean;
+    MultiSampling: TMultiSample;
+    ColorBits: Integer;
+    DepthBits: Integer;
+    StencilBits: Integer;
+    AccumBits: Integer;
+    AuxBuffers: Integer;
+    Layer: Integer;
+  end;
+  TglcContextVersionSettings = packed record
+    Major: Integer;
+    Minor: Integer;
+    ForwardCompatible: Boolean;
+  end;
+  TSeverity = (svLow, svMedium, svHigh);
+  TLogEvent = procedure(const aSender: TObject; const aSeverity: TSeverity; const aMsg: String) of Object;
+
+  TglcDisplayFlag = (
+    dfFullscreen);
+  TglcDisplayFlags = set of TglcDisplayFlag;
+
+  EGLError = class(Exception);
+
+  { TglcContext }
+  TglcContextClass = class of TglcContext;
+  TglcContext = class
+  private
+    fControl: TWinControl;
+    fThreadID: TThreadID;
+    fEnableVsync: Boolean;
+    fLogEvent: TLogEvent;
+
+    function GetEnableVSync: Boolean;
+    procedure SetEnableVSync(aValue: Boolean);
+    procedure LogMsg(const aSeverity: TSeverity; const aMsg: String);
+    procedure SetDebugMode(const aEnable: Boolean);
+  protected
+    fUseVersion: Boolean;
+    fPixelFormatSettings: TglcContextPixelFormatSettings;
+    fVersionSettings: TglcContextVersionSettings;
+    procedure OpenContext; virtual;
+
+  public
+    property PixelFormatSettings: TglcContextPixelFormatSettings read fPixelFormatSettings;
+    property VersionSettings:     TglcContextVersionSettings     read fVersionSettings;
+
+    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings); overload; virtual;
+    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings); overload; virtual;
+    destructor Destroy; override;
+
+    property ThreadID:    TThreadID read fThreadID;
+    property EnableVSync: Boolean   read GetEnableVSync write SetEnableVSync;
+
+    procedure BuildContext;
+    procedure EnableDebugOutput(const aLogEvent: TLogEvent);
+    procedure DisableDebugOutput;
+    procedure CloseContext; virtual;
+    procedure Activate; virtual; abstract;
+    procedure Deactivate; virtual; abstract;
+    function IsActive: boolean; virtual; abstract;
+    procedure SwapBuffers; virtual; abstract;
+    procedure SetSwapInterval(const aInterval: GLint); virtual; abstract;
+    function GetSwapInterval: GLint; virtual; abstract;
+    procedure Share(const aContext: TglcContext); virtual; abstract;
+{$IFDEF fpc}
+  private class var
+    fMainContextThreadID: TThreadID;
+  public
+    class property MainContextThreadID: TThreadID read fMainContextThreadID;
+{$ENDIF}
+  public    
+    class function MakePF(DoubleBuffered: boolean = true;
+                          Stereo: boolean=false;
+                          MultiSampling: TMultiSample=1;
+                          ColorBits: Integer=32;
+                          DepthBits: Integer=24;
+                          StencilBits: Integer=0;
+                          AccumBits: Integer=0;
+                          AuxBuffers: Integer=0;
+                          Layer: Integer=0): TglcContextPixelFormatSettings;
+    class function MakeVersion(const aMajor, aMinor: Integer; const aForwardCompatible: Boolean): TglcContextVersionSettings;
+    class function GetPlatformClass: TglcContextClass;
+    class function ChangeDisplaySettings(const aWidth, aHeight,
+      aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean; virtual; abstract;
+    class function IsAnyContextActive: boolean; virtual;
+  end;
+
+implementation
+
+uses
+  {$IFDEF WINDOWS}
+    uglcContextWGL
+  {$ELSE}{$IFDEF WIN32}
+    uglcContextWGL{$IFNDEF fpc}, Windows{$ENDIF}
+  {$ENDIF}{$ENDIF}
+
+  {$IFDEF LINUX}
+    uglcContextGtk2GLX
+  {$ENDIF}
+  ;
+
+{$IFNDEF fpc}
+var
+  fMainContextThreadID: TThreadID;
+{$ENDIF}
+
+procedure GlDebugCallbackARB(source: GLenum; type_: GLenum; id: GLuint; severity: GLenum; {%H-}length: GLsizei; const message_: PGLchar; {%H-}userParam: PGLvoid); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
+var
+  src, typ: String;
+  sv: TSeverity;
+begin
+  case source of
+    GL_DEBUG_SOURCE_API_ARB            : src:= 'API';
+    GL_DEBUG_SOURCE_WINDOW_SYSTEM_ARB  : src:= 'WINDOW';
+    GL_DEBUG_SOURCE_SHADER_COMPILER_ARB: src:= 'SHADER';
+    GL_DEBUG_SOURCE_THIRD_PARTY_ARB    : src:= '3RDPARTY';
+    GL_DEBUG_SOURCE_APPLICATION_ARB    : src:= 'APPLICATION';
+    GL_DEBUG_SOURCE_OTHER_ARB          : src:= 'OTHER';
+  end;
+  src:= 'GL_' + src;
+
+  case type_ of
+    GL_DEBUG_TYPE_ERROR_ARB               : typ:= 'ERROR';
+    GL_DEBUG_TYPE_DEPRECATED_BEHAVIOR_ARB : typ:= 'DEPRECATED';
+    GL_DEBUG_TYPE_UNDEFINED_BEHAVIOR_ARB  : typ:= 'UNDEF BEHAV';
+    GL_DEBUG_TYPE_PORTABILITY_ARB         : typ:= 'PORTABILITY';
+    GL_DEBUG_TYPE_PERFORMANCE_ARB         : typ:= 'PERFORMANCE';
+    GL_DEBUG_TYPE_OTHER_ARB               : typ:= 'OTHER';
+  end;
+
+  case severity of
+    GL_DEBUG_SEVERITY_LOW_ARB:    sv := svLow;
+    GL_DEBUG_SEVERITY_MEDIUM_ARB: sv := svMedium;
+    GL_DEBUG_SEVERITY_HIGH_ARB:   sv := svHigh;
+  end;
+
+  TglcContext(userParam).LogMsg(sv, format('%s [%d] %s',[typ, id, message_]));
+end;
+
+procedure GlDebugCallbackAMD(id: GLuint; category: GLenum; severity: GLenum; {%H-}length: GLsizei; const message_: PGLchar; {%H-}userParam: PGLvoid); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
+var
+  src: String;
+  sv: TSeverity;
+begin
+  case category of
+    GL_DEBUG_CATEGORY_API_ERROR_AMD            : src:= 'API';
+    GL_DEBUG_CATEGORY_WINDOW_SYSTEM_AMD        : src:= 'WINDOW';
+    GL_DEBUG_CATEGORY_DEPRECATION_AMD          : src:= 'SHADER';
+    GL_DEBUG_CATEGORY_UNDEFINED_BEHAVIOR_AMD   : src:= 'UNDEF BEHAV';
+    GL_DEBUG_CATEGORY_PERFORMANCE_AMD          : src:= 'PERFORMANCE';
+    GL_DEBUG_CATEGORY_SHADER_COMPILER_AMD      : src:= 'SHADER';
+    GL_DEBUG_CATEGORY_APPLICATION_AMD          : src:= 'APPLICATION';
+    GL_DEBUG_CATEGORY_OTHER_AMD                : src:= 'OTHER';
+  end;
+  src:= 'GL_' + src;
+
+  case severity of
+    GL_DEBUG_SEVERITY_LOW_AMD:    sv := svLow;
+    GL_DEBUG_SEVERITY_MEDIUM_AMD: sv := svMedium;
+    GL_DEBUG_SEVERITY_HIGH_AMD:   sv := svHigh;
+  end;
+
+  TglcContext(userParam).LogMsg(sv, format('[%d] %s',[id, message_]));
+end;
+
+function TglcContext.GetEnableVSync: Boolean;
+begin
+  result := fEnableVsync;
+end;
+
+procedure TglcContext.SetEnableVSync(aValue: Boolean);
+begin
+  fEnableVsync := aValue;
+  if IsActive then begin
+    if fEnableVsync then
+      SetSwapInterval(1)
+    else
+      SetSwapInterval(0);
+  end;
+end;
+
+procedure TglcContext.LogMsg(const aSeverity: TSeverity; const aMsg: String);
+begin
+  if Assigned(fLogEvent) then
+    fLogEvent(self, aSeverity, aMsg);
+end;
+
+procedure TglcContext.SetDebugMode(const aEnable: Boolean);
+begin
+  // ARB Debug Output
+  if GL_ARB_debug_output then begin
+    glDebugMessageCallbackARB(@GlDebugCallbackARB, self);
+    glDebugMessageControlARB(GL_DONT_CARE, GL_DONT_CARE, GL_DONT_CARE, 0, nil, aEnable);
+    if aEnable then begin
+      glEnable(GL_DEBUG_OUTPUT_SYNCHRONOUS_ARB);
+      glDebugMessageInsertARB(GL_DEBUG_SOURCE_APPLICATION_ARB, GL_DEBUG_TYPE_OTHER_ARB, 0, GL_DEBUG_SEVERITY_LOW_ARB, -1, PGLchar('Attached ARB_debug_output'));
+    end;
+
+  // AMD Debug Output
+  end else if GL_AMD_debug_output then begin
+    glDebugMessageCallbackAMD(@GlDebugCallbackAMD, self);
+    glDebugMessageEnableAMD(GL_DONT_CARE, GL_DONT_CARE, 0, nil, aEnable);
+    if aEnable then
+      glDebugMessageInsertAMD(GL_DEBUG_CATEGORY_OTHER_AMD, GL_DEBUG_SEVERITY_LOW_ARB, 0, -1, PGLchar('Attached ARB_debug_output'));
+  end;
+end;
+
+procedure TglcContext.OpenContext;
+begin
+  fThreadID := GetCurrentThreadId;
+  if fMainContextThreadID = 0 then
+    fMainContextThreadID := fThreadID;
+end;
+
+class function TglcContext.MakePF(DoubleBuffered: boolean; Stereo: boolean; MultiSampling: TMultiSample; ColorBits: Integer;
+  DepthBits: Integer; StencilBits: Integer; AccumBits: Integer; AuxBuffers: Integer; Layer: Integer): TglcContextPixelFormatSettings;
+begin
+  Result.DoubleBuffered:= DoubleBuffered;
+  Result.Stereo:= Stereo;
+  Result.MultiSampling:= MultiSampling;
+  Result.ColorBits:= ColorBits;
+  Result.DepthBits:= DepthBits;
+  Result.StencilBits:= StencilBits;
+  Result.AccumBits:= AccumBits;
+  Result.AuxBuffers:= AuxBuffers;
+  Result.Layer:= Layer;
+end;
+
+class function TglcContext.MakeVersion(const aMajor, aMinor: Integer; const aForwardCompatible: Boolean): TglcContextVersionSettings;
+begin
+  result.Major := aMajor;
+  result.Minor := aMinor;
+  result.ForwardCompatible := aForwardCompatible;
+end;
+
+class function TglcContext.GetPlatformClass: TglcContextClass;
+begin
+  Result := nil;
+  {$IFDEF WINDOWS}
+  Result:= TglcContextWGL;
+  {$ELSE}{$IFDEF WIN32}
+  Result:= TglcContextWGL;
+  {$ENDIF}{$ENDIF}
+  {$IFDEF LINUX}
+  Result:= TglcContextGtk2GLX;
+  {$ENDIF}
+  if not Assigned(result) then
+    raise EGLError.Create('unable to find suitabe context class');
+end;
+
+class function TglcContext.IsAnyContextActive: boolean;
+begin
+  Result:= GetPlatformClass.IsAnyContextActive;
+end;
+
+constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings);
+begin
+  inherited Create;
+  fPixelFormatSettings := aPixelFormatSettings;
+  FControl             := aControl;
+  fThreadID            := 0;
+  fEnableVsync         := false;
+  fUseVersion          := false;
+  InitOpenGL();
+end;
+
+constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings);
+begin
+  Create(aControl, aPixelFormatSettings);
+  fVersionSettings := aVersionSettings;
+  fUseVersion      := true;
+end;
+
+destructor TglcContext.Destroy;
+begin
+  if (GetCurrentThreadId = fMainContextThreadID) then
+    fMainContextThreadID := 0;
+  CloseContext;
+  inherited Destroy;
+end;
+
+procedure TglcContext.BuildContext;
+begin
+  OpenContext;
+  Activate;
+  ReadImplementationProperties;
+  ReadExtensions;
+  SetEnableVSync(fEnableVsync);
+end;
+
+procedure TglcContext.EnableDebugOutput(const aLogEvent: TLogEvent);
+begin
+  fLogEvent := aLogEvent;
+  SetDebugMode(true);
+end;
+
+procedure TglcContext.DisableDebugOutput;
+begin
+  SetDebugMode(false);
+end;
+
+procedure TglcContext.CloseContext;
+begin
+  if fMainContextThreadID = fThreadID then
+    fMainContextThreadID := 0;
+end;
+
+initialization
+  {$IFDEF fpc}TglcContext.{$ENDIF}fMainContextThreadID := 0;
+
+end.
+

examples/utils/uglcContextGtk2GLX.pas

@@ -0,0 +1,572 @@
+unit uglcContextGtk2GLX;
+
+{ Package:      OpenGLCore
+  Prefix:       glc - OpenGL Core
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung für OpenGL Kontexte für Linux
+  Hint:         diese Unit sollte niemals direkt genutzt werden (siehe uglcContext) }
+
+interface
+
+uses
+  SysUtils, Controls, uglcContext, LCLType, XUtil, XLib, gdk2x, gtk2, gdk2, dglOpenGL,
+  LMessages, uglcContextGtkCustomVisual;
+
+type
+  EGLXError = class(EGLError);
+
+  TRenderControl = class(TCustomVisualControl)
+  private
+    fTarget: TWinControl;
+  protected
+    procedure WndProc(var Message: TLMessage); override;
+  public
+    property Target: TWinControl read fTarget write fTarget;
+  end;
+
+  { TglcContextGtk2GLX }
+
+  TglcContextGtk2GLX = class(TglcContext)
+  private
+    FVisual: PXVisualInfo;
+    FDisplay: PDisplay;
+    FWidget: PGtkWidget;
+    FContext: GLXContext;
+    FRenderControl: TRenderControl;
+    procedure UpdateVisual(const aControl: TWinControl);
+  protected
+    procedure OpenContext; override;
+  public
+    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings); override; overload;
+    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings); override; overload;
+    destructor Destroy; override;
+
+    procedure CloseContext; override;
+    procedure Activate; override;
+    procedure Deactivate; override;
+    function IsActive: boolean; override;
+    procedure SwapBuffers; override;
+    procedure SetSwapInterval(const aInterval: GLint); override;
+    procedure Share(const aContext: TglcContext); override;
+
+    class function ChangeDisplaySettings(const aWidth, aHeight,
+      aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean; override;
+    class function IsAnyContextActive: boolean; override;
+  end;
+
+implementation
+
+type
+  TGLIntArray = packed array of GLInt;
+
+{$region messages -fold}
+procedure TRenderControl.WndProc(var Message: TLMessage);
+begin
+  case Message.msg of
+    //LM_ACTIVATEITEM,
+    //LM_CHANGED,
+    //LM_FOCUS,
+    LM_CLICKED,
+    //LM_RELEASED,
+    LM_ENTER,
+    LM_LEAVE,
+    //LM_CHECKRESIZE,
+    //LM_SETEDITABLE,
+    //LM_MOVEWORD,
+    //LM_MOVEPAGE,
+    //LM_MOVETOROW,
+    //LM_MOVETOCOLUMN,
+    //LM_KILLCHAR,
+    //LM_KILLWORD,
+    //LM_KILLLINE,
+    //LM_CLOSEQUERY,
+    //LM_DRAGSTART,
+    //LM_MONTHCHANGED,
+    //LM_YEARCHANGED,
+    //LM_DAYCHANGED,
+    LM_LBUTTONTRIPLECLK,
+    LM_LBUTTONQUADCLK,
+    LM_MBUTTONTRIPLECLK,
+    LM_MBUTTONQUADCLK,
+    LM_RBUTTONTRIPLECLK,
+    LM_RBUTTONQUADCLK,
+    LM_MOUSEENTER,
+    LM_MOUSELEAVE,
+    LM_XBUTTONTRIPLECLK,
+    LM_XBUTTONQUADCLK,
+
+    //SC_SIZE,
+    //SC_MOVE,
+    //SC_MINIMIZE,
+    //SC_MAXIMIZE,
+    //SC_NEXTWINDOW,
+    //SC_PREVWINDOW,
+    //SC_CLOSE,
+    SC_VSCROLL,
+    SC_HSCROLL,
+    SC_MOUSEMENU,
+    SC_KEYMENU,
+    //SC_ARRANGE,
+    //SC_RESTORE,
+    //SC_TASKLIST,
+    //SC_SCREENSAVE,
+    //SC_HOTKEY,
+    //SC_DEFAULT,
+    //SC_MONITORPOWER,
+    //SC_CONTEXTHELP,
+    //SC_SEPARATOR,
+
+    //LM_MOVE,
+    //LM_SIZE,
+    LM_ACTIVATE,
+    LM_SETFOCUS,
+    LM_KILLFOCUS,
+    //LM_ENABLE,
+    //LM_GETTEXTLENGTH,
+    //LM_SHOWWINDOW,
+    //LM_CANCELMODE,
+    //LM_DRAWITEM,
+    //LM_MEASUREITEM,
+    //LM_DELETEITEM,
+    //LM_VKEYTOITEM,
+    //LM_CHARTOITEM,
+    //LM_COMPAREITEM,
+    //LM_WINDOWPOSCHANGING,
+    //LM_WINDOWPOSCHANGED,
+    //LM_NOTIFY,
+    //LM_HELP,
+    //LM_NOTIFYFORMAT,
+    //LM_CONTEXTMENU,
+    //LM_NCCALCSIZE,
+    //LM_NCHITTEST,
+    //LM_NCPAINT,
+    //LM_NCACTIVATE,
+    //LM_GETDLGCODE,
+    LM_NCMOUSEMOVE,
+    LM_NCLBUTTONDOWN,
+    LM_NCLBUTTONUP,
+    LM_NCLBUTTONDBLCLK,
+    LM_KEYDOWN,
+    LM_KEYUP,
+    LM_CHAR,
+    LM_SYSKEYDOWN,
+    LM_SYSKEYUP,
+    LM_SYSCHAR,
+    LM_COMMAND,
+    LM_SYSCOMMAND,
+    LM_TIMER,
+    LM_HSCROLL,
+    LM_VSCROLL,
+    //LM_CTLCOLORMSGBOX,
+    //LM_CTLCOLOREDIT,
+    //LM_CTLCOLORLISTBOX,
+    //LM_CTLCOLORBTN,
+    //LM_CTLCOLORDLG,
+    //LM_CTLCOLORSCROLLBAR,
+    //LM_CTLCOLORSTATIC,
+    LM_MOUSEMOVE,
+    LM_LBUTTONDOWN,
+    LM_LBUTTONUP,
+    LM_LBUTTONDBLCLK,
+    LM_RBUTTONDOWN,
+    LM_RBUTTONUP,
+    LM_RBUTTONDBLCLK,
+    LM_MBUTTONDOWN,
+    LM_MBUTTONUP,
+    LM_MBUTTONDBLCLK,
+    LM_MOUSEWHEEL,
+    LM_XBUTTONDOWN,
+    LM_XBUTTONUP,
+    LM_XBUTTONDBLCLK,
+    //LM_PARENTNOTIFY,
+    //LM_CAPTURECHANGED,
+    //LM_DROPFILES,
+    //LM_SELCHANGE,
+    LM_CUT,
+    LM_COPY,
+    LM_PASTE,
+    //LM_CLEAR,
+    //LM_CONFIGUREEVENT,
+    //LM_EXIT,
+    //LM_QUIT,
+    //LM_NULL,
+    //LM_PAINT,
+    //LM_ERASEBKGND,
+    //LM_SETCURSOR,
+    //LM_SETFONT:
+
+    //CM_ACTIVATE,
+    //CM_DEACTIVATE,
+    //CM_FOCUSCHANGED,
+    //CM_PARENTFONTCHANGED,
+    //CM_PARENTCOLORCHANGED,
+    //CM_HITTEST,
+    //CM_VISIBLECHANGED,
+    //CM_ENABLEDCHANGED,
+    //CM_COLORCHANGED,
+    //CM_FONTCHANGED,
+    //CM_CURSORCHANGED,
+    //CM_TEXTCHANGED,
+    CM_MOUSEENTER,
+    CM_MOUSELEAVE,
+    //CM_MENUCHANGED,
+    //CM_APPSYSCOMMAND,
+    //CM_BUTTONPRESSED,
+    //CM_SHOWINGCHANGED,
+    //CM_ENTER,
+    //CM_EXIT,
+    //CM_DESIGNHITTEST,
+    //CM_ICONCHANGED,
+    //CM_WANTSPECIALKEY,
+    //CM_RELEASE,
+    //CM_FONTCHANGE,
+    //CM_TABSTOPCHANGED,
+    //CM_UIACTIVATE,
+    //CM_CONTROLLISTCHANGE,
+    //CM_GETDATALINK,
+    //CM_CHILDKEY,
+    //CM_HINTSHOW,
+    //CM_SYSFONTCHANGED,
+    //CM_CONTROLCHANGE,
+    //CM_CHANGED,
+    //CM_BORDERCHANGED,
+    //CM_BIDIMODECHANGED,
+    //CM_PARENTBIDIMODECHANGED,
+    //CM_ALLCHILDRENFLIPPED,
+    //CM_ACTIONUPDATE,
+    //CM_ACTIONEXECUTE,
+    //CM_HINTSHOWPAUSE,
+    //CM_DOCKNOTIFICATION,
+    CM_MOUSEWHEEL,
+    //CM_APPSHOWBTNGLYPHCHANGED,
+    //CM_APPSHOWMENUGLYPHCHANGED,
+
+    //CN_BASE,
+    //CN_CHARTOITEM,
+    //CN_COMMAND,
+    //CN_COMPAREITEM,
+    //CN_CTLCOLORBTN,
+    //CN_CTLCOLORDLG,
+    //CN_CTLCOLOREDIT,
+    //CN_CTLCOLORLISTBOX,
+    //CN_CTLCOLORMSGBOX,
+    //CN_CTLCOLORSCROLLBAR,
+    //CN_CTLCOLORSTATIC,
+    //CN_DELETEITEM,
+    //CN_DRAWITEM,
+    CN_HSCROLL,
+    //CN_MEASUREITEM,
+    //CN_PARENTNOTIFY,
+    //CN_VKEYTOITEM,
+    CN_VSCROLL,
+    CN_KEYDOWN,
+    CN_KEYUP,
+    CN_CHAR,
+    CN_SYSKEYUP,
+    CN_SYSKEYDOWN,
+    CN_SYSCHAR,
+    CN_NOTIFY:
+    begin
+      if Assigned(fTarget) then
+        Message.Result := fTarget.Perform(Message.msg, Message.wParam, Message.lParam);
+    end;
+  end;
+  inherited WndProc(Message);
+end;
+
+{$endregion}
+
+function CreateOpenGLContextAttrList(UseFB: boolean; pf: TglcContextPixelFormatSettings): TGLIntArray;
+var
+  p: integer;
+
+  procedure Add(i: integer);
+  begin
+    SetLength(Result, p+1);
+    Result[p]:=i;
+    inc(p);
+  end;
+
+  procedure CreateList;
+  begin
+    if UseFB then begin Add(GLX_X_RENDERABLE); Add(1); end;
+    if pf.DoubleBuffered then begin
+      if UseFB then begin
+        Add(GLX_DOUBLEBUFFER); Add(1);
+      end else
+        Add(GLX_DOUBLEBUFFER);
+    end;
+    if not UseFB and (pf.ColorBits>24) then Add(GLX_RGBA);
+    if UseFB then begin
+      Add(GLX_DRAWABLE_TYPE);
+      Add(GLX_WINDOW_BIT);
+    end;
+    Add(GLX_RED_SIZE);  Add(8);
+    Add(GLX_GREEN_SIZE);  Add(8);
+    Add(GLX_BLUE_SIZE);  Add(8);
+    if pf.ColorBits>24 then
+      Add(GLX_ALPHA_SIZE);  Add(8);
+    Add(GLX_DEPTH_SIZE);  Add(pf.DepthBits);
+    Add(GLX_STENCIL_SIZE);  Add(pf.StencilBits);
+    Add(GLX_AUX_BUFFERS);  Add(pf.AUXBuffers);
+
+    if pf.MultiSampling > 1 then begin
+      Add(GLX_SAMPLE_BUFFERS_ARB); Add(1);
+      Add(GLX_SAMPLES_ARB); Add(pf.MultiSampling);
+    end;
+
+    Add(0); { 0 = X.None (be careful: GLX_NONE is something different) }
+  end;
+
+begin
+  SetLength(Result, 0);
+  p:=0;
+  CreateList;
+end;
+
+function FBglXChooseVisual(dpy:PDisplay; screen:longint; attrib_list:Plongint):PXVisualInfo;
+type
+  PGLXFBConfig = ^GLXFBConfig;
+var
+  FBConfigsCount: integer;
+  FBConfigs: PGLXFBConfig;
+  FBConfig: GLXFBConfig;
+begin
+  Result:= nil;
+  FBConfigsCount:=0;
+  FBConfigs:= glXChooseFBConfig(dpy, screen, attrib_list, @FBConfigsCount);
+  if FBConfigsCount = 0 then
+    exit;
+
+  { just choose the first FB config from the FBConfigs list.
+    More involved selection possible. }
+  FBConfig := FBConfigs^;
+  Result:=glXGetVisualFromFBConfig(dpy, FBConfig);
+end;
+
+
+{ TglcContextGtk2GLX }
+
+procedure TglcContextGtk2GLX.UpdateVisual(const aControl: TWinControl);
+var
+  attrList: TGLIntArray;
+  drawable: PGdkDrawable;
+begin
+  if not Assigned(aControl) then
+    raise EArgumentException.Create('aControl is not assigned');
+
+  {
+    Temporary (realized) widget to get to display
+  }
+  FWidget:= {%H-}PGtkWidget(PtrUInt(aControl.Handle));
+  gtk_widget_realize(FWidget);
+  drawable:= GTK_WIDGET(FWidget)^.window;
+
+  FDisplay:= GDK_WINDOW_XDISPLAY(drawable);
+
+  {
+    Find a suitable visual from PixelFormat using GLX 1.3 FBConfigs or
+    old-style Visuals
+  }
+  if Assigned(glXChooseFBConfig) then begin
+    attrList := CreateOpenGLContextAttrList(true, fPixelFormatSettings);
+    FVisual  := FBglXChooseVisual(FDisplay, DefaultScreen(FDisplay), @attrList[0]);
+    if not Assigned(FVisual) and (fPixelFormatSettings.MultiSampling > 1) then begin
+      fPixelFormatSettings.MultiSampling := 1;
+      attrList := CreateOpenGLContextAttrList(true, fPixelFormatSettings);
+      FVisual  := FBglXChooseVisual(FDisplay, DefaultScreen(FDisplay), @attrList[0]);
+    end;
+  end;
+  if not Assigned(FVisual) then begin
+    attrList := CreateOpenGLContextAttrList(false, fPixelFormatSettings);
+    FVisual  := glXChooseVisual(FDisplay, DefaultScreen(FDisplay), @attrList[0]);
+    if not Assigned(FVisual) and (fPixelFormatSettings.MultiSampling > 1) then begin
+      fPixelFormatSettings.MultiSampling := 1;
+      attrList := CreateOpenGLContextAttrList(false, fPixelFormatSettings);
+      FVisual  := glXChooseVisual(FDisplay, DefaultScreen(FDisplay), @attrList[0]);
+    end;
+  end;
+  if not Assigned(FVisual) then
+    raise EGLXError.Create('choose visual failed');
+
+  {
+    Most widgets inherit the drawable of their parent. In contrast to Windows, descending from
+    TWinControl does not mean it's actually always a window of its own.
+    Famous example: TPanel is just a frame painted on a canvas.
+    Also, the LCL does somethin weird to colormaps in window creation, so we have
+    to use a custom widget here to have full control about visual selection.
+  }
+  FRenderControl:= TRenderControl.Create(aControl, FVisual^.visual^.visualid);
+  try
+    FRenderControl.Parent := aControl;
+    FRenderControl.HandleNeeded;
+    FRenderControl.Target := aControl;
+  except
+    FreeAndNil(FRenderControl);
+    raise;
+  end;
+
+  {
+    Real Widget handle, unrealized!!!
+  }
+  FWidget:= FRenderControl.Widget;
+  gtk_widget_realize(FWidget);
+  drawable:= GTK_WIDGET(FWidget)^.window;
+  FDisplay:= GDK_WINDOW_XDISPLAY(drawable);
+
+  // FRenderControl.Align:= alClient breaks the context or something
+  FRenderControl.BoundsRect := aControl.ClientRect;
+  FRenderControl.Anchors    := [akLeft, akTop, akRight, akBottom];
+end;
+
+procedure TglcContextGtk2GLX.OpenContext;
+var
+  Attribs: array of GLint;
+  tmpContext: GLXContext;
+  glxID: GLXDrawable;
+begin
+  inherited OpenContext;
+
+  if not Assigned(FVisual) then
+    raise EGLXError.Create('Failed to find Visual');
+
+  tmpContext := glXCreateContext(FDisplay, FVisual, nil, true);
+  if fUseVersion and
+     (fVersionSettings.Major <> GLC_CONTEXT_VERSION_UNKNOWN) and
+     (fVersionSettings.Minor <> GLC_CONTEXT_VERSION_UNKNOWN) then
+  begin
+    // Set attributes to describe our requested context
+    SetLength(Attribs, 5);
+    Attribs[0] := WGL_CONTEXT_MAJOR_VERSION_ARB;
+    Attribs[1] := fVersionSettings.Major;
+    Attribs[2] := WGL_CONTEXT_MINOR_VERSION_ARB;
+    Attribs[3] := fVersionSettings.Minor;
+
+    // Add context flag for forward compatible context
+    // Forward compatible means no more support for legacy functions like
+    // immediate mode (glvertex, glrotate, gltranslate, etc.)
+    if fVersionSettings.ForwardCompatible then begin
+      SetLength(Attribs, Length(Attribs)+2);
+      Attribs[4] := WGL_CONTEXT_FLAGS_ARB;
+      Attribs[5] := WGL_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB;
+    end;
+
+    // Attribute flags must be finalized with a zero
+    SetLength(Attribs, 1);
+    Attribs[High(Attribs)] := 0;
+
+    glxID := GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window);
+    glXMakeCurrent(FDisplay, glxID, tmpContext);
+    ReadImplementationProperties;
+    if not Assigned(glXCreateContextAttribsARB) or not GLX_ARB_create_context then begin
+      glXDestroyContext(FDisplay, tmpContext);
+      raise Exception.Create('GLX_ARB_create_context not supported');
+    end;
+    FContext := glXCreateContextAttribsARB(FDisplay, FVisual, nil, true, @Attribs[0]);
+
+    glXDestroyContext(FDisplay, tmpContext);
+  end else
+    FContext := tmpContext;
+
+  if (FContext = nil) then
+    raise EGLXError.Create('Failed to create Context');
+end;
+
+constructor TglcContextGtk2GLX.Create(const aControl: TWinControl;
+  const aPixelFormatSettings: TglcContextPixelFormatSettings);
+begin
+  inherited Create(aControl, aPixelFormatSettings);
+  UpdateVisual(aControl);
+end;
+
+constructor TglcContextGtk2GLX.Create(const aControl: TWinControl;
+  const aPixelFormatSettings: TglcContextPixelFormatSettings;
+  const aVersionSettings: TglcContextVersionSettings);
+begin
+  inherited Create(aControl, aPixelFormatSettings, aVersionSettings);
+  UpdateVisual(aControl);
+end;
+
+destructor TglcContextGtk2GLX.Destroy;
+begin
+  FreeAndNil(FRenderControl);
+  XFree(FVisual);
+  inherited Destroy;
+end;
+
+procedure TglcContextGtk2GLX.CloseContext;
+begin
+  if not Assigned(FWidget) then exit;
+  if Assigned(FContext) then
+    glXDestroyContext(FDisplay, FContext);
+  FreeAndNil(FRenderControl);
+end;
+
+procedure TglcContextGtk2GLX.Activate;
+var
+   glxID: GLXDrawable;
+begin
+  if not Assigned(FWidget) then exit;
+  // make sure the widget is realized
+  gtk_widget_realize(FWidget);
+  if not GTK_WIDGET_REALIZED(FWidget) then exit;
+
+  // make current
+  glxID := GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window);
+  glXMakeCurrent(FDisplay, glxID, FContext);
+end;
+
+procedure TglcContextGtk2GLX.Deactivate;
+var
+   glxID: GLXDrawable;
+begin
+  if not Assigned(FWidget) then exit;
+  glxID := GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window);
+  glXMakeCurrent(FDisplay, glxID, nil);
+end;
+
+function TglcContextGtk2GLX.IsActive: boolean;
+var
+  glxID: GLXDrawable;
+begin
+  glxID := GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window);
+  Result:= (FContext = glXGetCurrentContext()) and
+           Assigned(FWidget) and
+           (glxID = glXGetCurrentDrawable());
+end;
+
+procedure TglcContextGtk2GLX.SwapBuffers;
+var
+  glxID: GLXDrawable;
+begin
+  if not Assigned(FWidget) then exit;
+  glxID := GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window);
+  glXSwapBuffers(FDisplay, glxID);
+end;
+
+procedure TglcContextGtk2GLX.SetSwapInterval(const aInterval: GLint);
+var
+  drawable: PGdkDrawable;
+begin
+  drawable:= GTK_WIDGET(FWidget)^.window;
+  if GLX_EXT_swap_control then
+    glXSwapIntervalEXT(FDisplay, GDK_WINDOW_XWINDOW(drawable), aInterval);
+end;
+
+procedure TglcContextGtk2GLX.Share(const aContext: TglcContext);
+begin
+  raise Exception.Create('not yet implemented');
+end;
+
+class function TglcContextGtk2GLX.{%H-}ChangeDisplaySettings(const aWidth, aHeight,
+  aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean;
+begin
+  raise Exception.Create('not yet implemented');
+end;
+
+class function TglcContextGtk2GLX.IsAnyContextActive: boolean;
+begin
+  Result:= (glXGetCurrentContext()<>nil) and (glXGetCurrentDrawable()<>0);
+end;
+
+end.
+

examples/utils/uglcContextGtkCustomVisual.pas

@@ -0,0 +1,225 @@
+unit uglcContextGtkCustomVisual;
+
+{ Package:      OpenGLCore
+  Prefix:       glc - OpenGL Core
+  Beschreibung: diese Unit enthält Klassen zum Erzeugen von Visuals (unter Linux),
+                auf denen ein OpenGL Kontext erstellt werden kann }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, LCLType, InterfaceBase, LMessages, WSLCLClasses, WSControls,
+  X, XLib, glib2, gdk2, gdk2x, gtk2, Gtk2Def, Gtk2Int;
+
+type
+  TCustomVisualControl = class(TWinControl)
+  private
+    FIntWidget: PGtkWidget;
+    FVisualID: TVisualID;
+  protected
+    function WSCreateHandle({%H-}const WSPrivate: TWSPrivateClass; const AParams: TCreateParams): TLCLIntfHandle;
+    procedure WSBeforeDestroyHandle;
+  public
+    constructor Create(TheOwner: TComponent; const aVisualID: TVisualID); overload;
+    property Widget: PGtkWidget read FIntWidget;
+  end;
+
+
+  TWSCustomVisualControl = class(TWSWinControl)
+  published
+    class function CreateHandle(const AWinControl: TWinControl;
+                                const AParams: TCreateParams): TLCLIntfHandle; override;
+    class procedure DestroyHandle(const AWinControl: TWinControl); override;
+  end;
+
+
+implementation
+
+type
+  PGtkCustomWidget = ^TGtkCustomWidget;
+  TGtkCustomWidget = record
+    darea: TGtkDrawingArea;
+  end;
+
+  PGtkCustomWidgetClass = ^TGtkCustomWidgetClass;
+  TGtkCustomWidgetClass = record
+    parent_class: TGtkDrawingAreaClass;
+  end;
+
+var
+  custom_widget_type: TGtkType = 0;
+  custom_widget_parent_class: Pointer = nil;
+
+function GTK_TYPE_CUSTOM_WIDGET: TGtkType; forward;
+
+
+procedure g_return_if_fail(b: boolean; const Msg: string);
+begin
+  if not b then raise Exception.Create(Msg);
+end;
+
+procedure g_return_if_fail(b: boolean);
+begin
+  g_return_if_fail(b,'');
+end;
+
+function GTK_IS_CUSTOM_WIDGET(obj: Pointer): Boolean;
+begin
+  GTK_IS_CUSTOM_WIDGET:=GTK_CHECK_TYPE(obj,GTK_TYPE_CUSTOM_WIDGET);
+end;
+
+function GTK_CUSTOM_WIDGET(obj: Pointer): PGtkCustomWidget;
+begin
+  g_return_if_fail(GTK_IS_CUSTOM_WIDGET(obj),'');
+  Result:=PGtkCustomWidget(obj);
+end;
+
+procedure gtk_custom_widget_init(custom_widget: PGTypeInstance; theClass: gpointer); cdecl;
+begin
+  if theClass=nil then ;
+  //DebugLn(['gtk_custom_widget_init START']);
+  gtk_widget_set_double_buffered(PGtkWidget(custom_widget),gdkFALSE);
+  GTK_WIDGET_UNSET_FLAGS(PGtkWidget(custom_widget),GTK_NO_WINDOW);
+  //DebugLn(['gtk_custom_widget_init END']);
+end;
+
+procedure gtk_custom_widget_destroy(obj: PGtkObject); cdecl;
+begin
+  g_return_if_fail (obj <>nil,'');
+  g_return_if_fail (GTK_IS_CUSTOM_WIDGET(obj),'');
+
+  if Assigned(GTK_OBJECT_CLASS(custom_widget_parent_class)^.destroy) then
+    GTK_OBJECT_CLASS(custom_widget_parent_class)^.destroy(obj);
+end;
+
+procedure gtk_custom_widget_class_init(klass: Pointer); cdecl;
+var
+  object_class: PGtkObjectClass;
+begin
+  custom_widget_parent_class := gtk_type_class(gtk_drawing_area_get_type());
+  g_return_if_fail(custom_widget_parent_class<>nil,'gtk_custom_widget_class_init parent_class=nil');
+  object_class := PGtkObjectClass(klass);
+  g_return_if_fail(object_class<>nil,'gtk_custom_widget_class_init object_class=nil');
+
+  object_class^.destroy := @gtk_custom_widget_destroy;
+end;
+
+function custom_widget_size_allocateCB(Widget: PGtkWidget; Size: pGtkAllocation;
+  Data: gPointer): GBoolean; cdecl;
+const
+  CallBackDefaultReturn = {$IFDEF GTK2}false{$ELSE}true{$ENDIF};
+var
+  SizeMsg: TLMSize;
+  GtkWidth, GtkHeight: integer;
+  LCLControl: TWinControl;
+begin
+  Result := CallBackDefaultReturn;
+  if not GTK_WIDGET_REALIZED(Widget) then begin
+    // the widget is not yet realized, so this GTK resize was not a user change.
+    // => ignore
+    exit;
+  end;
+  if Size=nil then ;
+  LCLControl:=TWinControl(Data);
+  if LCLControl=nil then exit;
+  //DebugLn(['gtkglarea_size_allocateCB ',DbgSName(LCLControl)]);
+
+  gtk_widget_get_size_request(Widget, @GtkWidth, @GtkHeight);
+
+  SizeMsg.Msg:=0;
+  FillChar(SizeMsg,SizeOf(SizeMsg),0);
+  with SizeMsg do
+  begin
+    Result := 0;
+    Msg := LM_SIZE;
+    SizeType := Size_SourceIsInterface;
+    Width := SmallInt(GtkWidth);
+    Height := SmallInt(GtkHeight);
+  end;
+  //DebugLn(['gtkglarea_size_allocateCB ',GtkWidth,',',GtkHeight]);
+  LCLControl.WindowProc(TLMessage(SizeMsg));
+end;
+
+function GTK_TYPE_CUSTOM_WIDGET: TGtkType;
+const
+  custom_widget_type_name = 'GtkGLArea';
+  custom_widget_info: TGtkTypeInfo = (
+    type_name: custom_widget_type_name;
+    object_size: SizeOf(TGtkCustomWidget);
+    class_size:  SizeOf(TGtkCustomWidgetClass);
+    class_init_func:  @gtk_custom_widget_class_init;
+    object_init_func: @gtk_custom_widget_init;
+    reserved_1: nil;
+    reserved_2: nil;
+    base_class_init_func: nil;
+  );
+begin
+  if (custom_widget_type=0) then begin
+    custom_widget_type:=gtk_type_unique(gtk_drawing_area_get_type(),@custom_widget_info);
+  end;
+  Result:=custom_widget_type;
+end;
+
+{ TCustomVisualControl }
+
+constructor TCustomVisualControl.Create(TheOwner: TComponent; const aVisualID: TVisualID);
+begin
+  inherited Create(TheOwner);
+  FIntWidget:= nil;
+  fVisualID:= aVisualID;
+  SetBounds(0, 0, 200, 200);
+end;
+
+function TCustomVisualControl.WSCreateHandle(const WSPrivate: TWSPrivateClass; const AParams: TCreateParams): TLCLIntfHandle;
+var
+  cmap: PGdkColormap;
+  gdkvis: PGdkVisual;
+begin
+  // is the requested VisualID different from what the widget would get?
+  cmap  := gdk_colormap_get_system;
+  gdkvis:= gdk_colormap_get_visual(cmap);
+  if XVisualIDFromVisual(gdk_x11_visual_get_xvisual(gdkvis)) <> FVisualID then begin
+    gdkvis:= gdkx_visual_get(FVisualID);
+    cmap  := gdk_colormap_new(gdkvis, false);
+  end;
+
+  FIntWidget:= gtk_type_new(GTK_TYPE_CUSTOM_WIDGET);
+  gtk_widget_set_colormap(FIntWidget, cmap);
+
+  Result:= TLCLIntfHandle({%H-}PtrUInt(FIntWidget));
+  PGtkobject(FIntWidget)^.flags:= PGtkobject(FIntWidget)^.flags or GTK_CAN_FOCUS;
+  TGTK2WidgetSet(WidgetSet).FinishCreateHandle(Self,FIntWidget,AParams);
+  g_signal_connect_after(FIntWidget, 'size-allocate', TGTKSignalFunc(@custom_widget_size_allocateCB), Self);
+end;
+
+procedure TCustomVisualControl.WSBeforeDestroyHandle;
+begin
+  if not HandleAllocated then exit;
+end;
+
+
+{ TWSCustomVisualControl }
+
+class function TWSCustomVisualControl.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
+begin
+  if csDesigning in AWinControl.ComponentState then begin
+    // do not use "inherited CreateHandle", because the LCL changes the hierarchy at run time
+    Result:= TWSWinControlClass(ClassParent).CreateHandle(AWinControl,AParams);
+  end else
+    Result:= (AWinControl as TCustomVisualControl).WSCreateHandle(WSPrivate, AParams);
+end;
+
+class procedure TWSCustomVisualControl.DestroyHandle(const AWinControl: TWinControl);
+begin
+  (AWinControl as TCustomVisualControl).WSBeforeDestroyHandle;
+  // do not use "inherited DestroyHandle", because the LCL changes the hierarchy at run time
+  TWSWinControlClass(ClassParent).DestroyHandle(AWinControl);
+end;
+
+initialization
+  RegisterWSComponent(TCustomVisualControl,TWSCustomVisualControl);
+
+end.
+

examples/utils/uglcContextWGL.pas

@@ -0,0 +1,432 @@
+unit uglcContextWGL;
+
+{ Package:      OpenGLCore
+  Prefix:       glc - OpenGL Core
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung für OpenGL Kontexte für Windows
+  Hint:         diese Unit sollte niemals direkt genutzt werden (siehe uglcContext) }
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Windows, uglcContext, dglOpenGL, Controls;
+
+type
+  EWGLError = class(EGLError);
+
+  { TglcContextWGL }
+
+  TglcContextWGL = class(TglcContext)
+  private
+    FDC: HDC;
+    FRC: HGLRC;
+    fHandle: THandle;
+    fPixelFormat: Integer;
+    {%H-}constructor Create(const aControl: TWinControl); overload;
+  protected
+    procedure UpdatePixelFormat;
+    procedure OpenContext; override;
+    function FindPixelFormat: Integer;
+    function FindPixelFormatNoAA: Integer;
+    procedure OpenFromPF(PixelFormat: Integer);
+  public
+    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings); overload; override;
+    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings); overload; override;
+
+    procedure CloseContext; override;
+    procedure Activate; override;
+    procedure Deactivate; override;
+    function IsActive: boolean; override;
+    procedure SwapBuffers; override;
+    procedure SetSwapInterval(const aInterval: GLint); override;
+    function GetSwapInterval: GLint; override;
+    procedure Share(const aContext: TglcContext); override;
+
+    class function ChangeDisplaySettings(const aWidth, aHeight, aBitPerPixel, aFreq: Integer;
+      const aFlags: TglcDisplayFlags): Boolean; override;
+    class function IsAnyContextActive: boolean; override;
+  end;
+
+implementation
+
+{ TglcContextWGL }
+
+constructor TglcContextWGL.Create(const aControl: TWinControl);
+begin
+  inherited Create(aControl, MakePF());
+  fHandle := aControl.Handle;
+end;
+
+procedure TglcContextWGL.UpdatePixelFormat;
+begin
+  fPixelFormat := FindPixelFormat;
+  if (fPixelFormat = 0) then begin
+    // try without MS
+    fPixelFormatSettings.MultiSampling := 1;
+    fPixelFormat := FindPixelFormat;
+  end;
+end;
+
+procedure TglcContextWGL.OpenContext;
+begin
+  inherited OpenContext;
+  OpenFromPF(fPixelFormat);
+end;
+
+function TglcContextWGL.FindPixelFormat: Integer;
+var
+  OldRC: HGLRC; OldDC: HDC;
+  tmpWnd: TForm;
+  tmpContext: TglcContextWGL;
+  pf, i, max: integer;
+  Count: GLuint;
+  PFList, SampleList: array[0..31] of GLint;
+
+  procedure ChoosePF(pPFList, pSampleList: PGLint; MaxCount: integer);
+  var
+    //ARB_Erweiterung vorhanden
+    //|          EXT_Erweiterung vorhanden
+    MultiARBSup, MultiEXTSup: Boolean;
+    //Liste der Integer Attribute
+    IAttrib: array[0..22] of GLint;
+    //Liste der Float Attribute (nur 0, da kein Wert)
+    FAttrib: GLFloat;
+    QueryAtrib, i: Integer;
+    PPosiblePF, PSample: PglInt;
+  begin
+    //Pixelformate mit AA auslesen
+    MultiARBSup := false;
+    MultiEXTSup := false;
+    if WGL_ARB_extensions_string and
+       WGL_ARB_pixel_format and
+       (WGL_ARB_MULTISAMPLE or GL_ARB_MULTISAMPLE) then
+      multiARBSup := true;
+    if WGL_EXT_extensions_string and
+       WGL_EXT_pixel_format and
+       (WGL_EXT_MULTISAMPLE or GL_EXT_MULTISAMPLE) then
+      multiEXTSup := true;
+
+    if multiARBSup then
+      Read_WGL_ARB_pixel_format
+    else if multiEXTSup then
+      Read_WGL_EXT_pixel_format;
+
+    if not (MultiARBSup or MultiEXTSup) then
+      exit;
+
+    IAttrib[00] := WGL_DRAW_TO_WINDOW_ARB;
+    IAttrib[01] := 1;
+
+    IAttrib[02] := WGL_SUPPORT_OPENGL_ARB;
+    IAttrib[03] := 1;
+
+    IAttrib[04] := WGL_DOUBLE_BUFFER_ARB;
+    if (fPixelFormatSettings.DoubleBuffered) then
+      IAttrib[05] := 1
+    else
+      IAttrib[05] := 0;
+
+    IAttrib[06] := WGL_PIXEL_TYPE_ARB;
+    IAttrib[07] := WGL_TYPE_RGBA_ARB;
+
+    IAttrib[08] := WGL_COLOR_BITS_ARB;
+    IAttrib[09] := fPixelFormatSettings.ColorBits;
+
+    IAttrib[10] := WGL_ALPHA_BITS_ARB;
+    IAttrib[11] := 0; //TODO: fPixelFormatSettings.AlphaBits;
+
+    IAttrib[12] := WGL_DEPTH_BITS_ARB;
+    IAttrib[13] := fPixelFormatSettings.DepthBits;
+
+    IAttrib[14] := WGL_STENCIL_BITS_ARB;
+    IAttrib[15] := fPixelFormatSettings.StencilBits;
+
+    IAttrib[16] := WGL_ACCUM_BITS_ARB;
+    IAttrib[17] := fPixelFormatSettings.AccumBits;
+
+    IAttrib[18] := WGL_AUX_BUFFERS_ARB;
+    IAttrib[19] := fPixelFormatSettings.AuxBuffers;
+
+    IAttrib[20] := WGL_SAMPLE_BUFFERS_ARB;
+    IAttrib[21] := 1;
+
+    IAttrib[22] := 0;
+    FAttrib     := 0;
+
+    if multiARBSup then
+      wglChoosePixelFormatARB(tmpContext.FDC, @IAttrib[0], @FAttrib, MaxCount, pPFList, @Count)
+    else if multiEXTSup then
+      wglChoosePixelFormatEXT(tmpContext.FDC, @IAttrib[0], @FAttrib, MaxCount, pPFList, @Count);
+
+    if Count > length(PFList) then
+      Count := length(PFList);
+
+    QueryAtrib := WGL_SAMPLES_ARB;
+    PSample    := pSampleList;
+    PPosiblePF := @PFList[0];
+    for i := 0 to Count-1 do begin
+      if multiARBSup then
+        wglGetPixelFormatAttribivARB(tmpContext.FDC, PPosiblePF^, 0, 1, @QueryAtrib, PSample)
+      else if multiEXTSup then
+        wglGetPixelFormatAttribivEXT(tmpContext.FDC, PPosiblePF^, 0, 1, @QueryAtrib, PSample);
+      inc(PSample);
+      inc(PPosiblePF);
+    end;
+  end;
+begin
+  if (fPixelFormatSettings.MultiSampling = 1) then begin
+    Result := FindPixelFormatNoAA;
+    exit;
+  end;
+  Result := 0;
+  OldDC  := wglGetCurrentDC();
+  OldRC  := wglGetCurrentContext();
+  try
+    tmpWnd     := TForm.Create(nil);
+    tmpContext := TglcContextWGL.Create(tmpWnd);
+    try
+      pf := tmpContext.FindPixelFormatNoAA;
+      tmpContext.OpenFromPF(pf);
+      tmpContext.Activate;
+
+      FillChar({%H-}PFList[0], Length(PFList), 0);
+      FillChar({%H-}SampleList[0], Length(SampleList), 0);
+      ChoosePF(@PFList[0], @SampleList[0], length(SampleList));
+      max := 0;
+      for i := 0 to Count-1 do begin
+        if (max < SampleList[i]) and (SampleList[i] <= fPixelFormatSettings.MultiSampling) and (PFList[i] <> 0) then begin
+          max := SampleList[i];
+          result := PFList[i];
+          if (max = fPixelFormatSettings.MultiSampling) then
+            break;
+        end;
+      end;
+      tmpContext.Deactivate;
+    finally
+      FreeAndNil(tmpContext);
+      FreeAndNil(tmpWnd);
+    end;
+  finally
+    if (OldDC <> 0) and (OldRC <> 0) then
+     ActivateRenderingContext(OldDC, OldRC);
+  end;
+end;
+
+function TglcContextWGL.FindPixelFormatNoAA: Integer;
+const
+  MemoryDCs = [OBJ_MEMDC, OBJ_METADC, OBJ_ENHMETADC];
+var
+  //DeviceContext
+  DC: HDC;
+  //Objekttyp des DCs
+  AType: DWord;
+  //Beschreibung zum passenden Pixelformat
+  PFDescriptor: TPixelFormatDescriptor;
+begin
+  result := 0;
+  DC := GetDC(fHandle);
+  if DC = 0 then begin
+    exit;
+  end;
+  FillChar(PFDescriptor{%H-}, SizeOf(PFDescriptor), #0);
+  with PFDescriptor do begin
+    nSize    := SizeOf(PFDescriptor);
+    nVersion := 1;
+    dwFlags  := PFD_SUPPORT_OPENGL;
+    AType    := GetObjectType(DC);
+    if AType = 0 then begin
+      exit;
+    end;
+    if fPixelFormatSettings.DoubleBuffered then
+      dwFlags := dwFlags or PFD_DOUBLEBUFFER;
+    if fPixelFormatSettings.Stereo then
+      dwFlags := dwFlags or PFD_STEREO;
+    if AType in MemoryDCs then
+      dwFlags := dwFlags or PFD_DRAW_TO_BITMAP
+    else
+      dwFlags := dwFlags or PFD_DRAW_TO_WINDOW;
+
+    iPixelType   := PFD_TYPE_RGBA;
+    cColorBits   := fPixelFormatSettings.ColorBits;
+//TODO:    cAlphaBits   := fPixelFormatSettings.AlphaBits;
+    cDepthBits   := fPixelFormatSettings.DepthBits;
+    cStencilBits := fPixelFormatSettings.StencilBits;
+    cAccumBits   := fPixelFormatSettings.AccumBits;
+    cAuxBuffers  := fPixelFormatSettings.AuxBuffers;
+
+    if fPixelFormatSettings.Layer = 0 then
+      iLayerType := PFD_MAIN_PLANE
+    else if fPixelFormatSettings.Layer > 0 then
+      iLayerType := PFD_OVERLAY_PLANE
+    else
+      iLayerType := Byte(PFD_UNDERLAY_PLANE);
+  end;
+  result := ChoosePixelFormat(DC, @PFDescriptor);
+end;
+
+procedure TglcContextWGL.OpenFromPF(PixelFormat: Integer);
+var
+  tmpRC: HGLRC;
+  Attribs: array of GLint;
+  CreateContextAttribs: TwglCreateContextAttribsARB;
+begin
+  if PixelFormat = 0 then begin
+    raise EWGLError.Create('Invalid PixelFormat');
+  end;
+
+  FDC := GetDC(fHandle);
+  if FDC = 0 then begin
+    raise EWGLError.CreateFmt('Cannot create DC on %x',[fHandle]);
+  end;
+
+  if not SetPixelFormat(FDC, PixelFormat, nil) then begin
+    ReleaseDC(fHandle, FDC);
+    raise EWGLError.CreateFmt('Cannot set PF %d on Control %x DC %d',[PixelFormat, fHandle, FDC]);
+  end;
+
+  tmpRC := wglCreateContext(FDC);
+  if tmpRC = 0 then begin
+    ReleaseDC(fHandle, FDC);
+    raise EWGLError.CreateFmt('Cannot create context on Control %x DC %d',[PixelFormat, fHandle, FDC]);
+  end;
+
+  if fUseVersion and
+     (fVersionSettings.Major <> GLC_CONTEXT_VERSION_UNKNOWN) and
+     (fVersionSettings.Minor <> GLC_CONTEXT_VERSION_UNKNOWN) then
+  begin
+    { Code from dglOpenGL.pas (modified) }
+    wglMakeCurrent(FDC, tmpRC);
+
+    // Set attributes to describe our requested context
+    SetLength(Attribs, 5);
+    Attribs[0] := WGL_CONTEXT_MAJOR_VERSION_ARB;
+    Attribs[1] := fVersionSettings.Major;
+    Attribs[2] := WGL_CONTEXT_MINOR_VERSION_ARB;
+    Attribs[3] := fVersionSettings.Minor;
+
+    // Add context flag for forward compatible context
+    // Forward compatible means no more support for legacy functions like
+    // immediate mode (glvertex, glrotate, gltranslate, etc.)
+    if fVersionSettings.ForwardCompatible then begin
+      SetLength(Attribs, Length(Attribs)+2);
+      Attribs[4] := WGL_CONTEXT_FLAGS_ARB;
+      Attribs[5] := WGL_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB;
+    end;
+
+    // Attribute flags must be finalized with a zero
+    Attribs[High(Attribs)] := 0;
+
+    // Get function pointer for new context creation function
+    CreateContextAttribs := TwglCreateContextAttribsARB(wglGetProcAddress('wglCreateContextAttribsARB'));
+    if not Assigned(CreateContextAttribs) then begin
+      wglMakeCurrent(0, 0);
+      wglDeleteContext(tmpRC);
+      ReleaseDC(fHandle, FDC);
+      raise Exception.Create('Could not get function pointer adress for wglCreateContextAttribsARB - OpenGL 3.x and above not supported!');
+    end;
+
+    // Create context
+    FRC := CreateContextAttribs(FDC, 0, @Attribs[0]);
+    if (FRC = 0) then begin
+      wglMakeCurrent(0, 0);
+      wglDeleteContext(tmpRC);
+      ReleaseDC(fHandle, FDC);
+      raise Exception.Create('Could not create the desired OpenGL rendering context!');
+    end;
+
+    wglMakeCurrent(0, 0);
+    wglDeleteContext(tmpRC);
+  end else
+    FRC := tmpRC;
+end;
+
+constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings);
+begin
+  inherited Create(aControl, aPixelFormatSettings);
+  fHandle := aControl.Handle;
+  UpdatePixelFormat;
+end;
+
+constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings);
+begin
+  inherited Create(aControl, aPixelFormatSettings, aVersionSettings);
+  fHandle := aControl.Handle;
+  UpdatePixelFormat;
+end;
+
+procedure TglcContextWGL.CloseContext;
+begin
+  if (FRC <> 0) then begin
+    Deactivate;
+    DestroyRenderingContext(FRC);
+    ReleaseDC(fHandle, FDC);
+    FRC := 0;
+    FDC := 0;
+  end;
+end;
+
+procedure TglcContextWGL.Activate;
+begin
+  ActivateRenderingContext(FDC, FRC);
+end;
+
+procedure TglcContextWGL.Deactivate;
+begin
+  if wglGetCurrentContext()=FRC then
+    DeactivateRenderingContext;
+end;
+
+function TglcContextWGL.IsActive: boolean;
+begin
+  Result:= (FRC <> 0) and
+           (FRC = wglGetCurrentContext()) and
+           (FDC = wglGetCurrentDC());
+end;
+
+procedure TglcContextWGL.SwapBuffers;
+begin
+  Windows.SwapBuffers(FDC);
+end;
+
+procedure TglcContextWGL.SetSwapInterval(const aInterval: GLint);
+begin
+  wglSwapIntervalEXT(aInterval);
+end;
+
+function TglcContextWGL.GetSwapInterval: GLint;
+begin
+  result := wglGetSwapIntervalEXT();
+end;
+
+procedure TglcContextWGL.Share(const aContext: TglcContext);
+begin
+  wglShareLists(FRC, (aContext as TglcContextWGL).FRC);
+end;
+
+class function TglcContextWGL.ChangeDisplaySettings(const aWidth, aHeight,
+  aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean;
+var
+  dm: TDeviceMode;
+  flags: Cardinal;
+begin
+  FillChar(dm{%H-}, SizeOf(dm), 0);
+  with dm do begin
+    dmSize             := SizeOf(dm);
+    dmPelsWidth        := aWidth;
+    dmPelsHeight       := aHeight;
+    dmDisplayFrequency := aFreq;
+    dmBitsPerPel       := aBitPerPixel;
+    dmFields           := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or DM_DISPLAYFREQUENCY;
+  end;
+  flags := 0; //CDS_TEST;
+  if (dfFullscreen in aFlags) then
+    flags := flags or CDS_FULLSCREEN;
+  result := (Windows.ChangeDisplaySettings(dm, flags) = DISP_CHANGE_SUCCESSFUL);
+end;
+
+class function TglcContextWGL.IsAnyContextActive: boolean;
+begin
+  Result:= (wglGetCurrentContext()<>0) and (wglGetCurrentDC()<>0);
+end;
+
+end.
+