opengl
/
OpenGLCore
1
0
Форкнуть 0
Код Задачи 0 Pull Request'ы 0 Релизы 0 Вики Активность
Просмотр исходного кода

* refactored share context to be able to support function for gtk2/glx 

* added example: sharecontext
master
Bergmann89 10 лет назад
Родитель
6c785c8545
Сommit
7c766d93b9
13 измененных файлов: 607 добавлений и 26 удалений
Единый вид
Опции Diff
Показать статистику Скачать Patch файл Скачать Diff файл
  1. +82
    -0
      examples/sharecontext/project1.lpi
  2. +21
    -0
      examples/sharecontext/project1.lpr
  3. +142
    -0
      examples/sharecontext/project1.lps
  4. Двоичные данные
     
  5. +19
    -0
      examples/sharecontext/shader.glsl
  6. +45
    -0
      examples/sharecontext/uMainForm.lfm
  7. +155
    -0
      examples/sharecontext/uMainForm.pas
  8. +46
    -0
      examples/simple/project1.lps
  9. Двоичные данные
     
  10. +34
    -0
      examples/vertexarrayobject/project1.lps
  11. Двоичные данные
     
  12. +27
    -10
      uglcContext.pas
  13. +36
    -16
      uglcContextWGL.pas

+ 82
- 0
examples/sharecontext/project1.lpi Просмотреть файл

@@ -0,0 +1,82 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainForm"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir);..\.."/>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

+ 21
- 0
examples/sharecontext/project1.lpr Просмотреть файл

@@ -0,0 +1,21 @@
program project1;

{$mode objfpc}{$H+}

uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, uMainForm
{ you can add units after this };

{$R *.res}

begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.


+ 142
- 0
examples/sharecontext/project1.lps Просмотреть файл

@@ -0,0 +1,142 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="6">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UsageCount Value="21"/>
</Unit0>
<Unit1>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainForm"/>
<IsVisibleTab Value="True"/>
<TopLine Value="96"/>
<CursorPos X="10" Y="110"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\uglcArrayBuffer.pas"/>
<UnitName Value="uglcArrayBuffer"/>
<EditorIndex Value="4"/>
<TopLine Value="38"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\uglcContext.pas"/>
<UnitName Value="uglcContext"/>
<EditorIndex Value="1"/>
<TopLine Value="84"/>
<CursorPos X="17" Y="102"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="..\..\uglcContextWGL.pas"/>
<UnitName Value="uglcContextWGL"/>
<EditorIndex Value="2"/>
<TopLine Value="360"/>
<CursorPos X="15" Y="368"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="..\..\uglcContextGtk2GLX.pas"/>
<UnitName Value="uglcContextGtk2GLX"/>
<EditorIndex Value="3"/>
<TopLine Value="31"/>
<CursorPos X="15" Y="14"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit5>
</Units>
<JumpHistory Count="19" HistoryIndex="18">
<Position1>
<Filename Value="uMainForm.pas"/>
<Caret Line="43" Column="22" TopLine="26"/>
</Position1>
<Position2>
<Filename Value="uMainForm.pas"/>
<Caret Line="26" Column="46" TopLine="8"/>
</Position2>
<Position3>
<Filename Value="uMainForm.pas"/>
<Caret Line="27" Column="46" TopLine="8"/>
</Position3>
<Position4>
<Filename Value="uMainForm.pas"/>
<Caret Line="26" Column="46" TopLine="8"/>
</Position4>
<Position5>
<Filename Value="uMainForm.pas"/>
<Caret Line="18" Column="4" TopLine="8"/>
</Position5>
<Position6>
<Filename Value="uMainForm.pas"/>
<Caret Line="114" Column="19" TopLine="101"/>
</Position6>
<Position7>
<Filename Value="uMainForm.pas"/>
<Caret Line="23" Column="7" TopLine="10"/>
</Position7>
<Position8>
<Filename Value="uMainForm.pas"/>
<Caret Line="60" Column="26" TopLine="48"/>
</Position8>
<Position9>
<Filename Value="..\..\uglcContext.pas"/>
<Caret Line="322" Column="3" TopLine="319"/>
</Position9>
<Position10>
<Filename Value="..\..\uglcContext.pas"/>
<Caret Line="101" Column="18" TopLine="83"/>
</Position10>
<Position11>
<Filename Value="..\..\uglcContext.pas"/>
<Caret Line="281" Column="46" TopLine="89"/>
</Position11>
<Position12>
<Filename Value="..\..\uglcContext.pas"/>
<Caret Line="118" Column="19" TopLine="96"/>
</Position12>
<Position13>
<Filename Value="..\..\uglcContextWGL.pas"/>
<Caret Line="70" Column="3" TopLine="68"/>
</Position13>
<Position14>
<Filename Value="uMainForm.pas"/>
<Caret Line="60" Column="26" TopLine="48"/>
</Position14>
<Position15>
<Filename Value="..\..\uglcContextWGL.pas"/>
<Caret Line="352" Column="30" TopLine="325"/>
</Position15>
<Position16>
<Filename Value="uMainForm.pas"/>
<Caret Line="62" Column="48" TopLine="48"/>
</Position16>
<Position17>
<Filename Value="..\..\uglcContextWGL.pas"/>
<Caret Line="352" Column="30" TopLine="336"/>
</Position17>
<Position18>
<Filename Value="..\..\uglcContextWGL.pas"/>
<Caret Line="34" Column="56" TopLine="16"/>
</Position18>
<Position19>
<Filename Value="uMainForm.pas"/>
<Caret Line="147" Column="23" TopLine="105"/>
</Position19>
</JumpHistory>
</ProjectSession>
</CONFIG>

