paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-15 01:19:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: imglist: fix StretchDraw. Issue #33105

Browse Source 
git-svn-id: trunk@57204 -
This commit is contained in:
ondrej 2018-02-01 12:39:43 +00:00
parent 215cce41c2
commit 889ccccb90
1 changed files with 5 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lcl/include/imglist.inc
View File

@ -814,27 +814,18 @@ end;
procedure TCustomImageListResolution.StretchDraw(Canvas: TCanvas; procedure TCustomImageListResolution.StretchDraw(Canvas: TCanvas;
Index: Integer; ARect: TRect; Enabled: Boolean); Index: Integer; ARect: TRect; Enabled: Boolean);
var var
FI: TFPCompactImgRGBA8Bit; Bmp: TBitmap;
Px: PRGBAQuad;
X, Y: Integer;
begin begin
if ((ARect.Right-ARect.Left)=FWidth) and ((ARect.Bottom-ARect.Top)=FHeight) then if ((ARect.Right-ARect.Left)=FWidth) and ((ARect.Bottom-ARect.Top)=FHeight) then
Draw(Canvas, ARect.Left, ARect.Top, Index, Enabled) Draw(Canvas, ARect.Left, ARect.Top, Index, Enabled)
else else
begin begin
FI := TFPCompactImgRGBA8Bit.Create(FWidth, FHeight); Bmp := TBitmap.Create;
try try
Px := @FData[Index * FWidth * FHeight]; GetBitmap(Index, Bmp, EffectMap[Enabled]);
for Y := 0 to FHeight-1 do Canvas.StretchDraw(ARect, Bmp);
for X := 0 to FWidth-1 do
begin
FI.Colors[X, Y] := FPColor(Px^.Red, Px^.Green, Px^.Blue, Px^.Alpha);
Inc(Px);
end;
TFPCustomCanvas(Canvas).StretchDraw(ARect.Left, ARect.Top, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, FI);
finally finally
FI.Free; Bmp.Free;
end; end;
end; end;
end; end;