Icon-Datei Header auslesen

[Luckie]

Also erstmal die struct Übersetzungen in Pascal Records:

Delphi-Quellcode:

 
type 
  TIconEntry = record 
    FWidth: Byte; // Width, in pixels, of the ima 
    FHeight: Byte; // Height, in pixels, of the image 
    FColorCount: Byte; // Number of colors in image (0 if >=8bpp 
    FReserved: Byte; // Reserved ( must be 0 
    FPlanes: WORD; // Color Planes 
    FBitCount: WORD; // Bits per pixel 
    FBytesInRes: DWORD; // How many bytes in this resource? 
    FImageOffset: DWORD; // Where in the file is this image? 
  end; 

type 
  TIconDir = record 
    FReserved: WORD; // Reserved (must be 0 
    FType: WORD; // Resource Type (1 for icons) 
    FCOUNT: WORD; // How many images? 
    FEntries: array of TICONENTRY; // An entry for each image (idCount of 'em) 
  end;

Dann das Auslesen des TIconDir und des TIconEntry Records aus der ICO-Datei:

Delphi-Quellcode:

 
function GetIconDir(Filename: string; var IconDir: TIconDir; var IconEntry: 
  TIconEntry): Integer; 
var 
  hFile: THandle; 
begin 
  SetLastError(0); 
{$IOCHECKS OFF} 
  hFile := FileOpen(Filename, $0000); 
  if hFile <> 0 then 
  begin 
    FileSeek(hFile, 0, 0); 
    FileRead(hFile, IconDir, sizeof(TIconDir)); 
    FileSeek(hFile, IconDir.FCOUNT * sizeof(TIconEntry), 0); 
    FileRead(hFile, IconEntry, sizeof(TIconEntry)); 
  end; 
  FileClose(hFile); 
{$IOCHECKS ON} 
  result := GetLastError(); 
end;

Rückgabewert der Funktion ist der letzte Systemfehler. Die Informationen werden als var Parameter "zurückgegeben".
So dann die IconEntry Infos für jedes Icon in der ICO-Datei. Es könne ja bekanntlich mehrer Icons in einer ICO-date stecken.):

Delphi-Quellcode:

function GetIconEntry(Filename: string; Offset: Integer; var IconEntry: 
  TIconEntry): Integer; 
var 
  hFile: THandle; 
begin 
  SetLastError(0); 
{$IOCHECKS OFF} 
  hFile := FileOpen(Filename, $0000); 
  if hFile <> 0 then 
  begin 
    FileSeek(hFile, Offset, 0); 
    FileRead(hFile, IconEntry, sizeof(TIconEntry)); 
  end; 
  FileClose(hFile); 
{$IOCHECKS ON} 
  result := GetLastError(); 
end;

Da sie vor jedem Icon steht, muss der Offset angeben werden.

So und jetzt das ganze in einem Demo Projekt mit einer Listbox und einem Buton:

Delphi-Quellcode:

 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  IconDir: TIconDir; 
  IconEntry: TIconEntry; 
  Loop: Integer; 
begin 
  if GetIconDir('d:\test.ico', IconDir, IconEntry) = 0 then 
  begin 
    // TIconDir 
    with Listbox1.Items do 
    begin 
      Add('TIconDir:'); 
      Add('  Reserved: ' + IntToStr(IconDir.FReserved)); 
      Add('  Type: ' + IntToStr(IconDir.FType)); 
      Add('  Count: ' + IntToStr(IconDir.FCOUNT)); 
    end; 
    // TIconEntry 
    setlength(IconDir.FEntries, IconDir.FCOUNT); 
    for Loop := 0 to IconDir.FCOUNT - 1 do 
    begin 
      if GetIconEntry('d:\test.ico', IconDir.FEntries[Loop].FImageOffset, 
        IconEntry) = 0 then 
      begin 
        with Listbox1.Items do 
        begin 
          Add('TIconEntry:'); 
          Add('  Width: ' + IntToStr(IconDir.FEntries[Loop].FWidth)); 
          Add('  Height: ' + IntToStr(IconDir.FEntries[Loop].FHeight)); 
          Add('  ColorCount: ' + IntToStr(IconDir.FEntries[Loop].FColorCount)); 
          Add('  Reserved: ' + IntToStr(IconDir.FEntries[Loop].FReserved)); 
          Add('  Planes: ' + IntToStr(IconDir.FEntries[Loop].FPlanes)); 
          Add('  BitCount: ' + IntToStr(IconDir.FEntries[Loop].FBitCount)); 
          Add('  BytesInRes: ' + IntToStr(IconDir.FEntries[Loop].FBytesInRes)); 
          Add('  ImageOffset: ' + 
            IntToStr(IconDir.FEntries[Loop].FImageOffset)); 
        end; 
      end; 
    end; 
  end; 
end;

Das Demo-Projekt ist auch hier: http://www.luckie-online.de/files/demos/IconInfos.zip (2KB) verfügbar.