paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 21:16:05 +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;
Index: Integer; ARect: TRect; Enabled: Boolean);
var
FI: TFPCompactImgRGBA8Bit;
Px: PRGBAQuad;
X, Y: Integer;
Bmp: TBitmap;
begin
if ((ARect.Right-ARect.Left)=FWidth) and ((ARect.Bottom-ARect.Top)=FHeight) then
Draw(Canvas, ARect.Left, ARect.Top, Index, Enabled)
else
begin
FI := TFPCompactImgRGBA8Bit.Create(FWidth, FHeight);
Bmp := TBitmap.Create;
try
Px := @FData[Index * FWidth * FHeight];
for Y := 0 to FHeight-1 do
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);
GetBitmap(Index, Bmp, EffectMap[Enabled]);
Canvas.StretchDraw(ARect, Bmp);
finally
FI.Free;
Bmp.Free;
end;
end;
end;