Browse Source

* refactored share context to be able to support function for gtk2/glx
* added example: sharecontext

Bergmann89 5 years ago
parent
commit
7c766d93b9

+ 82 - 0
examples/sharecontext/project1.lpi

@@ -0,0 +1,82 @@
1
+<?xml version="1.0" encoding="UTF-8"?>
2
+<CONFIG>
3
+  <ProjectOptions>
4
+    <Version Value="9"/>
5
+    <PathDelim Value="\"/>
6
+    <General>
7
+      <SessionStorage Value="InProjectDir"/>
8
+      <MainUnit Value="0"/>
9
+      <Title Value="project1"/>
10
+      <ResourceType Value="res"/>
11
+      <UseXPManifest Value="True"/>
12
+    </General>
13
+    <i18n>
14
+      <EnableI18N LFM="False"/>
15
+    </i18n>
16
+    <VersionInfo>
17
+      <StringTable ProductVersion=""/>
18
+    </VersionInfo>
19
+    <BuildModes Count="1">
20
+      <Item1 Name="Default" Default="True"/>
21
+    </BuildModes>
22
+    <PublishOptions>
23
+      <Version Value="2"/>
24
+    </PublishOptions>
25
+    <RunParams>
26
+      <local>
27
+        <FormatVersion Value="1"/>
28
+      </local>
29
+    </RunParams>
30
+    <RequiredPackages Count="1">
31
+      <Item1>
32
+        <PackageName Value="LCL"/>
33
+      </Item1>
34
+    </RequiredPackages>
35
+    <Units Count="2">
36
+      <Unit0>
37
+        <Filename Value="project1.lpr"/>
38
+        <IsPartOfProject Value="True"/>
39
+      </Unit0>
40
+      <Unit1>
41
+        <Filename Value="uMainForm.pas"/>
42
+        <IsPartOfProject Value="True"/>
43
+        <ComponentName Value="MainForm"/>
44
+        <HasResources Value="True"/>
45
+        <ResourceBaseClass Value="Form"/>
46
+        <UnitName Value="uMainForm"/>
47
+      </Unit1>
48
+    </Units>
49
+  </ProjectOptions>
50
+  <CompilerOptions>
51
+    <Version Value="11"/>
52
+    <PathDelim Value="\"/>
53
+    <Target>
54
+      <Filename Value="project1"/>
55
+    </Target>
56
+    <SearchPaths>
57
+      <IncludeFiles Value="$(ProjOutDir);..\.."/>
58
+      <OtherUnitFiles Value="..\.."/>
59
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
60
+    </SearchPaths>
61
+    <Linking>
62
+      <Options>
63
+        <Win32>
64
+          <GraphicApplication Value="True"/>
65
+        </Win32>
66
+      </Options>
67
+    </Linking>
68
+  </CompilerOptions>
69
+  <Debugging>
70
+    <Exceptions Count="3">
71
+      <Item1>
72
+        <Name Value="EAbort"/>
73
+      </Item1>
74
+      <Item2>
75
+        <Name Value="ECodetoolError"/>
76
+      </Item2>
77
+      <Item3>
78
+        <Name Value="EFOpenError"/>
79
+      </Item3>
80
+    </Exceptions>
81
+  </Debugging>
82
+</CONFIG>

+ 21 - 0
examples/sharecontext/project1.lpr

@@ -0,0 +1,21 @@
1
+program project1;
2
+
3
+{$mode objfpc}{$H+}
4
+
5
+uses
6
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
7
+  cthreads,
8
+  {$ENDIF}{$ENDIF}
9
+  Interfaces, // this includes the LCL widgetset
10
+  Forms, uMainForm
11
+  { you can add units after this };
12
+
13
+{$R *.res}
14
+
15
+begin
16
+  RequireDerivedFormResource := True;
17
+  Application.Initialize;
18
+  Application.CreateForm(TMainForm, MainForm);
19
+  Application.Run;
20
+end.
21
+

+ 142 - 0
examples/sharecontext/project1.lps

