Cargar iconos MultiFrame

Question

¿Alguien sabe de una clase que puede leer iconos de multitrama? La búsqueda en Internet no ha producido ninguna información.

Probé con IconTools 2.0 de Alan Peter Stotz, que carga correctamente los iconos en una lista, pero la profundidad de bits para los iconos de 8 y 4 bits retorna como 0. La profundidad de bits para los marcos de iconos de 32 y 24 bits se devuelve correctamente, sin embargo.

El icono en sí aparece correcto al visualizar ... solo la profundidad de bits es incorrecta para los bits mencionados.

editar # 2 baised en el comentario de Tlama Aquí hay un código no probado:

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; 

estoy en el camino correcto? En mis pruebas, ahora obtengo 1 ícono pero la función NumberOfIcons devuelve 1?

editar # 3 De acuerdo con el archivo de ayuda "Si el archivo es un archivo ICO, el valor de retorno de ExtractIcon es 1." Entonces, ¿qué método se puede usar para obtener la cantidad de iconos en el archivo ico?

Answer 1

Aquí es un pequeño ejemplo de código:

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;