Двоичные данные
Просмотреть файл


+ 19
- 0
examples/sharecontext/shader.glsl Просмотреть файл

@@ -0,0 +1,19 @@
/* ShaderObject: GL_VERTEX_SHADER */
#version 330
uniform mat4 uModelViewProjMat;
layout(location = 0) in vec3 inPos;
void main(void)
{
gl_Position = vec4(inPos, 1.0);
}

/* ShaderObject: GL_FRAGMENT_SHADER */
#version 330
out vec4 outColor; // ausgegebene Farbe
void main(void)
{
outColor = vec4(1.0, 0.0, 0.0, 1.0);
}

+ 45
- 0
examples/sharecontext/uMainForm.lfm Просмотреть файл

@@ -0,0 +1,45 @@
object MainForm: TMainForm
Left = 465
Height = 460
Top = 217
Width = 683
Caption = 'MainForm'
ClientHeight = 460
ClientWidth = 683
OnCreate = FormCreate
OnDestroy = FormDestroy
OnResize = FormResize
LCLVersion = '1.3'
object LogLB: TListBox
Left = 0
Height = 80
Top = 380
Width = 683
Align = alBottom
ItemHeight = 0
TabOrder = 0
end
object RenderPanel1: TPanel
Left = 144
Height = 200
Top = 40
Width = 200
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 1
end
object RenderPanel2: TPanel
Left = 200
Height = 200
Top = 88
Width = 200
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 2
end
object ApplicationProperties: TApplicationProperties
OnIdle = ApplicationPropertiesIdle
left = 64
top = 24
end
end

+ 155
- 0
examples/sharecontext/uMainForm.pas Просмотреть файл

@@ -0,0 +1,155 @@
unit uMainForm;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
uglcContext, uglcShader, uglcArrayBuffer, uglcTypes;

type
TMainForm = class(TForm)
ApplicationProperties: TApplicationProperties;
LogLB: TListBox;
RenderPanel2: TPanel;
RenderPanel1: TPanel;
procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
private
fContext1: TglcContext;
fContext2: TglcContext;
fShader: TglcShaderProgram;
fVBO: TglcArrayBuffer;
procedure Log(aSender: TObject; const aMsg: String);
procedure Render;
public
{ public declarations }
end;

var
MainForm: TMainForm;

implementation

{$R *.lfm}

uses
dglOpenGL, ugluVector;

const
SHADER_FILE = 'shader.glsl';

LAYOUT_LOCATION_POS = 0;

procedure TMainForm.FormCreate(Sender: TObject);
type
TVertex = packed record
pos: TgluVector3f;
end;
PVertex = ^TVertex;
var
pf: TglcContextPixelFormatSettings;
p: PVertex;
begin
pf := TglcContext.MakePF();
fContext1 := TglcContext.GetPlatformClass.Create(RenderPanel1, pf);
fContext1.BuildContext;

fContext2 := TglcContext.GetPlatformClass.Create(RenderPanel2, pf, fContext1);
fContext2.BuildContext;

fContext1.Activate;

fShader := TglcShaderProgram.Create(@Log);
fShader.LoadFromFile(ExtractFilePath(Application.ExeName) + SHADER_FILE);
fShader.Compile;