@@ -0,0 +1,142 @@
1
+<?xml version="1.0" encoding="UTF-8"?>
2
+<CONFIG>
3
+  <ProjectSession>
4
+    <PathDelim Value="\"/>
5
+    <Version Value="9"/>
6
+    <BuildModes Active="Default"/>
7
+    <Units Count="6">
8
+      <Unit0>
9
+        <Filename Value="project1.lpr"/>
10
+        <IsPartOfProject Value="True"/>
11
+        <UsageCount Value="21"/>
12
+      </Unit0>
13
+      <Unit1>
14
+        <Filename Value="uMainForm.pas"/>
15
+        <IsPartOfProject Value="True"/>
16
+        <ComponentName Value="MainForm"/>
17
+        <HasResources Value="True"/>
18
+        <ResourceBaseClass Value="Form"/>
19
+        <UnitName Value="uMainForm"/>
20
+        <IsVisibleTab Value="True"/>
21
+        <TopLine Value="96"/>
22
+        <CursorPos X="10" Y="110"/>
23
+        <UsageCount Value="21"/>
24
+        <Loaded Value="True"/>
25
+        <LoadedDesigner Value="True"/>
26
+      </Unit1>
27
+      <Unit2>
28
+        <Filename Value="..\..\uglcArrayBuffer.pas"/>
29
+        <UnitName Value="uglcArrayBuffer"/>
30
+        <EditorIndex Value="4"/>
31
+        <TopLine Value="38"/>
32
+        <UsageCount Value="10"/>
33
+        <Loaded Value="True"/>
34
+      </Unit2>
35
+      <Unit3>
36
+        <Filename Value="..\..\uglcContext.pas"/>
37
+        <UnitName Value="uglcContext"/>
38
+        <EditorIndex Value="1"/>
39
+        <TopLine Value="84"/>
40
+        <CursorPos X="17" Y="102"/>
41
+        <UsageCount Value="10"/>
42
+        <Loaded Value="True"/>
43
+      </Unit3>
44
+      <Unit4>
45
+        <Filename Value="..\..\uglcContextWGL.pas"/>
46
+        <UnitName Value="uglcContextWGL"/>
47
+        <EditorIndex Value="2"/>
48
+        <TopLine Value="360"/>
49
+        <CursorPos X="15" Y="368"/>
50
+        <UsageCount Value="10"/>
51
+        <Loaded Value="True"/>
52
+      </Unit4>
53
+      <Unit5>
54
+        <Filename Value="..\..\uglcContextGtk2GLX.pas"/>
55
+        <UnitName Value="uglcContextGtk2GLX"/>
56
+        <EditorIndex Value="3"/>
57
+        <TopLine Value="31"/>
58
+        <CursorPos X="15" Y="14"/>
59
+        <UsageCount Value="10"/>
60
+        <Loaded Value="True"/>
61
+      </Unit5>
62
+    </Units>
63
+    <JumpHistory Count="19" HistoryIndex="18">
64
+      <Position1>
65
+        <Filename Value="uMainForm.pas"/>
66
+        <Caret Line="43" Column="22" TopLine="26"/>
67
+      </Position1>
68
+      <Position2>
69
+        <Filename Value="uMainForm.pas"/>
70
+        <Caret Line="26" Column="46" TopLine="8"/>
71
+      </Position2>
72
+      <Position3>
73
+        <Filename Value="uMainForm.pas"/>
74
+        <Caret Line="27" Column="46" TopLine="8"/>
75
+      </Position3>
76
+      <Position4>
77
+        <Filename Value="uMainForm.pas"/>
78
+        <Caret Line="26" Column="46" TopLine="8"/>
79
+      </Position4>
80
+      <Position5>
81
+        <Filename Value="uMainForm.pas"/>
82
+        <Caret Line="18" Column="4" TopLine="8"/>
83
+      </Position5>
84
+      <Position6>
85
+        <Filename Value="uMainForm.pas"/>
86
+        <Caret Line="114" Column="19" TopLine="101"/>
87
+      </Position6>
88
+      <Position7>
89
+        <Filename Value="uMainForm.pas"/>
90
+        <Caret Line="23" Column="7" TopLine="10"/>
91
+      </Position7>
92
+      <Position8>
93
+        <Filename Value="uMainForm.pas"/>
94
+        <Caret Line="60" Column="26" TopLine="48"/>
95
+      </Position8>
96
+      <Position9>
97
+        <Filename Value="..\..\uglcContext.pas"/>
98
+        <Caret Line="322" Column="3" TopLine="319"/>
99
+      </Position9>
100
+      <Position10>
101
+        <Filename Value="..\..\uglcContext.pas"/>
102
+        <Caret Line="101" Column="18" TopLine="83"/>
103
+      </Position10>
104
+      <Position11>
105
+        <Filename Value="..\..\uglcContext.pas"/>
106
+        <Caret Line="281" Column="46" TopLine="89"/>
107
+      </Position11>
108
+      <Position12>
109
+        <Filename Value="..\..\uglcContext.pas"/>
110
+        <Caret Line="118" Column="19" TopLine="96"/>
111
+      </Position12>
112
+      <Position13>
113
+        <Filename Value="..\..\uglcContextWGL.pas"/>
114
+        <Caret Line="70" Column="3" TopLine="68"/>
115
+      </Position13>
116
+      <Position14>
117
+        <Filename Value="uMainForm.pas"/>
118
+        <Caret Line="60" Column="26" TopLine="48"/>
119
+      </Position14>
120
+      <Position15>
121
+        <Filename Value="..\..\uglcContextWGL.pas"/>
122
+        <Caret Line="352" Column="30" TopLine="325"/>
123
+      </Position15>
124
+      <Position16>
125
+        <Filename Value="uMainForm.pas"/>
126
+        <Caret Line="62" Column="48" TopLine="48"/>
127
+      </Position16>
128
+      <Position17>
129
+        <Filename Value="..\..\uglcContextWGL.pas"/>
130
+        <Caret Line="352" Column="30" TopLine="336"/>
131
+      </Position17>
132
+      <Position18>
133
+        <Filename Value="..\..\uglcContextWGL.pas"/>
134
+        <Caret Line="34" Column="56" TopLine="16"/>
135
+      </Position18>
136
+      <Position19>
137
+        <Filename Value="uMainForm.pas"/>
138
+        <Caret Line="147" Column="23" TopLine="105"/>
139
+      </Position19>
140
+    </JumpHistory>
141
+  </ProjectSession>
142
+</CONFIG>

