1

我有大小为 72x72 的 ImageList，由 SHGetFileInfo 获得的图标 (HICON) 的句柄（例如大小为 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). 有什么办法可以解决这个问题吗？

谢谢。

4

2 回答 2

1

This is the code that I use to perform this task.

Note that I am assuming that the original icon uses 32 bit colour, with alpha channel. That's reasonable in the settings that I use this code, but I can't be sure whether or not it's reasonable for you.

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;
于 2012-08-28T08:11:47.667 回答
0

好的，我的解决方案如下：

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;
于 2012-08-28T07:24:34.467 回答