4 Prefix: glc - OpenGL Core
5 Beschreibung: diese Unit enthält eine Klassen-Kapselung für OpenGL Kontexte für Windows
6 Hint: diese Unit sollte niemals direkt genutzt werden (siehe uglcContext) }
11 Classes, SysUtils, Forms, Windows, uglcContext, dglOpenGL, Controls;
14 EWGLError = class(EGLError);
18 TglcContextWGL = class(TglcContext)
23 fPixelFormat: Integer;
24 {%H-}constructor Create(const aControl: TWinControl); overload;
26 procedure UpdatePixelFormat;
27 procedure OpenContext; override;
28 function FindPixelFormat: Integer;
29 function FindPixelFormatNoAA: Integer;
30 procedure OpenFromPF(PixelFormat: Integer);
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;
35 procedure CloseContext; override;
36 procedure Activate; override;
37 procedure Deactivate; override;
38 function IsActive: boolean; override;
39 procedure SwapBuffers; override;
40 procedure SetSwapInterval(const aInterval: GLint); override;
41 function GetSwapInterval: GLint; override;
42 procedure Share(const aContext: TglcContext); override;
44 class function ChangeDisplaySettings(const aWidth, aHeight, aBitPerPixel, aFreq: Integer;
45 const aFlags: TglcDisplayFlags): Boolean; override;
46 class function IsAnyContextActive: boolean; override;
53 constructor TglcContextWGL.Create(const aControl: TWinControl);
55 inherited Create(aControl, MakePF());
56 fHandle := aControl.Handle;
59 procedure TglcContextWGL.UpdatePixelFormat;
61 fPixelFormat := FindPixelFormat;
62 if (fPixelFormat = 0) then begin
64 fPixelFormatSettings.MultiSampling := 1;
65 fPixelFormat := FindPixelFormat;
69 procedure TglcContextWGL.OpenContext;
71 inherited OpenContext;
72 OpenFromPF(fPixelFormat);
75 function TglcContextWGL.FindPixelFormat: Integer;
77 OldRC: HGLRC; OldDC: HDC;
79 tmpContext: TglcContextWGL;
82 PFList, SampleList: array[0..31] of GLint;
84 procedure ChoosePF(pPFList, pSampleList: PGLint; MaxCount: integer);
86 //ARB_Erweiterung vorhanden
87 //| EXT_Erweiterung vorhanden
88 MultiARBSup, MultiEXTSup: Boolean;
89 //Liste der Integer Attribute
90 IAttrib: array[0..22] of GLint;
91 //Liste der Float Attribute (nur 0, da kein Wert)
93 QueryAtrib, i: Integer;
94 PPosiblePF, PSample: PglInt;
96 //Pixelformate mit AA auslesen
99 if WGL_ARB_extensions_string and
100 WGL_ARB_pixel_format and
101 (WGL_ARB_MULTISAMPLE or GL_ARB_MULTISAMPLE) then
103 if WGL_EXT_extensions_string and
104 WGL_EXT_pixel_format and
105 (WGL_EXT_MULTISAMPLE or GL_EXT_MULTISAMPLE) then
109 Read_WGL_ARB_pixel_format
110 else if multiEXTSup then
111 Read_WGL_EXT_pixel_format;
113 if not (MultiARBSup or MultiEXTSup) then
116 IAttrib[00] := WGL_DRAW_TO_WINDOW_ARB;
119 IAttrib[02] := WGL_SUPPORT_OPENGL_ARB;
122 IAttrib[04] := WGL_DOUBLE_BUFFER_ARB;
123 if (fPixelFormatSettings.DoubleBuffered) then
128 IAttrib[06] := WGL_PIXEL_TYPE_ARB;
129 IAttrib[07] := WGL_TYPE_RGBA_ARB;
131 IAttrib[08] := WGL_COLOR_BITS_ARB;
132 IAttrib[09] := fPixelFormatSettings.ColorBits;
134 IAttrib[10] := WGL_ALPHA_BITS_ARB;
135 IAttrib[11] := 0; //TODO: fPixelFormatSettings.AlphaBits;
137 IAttrib[12] := WGL_DEPTH_BITS_ARB;
138 IAttrib[13] := fPixelFormatSettings.DepthBits;
140 IAttrib[14] := WGL_STENCIL_BITS_ARB;
141 IAttrib[15] := fPixelFormatSettings.StencilBits;
143 IAttrib[16] := WGL_ACCUM_BITS_ARB;
144 IAttrib[17] := fPixelFormatSettings.AccumBits;
146 IAttrib[18] := WGL_AUX_BUFFERS_ARB;
147 IAttrib[19] := fPixelFormatSettings.AuxBuffers;
149 IAttrib[20] := WGL_SAMPLE_BUFFERS_ARB;
156 wglChoosePixelFormatARB(tmpContext.FDC, @IAttrib[0], @FAttrib, MaxCount, pPFList, @Count)
157 else if multiEXTSup then
158 wglChoosePixelFormatEXT(tmpContext.FDC, @IAttrib[0], @FAttrib, MaxCount, pPFList, @Count);
160 if Count > length(PFList) then
161 Count := length(PFList);
163 QueryAtrib := WGL_SAMPLES_ARB;
164 PSample := pSampleList;
165 PPosiblePF := @PFList[0];
166 for i := 0 to Count-1 do begin
168 wglGetPixelFormatAttribivARB(tmpContext.FDC, PPosiblePF^, 0, 1, @QueryAtrib, PSample)
169 else if multiEXTSup then
170 wglGetPixelFormatAttribivEXT(tmpContext.FDC, PPosiblePF^, 0, 1, @QueryAtrib, PSample);
176 if (fPixelFormatSettings.MultiSampling = 1) then begin
177 Result := FindPixelFormatNoAA;
181 OldDC := wglGetCurrentDC();
182 OldRC := wglGetCurrentContext();
184 tmpWnd := TForm.Create(nil);
185 tmpContext := TglcContextWGL.Create(tmpWnd);
187 pf := tmpContext.FindPixelFormatNoAA;
188 tmpContext.OpenFromPF(pf);
191 FillChar({%H-}PFList[0], Length(PFList), 0);
192 FillChar({%H-}SampleList[0], Length(SampleList), 0);
193 ChoosePF(@PFList[0], @SampleList[0], length(SampleList));
195 for i := 0 to Count-1 do begin
196 if (max < SampleList[i]) and (SampleList[i] <= fPixelFormatSettings.MultiSampling) and (PFList[i] <> 0) then begin
197 max := SampleList[i];
199 if (max = fPixelFormatSettings.MultiSampling) then
203 tmpContext.Deactivate;
205 FreeAndNil(tmpContext);
209 if (OldDC <> 0) and (OldRC <> 0) then
210 ActivateRenderingContext(OldDC, OldRC);
214 function TglcContextWGL.FindPixelFormatNoAA: Integer;
216 MemoryDCs = [OBJ_MEMDC, OBJ_METADC, OBJ_ENHMETADC];
222 //Beschreibung zum passenden Pixelformat
223 PFDescriptor: TPixelFormatDescriptor;
226 DC := GetDC(fHandle);
230 FillChar(PFDescriptor{%H-}, SizeOf(PFDescriptor), #0);
231 with PFDescriptor do begin
232 nSize := SizeOf(PFDescriptor);
234 dwFlags := PFD_SUPPORT_OPENGL;
235 AType := GetObjectType(DC);
236 if AType = 0 then begin
239 if fPixelFormatSettings.DoubleBuffered then
240 dwFlags := dwFlags or PFD_DOUBLEBUFFER;
241 if fPixelFormatSettings.Stereo then
242 dwFlags := dwFlags or PFD_STEREO;
243 if AType in MemoryDCs then
244 dwFlags := dwFlags or PFD_DRAW_TO_BITMAP
246 dwFlags := dwFlags or PFD_DRAW_TO_WINDOW;
248 iPixelType := PFD_TYPE_RGBA;
249 cColorBits := fPixelFormatSettings.ColorBits;
250 //TODO: cAlphaBits := fPixelFormatSettings.AlphaBits;
251 cDepthBits := fPixelFormatSettings.DepthBits;
252 cStencilBits := fPixelFormatSettings.StencilBits;
253 cAccumBits := fPixelFormatSettings.AccumBits;
254 cAuxBuffers := fPixelFormatSettings.AuxBuffers;
256 if fPixelFormatSettings.Layer = 0 then
257 iLayerType := PFD_MAIN_PLANE
258 else if fPixelFormatSettings.Layer > 0 then
259 iLayerType := PFD_OVERLAY_PLANE
261 iLayerType := Byte(PFD_UNDERLAY_PLANE);
263 result := ChoosePixelFormat(DC, @PFDescriptor);
266 procedure TglcContextWGL.OpenFromPF(PixelFormat: Integer);
269 Attribs: array of GLint;
270 CreateContextAttribs: TwglCreateContextAttribsARB;
272 if PixelFormat = 0 then begin
273 raise EWGLError.Create('Invalid PixelFormat');
276 FDC := GetDC(fHandle);
277 if FDC = 0 then begin
278 raise EWGLError.CreateFmt('Cannot create DC on %x',[fHandle]);
281 if not SetPixelFormat(FDC, PixelFormat, nil) then begin
282 ReleaseDC(fHandle, FDC);
283 raise EWGLError.CreateFmt('Cannot set PF %d on Control %x DC %d',[PixelFormat, fHandle, FDC]);
286 tmpRC := wglCreateContext(FDC);
287 if tmpRC = 0 then begin
288 ReleaseDC(fHandle, FDC);
289 raise EWGLError.CreateFmt('Cannot create context on Control %x DC %d',[PixelFormat, fHandle, FDC]);
293 (fVersionSettings.Major <> GLC_CONTEXT_VERSION_UNKNOWN) and
294 (fVersionSettings.Minor <> GLC_CONTEXT_VERSION_UNKNOWN) then
296 { Code from dglOpenGL.pas (modified) }
297 wglMakeCurrent(FDC, tmpRC);
299 // Set attributes to describe our requested context
300 SetLength(Attribs, 5);
301 Attribs[0] := WGL_CONTEXT_MAJOR_VERSION_ARB;
302 Attribs[1] := fVersionSettings.Major;
303 Attribs[2] := WGL_CONTEXT_MINOR_VERSION_ARB;
304 Attribs[3] := fVersionSettings.Minor;
306 // Add context flag for forward compatible context
307 // Forward compatible means no more support for legacy functions like
308 // immediate mode (glvertex, glrotate, gltranslate, etc.)
309 if fVersionSettings.ForwardCompatible then begin
310 SetLength(Attribs, Length(Attribs)+2);
311 Attribs[4] := WGL_CONTEXT_FLAGS_ARB;
312 Attribs[5] := WGL_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB;
315 // Attribute flags must be finalized with a zero
316 Attribs[High(Attribs)] := 0;
318 // Get function pointer for new context creation function
319 CreateContextAttribs := TwglCreateContextAttribsARB(wglGetProcAddress('wglCreateContextAttribsARB'));
320 if not Assigned(CreateContextAttribs) then begin
321 wglMakeCurrent(0, 0);
322 wglDeleteContext(tmpRC);
323 ReleaseDC(fHandle, FDC);
324 raise Exception.Create('Could not get function pointer adress for wglCreateContextAttribsARB - OpenGL 3.x and above not supported!');
328 FRC := CreateContextAttribs(FDC, 0, @Attribs[0]);
329 if (FRC = 0) then begin
330 wglMakeCurrent(0, 0);
331 wglDeleteContext(tmpRC);
332 ReleaseDC(fHandle, FDC);
333 raise Exception.Create('Could not create the desired OpenGL rendering context!');
336 wglMakeCurrent(0, 0);
337 wglDeleteContext(tmpRC);
342 constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings);
344 inherited Create(aControl, aPixelFormatSettings);
345 fHandle := aControl.Handle;
349 constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings);
351 inherited Create(aControl, aPixelFormatSettings, aVersionSettings);
352 fHandle := aControl.Handle;
356 procedure TglcContextWGL.CloseContext;
358 if (FRC <> 0) then begin
360 DestroyRenderingContext(FRC);
361 ReleaseDC(fHandle, FDC);
367 procedure TglcContextWGL.Activate;
369 ActivateRenderingContext(FDC, FRC);
372 procedure TglcContextWGL.Deactivate;
374 if wglGetCurrentContext()=FRC then
375 DeactivateRenderingContext;
378 function TglcContextWGL.IsActive: boolean;
380 Result:= (FRC <> 0) and
381 (FRC = wglGetCurrentContext()) and
382 (FDC = wglGetCurrentDC());
385 procedure TglcContextWGL.SwapBuffers;
387 Windows.SwapBuffers(FDC);
390 procedure TglcContextWGL.SetSwapInterval(const aInterval: GLint);
392 wglSwapIntervalEXT(aInterval);
395 function TglcContextWGL.GetSwapInterval: GLint;
397 result := wglGetSwapIntervalEXT();
400 procedure TglcContextWGL.Share(const aContext: TglcContext);
402 wglShareLists(FRC, (aContext as TglcContextWGL).FRC);
405 class function TglcContextWGL.ChangeDisplaySettings(const aWidth, aHeight,
406 aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean;
411 FillChar(dm{%H-}, SizeOf(dm), 0);
413 dmSize := SizeOf(dm);
414 dmPelsWidth := aWidth;
415 dmPelsHeight := aHeight;
416 dmDisplayFrequency := aFreq;
417 dmBitsPerPel := aBitPerPixel;
418 dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or DM_DISPLAYFREQUENCY;
420 flags := 0; //CDS_TEST;
421 if (dfFullscreen in aFlags) then
422 flags := flags or CDS_FULLSCREEN;
423 result := (Windows.ChangeDisplaySettings(dm, flags) = DISP_CHANGE_SUCCESSFUL);
426 class function TglcContextWGL.IsAnyContextActive: boolean;
428 Result:= (wglGetCurrentContext()<>0) and (wglGetCurrentDC()<>0);