procedure SaveBmpAsIcon(const Bmp: TBitmap; const Icon: string; const SmallIcon: Boolean; 
const Transparent: Boolean; const X, Y: Integer); 
//  Bmp        : Bitmap图片 
//  Icon      : 最终输出的icon文件全路径和文件名。如果文件已经存在则会将其覆盖 
//  SmallIcon  : True: 16x16 图标, False: 32x32 图标 
//  Transparent: 确定是否按照参数X,Y的坐标色生成透明图标 
//  X, Y      : 此参数指明坐标下的色值将会作为透明色替换全图 
var 
  PBI, MPBI: PBitmapInfo; 
  IHS, MIHS, ImageSize, MImageSize: DWord; 
  bmBuffer, MaskBuffer: Pointer; 
  TID: TIconDir; 
  TBIH: TBitmapInfoHeader; 
  Bmx, Bmm: TBitmap; 
  TranspCol: TColor; 
  I, J: Integer; 
begin 
  Bmx:= TBitmap.Create; 
  Bmm:= TBitmap.Create; 
  try 
    if SmallIcon then 
    begin 
      Bmx.Width:= GetSystemMetrics(SM_CXSMICON); 
      Bmx.Height:= GetSystemMetrics(SM_CYSMICON); 
    end 
    else 
    begin 
      Bmx.Width:= GetSystemMetrics(SM_CXICON); 
      Bmx.Height:= GetSystemMetrics(SM_CYICON); 
    end; 
    bmx.pixelformat:=pf24bit; 
    Bmx.Canvas.StretchDraw(Rect(0, 0, Bmx.Width, Bmx.Height), Bmp); 
    TranspCol:= Bmx.Canvas.Pixels[X, Y]; 
    //TranspCol:= clWhite; 
    Bmm.Assign(Bmx); 
    Bmm.Mask(TranspCol); 
    GetDIBSizes(Bmm.Handle, MIHS, MImageSize); 
    GetDIBSizes(Bmx.Handle, IHS, ImageSize); 
    MaskBuffer:= AllocMem(MImageSize); 
    bmBuffer:= AllocMem(ImageSize); 
    MPBI:= AllocMem(MIHS); 
    PBI:= AllocMem(IHS); 
    try 
      if Transparent then 
      begin 
        for I:=0 to Bmx.Width-1 do 
          for J:=0 to Bmx.Height-1 do 
            if Bmx.Canvas.Pixels[I, J] = TranspCol then Bmx.Canvas.Pixels[I, J]:= 0; 
        with MPBI^.bmiHeader do 
        begin 
          biSize:= SizeOf(TBitmapInfoHeader); 
          biWidth:= Bmm.Width; 
          biHeight:= Bmm.Height; 
          biPlanes:= 1; 
          biBitCount:= 1; 
          biCompression:= BI_RGB; 
          biSizeImage:= MImageSize; 
          biXPelsPerMeter:= 0; 
          biYPelsPerMeter:= 0; 
          biClrUsed:= 2; 
          biClrImportant:= 2; 
        end; 
        GetDIBits(Bmm.Canvas.Handle, Bmm.Handle, 0, Bmm.height, MaskBuffer, MPBI^, DIB_RGB_COLORS); 
      end; 
      with PBI^.bmiHeader do 
      begin 
        biSize:= SizeOf(TBitmapInfoHeader); 
        biWidth:= Bmx.Width; 
        biHeight:= Bmx.Height; 
        biPlanes:= 1; 
        biBitCount:= 24; 
        biCompression:= BI_RGB; 
        biSizeImage:= ImageSize; 
        biXPelsPerMeter:= 0; 
        biYPelsPerMeter:= 0; 
        biClrUsed:= 0; 
        biClrImportant:= 0; 
      end; 
      GetDIBits(Bmx.Canvas.Handle, Bmx.Handle, 0, Bmx.Height, bmBuffer, PBI^, DIB_RGB_COLORS); 
      with TBIH do 
      begin 
        biSize:= 40; 
        biWidth:= Bmx.Width; 
        biHeight:= Bmx.Height * 2; 
        biPlanes:= 1; 
        biBitCount:= 24; 
        biCompression:= 0; 
        biSizeImage:= ImageSize; 
        biXPelsPerMeter:= 0; 
        biYPelsPerMeter:= 0; 
        biClrUsed:= 0; 
        biClrImportant:= 0; 
      end; 
      with TID do 
      begin 
        idReserved:=0; 
        idType:=1; 
        idCount:=1; 
        with idEntries[1] do 
        begin 
          bWidth:=bmx.width; 
          bHeight:=bmx.height; 
          bColorCount:=0; 
          bReserved:=0; 
          wPlanes:=1; 
          wBitCount:=24; 
          dwBytesInRes:= SizeOf(TBitmapInfoHeader) + TBIH.biSizeImage + MImageSize; 
          dwImageOffset:= 6 + TID.idCount * SizeOf(TIconDirEntry); 
        end; 
      end; 
      with TFileStream.Create(Icon, fmCreate) do 
      try 
        Write(TID, 6 + TID.idCount * SizeOf(TIconDirEntry)); 
        Write(TBIH, SizeOf(TBitmapInfoheader)); 
        Write(bmBuffer^, TBIH.biSizeImage); 
        Write(maskBuffer^, MImageSize); 
      finally 
        Free; 
      end; 
    finally 
      FreeMem(MaskBuffer); 
      FreeMem(bmBuffer); 
      FreeMem(MPBI); 
      FreeMem(PBI); 
    end; 
  finally 
    Bmx.free; 
    Bmm.free; 
  end; 
end;