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

LCL: High-DPI ImageList: fix replace methods

Browse Source 
git-svn-id: branches/HiDPIImageList@57056 -
This commit is contained in:
ondrej 2018-01-11 13:22:32 +00:00
parent 1c42b91f5b
commit 61f7a6bd86
2 changed files with 20 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/imglist.pp
View File

@ -316,9 +316,9 @@ type
procedure Move(ACurIndex, ANewIndex: Integer);
procedure Overlay(AIndex: Integer; Overlay: TOverlay);
property HasOverlays: boolean read fHasOverlays;
procedure Replace(AIndex: Integer; AImage, AMask: TCustomBitmap; const AAllResolutions: Boolean = True);
procedure Replace(AIndex: Integer; AImage, AMask: TCustomBitmap; const AllResolutions: Boolean = False);
procedure ReplaceIcon(AIndex: Integer; AIcon: TCustomIcon);
procedure ReplaceMasked(Index: Integer; NewImage: TCustomBitmap; MaskColor: TColor; const AAllResolutions: Boolean = True);
procedure ReplaceMasked(Index: Integer; NewImage: TCustomBitmap; MaskColor: TColor; const AllResolutions: Boolean = False);
procedure RegisterChanges(Value: TChangeLink);
procedure StretchDraw(Canvas: TCanvas; Index: Integer; ARect: TRect; Enabled: Boolean = True);
procedure UnRegisterChanges(Value: TChangeLink);

24
lcl/include/imglist.inc
View File

@ -2046,7 +2046,7 @@ end;
the image has no transparent parts.
------------------------------------------------------------------------------}
procedure TCustomImageList.Replace(AIndex: Integer; AImage,
AMask: TCustomBitmap; const AAllResolutions: Boolean);
AMask: TCustomBitmap; const AllResolutions: Boolean);
var
msk: THandle;
R: TCustomImageListResolution;
@ -2063,7 +2063,7 @@ begin
if AMask = nil
then msk := 0
else msk := AMask.Handle;
if AAllResolutions then
if AllResolutions then
begin
for R in Resolutions do
_Replace;
@ -2106,11 +2106,17 @@ end;
Every occurrence of MaskColor will be converted to transparent.
------------------------------------------------------------------------------}
procedure TCustomImageList.ReplaceMasked(Index: Integer;
NewImage: TCustomBitmap; MaskColor: TColor; const AAllResolutions: Boolean);
NewImage: TCustomBitmap; MaskColor: TColor; const AllResolutions: Boolean);
var
Bmp: TBitmap;
R: TCustomImageListResolution;
Data: TRGBAQuadArray;
procedure _Replace;
begin
ScaleImage(Bmp, nil, R.Width, R.Height, Data);
R.InternalReplace(Index, @Data[0]);
end;
begin
if NewImage = nil then Exit;
@ -2120,9 +2126,15 @@ begin
Bmp.TransparentColor := MaskColor;
Bmp.Transparent := True;
R := GetResolution(NewImage.Width);
ScaleImage(Bmp, nil, R.Width, R.Height, Data);
R.InternalReplace(Index, @Data[0]);
if AllResolutions then
begin
for R in Resolutions do
_Replace;
end else
begin
R := GetResolution(NewImage.Width);
_Replace;
end;
finally
Bmp.Free;
end;