[delphi]向ImageList中加入png类型的资源图片

向ImageList中动态加入Png图片有些失真，经过多方查询，发现需要将Bitmap的AlphaFormat指定一下。

下面代码支持多层Png导入到ImageList。

//向ImageList中加入png类型的资源图片

procedure AddPngToImageList(AImageList: TImagelist; AResName: string);

var

LResStream: TStream;

LPng: TPngImage;

LBitMap, LRowBitMap: TBitmap;

LRect, LRowRect: TRect;

begin

//AImageList.DrawingStyle := dsTransparent;

AImageList.ColorDepth := cd32Bit;

LResStream := TResourceStream.Create(uResourcesImpl.GetResHandle, AResName, RT_RCDATA);

LPng := TPngImage.Create;

LBitMap := TBitmap.Create;

try

LPng.LoadFromStream(LResStream);

LBitMap.Assign(LPng);

LBitMap.AlphaFormat := afIgnored;

if LBitMap.Height > AImageList.Height then

begin

LRowBitMap := TBitmap.Create;

try

LRowBitMap.Width := LBitMap.Width;

LRowBitMap.Height := AImageList.Height;

LRect := Rect(0, 0, LBitMap.Width, LRowBitMap.Height);

LRowRect := Rect(0, 0, LRowBitMap.Width, LRowBitMap.Height);

while LRect.Bottom <= LBitMap.Height do

begin

LRowBitMap.Canvas.CopyRect(LRowRect, LBitMap.Canvas, LRect);

OffsetRect(LRect, 0, LRowBitMap.Height);

AImageList.Add(LRowBitMap, nil);

end;

finally

LRowBitMap.Free;

end;

end

else

AImageList.Add(LBitMap, nil);

finally

LResStream.Free;

LPng.Free;

LBitMap.Free;

end;

end;