How to create an icon from a TBitmap

Problem/Question/Abstract:

How to create an icon from a TBitmap

Answer:

You must create two bitmaps, a mask bitmap (called the "AND" bitmap) and a image bitmap (called the XOR bitmap). You can pass the handles to the "AND" and "XOR" bitmaps to the Windows API function CreateIconIndirect() and use the returned icon handle in your application:

procedure TForm1.Button1Click(Sender: TObject);
var
  IconSizeX: Integer;
  IconSizeY: Integer;
  AndMask: TBitmap;
  XOrMask: TBitmap;
  IconInfo: TIconInfo;
  Icon: TIcon;
begin
  {Getting the icon size}
  IconSizeX := GetSystemMetrics(SM_CXICON);
  IconSizeY := GetSystemMetrics(SM_CYICON);
  {Creating the "And" mask}
  AndMask := TBitmap.Create;
  AndMask.Monochrome := true;
  AndMask.Width := IconSizeX;
  AndMask.Height := IconSizeY;
  {Drawing on the "And" mask}
  AndMask.Canvas.Brush.Color := clWhite;
  AndMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
  AndMask.Canvas.Brush.Color := clBlack;
  AndMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);
  {Test drawing}
  Form1.Canvas.Draw(IconSizeX * 2, IconSizeY, AndMask);
  {Creating the "XOR" mask}
  XOrMask := TBitmap.Create;
  XOrMask.Width := IconSizeX;
  XOrMask.Height := IconSizeY;
  {Drawing onto the "XOR" mask}
  XOrMask.Canvas.Brush.Color := ClBlack;
  XOrMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
  XOrMask.Canvas.Pen.Color := clRed;
  XOrMask.Canvas.Brush.Color := clRed;
  XOrMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);
  {Test drawing}
  Form1.Canvas.Draw(IconSizeX * 4, IconSizeY, XOrMask);
  {Create an icon}
  Icon := TIcon.Create;
  IconInfo.fIcon := true;
  IconInfo.xHotspot := 0;
  IconInfo.yHotspot := 0;
  IconInfo.hbmMask := AndMask.Handle;
  IconInfo.hbmColor := XOrMask.Handle;
  Icon.Handle := CreateIconIndirect(IconInfo);
  {Destroying temporary bitmaps}
  AndMask.Free;
  XOrMask.Free;
  {Test drawing}
  Form1.Canvas.Draw(IconSizeX * 6, IconSizeY, Icon);
  {Assigning the application's icon}
  Application.Icon := Icon;
  {Forcing a repaint}
  InvalidateRect(Application.Handle, nil, true);
  {Free the icon}
  Icon.Free;
end;