unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ShellAPI, StdCtrls, ExtCtrls;
type
TForm1 =
class(TForm)
PaintBox1: TPaintBox;
OpenDialog1: TOpenDialog;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
procedure DrawFile(
Name:
String);
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute
then
DrawFile(OpenDialog1.FileName);
end;
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 PaintBox1
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;
end.