ico und bmp

[G G]

hi leutz, ich will umbedingt ein bmp zu einem ico umformen, dann nach langer suche hab ich diesen code gefunden. Ich hab probiert in so umzuformen dass ich eine bmp datei angeben kann, und dann eine ico datei dann gespeichert wird. Nur dies erscheint mir unmöglich. Könnnt ihr mir helfen, danke. Wenns geht vielleicht da n bisschen was an code dazutexen dass es auch funktioniert. danke

Delphi-Quellcode:

function CreateIconFromBmp(Bmp: TBitmap): TIcon;
begin
  with TImageList.CreateSize(Bmp.Width, Bmp.Height) do
  try
    {$IFDEF VER90}
    with Bmp do AddMasked(Bmp, Canvas.Pixels[Width-1, Height-1]);
    {$ELSE}
    AddMasked(Bmp, Bmp.TransparentColor);
    {$ENDIF}
    Result := TIcon.Create;
    GetIcon(0, Result);
  finally
    Free;
  end;
end;

[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;