*.bmp loses transparent background if using v6 Ima

问题:

I'm sorry, my english is not very good.

I need to use semi-transparent bitmap pictures in my D7 app. So, i should use XPManifest and ImageList version6 instead of 5.8 standard one. But in this case, I faced a problev: all images loses their transparency while I load them form stream!

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 Before http://s001.radikal.ru/i195/1403/e2/1dd5ff14aa51.png After

Can somebody help me?

回答1:

Once you put a bitmap having alpha channel information in an image list, there's no easy (*) way you can get it out in its original bitmap form. TImageList.GetBitmap just sets the dimensions of the bitmap you pass to it, and draws on its canvas. It doesn't use the overload that could draw transparently BTW, but it's not all that important as instead of using GetBitmap you can call the Draw overload yourself.

As a result, instead of streaming the image list in and out, I suggest to stream the bitmaps themselves if you need to preserve their original form.

---

Try the below and see if it fits your needs (it is transparent but it may not be identical with the source bitmap as it is again drawn):

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;

回答2:

I suppose, I found a kind of solution.

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;

This code will get exactly the same bitmap, as was put into ImageList;

To copy one ImageList to another without losses, we can use copying with streams:

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;