BIN
examples/sharecontext/project1.res


+ 19 - 0
examples/sharecontext/shader.glsl

@@ -0,0 +1,19 @@
1
+/* ShaderObject: GL_VERTEX_SHADER */
2
+#version 330
3
+uniform mat4 uModelViewProjMat;
4
+layout(location = 0) in vec3 inPos;
5
+ 
6
+void main(void)
7
+{
8
+  gl_Position = vec4(inPos, 1.0);
9
+}
10
+
11
+/* ShaderObject: GL_FRAGMENT_SHADER */
12
+#version 330
13
+ 
14
+out vec4 outColor; // ausgegebene Farbe
15
+ 
16
+void main(void)
17
+{
18
+  outColor = vec4(1.0, 0.0, 0.0, 1.0);
19
+}

+ 45 - 0
examples/sharecontext/uMainForm.lfm

@@ -0,0 +1,45 @@
1
+object MainForm: TMainForm
2
+  Left = 465
3
+  Height = 460
4
+  Top = 217
5
+  Width = 683
6
+  Caption = 'MainForm'
7
+  ClientHeight = 460
8
+  ClientWidth = 683
9
+  OnCreate = FormCreate
10
+  OnDestroy = FormDestroy
11
+  OnResize = FormResize
12
+  LCLVersion = '1.3'
13
+  object LogLB: TListBox
14
+    Left = 0
15
+    Height = 80
16
+    Top = 380
17
+    Width = 683
18
+    Align = alBottom
19
+    ItemHeight = 0
20
+    TabOrder = 0
21
+  end
22
+  object RenderPanel1: TPanel
23
+    Left = 144
24
+    Height = 200
25
+    Top = 40
26
+    Width = 200
27
+    BevelOuter = bvNone
28
+    BorderStyle = bsSingle
29
+    TabOrder = 1
30
+  end
31
+  object RenderPanel2: TPanel
32
+    Left = 200
33
+    Height = 200
34
+    Top = 88
35
+    Width = 200
36
+    BevelOuter = bvNone
37
+    BorderStyle = bsSingle
38
+    TabOrder = 2
39
+  end
40
+  object ApplicationProperties: TApplicationProperties
41
+    OnIdle = ApplicationPropertiesIdle
42
+    left = 64
43
+    top = 24
44
+  end
45
+end

