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

LCL: High-DPI ImageList: improve ICO scaling when adding

Browse Source 
git-svn-id: branches/HiDPIImageList@57040 -
This commit is contained in:
ondrej 2018-01-10 13:07:54 +00:00
parent 90f22ba7fd
commit 4d88950a76
1 changed files with 21 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lcl/include/imglist.inc
View File

@ -1608,6 +1608,26 @@ begin
end;
procedure TCustomImageList.InsertIcon(AIndex: Integer; AIcon: TCustomIcon);
function GetBestIndexForSize(AWidth: Integer): Integer;
var
MaxWidth, MaxWidthI: Integer;
begin
MaxWidth := 0;
for Result := 0 to AIcon.Count-1 do // first try to find the smallest (but bigger) multiple
begin
AIcon.Current := Result;
if (AIcon.Width mod AWidth = 0) then
Exit;
if AIcon.Width>MaxWidth then
begin
MaxWidth := AIcon.Width;
MaxWidthI := Result;
end;
end;
Result := MaxWidthI; // just pickup the biggest image
end;
var
R: TCustomImageListResolution;
BmpFree: Boolean;
@ -1619,7 +1639,7 @@ begin
R := GetResolution(FWidth); // create default resolution if needed - do not create all icon resolutions
for R in Resolutions do
begin
AIcon.Current := AIcon.GetBestIndexForSize(Size(R.Width, R.Height));
AIcon.Current := GetBestIndexForSize(R.Width);
if AIcon.Masked then
msk := AIcon.MaskHandle
else