TIcon to TBitmap
lazarus / 39-Graphics

----------------------------------------------------------------------
Monolith · 2009-06-25 23:09

Since TImageList.AddIcon isnt supported yet, I was looking for a way
to add an TIcon to an ImageList.

Here is my work around using Windows API:

Code: [Select]function TMainForm.AddIconToImageList(Ico:HICON;
ImageList:TImageList):Integer;
var
  Bmp : Graphics.TBitmap;
  IconInfo : TIconInfo;
begin
  if not GetIconInfo(Ico,IconInfo) then
    Exit(0); // default Icon
   
  Bmp := Graphics.TBitmap.Create;
  Bmp.SetHandles(IconInfo.hbmColor,IconInfo.hbmMask);
  Bmp.Masked := TRUE;
 
  ImageList.Add(Bmp,nil);
 
  DeleteObject(IconInfo.hbmColor);
  DeleteObject(IconInfo.hbmMask);
  DestroyIcon(Ico);
  Bmp.Free;
 
  Result := ImageList.Count - 1;
end;
I would like to be able to complete this task without GetIconInfo, so
I tried a couple of different ways, for instance:

Code: [Select]function TMainForm.AddIconToImageList(Ico:TIcon;
ImageList:TImageList):Integer;
var
  Bmp : Graphics.TBitmap;
begin
  Bmp := Graphics.TBitmap.Create;
  Bmp.Assign(Ico);
  Bmp.Height := 16;
  Bmp.Width := 16;
 
  ImageList.Add(Bmp,nil);
 
  Ico.Free;
  Bmp.Free;
 
  Result := ImageList.Count - 1;
end;
But all I am getting is black boxes. Thanks in advance for any
information.

----------------------------------------------------------------------
Marc · 2009-06-26 00:06

Don't change the size of the bmp after you assignd the icon, since
this will erase the bitmap.

First select the IconImage you want:
  icon.Current := someindex;
or
  icon.Current := GetBestIndexForSize(ASize);

then assign it to a bitmap:
  bmp.Assign(icon);

----------------------------------------------------------------------
Monolith · 2009-06-26 02:39

I still have a problem getting this to work, for some reason TIcon
doesn't appear to get set, the size is always 0, and just straight
black background.

Code: [Select]var
  aIcon : TIcon;
begin
  aIcon := TIcon.Create;
  aIcon.Handle := Ico;
  ...

This code should be working right?

----------------------------------------------------------------------
Marc · 2009-06-26 08:35

Should be working... yes.
But I cant tell you if we made some mistake there.

Have you tried to display the Icon using a timage (just for checking
if the icon is OK)?

----------------------------------------------------------------------
Monolith · 2009-09-25 07:33

I hate to bring up an old post, but I think I should post my best
solution for this. Since the TIcon module is pretty much completely
broken or not complete, it is best just to use system api and draw the
Icon to the bitmap, for instance:

Code: [Select]procedure ...(AIcon: HICON);
var
  ABitmap: TBitmap;
begin
  ABitmap := TBitmap.Create;
  ABitmap.SetSize(32,32);
  DrawIcon(ABitmap.Canvas.Handle,0,0,AIcon);

  ... Do stuff

end;

I wish I knew more about the Lazarus library so I could help finish
the Icon module, but ... BTW: No, it did not take me this long to
figure this out.

----------------------------------------------------------------------
Marc · 2009-09-30 10:19

Do you mind telling us what is broken or not complete ?