paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-31 11:40:33 +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;
begin
if (Gtk3DC <> nil) then
cairo_scale(gtk3DC.pcr, AScaleRatio, AScaleRatio);
gtk3DC.DeviceScaleRatio := AScaleRatio;
end;
//##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;
FCurrentPen: TGtk3Pen;
FBkMode: Integer;
FDeviceScaleRatio: double;
function GetOffset: TPoint;
procedure setBrush(AValue: TGtk3Brush);
procedure SetFont(AValue: TGtk3Font);
@ -227,6 +228,7 @@ type
procedure ApplyFont;
procedure ApplyPen;
procedure FillAndStroke;
procedure setDeviceScaleRatio(const AValue: double);
public
CairoSurface: Pcairo_surface_t;
pcr: Pcairo_t;
@ -286,6 +288,7 @@ type
property CurrentPen: TGtk3Pen read FCurrentPen write FCurrentPen;
property CurrentRegion: TGtk3Region read FCurrentRegion;
property CurrentTextColor: TColorRef read FCurrentTextColor write FCurrentTextColor;
property DeviceScaleRatio: double read FDeviceScaleRatio write setDeviceScaleRatio;
property Offset: TPoint read GetOffset write SetOffset;
property OwnsSurface: Boolean read FOwnsSurface;
property vBrush: TGtk3Brush read FBrush write setBrush;
@ -1472,6 +1475,7 @@ begin
' FromPaintEvent:',BoolToStr(APaintEvent),' )');
{$endif}
inherited Create;
FDeviceScaleRatio := 1;
FvClipRect := Rect(0, 0, 0, 0);
Window := nil;
Parent := nil;
@ -1546,6 +1550,7 @@ begin
' FromPaintEvent:',BoolToStr(APaintEvent),' )');
{$endif}
inherited Create;
FDeviceScaleRatio := 1;
FvClipRect := Rect(0, 0, 0, 0);
Parent := nil;
ParentPixmap := nil;
@ -1575,6 +1580,7 @@ begin
' FromPaintEvent:',BoolToStr(True),' )');
{$endif}
inherited Create;
FDeviceScaleRatio := 1;
FOwnsCairo := False;
Window := nil;
Parent := AWidget;
@ -2409,6 +2415,18 @@ begin
cairo_set_antialias(pcr, caa[aamode]);
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

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

@ -3994,6 +3994,11 @@ begin
{$IFDEF GTK3DEBUGNOTIMPLEMENTED}
DebugLn('WARNING: TGtk3WidgetSet.StretchMaskBlt not implemented ...');
{$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);
ASrcRect := Rect(XSrc, YSrc, SrcWidth + XSrc, SrcHeight + YSrc);