fVBO := TglcArrayBuffer.Create(TglcBufferTarget.btArrayBuffer);
fVBO.BufferData(4, sizeof(TVertex), TglcBufferUsage.buStaticDraw, nil);
p := fVBO.MapBuffer(TglcBufferAccess.baWriteOnly);
try
p^.pos := gluVector3f(-0.5, -0.5, 0); inc(p);
p^.pos := gluVector3f( 0.5, -0.5, 0); inc(p);
p^.pos := gluVector3f( 0.5, 0.5, 0); inc(p);
p^.pos := gluVector3f(-0.5, 0.5, 0); inc(p);
finally
fVBO.UnmapBuffer;
end;
end;

procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
begin
Render;
Done := false;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
FreeAndNil(fVBO);
FreeAndNil(fShader);
FreeAndNil(fContext2);
FreeAndNil(fContext1);
end;

procedure TMainForm.FormResize(Sender: TObject);

procedure DoResize(const l, r, w, h: Integer; const aPanel: TPanel; const aContext: TglcContext);
begin
aPanel.SetBounds(l, r, w, h);
if Assigned(aContext) then begin
aContext.Activate;
glViewport(0, 0, w, h);
end;
end;

var
w, h: Integer;
begin
w := (ClientWidth - 24) div 2;
h := LogLB.Top - 16;
DoResize( 8, 8, w, h, RenderPanel1, fContext1);
DoResize(w + 16, 8, w, h, RenderPanel2, fContext2);
end;

procedure TMainForm.Log(aSender: TObject; const aMsg: String);
begin
LogLB.Items.Add(aMsg);
end;

procedure TMainForm.Render;

procedure DoRender;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

fVBO.Bind;
fShader.Enable;

glEnableVertexAttribArray(LAYOUT_LOCATION_POS);
glVertexAttribPointer(LAYOUT_LOCATION_POS, 3, GL_FLOAT, False, 0, nil);

glDrawArrays(GL_QUADS, 0, fVBO.DataCount);

glDisableVertexAttribArray(LAYOUT_LOCATION_POS);

fShader.Disable;
fVBO.Unbind;
end;

begin
fContext1.Activate;
glClearColor(0.1, 0.2, 0.1, 0);
DoRender;
fContext1.SwapBuffers;

fContext2.Activate;
glClearColor(0.1, 0.1, 0.2, 0);
DoRender;
fContext2.SwapBuffers;
end;

end.


+ 46
- 0
examples/simple/project1.lps Просмотреть файл

@@ -0,0 +1,46 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="3">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainForm"/>
<IsVisibleTab Value="True"/>
<TopLine Value="20"/>
<CursorPos X="36" Y="35"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\uglcArrayBuffer.pas"/>
<UnitName Value="uglcArrayBuffer"/>
<EditorIndex Value="1"/>
<TopLine Value="38"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
</Units>
<JumpHistory Count="2" HistoryIndex="1">
<Position1>
<Filename Value="uMainForm.pas"/>
<Caret Line="39" Column="29" TopLine="85"/>
</Position1>
<Position2>
<Filename Value="uMainForm.pas"/>
<Caret Line="43" Column="22" TopLine="26"/>
</Position2>
</JumpHistory>
</ProjectSession>
</CONFIG>

Двоичные данные
Просмотреть файл


+ 34
- 0
examples/vertexarrayobject/project1.lps Просмотреть файл

@@ -0,0 +1,34 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="3">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainForm"/>
<IsVisibleTab Value="True"/>
<TopLine Value="95"/>
<CursorPos X="63" Y="108"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\uglcVertexArrayObject.pas"/>
<IsPartOfProject Value="True"/>
<UsageCount Value="20"/>
</Unit2>
</Units>
<JumpHistory HistoryIndex="-1"/>
</ProjectSession>
</CONFIG>

Двоичные данные
Просмотреть файл


+ 27
- 10
uglcContext.pas Просмотреть файл

@@ -82,6 +82,7 @@ type
fThreadID: TThreadID; fThreadID: TThreadID;
fEnableVsync: Boolean; fEnableVsync: Boolean;
fLogEvent: TLogEvent; fLogEvent: TLogEvent;
fShareContext: TglcContext;


function GetEnableVSync: Boolean; function GetEnableVSync: Boolean;
procedure SetEnableVSync(aValue: Boolean); procedure SetEnableVSync(aValue: Boolean);
@@ -96,9 +97,15 @@ type
public public
property PixelFormatSettings: TglcContextPixelFormatSettings read fPixelFormatSettings; property PixelFormatSettings: TglcContextPixelFormatSettings read fPixelFormatSettings;
property VersionSettings: TglcContextVersionSettings read fVersionSettings; 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;
property ShareContext: TglcContext read fShareContext;

