unit icon_get;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Registry,shellapi, ExtCtrls;
type
TForm1 = class(TForm)
FN: TEdit;
Label1: TLabel;
Button1: TButton;
Button2: TButton;
INN: TEdit;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
FileName: String;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Icon:TICON;
Key : string;
App : string;
Index : Integer;
begin
FileName:=FN.Text;
if Pos('.',FileName) = 0 then
begin
Exit;
end;
with TRegistry.Create do
try
RootKey := HKEY_CLASSES_ROOT;
Key := ExtractFileExt(FileName);
if KeyExists(Key) then
begin
OpenKey(Key,false);
Key := ReadString('');
CloseKey;
end;
if Key <> '' then
begin
RootKey:=HKEY_CLASSES_ROOT;
if KeyExists(Key) then
begin
OpenKey(Key,false);
OpenKey('DefaultIcon',false);
Key:=ReadString('');
CloseKey;
end;
end;
finally
free;
end;
if Key <> '' then
begin
Icon:=TIcon.Create;
App := '';
Index :=0;
If Pos(',',Key) > 0 then
begin
App :=Copy(Key,1,Pos(',',Key)-1);
try
Index :=StrToInt(Copy(Key,Pos(',',Key)+1,Length(Key)));
except
Index :=0;
end;
end;
if App <> '' then
begin
Icon.Handle := ExtractIcon(HINSTANCE,PChar(App),Index);
Form1.Icon := Icon;
end;
Icon.Free;
end;
INN.Text := Key;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;
end.
