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;