ico und bmp

[scp]

Eine Alternative wäre:

Delphi-Quellcode:

function Bmp2Ico(ABitmap : TBitmap; ATransColor : TColor) : TIcon;
var
  IconSizeX  : Integer;
  IconSizeY  : Integer;
  XOrMask    : TBitmap;
  MonoMask   : TBitmap;
  BlackMask  : TBitmap;
  IconInfo   : TIconInfo;
  transcolor : TColor;
  R : TRect;
begin
 {Get the icon size}
  IconSizeX := GetSystemMetrics(SM_CXICON);
  IconSizeY := GetSystemMetrics(SM_CYICON);
  R := Rect(0, 0, IconSizeX, IconSizeY);


 {Create the "XOr" mask}
  XOrMask := TBitmap.Create;
  XOrMask.Width  := IconSizeX;
  XOrMask.Height := IconSizeY;

  {stretchdraw mypaint}
  XorMask.canvas.draw(0, 0, Abitmap);
  If (ATransColor > 0) then
    transcolor := ATransColor
  else
    transcolor := XorMask.Canvas.Pixels [0, IconSizeY - 1];

 {Create the Monochrome mask}
  MonoMask := TBitmap.Create;
  MonoMask.Width  := IconSizeX;
  MonoMask.Height := IconSizeY;
  MonoMask.Canvas.Brush.Color := Clwhite;
  MonoMask.Canvas.FillRect(R);

 {Create the Black mask}
  BlackMask := TBitmap.Create;
  BlackMask.Width  := IconSizeX;
  BlackMask.Height := IconSizeY;

 {if black is not the transcolor we must replace black
  with a temporary color}
  If (transcolor <> clBlack) then
    begin
      BlackMask.Canvas.Brush.Color := $F8F9FA;
      BlackMask.Canvas.FillRect(R);
      BlackMask.Canvas.BrushCopy(R, XorMask, R, clBlack);
      XorMask.Assign (BlackMask);
    end;

  {now make the black mask}
  BlackMask.Canvas.Brush.Color := clBlack;
  BlackMask.Canvas.FillRect(R);

 {draw the XorMask with brushcopy}
  BlackMask.canvas.BrushCopy(R, XorMask, R, transcolor);
  XorMask.Assign (BlackMask);

 {Assign and draw the mono mask}
  XorMask.Transparent := true;
//  XorMask.TransparentColor := transcolor;
  XorMask.TransparentColor := clblack;
  MonoMask.Canvas.draw(0, 0, XorMask);
  MonoMask.canvas.copymode := cmSrcInvert;
  MonoMask.canvas.CopyRect (R, XorMask.canvas, R);
  MonoMask.monochrome := true;

//  XorMask.transparent := false;

  {restore the black color in the image}
  BlackMask.Canvas.Brush.Color := clBlack;
  BlackMask.Canvas.FillRect(R);
  BlackMask.canvas.BrushCopy(R, XorMask, R, $F8F9FA);
  XorMask.Assign(BlackMask);


 {Create a icon}
  result := TIcon.Create;
  IconInfo.fIcon := true;
  IconInfo.xHotspot := 0;
  IconInfo.yHotspot := 0;
  IconInfo.hbmMask  := MonoMask.Handle;
  IconInfo.hbmColor := XOrMask.Handle;
  result.Handle := CreateIconIndirect(IconInfo);

 {Destroy the temporary bitmaps}
  XOrMask.Free;
  MonoMask.free;
  BlackMask.free;
end;