Title: Get the icon of a file extension without having a file
Question: Ever wanted to show a nice icon in a list of files that doesnt exist on your system? You might be writing an FTP client and need to list files on the server for example? Most examples on how to get a files associated shell icon demands that you pass the filename to an actual file on your system. This code makes it possible to just pass the extension "*.xls" for example.
Answer:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ShellAPI;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
CheckBox1: TCheckBox;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetFileInfo(AExt : string; var AInfo : TSHFileInfo; ALargeIcon : boolean = false) : boolean;
var uFlags : integer;
begin
FillMemory(@AInfo,SizeOf(TSHFileInfo),0);
uFlags := SHGFI_ICON+SHGFI_TYPENAME+SHGFI_USEFILEATTRIBUTES;
if ALargeIcon then uFlags := uFlags + SHGFI_LARGEICON else uFlags := uFlags + SHGFI_SMALLICON;
result := (SHGetFileInfo(PChar(AExt),FILE_ATTRIBUTE_NORMAL,AInfo,SizeOf(TSHFileInfo),uFlags) 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var AExt : string;
AInfo : TSHFileInfo;
MyIcon: TIcon;
begin
AExt := Edit1.Text;
if GetFileInfo(AExt,AInfo,CheckBox1.Checked) then begin
MyIcon:= TIcon.Create;
try
MyIcon.Handle := AInfo.hIcon;
MyIcon.Transparent := true;
Label1.Caption := Trim(AExt);
Label2.Caption := AInfo.szTypeName;
Image1.Picture.Assign(MyIcon);
Image1.Update;
finally
MyIcon.Free;
end;
end else begin
Label1.Caption := 'Could not get an icon for that extension';
end;
end;
end.