+ 155 - 0
examples/sharecontext/uMainForm.pas

@@ -0,0 +1,155 @@
1
+unit uMainForm;
2
+
3
+{$mode objfpc}{$H+}
4
+
5
+interface
6
+
7
+uses
8
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9
+  uglcContext, uglcShader, uglcArrayBuffer, uglcTypes;
10
+
11
+type
12
+  TMainForm = class(TForm)
13
+    ApplicationProperties: TApplicationProperties;
14
+    LogLB: TListBox;
15
+    RenderPanel2: TPanel;
16
+    RenderPanel1: TPanel;
17
+    procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
18
+    procedure FormCreate(Sender: TObject);
19
+    procedure FormDestroy(Sender: TObject);
20
+    procedure FormResize(Sender: TObject);
21
+  private
22
+    fContext1: TglcContext;
23
+    fContext2: TglcContext;
24
+    fShader: TglcShaderProgram;
25
+    fVBO: TglcArrayBuffer;
26
+    procedure Log(aSender: TObject; const aMsg: String);
27
+    procedure Render;
28
+  public
29
+    { public declarations }
30
+  end;
31
+
32
+var
33
+  MainForm: TMainForm;
34
+
35
+implementation
36
+
37
+{$R *.lfm}
38
+
39
+uses
40
+  dglOpenGL, ugluVector;
41
+
42
+const
43
+  SHADER_FILE  = 'shader.glsl';
44
+
45
+  LAYOUT_LOCATION_POS = 0;
46
+
47
+procedure TMainForm.FormCreate(Sender: TObject);
48
+type
49
+  TVertex = packed record
50
+    pos: TgluVector3f;
51
+  end;
52
+  PVertex = ^TVertex;
53
+var
54
+  pf: TglcContextPixelFormatSettings;
55
+  p: PVertex;
56
+begin
57
+  pf := TglcContext.MakePF();
58
+  fContext1 := TglcContext.GetPlatformClass.Create(RenderPanel1, pf);
59
+  fContext1.BuildContext;
60
+
61
+  fContext2 := TglcContext.GetPlatformClass.Create(RenderPanel2, pf, fContext1);
62
+  fContext2.BuildContext;
63
+
64
+  fContext1.Activate;
65
+
66
+  fShader := TglcShaderProgram.Create(@Log);
67
+  fShader.LoadFromFile(ExtractFilePath(Application.ExeName) + SHADER_FILE);
68
+  fShader.Compile;
69
+
70
+  fVBO := TglcArrayBuffer.Create(TglcBufferTarget.btArrayBuffer);
71
+  fVBO.BufferData(4, sizeof(TVertex), TglcBufferUsage.buStaticDraw, nil);
72
+  p := fVBO.MapBuffer(TglcBufferAccess.baWriteOnly);
73
+  try
74
+    p^.pos := gluVector3f(-0.5, -0.5, 0); inc(p);
75
+    p^.pos := gluVector3f( 0.5, -0.5, 0); inc(p);
76
+    p^.pos := gluVector3f( 0.5,  0.5, 0); inc(p);
77
+    p^.pos := gluVector3f(-0.5,  0.5, 0); inc(p);
78
+  finally
79
+    fVBO.UnmapBuffer;
80
+  end;
81
+end;
82
+
83
+procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
84
+begin
85
+  Render;
86
+  Done := false;
87
+end;
88
+
89
+procedure TMainForm.FormDestroy(Sender: TObject);
90
+begin
91
+  FreeAndNil(fVBO);
92
+  FreeAndNil(fShader);
93
+  FreeAndNil(fContext2);
94
+  FreeAndNil(fContext1);
95
+end;
96
+
97
+procedure TMainForm.FormResize(Sender: TObject);
98
+
99
+  procedure DoResize(const l, r, w, h: Integer; const aPanel: TPanel; const aContext: TglcContext);
100
+  begin
101
+    aPanel.SetBounds(l, r, w, h);
102
+    if Assigned(aContext) then begin
103
+      aContext.Activate;
104
+      glViewport(0, 0, w, h);
105
+    end;
106
+  end;
107
+
108
+var
109
+  w, h: Integer;
110
+begin
111
+  w := (ClientWidth - 24) div 2;
112
+  h := LogLB.Top - 16;
113
+  DoResize(     8, 8, w, h, RenderPanel1, fContext1);
114
+  DoResize(w + 16, 8, w, h, RenderPanel2, fContext2);
115
+end;
116
+
117
+procedure TMainForm.Log(aSender: TObject; const aMsg: String);
118
+begin
119
+  LogLB.Items.Add(aMsg);
120
+end;
121
+
122
+procedure TMainForm.Render;
123
+
124
+  procedure DoRender;
125
+  begin
126
+    glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
127
+
128
+    fVBO.Bind;
129
+    fShader.Enable;
130
+
131
+    glEnableVertexAttribArray(LAYOUT_LOCATION_POS);
132
+    glVertexAttribPointer(LAYOUT_LOCATION_POS, 3, GL_FLOAT, False, 0, nil);
133
+
134
+    glDrawArrays(GL_QUADS, 0, fVBO.DataCount);
135
+
136
+    glDisableVertexAttribArray(LAYOUT_LOCATION_POS);
137
+
138
+    fShader.Disable;
139
+    fVBO.Unbind;
140
+  end;
141
+
142
+begin
143
+  fContext1.Activate;
144
+  glClearColor(0.1, 0.2, 0.1, 0);
145
+  DoRender;
146
+  fContext1.SwapBuffers;
147
+
148
+  fContext2.Activate;
149
+  glClearColor(0.1, 0.1, 0.2, 0);
150
+  DoRender;
151
+  fContext2.SwapBuffers;
152
+end;
153
+
154
+end.
155
+

