*.bmp loses transparent background if using v6 ImageList Control

1
votes

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?

2
delphidelphi-7alpha-transparencyimagelist
@Ken That question is different. There the user was trying to work with the comctl32 v5.8 control. – David Heffernan
@user I see no evidence that the image list ever has transparency. You are not setting the color depth anywhere. IIRC that property does not exist in D7 and you have to create the image list handle manually. – David Heffernan
David Heffernan, iam sorry, forgot to add this peace of code. Fixed. – user1443993
@SertacAkyuz but TBitmap is not a descedant of TComponent. We only can stream components. I suppose, i just doing something wrong. There should be some nice deсision... – user1443993
Ok. That looks fine. Where is the transparency lost? My instincts tell me that saving/loading to/from .bmp is the real problem. – David Heffernan

2 Answers

2
votes

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;
0
votes

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;