如何在不拉伸的情况下将图标添加到更大尺寸的 ImageList？

Question

我有大小为 72x72 的 ImageList，图标 (HICON) 的句柄，由 SHGetFileInfo 获得（例如一个大小为 32x32 的大图标）。如何将它添加到这个 ImageList 保持透明度，但不拉伸？现在我在中间绘制一个临时位图所需大小的图标，然后将其添加到 ImageList 中。

SHGetFileInfo(PChar(Path + sr.Name), sr.FindData.dwFileAttributes, fi, SizeOf(fi), SHGFI_ICON or SHGFI_LARGEICON or SHGFI_USEFILEATTRIBUTES);
Bmp:=TBitmap.Create;
Bmp.PixelFormat:=pf32bit;
Bmp.SetSize(72, 72);
DrawIcon(Bmp.Canvas.Handle, 20, 20, fi.hIcon);
iIcon:=ImageList_AddMasked(ilThumbs.Handle, Bmp.Handle, 0);
Bmp.Free;

但我认为存在一种更快的方法（无需在临时位图上绘图）。 Also image in ImageList loses transparency and when I set index of this Image in ImageList for ListView item.ImageIndex it looks not pretty (when this item is selected, white background around is present).有什么办法可以解决这个问题吗？

谢谢。

Answer 1

好的，下面是我的解决方案：

procedure SetAlpha(Bitmap: TBitmap);
type
  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B, G, R, Alpha: Byte;
  end;
var
  X, Y: Integer;
  Pixel: PPixelRec;
begin
  for Y := 0 to (Bitmap.Height - 1) do
  begin
    Pixel := Bitmap.ScanLine[Y];
    for X := 0 to (Bitmap.Width - 1) do
    begin
      Pixel.Alpha:=255;
      Inc(Pixel);
    end;
  end;
end;
//skipped
var Bmp: TBitmap;
    fi: TSHFileInfo;
    ImageList1: TImageList;
begin
  ImageList1:=TImageList.CreateSize(72, 72);
  ImageList1.DrawingStyle:=dsTransparent;
  ImageList1.ColorDepth:=cd32Bit;
  SHGetFileInfo('c:\Windows\notepad.exe', FILE_ATTRIBUTE_NORMAL, fi, SizeOf(fi), SHGFI_ICON or SHGFI_LARGEICON or SHGFI_USEFILEATTRIBUTES);
  Bmp:=TBitmap.Create;
  Bmp.SetSize(72, 72);
  SetAlpha(Bmp);
  Bmp.Canvas.Brush.Color:=clWhite;
  Bmp.Canvas.FillRect(Rect(0, 0, 72, 72));
  DrawIcon(Bmp.Canvas.Handle, 20, 20, fi.hIcon);
  fi.iIcon:=ImageList1.Add(Bmp, nil);
  ImageList1.Draw(Canvas, 0, 0, fi.iIcon); //just to see that's alright
end;

Answer 2

这是我用来执行此任务的代码。

请注意，我假设原始图标使用 32 位颜色，带有 alpha 通道。这在我使用此代码的设置中是合理的，但我无法确定它对您是否合理。

uses
  Windows, Graphics;

function CreateIconFromSmallerIcon(IconSize: Integer; SmallerIcon: HICON): HICON;

  procedure GetDIBheaderAndBits(bmp: HBITMAP; out bih: BITMAPINFOHEADER; out bits: Pointer);
  var
    pbih: ^BITMAPINFOHEADER;
    bihSize, bitsSize: DWORD;
  begin
    bits := nil;
    GetDIBSizes(bmp, bihSize, bitsSize);
    pbih := AllocMem(bihSize);
    Try
      bits := AllocMem(bitsSize);
      GetDIB(bmp, 0, pbih^, bits^);
      if pbih.biSize<SizeOf(bih) then begin
        FreeMem(bits);
        bits := nil;
        exit;
      end;
      bih := pbih^;
    Finally
      FreeMem(pbih);
    End;
  end;

  procedure InitialiseBitmapInfoHeader(var bih: BITMAPINFOHEADER);
  begin
    bih.biSize := SizeOf(BITMAPINFOHEADER);
    bih.biWidth := IconSize;
    bih.biHeight := 2*IconSize;//height of xor bitmap plus height of and bitmap
    bih.biPlanes := 1;
    bih.biBitCount := 32;
    bih.biCompression := BI_RGB;
  end;

  procedure CreateXORbitmap(const sbih, dbih: BITMAPINFOHEADER; sptr, dptr: PDWORD);
  var
    line, xOffset, yOffset: Integer;
  begin
    xOffset := (IconSize-sbih.biWidth) div 2;
    yOffset := (IconSize-sbih.biHeight) div 2;
    inc(dptr, xOffset + IconSize*yOffset);
    for line := 0 to sbih.biHeight-1 do begin
      Move(sptr^, dptr^, sbih.biWidth*SizeOf(DWORD));
      inc(dptr, IconSize);//relies on the fact that no padding is needed for RGBA scanlines
      inc(sptr, sbih.biWidth);//likewise
    end;
  end;

var
  SmallerIconInfo: TIconInfo;
  sBits, xorBits: PDWORD;
  xorScanSize, andScanSize: Integer;
  xorBitsSize, andBitsSize: Integer;
  sbih: BITMAPINFOHEADER;
  dbih: ^BITMAPINFOHEADER;
  resbitsSize: DWORD;
  resbits: Pointer;

begin
  Result := 0;
  Try
    if not GetIconInfo(SmallerIcon, SmallerIconInfo) then begin
      exit;
    end;
    Try
      GetDIBheaderAndBits(SmallerIconInfo.hbmColor, sbih, Pointer(sBits));
      if Assigned(sBits) then begin
        Try
          if (sbih.biWidth>IconSize) or (sbih.biHeight>IconSize) or (sbih.biPlanes<>1) or (sbih.biBitCount<>32) then begin
            exit;
          end;

          xorScanSize := BytesPerScanline(IconSize, 32, 32);
          Assert(xorScanSize=SizeOf(DWORD)*IconSize);
          andScanSize := BytesPerScanline(IconSize, 1, 32);
          xorBitsSize := IconSize*xorScanSize;
          andBitsSize := IconSize*andScanSize;
          resbitsSize := SizeOf(BITMAPINFOHEADER) + xorBitsSize + andBitsSize;
          resbits := AllocMem(resbitsSize);//AllocMem zeroises the memory
          Try
            dbih := resbits;
            InitialiseBitmapInfoHeader(dbih^);

            xorBits := resbits;
            inc(PByte(xorBits), SizeOf(BITMAPINFOHEADER));
            CreateXORbitmap(sbih, dbih^, sBits, xorBits);

            //don't need to fill in the mask bitmap when using RGBA
            Result := CreateIconFromResourceEx(resbits, resbitsSize, True, $00030000, IconSize, IconSize, LR_DEFAULTCOLOR);
          Finally
            FreeMem(resbits);
          End;
        Finally
          FreeMem(sBits);
        End;
      end;
    Finally
      if SmallerIconInfo.hbmMask<>0 then begin
        DeleteObject(SmallerIconInfo.hbmMask);
      end;
      if SmallerIconInfo.hbmColor<>0 then begin
        DeleteObject(SmallerIconInfo.hbmColor);
      end;
    End;
  Finally
    DestroyIcon(SmallerIcon);
  End;
end;