mirror of
https://git.vladimir.cc/vladimir/lazopenglcontextex.git
synced 2026-08-25 17:37:31 +00:00
LazOpenGLContextEx: TOpenGLControl с Qt-бэкендом на QOpenGLWidget
Форк штатного пакета LazOpenGLContext (Lazarus components/opengl). Qt5/Qt6-бэкенд (glqtnativecontext.pas) использует собственный контекст настоящего QOpenGLWidget вместо ручного GLX на winId(): EGL на Wayland, GLX на X11, WGL/CGL на Windows/macOS под ws=qt6. QOpenGLWidget-наследник с paintGL-хуком живёт в маленькой C++-либе csrc/qlclglwidget.cpp (QLCLOpenGLWidget из libQt6Pas — не QOpenGLWidget, а голый QWidget под внешний GLX). Сборка: csrc/Makefile (linux/macos/windows-кросс mingw-w64/windows-native MSYS2, install, install-app) + build-msvc.bat для MSVC-Qt. Либа грузится в рантайме рядом с бинарником приложения. Бэкенды gtk2/gtk3/win32/cocoa скопированы из стока без изменений (юниты переименованы с суффиксом Ex). Детали и нюансы — в README.md. Проверено: EWSDR, спектр/водопад через GL в нативном Wayland (KDE, qt6), живой эфир QO-100. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
Claude Fable 5
@@ -0,0 +1,699 @@
|
||||
{
|
||||
*****************************************************************************
|
||||
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
||||
for details about the license.
|
||||
*****************************************************************************
|
||||
|
||||
Author: Mattias Gaertner
|
||||
|
||||
}
|
||||
unit GLWin32WGLContextEx;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LMessages, Windows, LCLProc, LCLType, gl, Forms, Controls,
|
||||
Win32Int, WSLCLClasses, WSControls, Win32WSControls, Win32Proc, LCLMessageGlue;
|
||||
|
||||
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
|
||||
procedure LOpenGLSwapBuffers(Handle: HWND);
|
||||
function LOpenGLMakeCurrent(Handle: HWND): boolean;
|
||||
function LOpenGLReleaseContext(Handle: HWND): boolean;
|
||||
function LOpenGLCreateContext(AWinControl: TWinControl;
|
||||
WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
|
||||
DoubleBuffered, RGBA, DebugContext: boolean;
|
||||
const RedBits, GreenBits, BlueBits,
|
||||
MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
|
||||
const AParams: TCreateParams): HWND;
|
||||
procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
|
||||
|
||||
procedure InitWGL(RequireWGL_ARB_create_context : boolean);
|
||||
procedure InitOpenGLContextGLWindowClass;
|
||||
|
||||
|
||||
type
|
||||
TWGLControlInfo = record
|
||||
Window: HWND;
|
||||
DC: HDC;
|
||||
PixelFormat: GLUInt;
|
||||
WGLContext: HGLRC;
|
||||
end;
|
||||
PWGLControlInfo = ^TWGLControlInfo;
|
||||
|
||||
var
|
||||
WGLControlInfoAtom: ATOM = 0;
|
||||
|
||||
function AllocWGLControlInfo(Window: HWND): PWGLControlInfo;
|
||||
function DisposeWGLControlInfo(Window: HWND): boolean;
|
||||
function GetWGLControlInfo(Window: HWND): PWGLControlInfo;
|
||||
|
||||
|
||||
const
|
||||
WGL_SAMPLE_BUFFERS_ARB = $2041;
|
||||
WGL_SAMPLES_ARB = $2042;
|
||||
|
||||
// WGL_ARB_pixel_format
|
||||
WGL_NUMBER_PIXEL_FORMATS_ARB = $2000;
|
||||
WGL_DRAW_TO_WINDOW_ARB = $2001;
|
||||
WGL_DRAW_TO_BITMAP_ARB = $2002;
|
||||
WGL_ACCELERATION_ARB = $2003;
|
||||
WGL_NEED_PALETTE_ARB = $2004;
|
||||
WGL_NEED_SYSTEM_PALETTE_ARB = $2005;
|
||||
WGL_SWAP_LAYER_BUFFERS_ARB = $2006;
|
||||
WGL_SWAP_METHOD_ARB = $2007;
|
||||
WGL_NUMBER_OVERLAYS_ARB = $2008;
|
||||
WGL_NUMBER_UNDERLAYS_ARB = $2009;
|
||||
WGL_TRANSPARENT_ARB = $200A;
|
||||
WGL_TRANSPARENT_RED_VALUE_ARB = $2037;
|
||||
WGL_TRANSPARENT_GREEN_VALUE_ARB = $2038;
|
||||
WGL_TRANSPARENT_BLUE_VALUE_ARB = $2039;
|
||||
WGL_TRANSPARENT_ALPHA_VALUE_ARB = $203A;
|
||||
WGL_TRANSPARENT_INDEX_VALUE_ARB = $203B;
|
||||
WGL_SHARE_DEPTH_ARB = $200C;
|
||||
WGL_SHARE_STENCIL_ARB = $200D;
|
||||
WGL_SHARE_ACCUM_ARB = $200E;
|
||||
WGL_SUPPORT_GDI_ARB = $200F;
|
||||
WGL_SUPPORT_OPENGL_ARB = $2010;
|
||||
WGL_DOUBLE_BUFFER_ARB = $2011;
|
||||
WGL_STEREO_ARB = $2012;
|
||||
WGL_PIXEL_TYPE_ARB = $2013;
|
||||
WGL_COLOR_BITS_ARB = $2014;
|
||||
WGL_RED_BITS_ARB = $2015;
|
||||
WGL_RED_SHIFT_ARB = $2016;
|
||||
WGL_GREEN_BITS_ARB = $2017;
|
||||
WGL_GREEN_SHIFT_ARB = $2018;
|
||||
WGL_BLUE_BITS_ARB = $2019;
|
||||
WGL_BLUE_SHIFT_ARB = $201A;
|
||||
WGL_ALPHA_BITS_ARB = $201B;
|
||||
WGL_ALPHA_SHIFT_ARB = $201C;
|
||||
WGL_ACCUM_BITS_ARB = $201D;
|
||||
WGL_ACCUM_RED_BITS_ARB = $201E;
|
||||
WGL_ACCUM_GREEN_BITS_ARB = $201F;
|
||||
WGL_ACCUM_BLUE_BITS_ARB = $2020;
|
||||
WGL_ACCUM_ALPHA_BITS_ARB = $2021;
|
||||
WGL_DEPTH_BITS_ARB = $2022;
|
||||
WGL_STENCIL_BITS_ARB = $2023;
|
||||
WGL_AUX_BUFFERS_ARB = $2024;
|
||||
WGL_NO_ACCELERATION_ARB = $2025;
|
||||
WGL_GENERIC_ACCELERATION_ARB = $2026;
|
||||
WGL_FULL_ACCELERATION_ARB = $2027;
|
||||
WGL_SWAP_EXCHANGE_ARB = $2028;
|
||||
WGL_SWAP_COPY_ARB = $2029;
|
||||
WGL_SWAP_UNDEFINED_ARB = $202A;
|
||||
WGL_TYPE_RGBA_ARB = $202B;
|
||||
WGL_TYPE_COLORINDEX_ARB = $202C;
|
||||
|
||||
// WGL_NV_float_buffer
|
||||
WGL_FLOAT_COMPONENTS_NV = $20B0;
|
||||
WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_R_NV = $20B1;
|
||||
WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RG_NV = $20B2;
|
||||
WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RGB_NV = $20B3;
|
||||
WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RGBA_NV = $20B4;
|
||||
WGL_TEXTURE_FLOAT_R_NV = $20B5;
|
||||
WGL_TEXTURE_FLOAT_RG_NV = $20B6;
|
||||
WGL_TEXTURE_FLOAT_RGB_NV = $20B7;
|
||||
WGL_TEXTURE_FLOAT_RGBA_NV = $20B8;
|
||||
|
||||
// WGL_ARB_pbuffer
|
||||
type
|
||||
HPBUFFERARB = Integer;
|
||||
TGLenum = uint;
|
||||
|
||||
const
|
||||
WGL_DRAW_TO_PBUFFER_ARB = $202D;
|
||||
WGL_MAX_PBUFFER_PIXELS_ARB = $202E;
|
||||
WGL_MAX_PBUFFER_WIDTH_ARB = $202F;
|
||||
WGL_MAX_PBUFFER_HEIGHT_ARB = $2030;
|
||||
WGL_PBUFFER_LARGEST_ARB = $2033;
|
||||
WGL_PBUFFER_WIDTH_ARB = $2034;
|
||||
WGL_PBUFFER_HEIGHT_ARB = $2035;
|
||||
WGL_PBUFFER_LOST_ARB = $2036;
|
||||
|
||||
// WGL_ARB_buffer_region
|
||||
WGL_FRONT_COLOR_BUFFER_BIT_ARB = $00000001;
|
||||
WGL_BACK_COLOR_BUFFER_BIT_ARB = $00000002;
|
||||
WGL_DEPTH_BUFFER_BIT_ARB = $00000004;
|
||||
WGL_STENCIL_BUFFER_BIT_ARB = $00000008;
|
||||
|
||||
WGL_CONTEXT_FLAGS_ARB = $2094;
|
||||
WGL_CONTEXT_DEBUG_BIT_ARB = $0001;
|
||||
|
||||
const
|
||||
opengl32 = 'OpenGL32.dll';
|
||||
glu32 = 'GLU32.dll';
|
||||
|
||||
type
|
||||
PWGLSwap = ^TWGLSwap;
|
||||
_WGLSWAP = packed record
|
||||
hdc: HDC;
|
||||
uiFlags: UINT;
|
||||
end;
|
||||
TWGLSwap = _WGLSWAP;
|
||||
WGLSWAP = _WGLSWAP;
|
||||
|
||||
function wglGetProcAddress(ProcName: PChar): Pointer; stdcall; external opengl32;
|
||||
function wglCopyContext(p1: HGLRC; p2: HGLRC; p3: Cardinal): BOOL; stdcall; external opengl32;
|
||||
function wglCreateContext(DC: HDC): HGLRC; stdcall; external opengl32;
|
||||
function wglCreateLayerContext(p1: HDC; p2: Integer): HGLRC; stdcall; external opengl32;
|
||||
function wglDeleteContext(p1: HGLRC): BOOL; stdcall; external opengl32;
|
||||
function wglDescribeLayerPlane(p1: HDC; p2, p3: Integer; p4: Cardinal; var p5: TLayerPlaneDescriptor): BOOL; stdcall; external opengl32;
|
||||
function wglGetCurrentContext: HGLRC; stdcall; external opengl32;
|
||||
function wglGetCurrentDC: HDC; stdcall; external opengl32;
|
||||
function wglGetLayerPaletteEntries(p1: HDC; p2, p3, p4: Integer; var pcr): Integer; stdcall; external opengl32;
|
||||
function wglMakeCurrent(DC: HDC; p2: HGLRC): BOOL; stdcall; external opengl32;
|
||||
function wglRealizeLayerPalette(p1: HDC; p2: Integer; p3: BOOL): BOOL; stdcall; external opengl32;
|
||||
function wglSetLayerPaletteEntries(p1: HDC; p2, p3, p4: Integer; var pcr): Integer; stdcall; external opengl32;
|
||||
function wglShareLists(p1, p2: HGLRC): BOOL; stdcall; external opengl32;
|
||||
function wglSwapLayerBuffers(p1: HDC; p2: Cardinal): BOOL; stdcall; external opengl32;
|
||||
function wglUseFontBitmapsA(DC: HDC; p2, p3, p4: DWORD): BOOL; stdcall; external opengl32;
|
||||
function wglUseFontOutlinesA (p1: HDC; p2, p3, p4: DWORD; p5, p6: Single; p7: Integer; p8: PGlyphMetricsFloat): BOOL; stdcall; external opengl32;
|
||||
function wglUseFontBitmapsW(DC: HDC; p2, p3, p4: DWORD): BOOL; stdcall; external opengl32;
|
||||
function wglUseFontOutlinesW (p1: HDC; p2, p3, p4: DWORD; p5, p6: Single; p7: Integer; p8: PGlyphMetricsFloat): BOOL; stdcall; external opengl32;
|
||||
function wglUseFontBitmaps(DC: HDC; p2, p3, p4: DWORD): BOOL; stdcall; external opengl32 name 'wglUseFontBitmapsA';
|
||||
function wglUseFontOutlines(p1: HDC; p2, p3, p4: DWORD; p5, p6: Single; p7: Integer; p8: PGlyphMetricsFloat): BOOL; stdcall; external opengl32 name 'wglUseFontOutlinesA';
|
||||
|
||||
var
|
||||
// WGL Extensions ----------------------------
|
||||
WGL_EXT_swap_control: boolean;
|
||||
WGL_ARB_multisample: boolean;
|
||||
WGL_ARB_extensions_string: boolean;
|
||||
WGL_ARB_pixel_format: boolean;
|
||||
WGL_ARB_pbuffer: boolean;
|
||||
WGL_ARB_buffer_region: boolean;
|
||||
WGL_ATI_pixel_format_float: boolean;
|
||||
|
||||
|
||||
// ARB wgl extensions
|
||||
wglCreateContextAttribsARB : function (DC: HDC; hShareContext:HGLRC; attribList:PInteger ):HGLRC;stdcall;
|
||||
wglGetExtensionsStringARB: function(DC: HDC): PChar; stdcall;
|
||||
wglGetPixelFormatAttribivARB: function(DC: HDC; iPixelFormat, iLayerPlane: Integer; nAttributes: TGLenum;
|
||||
const piAttributes: PGLint; piValues : PGLint) : BOOL; stdcall;
|
||||
wglGetPixelFormatAttribfvARB: function(DC: HDC; iPixelFormat, iLayerPlane: Integer; nAttributes: TGLenum;
|
||||
const piAttributes: PGLint; piValues: PGLFloat) : BOOL; stdcall;
|
||||
wglChoosePixelFormatARB: function(DC: HDC; const piAttribIList: PGLint; const pfAttribFList: PGLFloat;
|
||||
nMaxFormats: GLint; piFormats: PGLint; nNumFormats: PGLenum) : BOOL; stdcall;
|
||||
wglCreatePbufferARB: function(DC: HDC; iPixelFormat: Integer; iWidth, iHeight : Integer;
|
||||
const piAttribList: PGLint) : HPBUFFERARB; stdcall;
|
||||
wglGetPbufferDCARB: function(hPbuffer: HPBUFFERARB) : HDC; stdcall;
|
||||
wglReleasePbufferDCARB: function(hPbuffer: HPBUFFERARB; DC: HDC) : Integer; stdcall;
|
||||
wglDestroyPbufferARB: function(hPbuffer: HPBUFFERARB): BOOL; stdcall;
|
||||
wglQueryPbufferARB: function(hPbuffer: HPBUFFERARB; iAttribute : Integer;
|
||||
piValue: PGLint) : BOOL; stdcall;
|
||||
|
||||
wglCreateBufferRegionARB: function(DC: HDC; iLayerPlane: Integer; uType: TGLenum) : Integer; stdcall;
|
||||
wglDeleteBufferRegionARB: procedure(hRegion: Integer); stdcall;
|
||||
wglSaveBufferRegionARB: function(hRegion: Integer; x, y, width, height: Integer): BOOL; stdcall;
|
||||
wglRestoreBufferRegionARB: function(hRegion: Integer; x, y, width, height: Integer;
|
||||
xSrc, ySrc: Integer): BOOL; stdcall;
|
||||
|
||||
// non-ARB wgl extensions
|
||||
wglSwapIntervalEXT: function(interval : Integer) : BOOL; stdcall;
|
||||
wglGetSwapIntervalEXT: function : Integer; stdcall;
|
||||
|
||||
var
|
||||
WGLInitialized: boolean = false;
|
||||
OpenGLContextWindowClassInitialized: boolean = false;
|
||||
OpenGLContextWindowClass: WNDCLASS;
|
||||
|
||||
const
|
||||
DefaultOpenGLContextInitAttrList: array [0..0] of LongInt = (
|
||||
0
|
||||
);
|
||||
|
||||
implementation
|
||||
uses glext;
|
||||
|
||||
function GLGetProcAddress(ProcName: PChar):Pointer;
|
||||
begin
|
||||
Result := wglGetProcAddress(ProcName);
|
||||
end;
|
||||
|
||||
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
|
||||
begin
|
||||
glViewport(Left,Top,Width,Height);
|
||||
end;
|
||||
|
||||
procedure LOpenGLSwapBuffers(Handle: HWND);
|
||||
var
|
||||
Info: PWGLControlInfo;
|
||||
begin
|
||||
Info:=GetWGLControlInfo(Handle);
|
||||
// don't use wglSwapLayerBuffers or wglSwapBuffers!
|
||||
SwapBuffers(Info^.DC);
|
||||
end;
|
||||
|
||||
function LOpenGLMakeCurrent(Handle: HWND): boolean;
|
||||
var
|
||||
Info: PWGLControlInfo;
|
||||
begin
|
||||
Info:=GetWGLControlInfo(Handle);
|
||||
Result:=wglMakeCurrent(Info^.DC,Info^.WGLContext);
|
||||
end;
|
||||
|
||||
function LOpenGLReleaseContext(Handle: HWND): boolean;
|
||||
begin
|
||||
Result:=wglMakeCurrent(0,0);
|
||||
end;
|
||||
|
||||
function GlWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
|
||||
LParam: Windows.LParam): LResult; stdcall;
|
||||
var
|
||||
PaintMsg : TLMPaint;
|
||||
winctrl : TWinControl;
|
||||
begin
|
||||
case Msg of
|
||||
WM_ERASEBKGND: begin
|
||||
Result:=0;
|
||||
end;
|
||||
WM_PAINT: begin
|
||||
winctrl := GetWin32WindowInfo(Window)^.WinControl;
|
||||
if Assigned(winctrl) then begin
|
||||
FillChar(PaintMsg, SizeOf(PaintMsg), 0);
|
||||
PaintMsg.Msg := LM_PAINT;
|
||||
PaintMsg.DC := WParam;
|
||||
DeliverMessage(winctrl, PaintMsg);
|
||||
Result:=PaintMsg.Result;
|
||||
end else
|
||||
Result:=WindowProc(Window, Msg, WParam, LParam);
|
||||
end;
|
||||
else
|
||||
Result:=WindowProc(Window, Msg, WParam, LParam);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
Temp_h_GLRc: HGLRC;
|
||||
Temp_h_Dc: HDC;
|
||||
Temp_h_Wnd: HWND;
|
||||
|
||||
procedure LGlMsDestroyTemporaryWindow; forward;
|
||||
|
||||
procedure LGlMsCreateTemporaryWindow;
|
||||
var
|
||||
PixelFormat: LongInt;
|
||||
pfd: PIXELFORMATDESCRIPTOR;
|
||||
begin
|
||||
Temp_h_Wnd := 0;
|
||||
Temp_h_Dc := 0;
|
||||
Temp_h_GLRc := 0;
|
||||
|
||||
try
|
||||
{ create Temp_H_wnd }
|
||||
Temp_H_wnd := CreateWindowEx(WS_EX_APPWINDOW or WS_EX_WINDOWEDGE,
|
||||
PChar('STATIC'),
|
||||
PChar('temporary window for wgl'),
|
||||
WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN,
|
||||
0, 0, 100, 100,
|
||||
0 { no parent window }, 0 { no menu }, hInstance,
|
||||
nil);
|
||||
if Temp_H_wnd=0 then
|
||||
raise Exception.Create('LGlMsCreateTemporaryWindow CreateWindowEx failed');
|
||||
|
||||
{ create Temp_h_Dc }
|
||||
Temp_h_Dc := GetDC(Temp_h_Wnd);
|
||||
if Temp_h_Dc=0 then
|
||||
raise Exception.Create('LGlMsCreateTemporaryWindow GetDC failed');
|
||||
|
||||
{ create and set PixelFormat (must support OpenGL to be able to
|
||||
later do wglCreateContext) }
|
||||
FillChar(pfd, SizeOf(pfd), 0);
|
||||
with pfd do
|
||||
begin
|
||||
nSize := SizeOf(pfd);
|
||||
nVersion := 1;
|
||||
dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
|
||||
iPixelType := PFD_TYPE_RGBA;
|
||||
iLayerType := PFD_MAIN_PLANE;
|
||||
end;
|
||||
PixelFormat := ChoosePixelFormat(Temp_h_Dc, @pfd);
|
||||
if PixelFormat = 0 then
|
||||
raise Exception.Create('LGlMsCreateTemporaryWindow ChoosePixelFormat failed');
|
||||
|
||||
if not SetPixelFormat(Temp_h_Dc, PixelFormat, @pfd) then
|
||||
raise Exception.Create('LGlMsCreateTemporaryWindow SetPixelFormat failed');
|
||||
|
||||
{ create and make current Temp_h_GLRc }
|
||||
Temp_h_GLRc := wglCreateContext(Temp_h_Dc);
|
||||
if Temp_h_GLRc = 0 then
|
||||
raise Exception.Create('LGlMsCreateTemporaryWindow wglCreateContext failed');
|
||||
|
||||
if not wglMakeCurrent(Temp_h_Dc, Temp_h_GLRc) then
|
||||
raise Exception.Create('LGlMsCreateTemporaryWindow wglMakeCurrent failed');
|
||||
except
|
||||
{ make sure to finalize all partially initialized window parts }
|
||||
LGlMsDestroyTemporaryWindow;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LGlMsDestroyTemporaryWindow;
|
||||
begin
|
||||
if Temp_h_GLRc <> 0 then
|
||||
begin
|
||||
wglMakeCurrent(Temp_h_Dc, 0);
|
||||
wglDeleteContext(Temp_h_GLRc);
|
||||
Temp_h_GLRc := 0;
|
||||
end;
|
||||
|
||||
if Temp_h_Dc <> 0 then
|
||||
begin
|
||||
ReleaseDC(Temp_h_Wnd, Temp_h_Dc);
|
||||
Temp_h_Dc := 0;
|
||||
end;
|
||||
|
||||
if Temp_h_Wnd <> 0 then
|
||||
begin
|
||||
DestroyWindow(Temp_h_Wnd);
|
||||
Temp_h_Wnd := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function LGlMsCreateOpenGLContextAttrList(DoubleBuffered: boolean; RGBA: boolean;
|
||||
const RedBits, GreenBits, BlueBits, MultiSampling, AlphaBits, DepthBits,
|
||||
StencilBits, AUXBuffers: Cardinal): PInteger;
|
||||
var
|
||||
p: integer;
|
||||
|
||||
procedure Add(i: integer);
|
||||
begin
|
||||
if Result<>nil then
|
||||
Result[p]:=i;
|
||||
inc(p);
|
||||
end;
|
||||
|
||||
procedure CreateList;
|
||||
begin
|
||||
Add(WGL_DRAW_TO_WINDOW_ARB); Add(GL_TRUE);
|
||||
Add(WGL_SUPPORT_OPENGL_ARB); Add(GL_TRUE);
|
||||
Add(WGL_ACCELERATION_ARB); Add(WGL_FULL_ACCELERATION_ARB);
|
||||
if DoubleBuffered then
|
||||
begin Add(WGL_DOUBLE_BUFFER_ARB); Add(GL_TRUE); end;
|
||||
Add(WGL_PIXEL_TYPE_ARB);
|
||||
if RGBA then
|
||||
Add(WGL_TYPE_RGBA_ARB)
|
||||
else
|
||||
Add(WGL_TYPE_COLORINDEX_ARB);
|
||||
|
||||
Add(WGL_RED_BITS_ARB); Add(RedBits);
|
||||
Add(WGL_GREEN_BITS_ARB); Add(GreenBits);
|
||||
Add(WGL_BLUE_BITS_ARB); Add(BlueBits);
|
||||
Add(WGL_COLOR_BITS_ARB); Add(RedBits+GreenBits+BlueBits);
|
||||
Add(WGL_ALPHA_BITS_ARB); Add(AlphaBits);
|
||||
Add(WGL_DEPTH_BITS_ARB); Add(DepthBits);
|
||||
Add(WGL_STENCIL_BITS_ARB); Add(StencilBits);
|
||||
Add(WGL_AUX_BUFFERS_ARB); Add(AUXBuffers);
|
||||
if MultiSampling > 1 then
|
||||
begin
|
||||
Add(WGL_SAMPLE_BUFFERS_ARB); Add(1);
|
||||
Add(WGL_SAMPLES_ARB); Add(MultiSampling);
|
||||
end;
|
||||
Add(0); Add(0);
|
||||
end;
|
||||
|
||||
begin
|
||||
Result:=nil;
|
||||
p:=0;
|
||||
CreateList;
|
||||
GetMem(Result,SizeOf(integer)*p);
|
||||
p:=0;
|
||||
CreateList;
|
||||
end;
|
||||
|
||||
function LOpenGLCreateContext(AWinControl: TWinControl;
|
||||
WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
|
||||
DoubleBuffered, RGBA, DebugContext: boolean;
|
||||
const RedBits, GreenBits, BlueBits,
|
||||
MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
|
||||
const AParams: TCreateParams): HWND;
|
||||
var
|
||||
Params: TCreateWindowExParams;
|
||||
pfd: PIXELFORMATDESCRIPTOR;
|
||||
Info, SharedInfo: PWGLControlInfo;
|
||||
|
||||
ReturnedFormats: UINT;
|
||||
VisualAttrList: PInteger;
|
||||
VisualAttrFloat: array [0..1] of Single;
|
||||
MsInitSuccess: WINBOOL;
|
||||
FailReason : string;
|
||||
attribList : array [0..2] of Integer;
|
||||
begin
|
||||
InitWGL( DebugContext );
|
||||
//InitOpenGLContextGLWindowClass;
|
||||
|
||||
// general initialization of Params
|
||||
PrepareCreateWindow(AWinControl, AParams, Params);
|
||||
// customization of Params
|
||||
with Params do begin
|
||||
pClassName := @ClsName;
|
||||
WindowTitle := StrCaption;
|
||||
SubClassWndProc := @GlWindowProc;
|
||||
end;
|
||||
// create window
|
||||
FinishCreateWindow(AWinControl, Params, false);
|
||||
Result := Params.Window;
|
||||
|
||||
// create info
|
||||
Info:=AllocWGLControlInfo(Result);
|
||||
|
||||
// create device context
|
||||
Info^.DC := GetDC(Result);
|
||||
if Info^.DC=0 then
|
||||
raise Exception.Create('LOpenGLCreateContext GetDC failed');
|
||||
|
||||
// get pixelformat
|
||||
FillChar(pfd,SizeOf(pfd),0);
|
||||
with pfd do begin
|
||||
nSize:=sizeOf(pfd);
|
||||
nVersion:=1;
|
||||
dwFlags:=PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL;
|
||||
if DoubleBuffered then
|
||||
dwFlags:=dwFlags or PFD_DOUBLEBUFFER;
|
||||
if RGBA then
|
||||
iPixelType:=PFD_TYPE_RGBA
|
||||
else
|
||||
iPixelType:=PFD_TYPE_COLORINDEX;
|
||||
cColorBits:=RedBits+GreenBits+BlueBits; // color depth
|
||||
cRedBits:=RedBits;
|
||||
cGreenBits:=GreenBits;
|
||||
cBlueBits:=BlueBits;
|
||||
cAlphaBits:=AlphaBits;
|
||||
cDepthBits:=DepthBits; // Z-Buffer
|
||||
cStencilBits:=StencilBits;
|
||||
cAuxBuffers:=AUXBuffers;
|
||||
iLayerType:=PFD_MAIN_PLANE;
|
||||
end;
|
||||
|
||||
MsInitSuccess := false;
|
||||
if (MultiSampling > 1) and WGL_ARB_multisample and WGL_ARB_pixel_format
|
||||
and Assigned(wglChoosePixelFormatARB) then
|
||||
begin
|
||||
VisualAttrList := LGlMsCreateOpenGLContextAttrList(DoubleBuffered, RGBA,
|
||||
RedBits, GreenBits, BlueBits, MultiSampling, AlphaBits, DepthBits,
|
||||
StencilBits, AUXBuffers);
|
||||
try
|
||||
FillChar(VisualAttrFloat, SizeOf(VisualAttrFloat), 0);
|
||||
MsInitSuccess := wglChoosePixelFormatARB(Info^.DC, PGLint(VisualAttrList),
|
||||
@VisualAttrFloat[0], 1, @Info^.PixelFormat, @ReturnedFormats);
|
||||
finally FreeMem(VisualAttrList) end;
|
||||
|
||||
if MsInitSuccess and (ReturnedFormats >= 1) then
|
||||
SetPixelFormat(Info^.DC, Info^.PixelFormat, nil)
|
||||
else
|
||||
MsInitSuccess := false;
|
||||
end;
|
||||
|
||||
if not MsInitSuccess then
|
||||
begin
|
||||
Info^.PixelFormat:=ChoosePixelFormat(Info^.DC,@pfd);
|
||||
if Info^.PixelFormat=0 then
|
||||
raise Exception.Create('LOpenGLCreateContext ChoosePixelFormat failed');
|
||||
|
||||
// set pixel format in device context
|
||||
if not SetPixelFormat(Info^.DC,Info^.PixelFormat,@pfd) then
|
||||
raise Exception.Create('LOpenGLCreateContext SetPixelFormat failed');
|
||||
end;
|
||||
|
||||
// create WGL context
|
||||
Info^.WGLContext:=0;
|
||||
if not DebugContext then
|
||||
begin
|
||||
Info^.WGLContext:=wglCreateContext(Info^.DC);
|
||||
FailReason:='wglCreateContext failed';
|
||||
end
|
||||
else if wglCreateContextAttribsARB = nil then
|
||||
begin
|
||||
FailReason:='wglCreateContextAttribsARB not supported';
|
||||
end
|
||||
else
|
||||
begin
|
||||
// try to create debug context
|
||||
attribList[0]:=WGL_CONTEXT_FLAGS_ARB;
|
||||
attribList[1]:=WGL_CONTEXT_DEBUG_BIT_ARB;
|
||||
attribList[2]:=0;
|
||||
Info^.WGLContext:=wglCreateContextAttribsARB(Info^.DC, 0, @attribList);
|
||||
FailReason:='wglCreateContextAttribsARB failed';
|
||||
end;
|
||||
|
||||
if Info^.WGLContext=0 then
|
||||
raise Exception.CreateFmt('LOpenGLCreateContext: %s', [FailReason]);
|
||||
|
||||
// share context objects
|
||||
if Assigned(SharedControl) then begin
|
||||
SharedInfo:=GetWGLControlInfo(SharedControl.Handle);
|
||||
if Assigned(SharedInfo) then wglShareLists(SharedInfo^.WGLContext, Info^.WGLContext);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
|
||||
var
|
||||
Info: PWGLControlInfo;
|
||||
begin
|
||||
if not AWinControl.HandleAllocated then exit;
|
||||
Info:=GetWGLControlInfo(AWinControl.Handle);
|
||||
if Info=nil then exit;
|
||||
if wglMakeCurrent(Info^.DC,Info^.WGLContext) then begin
|
||||
wglDeleteContext(Info^.WGLContext);
|
||||
Info^.WGLContext:=0;
|
||||
end;
|
||||
if (Info^.DC<>0) then begin
|
||||
ReleaseDC(Info^.Window,Info^.DC);
|
||||
end;
|
||||
DisposeWGLControlInfo(Info^.Window);
|
||||
end;
|
||||
|
||||
procedure InitWGL( RequireWGL_ARB_create_context : boolean );
|
||||
var
|
||||
Buffer: string;
|
||||
|
||||
// Checks if the given Extension string is in Buffer.
|
||||
function CheckExtension(const extension : String) : Boolean;
|
||||
begin
|
||||
Result:=(Pos(extension, Buffer)>0);
|
||||
end;
|
||||
|
||||
begin
|
||||
if WGLInitialized then exit;
|
||||
WGLInitialized:=true;
|
||||
|
||||
try
|
||||
{ to successfully use wglGetExtensionsStringARB (to query e.g. ARB_multisample,
|
||||
needed for MultiSampling), you need to have OpenGL context
|
||||
already initialized. We create a temporary window for this purpose. }
|
||||
LGlMsCreateTemporaryWindow;
|
||||
|
||||
if wglGetCurrentContext() = 0 then
|
||||
raise Exception.Create('Context is not active');
|
||||
|
||||
// ARB wgl extensions
|
||||
Pointer(wglCreateContextAttribsARB) := GLGetProcAddress('wglCreateContextAttribsARB');
|
||||
Pointer(wglGetExtensionsStringARB) := GLGetProcAddress('wglGetExtensionsStringARB');
|
||||
Pointer(wglGetPixelFormatAttribivARB) := GLGetProcAddress('wglGetPixelFormatAttribivARB');
|
||||
Pointer(wglGetPixelFormatAttribfvARB) := GLGetProcAddress('wglGetPixelFormatAttribfvARB');
|
||||
Pointer(wglChoosePixelFormatARB) := GLGetProcAddress('wglChoosePixelFormatARB');
|
||||
|
||||
Pointer(wglCreatePbufferARB) := GLGetProcAddress('wglCreatePbufferARB');
|
||||
Pointer(wglGetPbufferDCARB) := GLGetProcAddress('wglGetPbufferDCARB');
|
||||
Pointer(wglReleasePbufferDCARB) := GLGetProcAddress('wglReleasePbufferDCARB');
|
||||
Pointer(wglDestroyPbufferARB) := GLGetProcAddress('wglDestroyPbufferARB');
|
||||
Pointer(wglQueryPbufferARB) := GLGetProcAddress('wglQueryPbufferARB');
|
||||
|
||||
Pointer(wglCreateBufferRegionARB) := GLGetProcAddress('wglCreateBufferRegionARB');
|
||||
Pointer(wglDeleteBufferRegionARB) := GLGetProcAddress('wglDeleteBufferRegionARB');
|
||||
Pointer(wglSaveBufferRegionARB) := GLGetProcAddress('wglSaveBufferRegionARB');
|
||||
Pointer(wglRestoreBufferRegionARB) := GLGetProcAddress('wglRestoreBufferRegionARB');
|
||||
|
||||
// -EGG- ----------------------------
|
||||
Pointer(wglSwapIntervalEXT) := GLGetProcAddress('wglSwapIntervalEXT');
|
||||
Pointer(wglGetSwapIntervalEXT) := GLGetProcAddress('wglGetSwapIntervalEXT');
|
||||
|
||||
// ARB wgl extensions
|
||||
if Assigned(wglGetExtensionsStringARB) then
|
||||
begin
|
||||
Buffer:=wglGetExtensionsStringARB(Temp_h_Dc);
|
||||
{ Writeln('WGL extensions supported: ', Buffer); }
|
||||
end else
|
||||
Buffer:='';
|
||||
WGL_ARB_multisample:=CheckExtension('WGL_ARB_multisample');
|
||||
WGL_EXT_swap_control:=CheckExtension('WGL_EXT_swap_control');
|
||||
WGL_ARB_buffer_region:=CheckExtension('WGL_ARB_buffer_region');
|
||||
WGL_ARB_extensions_string:=CheckExtension('WGL_ARB_extensions_string');
|
||||
WGL_ARB_pbuffer:=CheckExtension('WGL_ARB_pbuffer ');
|
||||
WGL_ARB_pixel_format:=CheckExtension('WGL_ARB_pixel_format');
|
||||
WGL_ATI_pixel_format_float:=CheckExtension('WGL_ATI_pixel_format_float');
|
||||
except
|
||||
on E: Exception do begin
|
||||
DebugLn('InitWGL ',E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
try
|
||||
if RequireWGL_ARB_create_context then
|
||||
begin
|
||||
if wglGetExtensionsStringARB = nil then
|
||||
raise Exception.Create('InitWGL : wglGetExtensionsStringARB = nil');
|
||||
if not CheckExtension('WGL_ARB_create_context') then
|
||||
begin
|
||||
raise Exception.CreateFmt('InitWGL : WGL_ARB_create_context not found. Version %s Renderer=%s'
|
||||
+ sLineBreak + 'Extensions found:' + sLineBreak + '%s',
|
||||
[String(glGetString(GL_VERSION)), String(glGetString(GL_RENDERER)), Buffer]);
|
||||
end;
|
||||
if wglCreateContextAttribsARB = nil then
|
||||
raise Exception.Create('InitWGL : wglCreateContextAttribsARB = nil');
|
||||
end;
|
||||
finally
|
||||
LGlMsDestroyTemporaryWindow;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure InitOpenGLContextGLWindowClass;
|
||||
begin
|
||||
if OpenGLContextWindowClassInitialized then exit;
|
||||
OpenGLContextWindowClassInitialized:=true;
|
||||
with OpenGLContextWindowClass do begin
|
||||
style:=CS_HREDRAW or CS_VREDRAW or CS_OWNDC;// Redraw On Move, And Own DC For Window
|
||||
lpfnWndProc := @WindowProc; // WndProc Handles Messages
|
||||
cbClsExtra := 0; // No Extra Window Data
|
||||
cbWndExtra := 0; // No Extra Window Data
|
||||
hInstance := System.HInstance; // Set The Instance
|
||||
hIcon := LoadIcon(NULL, IDI_WINLOGO);// Load The Default Icon
|
||||
hCursor := LoadCursor(NULL, IDC_ARROW);// Load The Arrow Pointer
|
||||
hbrBackground:= NULL; // No Background Required For GL
|
||||
lpszMenuName := nil; // We Don't Want A Menu
|
||||
lpszClassName:= 'LazOpenGLContext'; // Set The Class Name
|
||||
end;
|
||||
if RegisterClass(@OpenGLContextWindowClass)=0 then
|
||||
raise Exception.Create('registering OpenGLContextWindowClass failed');
|
||||
end;
|
||||
|
||||
function AllocWGLControlInfo(Window: HWND): PWGLControlInfo;
|
||||
begin
|
||||
New(Result);
|
||||
FillChar(Result^, sizeof(Result^), 0);
|
||||
Result^.Window := Window;
|
||||
if WGLControlInfoAtom=0 then
|
||||
WGLControlInfoAtom := Windows.GlobalAddAtom('WGLControlInfo');
|
||||
Windows.SetProp(Window, PChar(PtrUInt(WGLControlInfoAtom)), PtrUInt(Result));
|
||||
end;
|
||||
|
||||
function DisposeWGLControlInfo(Window: HWND): boolean;
|
||||
var
|
||||
Info: PWGLControlInfo;
|
||||
begin
|
||||
Info := PWGLControlInfo(Windows.GetProp(Window,
|
||||
PChar(PtrUInt(WGLControlInfoAtom))));
|
||||
Result := Windows.RemoveProp(Window, PChar(PtrUInt(WGLControlInfoAtom)))<>0;
|
||||
if Result then begin
|
||||
Dispose(Info);
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetWGLControlInfo(Window: HWND): PWGLControlInfo;
|
||||
begin
|
||||
Result:=PWGLControlInfo(Windows.GetProp(Window,
|
||||
PChar(PtrUInt(WGLControlInfoAtom))));
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user