//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;