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

Gtk3: proper unscale in StretchBlt

Browse Source
This commit is contained in:
zeljan1 2025-01-08 21:41:19 +01:00
parent ae3b05a6bd
commit a7a64de5bf
3 changed files with 24 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/interfaces/gtk3/gtk3lclintf.inc
View File

@ -1191,7 +1191,7 @@ var
Gtk3DC: TGtk3DeviceContext absolute DC; Gtk3DC: TGtk3DeviceContext absolute DC;
begin begin
if (Gtk3DC <> nil) then if (Gtk3DC <> nil) then
cairo_scale(gtk3DC.pcr, AScaleRatio, AScaleRatio); gtk3DC.DeviceScaleRatio := AScaleRatio;
end; end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line //##apiwiz##eps## // Do not remove, no wizard declaration after this line

18
lcl/interfaces/gtk3/gtk3objects.pas
View File

@ -213,6 +213,7 @@ type
FvClipRect: TRect; FvClipRect: TRect;
FCurrentPen: TGtk3Pen; FCurrentPen: TGtk3Pen;
FBkMode: Integer; FBkMode: Integer;
FDeviceScaleRatio: double;
function GetOffset: TPoint; function GetOffset: TPoint;
procedure setBrush(AValue: TGtk3Brush); procedure setBrush(AValue: TGtk3Brush);
procedure SetFont(AValue: TGtk3Font); procedure SetFont(AValue: TGtk3Font);
@ -227,6 +228,7 @@ type
procedure ApplyFont; procedure ApplyFont;
procedure ApplyPen; procedure ApplyPen;
procedure FillAndStroke; procedure FillAndStroke;
procedure setDeviceScaleRatio(const AValue: double);
public public
CairoSurface: Pcairo_surface_t; CairoSurface: Pcairo_surface_t;
pcr: Pcairo_t; pcr: Pcairo_t;
@ -286,6 +288,7 @@ type
property CurrentPen: TGtk3Pen read FCurrentPen write FCurrentPen; property CurrentPen: TGtk3Pen read FCurrentPen write FCurrentPen;
property CurrentRegion: TGtk3Region read FCurrentRegion; property CurrentRegion: TGtk3Region read FCurrentRegion;
property CurrentTextColor: TColorRef read FCurrentTextColor write FCurrentTextColor; property CurrentTextColor: TColorRef read FCurrentTextColor write FCurrentTextColor;
property DeviceScaleRatio: double read FDeviceScaleRatio write setDeviceScaleRatio;
property Offset: TPoint read GetOffset write SetOffset; property Offset: TPoint read GetOffset write SetOffset;
property OwnsSurface: Boolean read FOwnsSurface; property OwnsSurface: Boolean read FOwnsSurface;
property vBrush: TGtk3Brush read FBrush write setBrush; property vBrush: TGtk3Brush read FBrush write setBrush;
@ -1472,6 +1475,7 @@ begin
' FromPaintEvent:',BoolToStr(APaintEvent),' )'); ' FromPaintEvent:',BoolToStr(APaintEvent),' )');
{$endif} {$endif}
inherited Create; inherited Create;
FDeviceScaleRatio := 1;
FvClipRect := Rect(0, 0, 0, 0); FvClipRect := Rect(0, 0, 0, 0);
Window := nil; Window := nil;
Parent := nil; Parent := nil;
@ -1546,6 +1550,7 @@ begin
' FromPaintEvent:',BoolToStr(APaintEvent),' )'); ' FromPaintEvent:',BoolToStr(APaintEvent),' )');
{$endif} {$endif}
inherited Create; inherited Create;
FDeviceScaleRatio := 1;
FvClipRect := Rect(0, 0, 0, 0); FvClipRect := Rect(0, 0, 0, 0);
Parent := nil; Parent := nil;
ParentPixmap := nil; ParentPixmap := nil;
@ -1575,6 +1580,7 @@ begin
' FromPaintEvent:',BoolToStr(True),' )'); ' FromPaintEvent:',BoolToStr(True),' )');
{$endif} {$endif}
inherited Create; inherited Create;
FDeviceScaleRatio := 1;
FOwnsCairo := False; FOwnsCairo := False;
Window := nil; Window := nil;
Parent := AWidget; Parent := AWidget;
@ -2409,6 +2415,18 @@ begin
cairo_set_antialias(pcr, caa[aamode]); cairo_set_antialias(pcr, caa[aamode]);
end; end;
procedure TGtk3DeviceContext.setDeviceScaleRatio(const AValue: double);
var
matrix: Tcairo_matrix_t;
begin
if FDeviceScaleRatio <> AValue then
begin
FDeviceScaleRatio := AValue;
cairo_get_matrix(pcr, @matrix);
cairo_matrix_scale(@matrix, FDeviceScaleRatio, FDeviceScaleRatio);
cairo_set_matrix(pcr, @matrix);
end;
end;
//various routines for text //various routines for text

5
lcl/interfaces/gtk3/gtk3winapi.inc
View File

@ -3994,6 +3994,11 @@ begin
{$IFDEF GTK3DEBUGNOTIMPLEMENTED} {$IFDEF GTK3DEBUGNOTIMPLEMENTED}
DebugLn('WARNING: TGtk3WidgetSet.StretchMaskBlt not implemented ...'); DebugLn('WARNING: TGtk3WidgetSet.StretchMaskBlt not implemented ...');
{$ENDIF} {$ENDIF}
if Assigned(SrcContext.pcr) and SrcContext.OwnsSurface then
begin
Width := Round(Width / SrcContext.DeviceScaleRatio);
Height := Round(Height / SrcContext.DeviceScaleRatio);
end;
ATargetRect := Rect(X, Y, Width + X, Height + Y); ATargetRect := Rect(X, Y, Width + X, Height + Y);
ASrcRect := Rect(XSrc, YSrc, SrcWidth + XSrc, SrcHeight + YSrc); ASrcRect := Rect(XSrc, YSrc, SrcWidth + XSrc, SrcHeight + YSrc);