Question

对不起，我的英语不是很好。

我需要在D7应用中使用半透明位图图片。所以，我应该使用XPManifest和ImageList版本6而不是5.8标准版本。但在这种情况下，我遇到了一个问题：所有图像在我加载形式流时失去了透明度！

type
  TForm2 = class(TForm)
    btn4: TButton;
    btn5: TButton;
    lst1: TbtkListView;
    il1: TImageList;
    btn1: TButton;
    tlb1: TToolBar;
    btn2: TToolButton;
    btn3: TToolButton;
    xpmnfst1: TXPManifest;
    procedure btn4Click(Sender: TObject);
    procedure btn5Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
  private
    FS: TFileStream;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.btn4Click(Sender: TObject);
var
  Bmp       : TBitmap;
  ImageList: TbtkImageList;
begin
  ImageList := TbtkImageList.Create(nil);
  Bmp       := TBitmap.Create;
  FS        := TFileStream.Create('c:\temp\1.cmp',fmCreate);
  try
    Bmp.LoadFromFile('c:\temp\1.bmp');
    ImageList.Add(Bmp, nil);
    FS.WriteComponent(ImageList);
  finally
    Bmp.Free;
  end;
end;

procedure TForm2.btn5Click(Sender: TObject);
var
  Bmp       : TBitmap;
  ImageList : TbtkImageList;
begin
  ImageList := TbtkImageList.Create(nil);
  Bmp := TBitmap.Create;
  try
    FS.Position := 0;
    FS.ReadComponent(ImageList);
    ImageList.GetBitmap(0, Bmp);
    Bmp.SaveToFile('c:\temp\3.bmp');
  finally
    Bmp.Free;
    ImageList.Free;
  end;
end;

ImageListCreationCode:
constructor TbtkImageList.Create(AOwner: TComponent);
begin
  inherited;

  if HandleAllocated then
    ImageList_Destroy(Handle);
  Handle := ImageList_Create(32, 32, ILC_COLOR32, AllocBy, AllocBy);
end;

http://s020.radikal.ru/i720/1403/36/c2702a8b5c1a.png之前 <{3}}之后

有人能帮助我吗？

Answer 1

一旦在图像列表中放置了具有alpha通道信息的位图，就没有简单的（*）方法可以将其以原始位图形式输出。 TImageList.GetBitmap只需设置传递给它的位图的尺寸，并在其画布上绘制。它没有使用可以透明地绘制BTW的重载，但它并不是那么重要，因为您可以自己调用GetBitmap重载而不是使用Draw。

因此，如果您需要保留原始形式，我建议不要将图像列表流入和流出，而是建议自己流式传输位图。

尝试以下内容，看看它是否符合您的需求（它是透明的，但可能与源位图不同，因为它再次被绘制）：

var
  Bmp       : TBitmap;
  ImageList : TImageList;
  FS: TFileStream;
begin
  ImageList := TImageList.Create(nil);
    try
      FS := TFileStream.Create('c:\temp\1.cmp',fmOpenRead or fmShareDenyWrite);
      try
        FS.ReadComponent(ImageList);
      finally
        FS.Free;
      end;
      Bmp := TBitmap.Create;
      try
        Bmp.PixelFormat := pf32bit;
        Bmp.Canvas.Brush.Color := clNone;
        Bmp.Width := ImageList.Width;
        Bmp.Height := ImageList.Height;
        ImageList.Draw(Bmp.Canvas, 0, 0, 0, dsNormal, itImage);
        Bmp.SaveToFile('c:\temp\3.bmp');
      finally
        Bmp.Free;
      end;
  finally
    ImageList.Free;
  end;
end;

Answer 2

我想，我找到了一种解决方案。

var
  BMP: TBitmap;
  ImageList : TImageList;
  FS: TFileStream;
  ico: TIcon;
  IconInfo: TIconInfo;
begin
  ImageList := TImageList.Create(nil);
    try
      FS := TFileStream.Create('c:\temp\1.cmp',fmOpenRead or fmShareDenyWrite);
      try
        FS.ReadComponent(ImageList);
      finally
        FS.Free;
      end;
      Bmp := TBitmap.Create;
      Ico := TIcon.Create;
      try
        ImageList.GetIcon(0, ico);

        GetIconInfo(ico.Handle, IconInfo);

        BMP.Handle := IconInfo.hbmColor;
        BMP.PixelFormat := pf32bit;
        BMP.Canvas.Brush.Color := clNone;

        Bmp.SaveToFile('c:\temp\3.bmp');
      finally
        ico.Free;
        Bmp.Free;
      end;
  finally
    ImageList.Free;
  end;
end;

此代码将获得完全相同的位图，就像放入ImageList;

要将一个ImageList复制到另一个没有损失，我们可以使用stream复制：

procedure TbtkImageList.Assign(Source: TPersistent);
var
  IL: TCustomImageList;
  BIL: TbtkImageList;
var
  st: TMemoryStream;
begin
  st := TMemoryStream.Create;
  try
    st.WriteComponent(TbtkImageList(Source));
    st.Seek(0, soFromBeginning);
    st.ReadComponent(Self);
  finally
    st.Free;
  end;
end;

* .bmp如果使用v6 ImageList Control则会丢失透明背景

2 个答案: