paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 11:18:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

opengl: Adds support to Option ocoMacRetinaMode, to support higher quality in retina displays

Browse Source 
git-svn-id: trunk@55354 -
This commit is contained in:
sekelsenmat 2017-06-15 21:01:28 +00:00
parent 313c3fc636
commit 5dfbda640a
6 changed files with 79 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/opengl/glcarbonaglcontext.pas
View File

@ -21,7 +21,7 @@ uses
WSLCLClasses, CarbonUtils,
Controls;
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
procedure LOpenGLSwapBuffers(Handle: HWND);
function LOpenGLMakeCurrent(Handle: HWND): boolean;
function LOpenGLReleaseContext(Handle: HWND): boolean;
@ -57,7 +57,7 @@ function GetAGLContext(Control: ControlRef): TAGLContext;
implementation
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
begin
glViewport(Left,Top,Width,Height);
end;

55
components/opengl/glcocoanscontext.pas
View File

@ -27,14 +27,16 @@ uses
Classes, SysUtils, types, CocoaWSCommon, CocoaPrivate, CocoaUtils, LCLType,
Controls, LazLoggerBase, WSLCLClasses, gl, MacOSAll, CocoaAll;
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
function LBackingScaleFactor(Handle: HWND): single;
procedure LSetWantsBestResolutionOpenGLSurface(const AValue: boolean; Handle: HWND);
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
procedure LOpenGLSwapBuffers(Handle: HWND);
function LOpenGLMakeCurrent(Handle: HWND): boolean;
function LOpenGLReleaseContext(Handle: HWND): boolean;
procedure LOpenGLClip(Handle: HWND);
function LOpenGLCreateContext(AWinControl: TWinControl;
{%H-}WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
DoubleBuffered: boolean;
DoubleBuffered, AMacRetinaMode: boolean;
MajorVersion, MinorVersion: Cardinal;
MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
const {%H-}AParams: TCreateParams): HWND;
@ -52,6 +54,12 @@ const
NSOpenGLProfileVersion4_1Core = $4100; //requires OSX SDK 10.10 or later, https://github.com/google/gxui/issues/98
type
NSOpenGLViewFix = objccategory external (NSOpenGLView)
procedure setWantsBestResolutionOpenGLSurface(bool: NSInteger); message 'setWantsBestResolutionOpenGLSurface:';
end;
NSScreenFix = objccategory external (NSScreen)
function backingScaleFactor: CGFloat ; message 'backingScaleFactor';
end;
TDummyNoWarnObjCNotUsed = objc.BOOL;
TDummyNoWarnObjCBaseNotUsed = objcbase.NSInteger;
@ -62,6 +70,7 @@ type
Owner: TWinControl;
//nsGL: NSOpenGLContext;
callback: TLCLCommonCallback;
backingScaleFactor: Single;
function acceptsFirstResponder: Boolean; override;
function becomeFirstResponder: Boolean; override;
function resignFirstResponder: Boolean; override;
@ -102,9 +111,42 @@ function IsCGLPixelFormatAvailable(Attribs: PInteger): boolean;*)
implementation
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
//value > 1 if screen is scaled, e.g. default for MOST retina displays is 2
function LBackingScaleFactor(Handle: HWND): single;
begin
glViewport(Left,Top,Width,Height);
result := TCocoaOpenGLView(Handle).backingScaleFactor;
end;
procedure LSetWantsBestResolutionOpenGLSurface(const AValue: boolean; Handle: HWND);
var
View: TCocoaOpenGLView;
begin
if Handle=0 then exit;
View:=TCocoaOpenGLView(Handle);
if not View.respondsToSelector(objcselector('setWantsBestResolutionOpenGLSurface:')) then exit;
if AValue then
View.setWantsBestResolutionOpenGLSurface(1)
else
View.setWantsBestResolutionOpenGLSurface(0);
if (AValue) and (NSScreen.mainScreen.respondsToSelector(objcselector('backingScaleFactor'))) then //MacOS >=10.7
View.backingScaleFactor := NSScreen.mainScreen.backingScaleFactor
else
View.backingScaleFactor := 1;
end;
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
var
View: NSOpenGLView absolute Handle;
lFinalWidth, lFinalHeight: Integer;
begin
lFinalWidth := Width;
lFinalHeight := Height;
if View <> nil then
begin
lFinalWidth := Round(Width * LBackingScaleFactor(Handle));
lFinalHeight := Round(Height * LBackingScaleFactor(Handle));
end;
glViewport(Left,Top,lFinalWidth,lFinalHeight);
end;
procedure LOpenGLSwapBuffers(Handle: HWND);
@ -140,7 +182,8 @@ begin
end;
function LOpenGLCreateContext(AWinControl: TWinControl;
WSPrivate: TWSPrivateClass; SharedControl: TWinControl; DoubleBuffered: boolean;
WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
DoubleBuffered, AMacRetinaMode: boolean;
MajorVersion, MinorVersion: Cardinal;
MultiSampling, AlphaBits, DepthBits, StencilBits,
AUXBuffers: Cardinal; const AParams: TCreateParams): HWND;
@ -180,6 +223,7 @@ begin
View.Owner:=AWinControl;
//View.nsGL := aNSOpenGLContext;
View.callback:=TLCLCommonCallback.Create(View, AWinControl);
LSetWantsBestResolutionOpenGLSurface(AMacRetinaMode, HWND(View));
//View.setPixelFormat(PixFmt);
Result:=TLCLIntfHandle(View);
end;
@ -268,6 +312,7 @@ begin
if OpenGLControlHandle=0 then exit;
View:=TCocoaOpenGLView(OpenGLControlHandle);
Result:=CGLContextObj(View.openGLContext.CGLContextObj);
NSScreen.mainScreen.colorSpace;
end;
(*

4
components/opengl/glgtkglxcontext.pas
View File

@ -107,7 +107,7 @@ function gdk_x11_get_default_xdisplay:PDisplay;cdecl;external;
function gdk_x11_get_default_screen:gint;cdecl;external;
{$ENDIF}
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
procedure LOpenGLSwapBuffers(Handle: HWND);
function LOpenGLMakeCurrent(Handle: HWND): boolean;
function LOpenGLReleaseContext({%H-}Handle: HWND): boolean;
@ -768,7 +768,7 @@ begin
gdk_gl_swap_buffers(GTK_WIDGET(gl_area)^.window);
end;
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
begin
glViewport(Left,Top,Width,Height);
end;

4
components/opengl/glqtcontext.pas
View File

@ -59,7 +59,7 @@ const
type
TGLXContext = pointer;
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
procedure LOpenGLSwapBuffers(Handle: HWND);
function LOpenGLMakeCurrent(Handle: HWND): boolean;
function LOpenGLReleaseContext(Handle: HWND): boolean;
@ -123,7 +123,7 @@ begin
result:=QWidget_winID(Widget);
end;
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
begin
glViewport(Left,Top,Width,Height);
end;

4
components/opengl/glwin32wglcontext.pas
View File

@ -17,7 +17,7 @@ uses
Classes, SysUtils, LMessages, Windows, LCLProc, LCLType, gl, Forms, Controls,
Win32Int, WSLCLClasses, WSControls, Win32WSControls, Win32Proc, LCLMessageGlue;
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
procedure LOpenGLSwapBuffers(Handle: HWND);
function LOpenGLMakeCurrent(Handle: HWND): boolean;
function LOpenGLReleaseContext(Handle: HWND): boolean;
@ -230,7 +230,7 @@ begin
Result := wglGetProcAddress(ProcName);
end;
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
begin
glViewport(Left,Top,Width,Height);
end;

25
components/opengl/openglcontext.pas
View File

@ -52,6 +52,7 @@ unit OpenGLContext;
{$DEFINE UseCocoaNS}
{$DEFINE UsesModernGL}
{$DEFINE OpenGLTargetDefined}
{$DEFINE HasMacRetinaMode}
{$ENDIF}
{$IFDEF LCLWin32}
{$DEFINE UseWin32WGL}
@ -102,6 +103,9 @@ type
TOpenGlCtrlMakeCurrentEvent = procedure(Sender: TObject;
var Allow: boolean) of object;
TOpenGLControlOption = (ocoMacRetinaMode);
TOpenGLControlOptions = set of TOpenGLControlOption;
{ TCustomOpenGLControl }
{ Sharing:
You can share opengl contexts. For example:
@ -136,12 +140,14 @@ type
FMultiSampling, FAlphaBits, FDepthBits, FStencilBits, FAUXBuffers: Cardinal;
FSharedOpenGLControl: TCustomOpenGLControl;
FSharingOpenGlControls: TList;
FOptions: TOpenGLControlOptions;
function GetSharingControls(Index: integer): TCustomOpenGLControl;
procedure SetAutoResizeViewport(const AValue: boolean);
procedure SetDebugContext(AValue: boolean);
procedure SetDoubleBuffered(const AValue: boolean);
procedure SetOpenGLMajorVersion(AValue: Cardinal);
procedure SetOpenGLMinorVersion(AValue: Cardinal);
procedure SetOptions(AValue: TOpenGLControlOptions);
procedure SetRGBA(const AValue: boolean);
{$IFDEF HasRGBBits}
procedure SetRedBits(const AValue: Cardinal);
@ -209,6 +215,7 @@ type
property DepthBits: Cardinal read FDepthBits write SetDepthBits default DefaultDepthBits;
property StencilBits: Cardinal read FStencilBits write SetStencilBits default 0;
property AUXBuffers: Cardinal read FAUXBuffers write SetAUXBuffers default 0;
property Options: TOpenGLControlOptions read FOptions write SetOptions;
end;
{ TOpenGLControl }
@ -302,7 +309,7 @@ begin
and ([csLoading,csDestroying]*ComponentState=[])
and IsVisible and HandleAllocated
and MakeCurrent then
LOpenGLViewport(0,0,Width,Height);
LOpenGLViewport(Handle,0,0,Width,Height);
end;
procedure TCustomOpenGLControl.SetDebugContext(AValue: boolean);
@ -331,6 +338,13 @@ begin
fOpenGLMinorVersion:=AValue;
end;
procedure TCustomOpenGLControl.SetOptions(AValue: TOpenGLControlOptions);
begin
if FOptions=AValue then Exit;
FOptions:=AValue;
OpenGLAttributesChanged();
end;
procedure TCustomOpenGLControl.SetRGBA(const AValue: boolean);
begin
if FRGBA=AValue then exit;
@ -520,14 +534,14 @@ begin
inherited Destroy;
end;
Procedure TCustomOpenGLControl.Paint;
procedure TCustomOpenGLControl.Paint;
begin
if IsVisible and HandleAllocated then begin
UpdateFrameTimeDiff;
if ([csDesigning,csDestroying]*ComponentState=[]) then begin
if not MakeCurrent then exit;
if AutoResizeViewport then
LOpenGLViewport(0,0,Width,Height);
LOpenGLViewport(Handle,0,0,Width,Height);
end;
//LOpenGLClip(Handle);
DoOnPaint;
@ -540,7 +554,7 @@ begin
and ([csDesigning,csDestroying]*ComponentState=[])
and AutoResizeViewport then begin
if MakeCurrent then
LOpenGLViewport(0,0,Width,Height);
LOpenGLViewport(Handle,0,0,Width,Height);
end;
inherited RealizeBounds;
end;
@ -643,6 +657,9 @@ begin
Result:=LOpenGLCreateContext(OpenGlControl,WSPrivate,
OpenGlControl.SharedControl,
AttrControl.DoubleBuffered,
{$IFDEF HasMacRetinaMode}
ocoMacRetinaMode in OpenGlControl.Options,
{$ENDIF}
{$IFDEF HasRGBA}
AttrControl.RGBA,
{$ENDIF}