constructor Create(const aControl: TWinControl;
const aPixelFormatSettings: TglcContextPixelFormatSettings;
const aShareContext: TglcContext = nil); overload; virtual;
constructor Create(const aControl: TWinControl;
const aPixelFormatSettings: TglcContextPixelFormatSettings;
const aVersionSettings: TglcContextVersionSettings;
const aShareContext: TglcContext = nil); overload; virtual;
destructor Destroy; override; destructor Destroy; override;


property ThreadID: TThreadID read fThreadID; property ThreadID: TThreadID read fThreadID;
@@ -108,13 +115,13 @@ type
procedure EnableDebugOutput(const aLogEvent: TLogEvent); procedure EnableDebugOutput(const aLogEvent: TLogEvent);
procedure DisableDebugOutput; procedure DisableDebugOutput;
procedure CloseContext; virtual; procedure CloseContext; virtual;
procedure Activate; virtual; abstract;
procedure ReleaseShareContext; virtual;
procedure Activate; virtual;
procedure Deactivate; virtual; abstract; procedure Deactivate; virtual; abstract;
function IsActive: boolean; virtual; abstract; function IsActive: boolean; virtual; abstract;
procedure SwapBuffers; virtual; abstract; procedure SwapBuffers; virtual; abstract;
procedure SetSwapInterval(const aInterval: GLint); virtual; abstract; procedure SetSwapInterval(const aInterval: GLint); virtual; abstract;
function GetSwapInterval: GLint; virtual; abstract; function GetSwapInterval: GLint; virtual; abstract;
procedure Share(const aContext: TglcContext); virtual; abstract;
{$IFDEF fpc} {$IFDEF fpc}
private class var private class var
fMainContextThreadID: TThreadID; fMainContextThreadID: TThreadID;
@@ -306,9 +313,10 @@ begin
Result:= GetPlatformClass.IsAnyContextActive; Result:= GetPlatformClass.IsAnyContextActive;
end; end;


constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings);
constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aShareContext: TglcContext);
begin begin
inherited Create; inherited Create;
fShareContext := aShareContext;
fPixelFormatSettings := aPixelFormatSettings; fPixelFormatSettings := aPixelFormatSettings;
FControl := aControl; FControl := aControl;
fThreadID := 0; fThreadID := 0;
@@ -317,9 +325,9 @@ begin
InitOpenGL(); InitOpenGL();
end; end;


constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings);
constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings; const aShareContext: TglcContext);
begin begin
Create(aControl, aPixelFormatSettings);
Create(aControl, aPixelFormatSettings, aShareContext);
fVersionSettings := aVersionSettings; fVersionSettings := aVersionSettings;
fUseVersion := true; fUseVersion := true;
end; end;
@@ -336,8 +344,6 @@ procedure TglcContext.BuildContext;
begin begin
OpenContext; OpenContext;
Activate; Activate;
ReadImplementationProperties;
ReadExtensions;
SetEnableVSync(fEnableVsync); SetEnableVSync(fEnableVsync);
end; end;


@@ -358,6 +364,17 @@ begin
fMainContextThreadID := 0; fMainContextThreadID := 0;
end; end;


procedure TglcContext.ReleaseShareContext;
begin
fShareContext := nil;
end;

procedure TglcContext.Activate;
begin
ReadImplementationProperties;
ReadExtensions;
end;

initialization initialization
{$IFDEF fpc}TglcContext.{$ENDIF}fMainContextThreadID := 0; {$IFDEF fpc}TglcContext.{$ENDIF}fMainContextThreadID := 0;




+ 36
- 16
uglcContextWGL.pas Просмотреть файл

@@ -29,8 +29,13 @@ type
function FindPixelFormatNoAA: Integer; function FindPixelFormatNoAA: Integer;
procedure OpenFromPF(PixelFormat: Integer); procedure OpenFromPF(PixelFormat: Integer);
public public
constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings); overload; override;
constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings); overload; override;
constructor Create(const aControl: TWinControl;
const aPixelFormatSettings: TglcContextPixelFormatSettings;
const aShareContext: TglcContext = nil); overload; override;
constructor Create(const aControl: TWinControl;
const aPixelFormatSettings: TglcContextPixelFormatSettings;
const aVersionSettings: TglcContextVersionSettings;
const aShareContext: TglcContext = nil); overload; override;


