paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 07:36:19 +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;

56
lcl/include/imglist.inc
View File

@ -1743,20 +1743,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;
CreateDefaultResolution; CreateDefaultResolution;
for R in Resolutions do SortedIcon := TIcon.Create;
begin try
AIcon.Current := GetBestIconIndexForSize(AIcon, R.Width); SortedIcon.Assign(AIcon);
if AIcon.Masked then SortedIcon.Sort;
msk := AIcon.MaskHandle for R in Resolutions do
else begin
msk := 0; SortedIcon.Current := GetBestIconIndexForSize(SortedIcon, R.Width);
ScaleImage(AIcon.BitmapHandle, msk, if SortedIcon.Masked then
AIcon.Width, AIcon.Height, R.Width, R.Height, ScBmp); msk := SortedIcon.MaskHandle
R.InternalInsert(AIndex, @ScBmp[0]); else
msk := 0;
ScaleImage(SortedIcon.BitmapHandle, msk,
SortedIcon.Width, SortedIcon.Height, R.Width, R.Height, ScBmp);
R.InternalInsert(AIndex, @ScBmp[0]);
end;
finally
SortedIcon.Free;
end; end;
end; end;
@ -2207,19 +2215,27 @@ 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;
for R in Resolutions do SortedIcon := TIcon.Create;
begin try
AIcon.Current := GetBestIconIndexForSize(AIcon, R.Width); SortedIcon.Assign(AIcon);
if AIcon.Masked then SortedIcon.Sort;
msk := AIcon.MaskHandle for R in Resolutions do
else begin
msk := 0; SortedIcon.Current := GetBestIconIndexForSize(SortedIcon, R.Width);
ScaleImage(AIcon.BitmapHandle, msk, if SortedIcon.Masked then
AIcon.Width, AIcon.Height, R.Width, R.Height, ScBmp); msk := SortedIcon.MaskHandle
R.InternalReplace(AIndex, @ScBmp[0]); else
msk := 0;
ScaleImage(SortedIcon.BitmapHandle, msk,
SortedIcon.Width, SortedIcon.Height, R.Width, R.Height, ScBmp);
R.InternalReplace(AIndex, @ScBmp[0]);
end;
finally
SortedIcon.Free;
end; end;
end; end;