Forum > Graphics

TIcon to TBitmap

(1/2) > >>

Monolith:
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: ---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;
--- End code ---

I would like to be able to complete this task without GetIconInfo, so I tried a couple of different ways, for instance:


--- Code: ---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;
--- End code ---

But all I am getting is black boxes. Thanks in advance for any information.

Marc:
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:
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: ---var
  aIcon : TIcon;
begin
  aIcon := TIcon.Create;
  aIcon.Handle := Ico;
  ...

--- End code ---

This code should be working right?

Marc:
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:
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: ---procedure ...(AIcon: HICON);
var
  ABitmap: TBitmap;
begin
  ABitmap := TBitmap.Create;
  ABitmap.SetSize(32,32);
  DrawIcon(ABitmap.Canvas.Handle,0,0,AIcon);

  ... Do stuff

end;

--- End code ---

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.

Navigation

[0] Message Index

[#] Next page

Go to full version