+ 46 - 0
examples/simple/project1.lps

@@ -0,0 +1,46 @@
1
+<?xml version="1.0" encoding="UTF-8"?>
2
+<CONFIG>
3
+  <ProjectSession>
4
+    <PathDelim Value="\"/>
5
+    <Version Value="9"/>
6
+    <BuildModes Active="Default"/>
7
+    <Units Count="3">
8
+      <Unit0>
9
+        <Filename Value="project1.lpr"/>
10
+        <IsPartOfProject Value="True"/>
11
+        <UsageCount Value="20"/>
12
+      </Unit0>
13
+      <Unit1>
14
+        <Filename Value="uMainForm.pas"/>
15
+        <IsPartOfProject Value="True"/>
16
+        <ComponentName Value="MainForm"/>
17
+        <HasResources Value="True"/>
18
+        <ResourceBaseClass Value="Form"/>
19
+        <UnitName Value="uMainForm"/>
20
+        <IsVisibleTab Value="True"/>
21
+        <TopLine Value="20"/>
22
+        <CursorPos X="36" Y="35"/>
23
+        <UsageCount Value="20"/>
24
+        <Loaded Value="True"/>
25
+      </Unit1>
26
+      <Unit2>
27
+        <Filename Value="..\..\uglcArrayBuffer.pas"/>
28
+        <UnitName Value="uglcArrayBuffer"/>
29
+        <EditorIndex Value="1"/>
30
+        <TopLine Value="38"/>
31
+        <UsageCount Value="10"/>
32
+        <Loaded Value="True"/>
33
+      </Unit2>
34
+    </Units>
35
+    <JumpHistory Count="2" HistoryIndex="1">
36
+      <Position1>
37
+        <Filename Value="uMainForm.pas"/>
38
+        <Caret Line="39" Column="29" TopLine="85"/>
39
+      </Position1>
40
+      <Position2>
41
+        <Filename Value="uMainForm.pas"/>
42
+        <Caret Line="43" Column="22" TopLine="26"/>
43
+      </Position2>
44
+    </JumpHistory>
45
+  </ProjectSession>
46
+</CONFIG>

