program Bmp2Ico;

uses
  Forms,
  Dialogs,
  Graphics,
  SysUtils,
  UGraph in '..\..\_Units\UGraph.pas';

{$R *.res}
procedure BmpToIco(FileName: String='');
var a: TPicture;
    b: TBitmap;
    i: TIcon;
    c, t: TRGBPack;
    m, n, l, p, q: Integer;
    precis: word;
    mask: TColor;
begin
  if FileName = '' then begin
     if ParamCount > 0 then begin
       for m := 1 to ParamCount do BmpToIco(ParamStr(m));
       Exit;
     end;
     If not PromptForFileName(FileName, 'Bitmap|*.bmp|All Files|*.*|', '*.bmp', 'Open a Bitmap to convert to Icon', '') then Exit;
  end;

 try
  a := TPicture.Create;
  b := TBitmap.Create;
  i := TIcon.Create;

  a.LoadFromFile(FileName);
  t := TRGBPack(a.Bitmap.Canvas.Pixels[0,0]); // Transparent color
  m := a.Graphic.Width;
  n := a.Graphic.Height;
  if m < n then l := n else l := m;
  l := ((l-1) shr 4 + 1) shl 4; {16, 32, 64,  128}

  {Culoarea de fon pentru b - transparenta}
  b.Canvas.Brush.Color := TColor(t);
  {Dimensiunile - patrat}
  b.Width  := l;
  b.Height := l;
  {Centrul imaginii b}
  m := (l-m)shr 1;
  n := (l-n)shr 1;

  precis := 7;                       // Cu aceasta aproximatie, culoarea t se va elimina
  mask := RGB(not 3, not 3, not 3);  // Se elimina unele culori
  for p := a.Graphic.Width-1 downto 0 do for q := a.Graphic.Height-1 downto 0 do begin
    c := TRGBPack(a.Bitmap.Canvas.Pixels[p,q] and mask);
    if (abs(c[0]-t[0])<=precis) and
       (abs(c[1]-t[1])<=precis) and
       (abs(c[2]-t[2])<=precis) then c := t ;
    b.Canvas.Pixels[m + p, n + q] := TColor(c);
  end;
  i := GetIco(b, TColor(t));
  i.SaveToFile(ChangeFileExt(FileName, '.ico'));
 finally
   a.Free;
   b.Free;
   i.Free;
 end;
end;

begin
  Application.Initialize;
  BmpToIco;
  Application.Run;
end.