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;