delphi - 加载多帧图标

Question

有人知道可以读取多帧图标的类吗？网上搜索没有找到任何信息。

我尝试使用 Alan Peter Stotz 的 IconTools 2.0，它将图标正确加载到列表中，但 8 位和 4 位图标的位深度返回为 0。32 和 24 位图标帧的位深度为然而，返回正确。

查看时图标本身看起来是正确的...只是提到的位的位深度是错误的。

编辑#2根据 TLama 的评论，这里有一些未经测试的代码:

function NumberOfIcons ( AFileName: string ): integer;
var
  iNumberOfIcons: Integer;
begin

  iNumberOfIcons := ExtractIcon ( hInstance, PChar ( AFilename ), UINT ( -1 ) );
  Result := iNumberOfIcons;

end;

function ExtractAnIcon ( AFilename: string; AIndex: integer ): TBitmap;
var
  icoHandle: HIcon;
  iBitmap: TBitmap;
  iIcon: TIcon;
  iNumberOfIcons, i: Integer;
begin

  Result := nil;

  iBitmap := TBitMap.Create;

  iIcon := TIcon.Create;
  try

    // Get the number of Icons
    iNumberOfIcons := ExtractIcon ( hInstance, PChar ( AFilename ), UINT ( -1 ) );

    // Extract the icon frame
    icoHandle := ExtractIcon ( hInstance, PChar ( AFileName ), AIndex );
    iIcon.Handle := icoHandle;
    iBitmap.Width := iIcon.Width;
    iBitmap.Height := iIcon.Height;
    // Draw the icon on your bitmap
    DrawIcon ( iBitmap.Canvas.Handle, 0, 0, iIcon.Handle );    
    Result := iBitmap;

  finally
    iIcon.Free;
  end;

end;

function PixelFormatToBitDepth ( APixelFormat: TPixelFormat ): integer;
// Convert TPixelFormat to integer
begin

  Result := -1;
  case APixelFormat of
    pf32Bit:
      Result := 32;
    pf24bit:
      Result := 24;
    pf8bit:
      Result := 8;
    pf4Bit:
      Result := 4;
    pf1bit:
      Result := 1;
  end;

end;

我走在正确的道路上吗？在我的测试中，我现在得到 1 个图标，但 NumberOfIcons 函数返回 1？

编辑#3根据帮助文件“如果文件是.ICO文件，ExtractIcon的返回值为1”。那么用什么方法可以获取ico文件中的图标数量呢？

Answer 1

这是一个小代码示例:

uses ShellApi;

type
  TICONDIRENTRY = packed record
    bWidth: Byte;          // Width, in pixels, of the image
    bHeight: Byte;         // Height, in pixels, of the image
    bColorCount: Byte;     // Number of colors in image (0 if >=8bpp)
    bReserved: Byte;       // Reserved ( must be 0)
    wPlanes: Word;         // Color Planes
    wBitCount: Word;       // Bits per pixel
    dwBytesInRes: DWORD;   // How many bytes in this resource?
    dwImageOffset: DWORD;  // Where in the file is this image?
  end;

  TICONDIR = packed record
    idReserved: Word; // Reserved (must be 0)
    idType: Word;     // Resource Type (1 for icons)
    idCount: Word;    // How many images?
    idEntries: array [0..255] of TICONDIRENTRY;
  end;
  PICONDIR=^TICONDIR;

function GetIconsCount(const FileName: string): Word;
var
  Stream: TMemoryStream;
  IconDir: PICONDIR;
begin
  Result := 0;
  if ExtractIcon(hInstance, PChar(FileName), UINT(-1)) <> 0 then
  try
    Stream := TMemoryStream.Create;
    try
      Stream.LoadFromFile(FileName);
      IconDir := Stream.Memory;
      if IconDir.idType = 1 then
        Result := IconDir.idCount;
    finally
      Stream.Free;
    end;
  except
    // do not raise exceptions
  end;
end;

function ExtractIcons(const FileName: string; IconList: TList): Boolean;
var
  Stream: TMemoryStream;
  NewIconStream: TMemoryStream;
  IconDir: PICONDIR;
  NewIconDir: PICONDIR;
  Icon: TIcon;
  I: Integer;
begin
  Result := False;
  if ExtractIcon(hInstance, PChar(FileName), UINT(-1)) <> 0 then
  try
    Stream := TMemoryStream.Create;
    try
      Stream.LoadFromFile(FileName);
      IconDir := Stream.Memory;
      for I := 0 to IconDir.idCount-1 do
      begin
        NewIconStream := TMemoryStream.Create;
        try
          NewIconStream.Size := SizeOf(Word) * 3 + SizeOf(TICONDIRENTRY);
          NewIconStream.Position:= SizeOf(Word) * 3 + SizeOf(TICONDIRENTRY);

          NewIconDir := NewIconStream.memory;
          NewIconDir.idCount := 1;
          NewIconDir.idType := IconDir.idType;
          NewIconDir.idReserved := IconDir.idReserved;
          NewIconDir.idEntries[0] := IconDir.idEntries[I];
          NewIconDir.idEntries[0].dwImageOffset := NewIconStream.Size;

          Stream.Position := IconDir.idEntries[I].dwImageOffset;
          NewIconStream.CopyFrom(Stream, IconDir.idEntries[I].dwBytesInRes);
          NewIconStream.Position := 0;
          Icon := TIcon.Create;
          Icon.LoadFromStream(NewIconStream);
          IconList.Add(Icon);
        finally
          NewIconStream.Free;
        end;
        IconList.Add(Icon);
      end;
      Result := True;
    finally
      Stream.Free;
    end;
  except
    // do not raise exceptions
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: string;
  Icon: TIcon;
  List: TList;
  I: Integer;
begin
  FileName := 'c:\myicon.ico';
  List := TList.Create;
  try
    if ExtractIcons(FileName, List) then
    for I := 0 to List.Count - 1 do
    begin
      Icon := TIcon(List.Items[I]);
      DrawIcon(Form1.Canvas.Handle, 10, I * 40, Icon.Handle);
      Icon.Free;
    end;
  finally
    List.Free;
  end;
end;