2007. június 14., csütörtök

Function to work with icons in DLL, EXE and ICO files


Problem/Question/Abstract:

There are a list of solution, but those are what i personally use for that work.

Answer:

You need to include the ShellAPI unit in your uses clausole!

// This returns how many icons are in a file.

function DLLIconsCount(FileName: string): Integer;
var
  IconaGrande: HIcon;
  IconaPiccola: HIcon;
begin
  Result := 0;
  if (FileExists(FileName)) then
  begin
    Result := ExtractIconEx(PChar(FileName), -1, IconaGrande, IconaPiccola, 0);
  end;
end;

// This returns if there're icons in a file

function DLLHasIcons(FileName: string): Boolean;
begin
  Result := (DLLIconsCount(FileName) > 0);
end;

// This returns a TIcon for a given file and index.

function GetDLLIcon(FileName: string; Index: Integer = 0): TIcon;
begin
  Result := TIcon.Create;
  Result.Handle := 0;
  if (DLLHasIcons(FileName)) then
  begin
    try
      if (Index < 0) then
        Index := 0;
      if (Index > DLLIconsCount(FileName)) then
        Index := DLLIconsCount(FileName);
      Result.Handle := ExtractIcon(0, PChar(FileName), Index);
    finally
    end;
  end;
end;

// This saves an icon from a DLL (EXE or ICO) to a ICO file.

function ExportDLLIcon(OutputFile, InputFile: string; Index: Integer = 0): Boolean;
var
  Icona: TIcon;
begin
  Result := False;
  Icona := GetDLLIcon(InputFile, Index);
  if (not (Icona.Handle = 0)) then
  try
    Icona.SaveToFile(OutputFile);
  finally
    if (FileExists(OutputFile)) then
      Result := True;
  end;
  Icona.Destroy;
end;

// This is like ExportDLLIcon, but it saves a bitmap file.

function ExportDLLIconAsBitmap(OutputFile, InputFile: string; Index: Integer = 0):
  Boolean;
var
  Icona: TIcon;
  Immagine: TBitmap;
begin
  Result := False;
  Icona := GetDLLIcon(InputFile, Index);
  Immagine := TBitmap.Create;
  if (not (Icona.Handle = 0)) then
  try
    Immagine.Assign(Icona);
    Immagine.SaveToFile(OutputFile);
  finally
    if (FileExists(OutputFile)) then
      Result := True;
  end;
  Icona.Destroy;
  Immagine.Destroy;
end;

Nincsenek megjegyzések:

Megjegyzés küldése