@@ -33,10 +33,10 @@ | |||||
-K$00400000 | -K$00400000 | ||||
-LE"c:\zusatzprogramme\delphi 7\Projects\Bpl" | -LE"c:\zusatzprogramme\delphi 7\Projects\Bpl" | ||||
-LN"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_TYPE | ||||
-w-UNSAFE_CODE | -w-UNSAFE_CODE | ||||
-w-UNSAFE_CAST | -w-UNSAFE_CAST |
@@ -94,7 +94,7 @@ OutputDir= | |||||
UnitOutputDir= | UnitOutputDir= | ||||
PackageDLLOutputDir= | PackageDLLOutputDir= | ||||
PackageDCPOutputDir= | 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 | Packages=rtl;vcl;vclie;xmlrtl;inet;inetdbbde;inetdbxpress;vclx;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;adortl;ibxpress;vclactnband;bdertl;vclshlctrls;dclOfficeXP | ||||
Conditionals= | Conditionals= | ||||
DebugSourceDirs= | DebugSourceDirs= | ||||
@@ -134,5 +134,6 @@ Comments= | |||||
Count=1 | Count=1 | ||||
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; | ||||
[HistoryLists\hlSearchPath] | [HistoryLists\hlSearchPath] | ||||
Count=1 | |||||
Item0=..\..;..\lib | |||||
Count=2 | |||||
Item0=..\..;..\utils | |||||
Item1=..\..;..\lib |
@@ -9,7 +9,6 @@ | |||||
<Title Value="PostProcess"/> | <Title Value="PostProcess"/> | ||||
<ResourceType Value="res"/> | <ResourceType Value="res"/> | ||||
<UseXPManifest Value="True"/> | <UseXPManifest Value="True"/> | ||||
<Icon Value="0"/> | |||||
</General> | </General> | ||||
<i18n> | <i18n> | ||||
<EnableI18N LFM="False"/> | <EnableI18N LFM="False"/> | ||||
@@ -44,7 +43,6 @@ | |||||
<ComponentName Value="MainForm"/> | <ComponentName Value="MainForm"/> | ||||
<HasResources Value="True"/> | <HasResources Value="True"/> | ||||
<ResourceBaseClass Value="Form"/> | <ResourceBaseClass Value="Form"/> | ||||
<UnitName Value="uMainForm"/> | |||||
</Unit1> | </Unit1> | ||||
</Units> | </Units> | ||||
</ProjectOptions> | </ProjectOptions> | ||||
@@ -56,7 +54,7 @@ | |||||
</Target> | </Target> | ||||
<SearchPaths> | <SearchPaths> | ||||
<IncludeFiles Value="$(ProjOutDir)"/> | <IncludeFiles Value="$(ProjOutDir)"/> | ||||
<OtherUnitFiles Value="..\lib;..\.."/> | |||||
<OtherUnitFiles Value="..\utils;..\.."/> | |||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> | ||||
</SearchPaths> | </SearchPaths> | ||||
<Linking> | <Linking> | ||||
@@ -9,7 +9,6 @@ | |||||
<Title Value="SimpleFreeType"/> | <Title Value="SimpleFreeType"/> | ||||
<ResourceType Value="res"/> | <ResourceType Value="res"/> | ||||
<UseXPManifest Value="True"/> | <UseXPManifest Value="True"/> | ||||
<Icon Value="0"/> | |||||
</General> | </General> | ||||
<i18n> | <i18n> | ||||
<EnableI18N LFM="False"/> | <EnableI18N LFM="False"/> | ||||
@@ -44,7 +43,6 @@ | |||||
<ComponentName Value="MainForm"/> | <ComponentName Value="MainForm"/> | ||||
<HasResources Value="True"/> | <HasResources Value="True"/> | ||||
<ResourceBaseClass Value="Form"/> | <ResourceBaseClass Value="Form"/> | ||||
<UnitName Value="uMainForm"/> | |||||
</Unit1> | </Unit1> | ||||
</Units> | </Units> | ||||
</ProjectOptions> | </ProjectOptions> | ||||
@@ -56,7 +54,7 @@ | |||||
</Target> | </Target> | ||||
<SearchPaths> | <SearchPaths> | ||||
<IncludeFiles Value="$(ProjOutDir)"/> | <IncludeFiles Value="$(ProjOutDir)"/> | ||||
<OtherUnitFiles Value="..\lib;..\.."/> | |||||
<OtherUnitFiles Value="..\utils;..\.."/> | |||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> | ||||
</SearchPaths> | </SearchPaths> | ||||
<Linking> | <Linking> | ||||
@@ -9,7 +9,6 @@ | |||||
<Title Value="SimpleGDI"/> | <Title Value="SimpleGDI"/> | ||||
<ResourceType Value="res"/> | <ResourceType Value="res"/> | ||||
<UseXPManifest Value="True"/> | <UseXPManifest Value="True"/> | ||||
<Icon Value="0"/> | |||||
</General> | </General> | ||||
<i18n> | <i18n> | ||||
<EnableI18N LFM="False"/> | <EnableI18N LFM="False"/> | ||||
@@ -44,7 +43,6 @@ | |||||
<ComponentName Value="MainForm"/> | <ComponentName Value="MainForm"/> | ||||
<HasResources Value="True"/> | <HasResources Value="True"/> | ||||
<ResourceBaseClass Value="Form"/> | <ResourceBaseClass Value="Form"/> | ||||
<UnitName Value="uMainForm"/> | |||||
</Unit1> | </Unit1> | ||||
</Units> | </Units> | ||||
</ProjectOptions> | </ProjectOptions> | ||||
@@ -56,7 +54,7 @@ | |||||
</Target> | </Target> | ||||
<SearchPaths> | <SearchPaths> | ||||
<IncludeFiles Value="$(ProjOutDir)"/> | <IncludeFiles Value="$(ProjOutDir)"/> | ||||
<OtherUnitFiles Value="..\lib;..\.."/> | |||||
<OtherUnitFiles Value="..\utils;..\.."/> | |||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> | ||||
</SearchPaths> | </SearchPaths> | ||||
<Linking> | <Linking> | ||||
@@ -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. | |||||
@@ -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. | |||||
@@ -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. | |||||
@@ -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. | |||||