BIN
examples/simple/project1.res


+ 34 - 0
examples/vertexarrayobject/project1.lps

@@ -0,0 +1,34 @@
1
+<?xml version="1.0" encoding="UTF-8"?>
2
+<CONFIG>
3
+  <ProjectSession>
4
+    <PathDelim Value="\"/>
5
+    <Version Value="9"/>
6
+    <BuildModes Active="Default"/>
7
+    <Units Count="3">
8
+      <Unit0>
9
+        <Filename Value="project1.lpr"/>
10
+        <IsPartOfProject Value="True"/>
11
+        <UsageCount Value="20"/>
12
+      </Unit0>
13
+      <Unit1>
14
+        <Filename Value="uMainForm.pas"/>
15
+        <IsPartOfProject Value="True"/>
16
+        <ComponentName Value="MainForm"/>
17
+        <HasResources Value="True"/>
18
+        <ResourceBaseClass Value="Form"/>
19
+        <UnitName Value="uMainForm"/>
20
+        <IsVisibleTab Value="True"/>
21
+        <TopLine Value="95"/>
22
+        <CursorPos X="63" Y="108"/>
23
+        <UsageCount Value="20"/>
24
+        <Loaded Value="True"/>
25
+      </Unit1>
26
+      <Unit2>
27
+        <Filename Value="..\..\uglcVertexArrayObject.pas"/>
28
+        <IsPartOfProject Value="True"/>
29
+        <UsageCount Value="20"/>
30
+      </Unit2>
31
+    </Units>
32
+    <JumpHistory HistoryIndex="-1"/>
33
+  </ProjectSession>
34
+</CONFIG>

BIN
examples/vertexarrayobject/project1.res


+ 27 - 10
uglcContext.pas

@@ -82,6 +82,7 @@ type
82 82
     fThreadID: TThreadID;
83 83
     fEnableVsync: Boolean;
84 84
     fLogEvent: TLogEvent;
85
+    fShareContext: TglcContext;
85 86
 
86 87
     function GetEnableVSync: Boolean;
87 88
     procedure SetEnableVSync(aValue: Boolean);
@@ -96,9 +97,15 @@ type
96 97
   public
97 98
     property PixelFormatSettings: TglcContextPixelFormatSettings read fPixelFormatSettings;
98 99
     property VersionSettings:     TglcContextVersionSettings     read fVersionSettings;
99
-
100
-    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings); overload; virtual;
101
-    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings); overload; virtual;
100
+    property ShareContext:        TglcContext                    read fShareContext;
101
+
102
+    constructor Create(const aControl: TWinControl;
103
+                       const aPixelFormatSettings: TglcContextPixelFormatSettings;
104
+                       const aShareContext: TglcContext = nil); overload; virtual;
105
+    constructor Create(const aControl: TWinControl;
106
+                       const aPixelFormatSettings: TglcContextPixelFormatSettings;
107
+                       const aVersionSettings: TglcContextVersionSettings;
108
+                       const aShareContext: TglcContext = nil); overload; virtual;
102 109
     destructor Destroy; override;
