Windows 来自imagelist的PNG图像

如何从

TImageList

中拍摄照片并将其放入

TImage

（或将其作为

TGraphic

返回）

重要的一点是

TImageList

可以包含32个bpp alpha混合图像。我们的目标是获得这些alpha混合图像之一，并将其放置在

TImage

中。这意味着在某个时候我可能需要一个

TGraphic

。尽管严格来说，我的问题是如何将图像从图像列表放入图像。如果这可以在没有中间夹的情况下完成，那么也可以

我们想要什么？ 我们需要一个函数的核心：

procedure GetImageListImageIntoImage(SourceImageList: TCustomImageList; 
      ImageIndex: Integer; TargetImage: TImage);
begin
   //TODO: Figure this out.
   //Neither SourceImageList.GetIcon nor SourceImageList.GetBitmap preserve the alpha channel
end;

function ImageListGetGraphic(ImageList: TCustomImageList; ImageIndex: Integer): TGraphic;
var
//  ico: TIcon;
    bmp: TBitmap;
begin
    {Doesn't work; loses alpha channel. 
    Windows Icon format can support 32bpp alpha bitmaps. But it just doesn't work here
    ico := TIcon.Create;
    ImageList.GetIcon(ImageIndex, ico, dsTransparent, itImage);
    Result := ico;
    }

    {Doesn't work; loses alpha channel.
    Windows does support 32bpp alpha bitmaps. But it just doesn't work here
    bmp := TBitmap.Create;
    bmp.PixelFormat := pf32bit;
    Imagelist.GetBitmap(ImageIndex, bmp);
    Result := bmp;
    }
end;

还有另一个有用的中间辅助函数：

procedure GetImageListImageIntoImage(SourceImageList: TCustomImageList; 
      ImageIndex: Integer; TargetImage: TImage);
begin
   //TODO: Figure this out.
   //Neither SourceImageList.GetIcon nor SourceImageList.GetBitmap preserve the alpha channel
end;

function ImageListGetGraphic(ImageList: TCustomImageList; ImageIndex: Integer): TGraphic;
var
//  ico: TIcon;
    bmp: TBitmap;
begin
    {Doesn't work; loses alpha channel. 
    Windows Icon format can support 32bpp alpha bitmaps. But it just doesn't work here
    ico := TIcon.Create;
    ImageList.GetIcon(ImageIndex, ico, dsTransparent, itImage);
    Result := ico;
    }

    {Doesn't work; loses alpha channel.
    Windows does support 32bpp alpha bitmaps. But it just doesn't work here
    bmp := TBitmap.Create;
    bmp.PixelFormat := pf32bit;
    Imagelist.GetBitmap(ImageIndex, bmp);
    Result := bmp;
    }
end;

让我们将原始程序转换为：

procedure GetImageListImageIntoImage(SourceImageList: TCustomImageList; ImageIndex: Integer; TargetImage: TImage);
var
   g: TGraphic;
begin
   g := ImageListGetGraphic(SourceImageList, ImageIndex);
   TargetImage.Picture.Graphic := g; //Assignment of TGraphic does a copy
   g.Free;
end;

我还有一些随机的事情：

Image1.Picture := TPicture(ImageList1.Components[0]);

但这并不能编译

---

另外，我有Delphi 2010的例行程序来从图像列表中获取一个透明的图形：

ImageList1.GetBitmap(0, Image1.Picture.Bitmap);

function ImageListGetGraphic(ImageList: TCustomImageList; ImageIndex: Integer): TGraphic;
var
    ico: HICON;
//  png: TPngImage;
//  icon: TIcon;
//  bmp: TBitmap;
    wicbmp: IWICBitmap;
    wi: TWicImage;
begin
{   //Works. Uses our own better Wic library.
    ico := ImageList_GetIcon(ImageList.Handle, ImageIndex, ILD_NORMAL);
    Result := TWicGraphic.FromHICON(ico);
    DestroyIcon(ico);}

    //Works, uses the built-in Delphi TWicImage (careful of VCL bugs)
    ico := ImageList_GetIcon(ImageList.Handle, ImageIndex, ILD_NORMAL);
    wi := TWICImage.Create; //Due to a bug in the VCL, you must construct the TWicImage before trying to access the Wic ImagingFactory
    OleCheck(TWicImage.ImagingFactory.CreateBitmapFromHICON(ico, wicbmp));
    wi.Handle := wicbmp;
    Result := wi;

{   //Doesn't work, loses alpha channel
    icon := TIcon.Create;
    ImageList.GetIcon(ImageIndex, icon, dsTransparent, itImage);
    Result := icon;
    }

{   //Doesn't work, loses alpha channel
    bmp := TBitmap.Create;
    bmp.PixelFormat := pf32bit;
    Imagelist.GetBitmap(ImageIndex, bmp);
    Result := bmp;
    }

{   //Fails: cannot assign a TIcon to a TPngImage
    icon := TIcon.Create;
    ImageList.GetIcon(ImageIndex, icon, ImgList.dsNormal, itImage);
    png := TPngImage.Create;
    png.Assign(icon);
    Result := png;
    icon.Free;
    }

{   //Working failure; doesn't support stretched drawing (e.g. TImage.Stretch = true)
    icon := TIcon.Create;
    ImageList.GetIcon(ImageIndex, icon, ImgList.dsNormal, itImage);
    Result := ico;
    }

end;

示例用法：

g: TGraphic;

g := ImageListGetGraphic(ImageList1, 7);
Image1.Picture.Graphic := g;
g.Free;

注意：发布到公共域的任何代码。无需归因

---

@Giacomo-什么问题，透明度丢失了？

TImageList

只支持ICO和BMP格式。将PNG放入

TImageList

会将其转换为BMP。如果要将PNG保留为PNG，则必须使用另一个支持该功能的组件，例如

TPngImageList

。将PNG添加到资源中。。。然后从资源加载它@对于32位png图像，您可以使用

GetIcon

方法提取图像并保持透明度，因此请尝试

ImageList1.GetIcon（0，Image1.Picture.Icon）@Giacomo-除非你告诉别人，否则没有人知道这个问题。“它不起作用”怎么说？你有错误吗？“我有运行时错误”没有任何意义，除非你告诉我们什么错误，包括确切的错误消息和任何内存地址。@Ken-我打赌这是一个编译时错误，因为时间没有“图片”属性，即使是“图片”，代码也不会编译（图片组件）。@Sertac，我同意。不过，如果问题中包含了这些信息，这会有所帮助。人们似乎忘记了我们坐在那里看不到他们的屏幕。（至少我不能，心理调试应该是最后的手段。）