GS

被sgao忘记的东西都在这里。
  博客园  :: 首页  :: 新随笔  :: 联系 :: 订阅 订阅  :: 管理

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

Posted on 2016-07-27 19:31  sgao  阅读(5167)  评论(0编辑  收藏  举报

向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;