BmpToIcon

[Shaman]

Hey there

Hab ich noch irgendwo in meiner CodeLib gefunden, aber nicht mehr getestet. Ist auch schon länger her...

Delphi-Quellcode:

type
  TIconDirEntry = packed record
    bWidth:Byte;
    bHeight:Byte;
    bColorCount:Byte;
    bReserved:Byte;
    wPlanes:Word;
    wBitCount:Word;
    dwBytesInRes:DWord;
    dwImageOffset:DWord;
  end;

  TIcondir = packed record
    idReserved:Word;
    idType:Word;
    idCount:Word;
    IdEntries:array[1..20] of TIconDirEntry;
  end;

procedure SaveBmpAsIcon(const Bmp: TBitmap; const Icon: string; const SmallIcon: Boolean;
                        const Transparent: Boolean; const X, Y: Integer);

//  Bmp        : Die Bitmpap
//  Icon       : Dateiname, unter welchem das Icon gespeichert wird
//  SmallIcon  : True: 16x16 Icon, False: 32x32 Icon
//  Transparent: Farbe des Pixels an (X, Y) als transparent definieren
//  X, Y       : Koordinaten der Transparentfarbe

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