我正在使用的SHGetFileInfoW函数存在问题。
这是一个非常慢的启动时首次读取(初始化)消耗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;
答案 0 :(得分:4)
您可以从注册表中找到给定文件扩展名的DefaultIcon
并使用ExtractIconEx
。 Here is an example
我不知道它是否比SHGetFileInfo
修改强>
我从扩展中提取了(从样本中)获取ICON的部分。 它实际上非常快。可以进行更多优化。 (我稍微修改了一下代码):
// 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标准。