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