我使用的SHGetFileInfoW函数有问题。
这是一个相当慢的过程,并且在启动(Initialization)时首次读取会消耗100毫秒的时间。
在MSDN中,应该从线程而不是主线程读取它,因为它可能卡住进程。
我想使用其他一些功能(如果有)以读取图标。
另一件事。如何读取大图标,目前我最多可以读取32x32(SHGFI_LARGEICON)
谢谢!
实际代码:
procedure TForm1.LoadIcons;
var
Info: TShFileInfo;
Icon: TIcon;
Flags: UINT;
FileName: PAnsiChar;
begin
FileName := '.txt';
Flags := SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or SHGFI_LARGEICON;
Icon := TIcon.Create;
try
SHGetFileInfo(FileName, FILE_ATTRIBUTE_NORMAL, Info,
SizeOf(Info), Flags);
Icon.Handle := Info.hIcon;
Image1.Picture.Assign(Icon);
Image1.Refresh;
finally
DestroyIcon(Info.hIcon);
Icon.Free;
end;
end;
最佳答案
您可以从注册表中找到给定文件扩展名的DefaultIcon
,然后使用ExtractIconEx
。 Here is an example
我不知道它是否比SHGetFileInfo
快
编辑:
我已经从样本中提取了从扩展中获取图标的部分。
实际上,它运行非常快。可以进一步优化。
(我修改了一下代码):
// find the icon for a certain file extension in the registry
function TForm1.RegistryIconExtraction(Extension : string): integer;
var
RegKey : TRegistry;
IconPos : integer;
AssocAppInfo : string;
ExtractPath, FileName : string;
IconHandle, PLargeIcon, PSmallIcon : HICON;
AnIcon : TIcon;
begin
Result := 0; // default icon
if Extension[1] <> '.' then Extension := '.' + Extension;
RegKey := TRegistry.Create(KEY_READ);
try
// KEY_QUERY_VALUE grants permission to query subkey data.
RegKey.RootKey := HKEY_CLASSES_ROOT; // set folder for icon info lookup
if RegKey.OpenKeyReadOnly(Extension) then // extension key exists?
try
AssocAppInfo := RegKey.ReadString(''); // read app key
RegKey.CloseKey;
except
Exit;
end;
if ((AssocAppInfo <> '') and // app key and icon info exists?
(RegKey.OpenKeyReadOnly(AssocAppInfo + '\DefaultIcon'))) then
try
ExtractPath := RegKey.ReadString(''); // icon path
RegKey.CloseKey;
except
Exit;
end;
finally
RegKey.Free;
end;
// IconPos after comma in key ie: C:\Program Files\Winzip\Winzip.Exe,0
// did we get a key for icon, does IconPos exist after comma seperator?
If ((ExtractPath <> '') and (pos(',', ExtractPath) <> 0)) then
begin
// Filename in registry key is before the comma seperator
FileName := Copy(ExtractPath, 1, Pos(',', ExtractPath) - 1);
// extract the icon Index from after the comma in the ExtractPath string
try
IconPos := StrToInt(copy(ExtractPath, Pos(',', ExtractPath) + 1,
Length(ExtractPath) - Pos(',', ExtractPath) + 1));
except
Exit;
end;
IconHandle := ExtractIconEx(PChar(FileName), IconPos, PLargeIcon, PSmallIcon, 1);
If (PLargeIcon <> 0) then
begin
AnIcon := TIcon.Create;
AnIcon.Handle := PLargeIcon;
Image1.Picture.Assign(AnIcon);
Image1.Refresh;
AnIcon.Free;
end;
DestroyIcon(PLargeIcon);
DestroyIcon(PSmallIcon);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
t1, t2: DWORD;
begin
t1 := GetTickCount;
RegistryIconExtraction('.txt');
t2 := GetTickCount;
Memo1.Lines.Add(IntToStr(t2-t1));
end;
EDIT2:示例代码现在符合Vista / Win7 UAC。