Delphi - Icon Infos auslesen

 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;

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;

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;

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;

 

2012-01-26T23:14:41 +0100, mail[at]michael[Bindestrich]puff.de