103 110
 
104 111
     property ThreadID:    TThreadID read fThreadID;
@@ -108,13 +115,13 @@ type
108 115
     procedure EnableDebugOutput(const aLogEvent: TLogEvent);
109 116
     procedure DisableDebugOutput;
110 117
     procedure CloseContext; virtual;
111
-    procedure Activate; virtual; abstract;
118
+    procedure ReleaseShareContext; virtual;
119
+    procedure Activate; virtual;
112 120
     procedure Deactivate; virtual; abstract;
113 121
     function IsActive: boolean; virtual; abstract;
114 122
     procedure SwapBuffers; virtual; abstract;
115 123
     procedure SetSwapInterval(const aInterval: GLint); virtual; abstract;
116 124
     function GetSwapInterval: GLint; virtual; abstract;
117
-    procedure Share(const aContext: TglcContext); virtual; abstract;
118 125
 {$IFDEF fpc}
119 126
   private class var
120 127
     fMainContextThreadID: TThreadID;
@@ -306,9 +313,10 @@ begin
306 313
   Result:= GetPlatformClass.IsAnyContextActive;
307 314
 end;
308 315
 
309
-constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings);
316
+constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aShareContext: TglcContext);
310 317
 begin
311 318
   inherited Create;
319
+  fShareContext        := aShareContext;
312 320
   fPixelFormatSettings := aPixelFormatSettings;
313 321
   FControl             := aControl;
314 322
   fThreadID            := 0;
@@ -317,9 +325,9 @@ begin
317 325
   InitOpenGL();
318 326
 end;
319 327
 
320
-constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings);
328
+constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings; const aShareContext: TglcContext);
321 329
 begin
322
-  Create(aControl, aPixelFormatSettings);
330
+  Create(aControl, aPixelFormatSettings, aShareContext);
323 331
   fVersionSettings := aVersionSettings;
324 332
   fUseVersion      := true;
325 333
 end;
@@ -336,8 +344,6 @@ procedure TglcContext.BuildContext;
336 344
 begin
337 345
   OpenContext;
338 346
   Activate;
339
-  ReadImplementationProperties;
340
-  ReadExtensions;
341 347
   SetEnableVSync(fEnableVsync);
342 348
 end;
343 349
 
@@ -358,6 +364,17 @@ begin
358 364
     fMainContextThreadID := 0;
359 365
 end;
360 366
 
367
+procedure TglcContext.ReleaseShareContext;
368
+begin
369
+  fShareContext := nil;
370
+end;
371
+
372
+procedure TglcContext.Activate;
373
+begin
374
+  ReadImplementationProperties;
375
+  ReadExtensions;
376
+end;
377
+
361 378
 initialization
362 379
   {$IFDEF fpc}TglcContext.{$ENDIF}fMainContextThreadID := 0;
363 380
 

+ 36 - 16
uglcContextWGL.pas

@@ -29,8 +29,13 @@ type
29 29
     function FindPixelFormatNoAA: Integer;
30 30
     procedure OpenFromPF(PixelFormat: Integer);
31 31
   public
32
-    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings); overload; override;
33
-    constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings); overload; override;
32
+    constructor Create(const aControl: TWinControl;
33
+                       const aPixelFormatSettings: TglcContextPixelFormatSettings;
34
+                       const aShareContext: TglcContext = nil); overload; override;
35
+    constructor Create(const aControl: TWinControl;
36
+                       const aPixelFormatSettings: TglcContextPixelFormatSettings;
37
+                       const aVersionSettings: TglcContextVersionSettings;
38
+                       const aShareContext: TglcContext = nil); overload; override;
34 39
 
35 40
     procedure CloseContext; override;
36 41
     procedure Activate; override;
@@ -39,7 +44,6 @@ type
39 44
     procedure SwapBuffers; override;
40 45
     procedure SetSwapInterval(const aInterval: GLint); override;
41 46
     function GetSwapInterval: GLint; override;
42
-    procedure Share(const aContext: TglcContext); override;
43 47
 
