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

LCL: High-DPI ImageList: don't create resolution for new image in add/insert/replace

Browse Source 
git-svn-id: branches/HiDPIImageList@57057 -
This commit is contained in:
ondrej 2018-01-11 13:53:58 +00:00
parent 61f7a6bd86
commit fb66dcdbac
2 changed files with 27 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/imglist.pp
View File

@ -251,6 +251,7 @@ type
function GetBestIconIndexForSize(AIcon: TCustomIcon; AWidth: Integer): Integer;
function GetResolutionByIndex(AIndex: Integer): TCustomImageListResolution;
function GetResolutionCount: Integer;
procedure CreateDefaultResolution;
protected
function GetResolution(AImageWidth: Integer): TCustomImageListResolution;
function GetResolutionClass: TCustomImageListResolutionClass; virtual;
@ -325,6 +326,7 @@ type
procedure RegisterResolutions(const AResolutionWidths: array of Integer);
procedure DeleteResolution(const AWidth: Integer);
function FindResolution(AImageWidth: Integer; out AResolution: TCustomImageListResolution): Boolean;
public
property AllocBy: Integer read FAllocBy write FAllocBy default 4;
property BlendColor: TColor read FBlendColor write FBlendColor default clNone;

32
lcl/include/imglist.inc
View File

@ -1598,6 +1598,12 @@ begin
FOverlays[I] := -1;
end;
procedure TCustomImageList.CreateDefaultResolution;
begin
if ResolutionCount=0 then
GetResolution(FWidth); // create default resolution if needed
end;
{------------------------------------------------------------------------------
Method: TCustomImageList.Insert
Params: Index: the index of the inserted image
@ -1616,7 +1622,7 @@ var
begin
if AImage = nil then Exit;
R := GetResolution(AImage.Width); // create image resolution if needed
CreateDefaultResolution;
for R in Resolutions do
begin
ScaleImage(AImage, AMask, R.Width, R.Height, ScBmp);
@ -1632,7 +1638,7 @@ var
begin
if AIcon = nil then Exit;
R := GetResolution(FWidth); // create default resolution if needed - do not create all icon resolutions
CreateDefaultResolution;
for R in Resolutions do
begin
AIcon.Current := GetBestIconIndexForSize(AIcon, R.Width);
@ -1687,7 +1693,7 @@ begin
MaskedImage.GetRawImage(RawImg);
MaskedImage.CreateBitmaps(Bmp, Msk);
try
R := GetResolution(FWidth); // create default resolution if needed - do not create image resolution
CreateDefaultResolution;
for R in Resolutions do
begin
ScaleImage(Bmp, Msk, MaskedImage.Width, MaskedImage.Height, R.Width, R.Height, ScBmp);
@ -1970,6 +1976,18 @@ begin
{$ENDIF}
end;
function TCustomImageList.FindResolution(AImageWidth: Integer; out
AResolution: TCustomImageListResolution): Boolean;
var
I: Integer;
begin
Result := FData.Find(AImageWidth, I);
if Result then
AResolution := ResolutionByIndex[I]
else
AResolution := nil;
end;
function TCustomImageList.GetBestIconIndexForSize(AIcon: TCustomIcon;
AWidth: Integer): Integer;
var
@ -2069,8 +2087,8 @@ begin
_Replace;
end else
begin
R := GetResolution(AImage.Width);
_Replace;
if FindResolution(AImage.Width, R) then
_Replace;
end;
end;
@ -2132,8 +2150,8 @@ begin
_Replace;
end else
begin
R := GetResolution(NewImage.Width);
_Replace;
if FindResolution(NewImage.Width, R) then
_Replace;
end;
finally
Bmp.Free;