Icons von Datei auslesen

[Matze]

Hi!

Nimm einfach anstatt der paintBox ein Image und gib noch die SaveDialog-Komponente aufs Formular:

Delphi-Quellcode:

//exe auswählen
procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  DrawFile(OpenDialog1.FileName);
end; 

//Icon auslesen:
procedure TForm1.DrawFile(Name: String);
var 
  FileInfo: TSHFileInfo;
  ImageListHandle: THandle; 
  aIcon: TIcon; 
begin 
  // Speicher löschen 
  FillChar(FileInfo, SizeOf(FileInfo), #0); 
  // Handle der Image Liste der ausgewählten Datei ermitteln 
  ImageListHandle := SHGetFileInfo( 
    PChar(Name), 0, FileInfo, SizeOf(FileInfo), 
    // großes Icon verlangen 
    SHGFI_ICON or SHGFI_LARGEICON 
  ); 
  try 
    // TIcon Objekt erstellen 
    aIcon := TIcon.Create; 
    try 
      // Icon Handle zuweisen 
      aIcon.Handle := FileInfo.hIcon; 
      // Transparent darstellen
      aIcon.Transparent := True;
      with Image1 do begin 
         // Paintbox auf die entsprechende Größe bringen 
         Width := aIcon.Width; 
         Height := aIcon.Height; 
         Application.ProcessMessages; 
         // Paintbox löschen 
         Canvas.Rectangle(-1, -1, Succ(Width), Succ(Height)); 
         // Icon darstellen 
         Canvas.Draw(0, 0, aIcon); 
      end; 
    finally 
      // TIcon Objekt freigeben 
      FreeAndNil(aIcon); 
    end; 
  finally 
    // Icon der Shell wieder freigeben 
    DestroyIcon(FileInfo.hIcon); 
    // Icon Liste der Shell wieder freigeben
    {ImageList_Destroy(ImageListHandle);}
  end;
end;

//Speicher freigeben, da
//ImageList_Destroy(ImageListHandle);  nicht funktioniert hatte :)
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Free;
end;

//Icon speichern
procedure TForm1.Button2Click(Sender: TObject);
begin
  SaveDialog1.Execute;

  if pos('.bmp', SaveDialog1.filename) = 0 then
  SaveDialog1.fileName := SaveDialog1.FileName + '.bmp';

  Image1.Picture.SaveToFile(SaveDialog1.FileName);
end;