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

LCL: image list: fix adding icons (correct size)

Browse Source 
git-svn-id: trunk@57179 -
This commit is contained in:
ondrej 2018-01-29 09:43:46 +00:00
parent de98dc8a6f
commit 545a00f620
2 changed files with 37 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/imglist.pp
View File

@ -259,7 +259,7 @@ type
function GetHeightForPPI(AImageWidth, APPI: Integer): Integer; function GetHeightForPPI(AImageWidth, APPI: Integer): Integer;
function GetCount: Integer; function GetCount: Integer;
function GetSizeForPPI(AImageWidth, APPI: Integer): TSize; function GetSizeForPPI(AImageWidth, APPI: Integer): TSize;
function GetBestIconIndexForSize(AIcon: TCustomIcon; AWidth: Integer): Integer; function GetBestIconIndexForSize(AIcon: TCustomIcon; AWidth: Integer): Integer; // the icon must be sorted
function GetResolutionByIndex(AIndex: Integer): TCustomImageListResolution; function GetResolutionByIndex(AIndex: Integer): TCustomImageListResolution;
function GetResolutionCount: Integer; function GetResolutionCount: Integer;
procedure CreateDefaultResolution; procedure CreateDefaultResolution;

36
lcl/include/imglist.inc
View File

@ -1743,21 +1743,29 @@ var
R: TCustomImageListResolution; R: TCustomImageListResolution;
ScBmp: TRGBAQuadArray; ScBmp: TRGBAQuadArray;
msk: HBITMAP; msk: HBITMAP;
SortedIcon: TIcon;
begin begin
if AIcon = nil then Exit; if AIcon = nil then Exit;
CreateDefaultResolution; CreateDefaultResolution;
SortedIcon := TIcon.Create;
try
SortedIcon.Assign(AIcon);
SortedIcon.Sort;
for R in Resolutions do for R in Resolutions do
begin begin
AIcon.Current := GetBestIconIndexForSize(AIcon, R.Width); SortedIcon.Current := GetBestIconIndexForSize(SortedIcon, R.Width);
if AIcon.Masked then if SortedIcon.Masked then
msk := AIcon.MaskHandle msk := SortedIcon.MaskHandle
else else
msk := 0; msk := 0;
ScaleImage(AIcon.BitmapHandle, msk, ScaleImage(SortedIcon.BitmapHandle, msk,
AIcon.Width, AIcon.Height, R.Width, R.Height, ScBmp); SortedIcon.Width, SortedIcon.Height, R.Width, R.Height, ScBmp);
R.InternalInsert(AIndex, @ScBmp[0]); R.InternalInsert(AIndex, @ScBmp[0]);
end; end;
finally
SortedIcon.Free;
end;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2207,20 +2215,28 @@ var
R: TCustomImageListResolution; R: TCustomImageListResolution;
ScBmp: TRGBAQuadArray; ScBmp: TRGBAQuadArray;
msk: HBITMAP; msk: HBITMAP;
SortedIcon: TIcon;
begin begin
if AIcon = nil then Exit; if AIcon = nil then Exit;
SortedIcon := TIcon.Create;
try
SortedIcon.Assign(AIcon);
SortedIcon.Sort;
for R in Resolutions do for R in Resolutions do
begin begin
AIcon.Current := GetBestIconIndexForSize(AIcon, R.Width); SortedIcon.Current := GetBestIconIndexForSize(SortedIcon, R.Width);
if AIcon.Masked then if SortedIcon.Masked then
msk := AIcon.MaskHandle msk := SortedIcon.MaskHandle
else else
msk := 0; msk := 0;
ScaleImage(AIcon.BitmapHandle, msk, ScaleImage(SortedIcon.BitmapHandle, msk,
AIcon.Width, AIcon.Height, R.Width, R.Height, ScBmp); SortedIcon.Width, SortedIcon.Height, R.Width, R.Height, ScBmp);
R.InternalReplace(AIndex, @ScBmp[0]); R.InternalReplace(AIndex, @ScBmp[0]);
end; end;
finally
SortedIcon.Free;
end;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------