44 48
     class function ChangeDisplaySettings(const aWidth, aHeight, aBitPerPixel, aFreq: Integer;
45 49
       const aFlags: TglcDisplayFlags): Boolean; override;
@@ -266,6 +270,7 @@ end;
266 270
 procedure TglcContextWGL.OpenFromPF(PixelFormat: Integer);
267 271
 var
268 272
   tmpRC: HGLRC;
273
+  err: DWORD;
269 274
   Attribs: array of GLint;
270 275
   CreateContextAttribs: TwglCreateContextAttribsARB;
271 276
 begin
@@ -337,18 +342,27 @@ begin
337 342
     wglDeleteContext(tmpRC);
338 343
   end else
339 344
     FRC := tmpRC;
345
+
346
+  if Assigned(ShareContext) then begin
347
+    if (ShareContext.ClassName <> ClassName) then
348
+      raise Exception.Create('share context has invalid type: ' + ShareContext.ClassName);
349
+    if not wglShareLists((ShareContext as TglcContextWGL).FRC, FRC) then begin
350
+      err := GetLastError();
351
+      raise EGLError.Create('wglShareLists failed (' + IntToStr(err) + ') ' + SysErrorMessage(err));
352
+    end;
353
+  end;
340 354
 end;
341 355
 
342
-constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings);
356
+constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aShareContext: TglcContext);
343 357
 begin
344
-  inherited Create(aControl, aPixelFormatSettings);
358
+  inherited Create(aControl, aPixelFormatSettings, aShareContext);
345 359
   fHandle := aControl.Handle;
346 360
   UpdatePixelFormat;
347 361
 end;
348 362
 
349
-constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings);
363
+constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings; const aShareContext: TglcContext);
350 364
 begin
351
-  inherited Create(aControl, aPixelFormatSettings, aVersionSettings);
365
+  inherited Create(aControl, aPixelFormatSettings, aVersionSettings, aShareContext);
352 366
   fHandle := aControl.Handle;
353 367
   UpdatePixelFormat;
354 368
 end;
@@ -365,14 +379,26 @@ begin
365 379
 end;
366 380
 
367 381
 procedure TglcContextWGL.Activate;
382
+var
383
+  err: DWORD;
368 384
 begin
369
-  ActivateRenderingContext(FDC, FRC);
385
+  if (FDC = 0) or (FRC = 0) then
386
+    raise Exception.Create('invalid context. did you call build context first?');
387
+  if (not wglMakeCurrent(FDC, FRC)) then begin
388
+    err := GetLastError;
389
+    raise Exception.Create('unable to activate context: (' + IntToStr(err) + ') ' + SysErrorMessage(err));
390
+  end;
391
+  inherited Activate;
370 392
 end;
371 393
 
372 394
 procedure TglcContextWGL.Deactivate;
395
+var
396
+  err: DWORD;
373 397
 begin
374
-  if wglGetCurrentContext()=FRC then
375
-    DeactivateRenderingContext;
398
+  if (wglGetCurrentContext()=FRC) and not wglMakeCurrent(0, 0) then begin
399
+    err := GetLastError;
400
+    raise Exception.Create('unable to deactivate context: (' + IntToStr(err) + ') ' + SysErrorMessage(err));
401
+  end;
376 402
 end;
377 403
 
378 404
 function TglcContextWGL.IsActive: boolean;
@@ -397,12 +423,6 @@ begin
397 423
   result := wglGetSwapIntervalEXT();
398 424
 end;
399 425
 
400
-procedure TglcContextWGL.Share(const aContext: TglcContext);
401
-begin
402
-  if not wglShareLists(FRC, (aContext as TglcContextWGL).FRC) then
403
-    raise EGLError.Create('wglShareLists failed: ' + IntToStr(GetLastError()));
404
-end;
405
-
406 426
 class function TglcContextWGL.ChangeDisplaySettings(const aWidth, aHeight,
407 427
   aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean;
408 428
 var