procedure CloseContext; override; procedure CloseContext; override;
procedure Activate; override; procedure Activate; override;
@@ -39,7 +44,6 @@ type
procedure SwapBuffers; override; procedure SwapBuffers; override;
procedure SetSwapInterval(const aInterval: GLint); override; procedure SetSwapInterval(const aInterval: GLint); override;
function GetSwapInterval: GLint; override; function GetSwapInterval: GLint; override;
procedure Share(const aContext: TglcContext); override;


class function ChangeDisplaySettings(const aWidth, aHeight, aBitPerPixel, aFreq: Integer; class function ChangeDisplaySettings(const aWidth, aHeight, aBitPerPixel, aFreq: Integer;
const aFlags: TglcDisplayFlags): Boolean; override; const aFlags: TglcDisplayFlags): Boolean; override;
@@ -266,6 +270,7 @@ end;
procedure TglcContextWGL.OpenFromPF(PixelFormat: Integer); procedure TglcContextWGL.OpenFromPF(PixelFormat: Integer);
var var
tmpRC: HGLRC; tmpRC: HGLRC;
err: DWORD;
Attribs: array of GLint; Attribs: array of GLint;
CreateContextAttribs: TwglCreateContextAttribsARB; CreateContextAttribs: TwglCreateContextAttribsARB;
begin begin
@@ -337,18 +342,27 @@ begin
wglDeleteContext(tmpRC); wglDeleteContext(tmpRC);
end else end else
FRC := tmpRC; FRC := tmpRC;

if Assigned(ShareContext) then begin
if (ShareContext.ClassName <> ClassName) then
raise Exception.Create('share context has invalid type: ' + ShareContext.ClassName);
if not wglShareLists((ShareContext as TglcContextWGL).FRC, FRC) then begin
err := GetLastError();
raise EGLError.Create('wglShareLists failed (' + IntToStr(err) + ') ' + SysErrorMessage(err));
end;
end;
end; end;


constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings);
constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aShareContext: TglcContext);
begin begin
inherited Create(aControl, aPixelFormatSettings);
inherited Create(aControl, aPixelFormatSettings, aShareContext);
fHandle := aControl.Handle; fHandle := aControl.Handle;
UpdatePixelFormat; UpdatePixelFormat;
end; end;


constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings);
constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings; const aShareContext: TglcContext);
begin begin
inherited Create(aControl, aPixelFormatSettings, aVersionSettings);
inherited Create(aControl, aPixelFormatSettings, aVersionSettings, aShareContext);
fHandle := aControl.Handle; fHandle := aControl.Handle;
UpdatePixelFormat; UpdatePixelFormat;
end; end;
@@ -365,14 +379,26 @@ begin
end; end;


procedure TglcContextWGL.Activate; procedure TglcContextWGL.Activate;
var
err: DWORD;
begin begin
ActivateRenderingContext(FDC, FRC);
if (FDC = 0) or (FRC = 0) then
raise Exception.Create('invalid context. did you call build context first?');
if (not wglMakeCurrent(FDC, FRC)) then begin
err := GetLastError;
raise Exception.Create('unable to activate context: (' + IntToStr(err) + ') ' + SysErrorMessage(err));
end;
inherited Activate;
end; end;


procedure TglcContextWGL.Deactivate; procedure TglcContextWGL.Deactivate;
var
err: DWORD;
begin begin
if wglGetCurrentContext()=FRC then
DeactivateRenderingContext;
if (wglGetCurrentContext()=FRC) and not wglMakeCurrent(0, 0) then begin
err := GetLastError;
raise Exception.Create('unable to deactivate context: (' + IntToStr(err) + ') ' + SysErrorMessage(err));
end;
end; end;


function TglcContextWGL.IsActive: boolean; function TglcContextWGL.IsActive: boolean;
@@ -397,12 +423,6 @@ begin
result := wglGetSwapIntervalEXT(); result := wglGetSwapIntervalEXT();
end; end;


procedure TglcContextWGL.Share(const aContext: TglcContext);
begin
if not wglShareLists(FRC, (aContext as TglcContextWGL).FRC) then
raise EGLError.Create('wglShareLists failed: ' + IntToStr(GetLastError()));
end;

class function TglcContextWGL.ChangeDisplaySettings(const aWidth, aHeight, class function TglcContextWGL.ChangeDisplaySettings(const aWidth, aHeight,
aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean; aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean;
var var


Редактирование Предпросмотр
Загрузка…
Отмена
Сохранить