怎样根据文件后缀名来得到该类型文件的图标？

Question

如题

Answer 1

//
unit GraphicsExpand;interface
uses
   Forms , Registry , Graphics , ShellAPI , Controls , SysUtils , Windows , Dialogs;Function GetExeByOpenFile(FileName:String):String; //得到打开这个文件的EXE文件
Function GetExeIcoByOpenFile(FileName:String):integer;  //得到这个文件对应的EXE里的图标号
Function AddFileIcoToImgLst(FileName : String ; ImageList : TImageList) : integer;
//把这个文件的图标增加到ImageList中去。
implementationFunction AddFileIcoToImgLst(FileName : String ; ImageList : TImageList) : integer;
var
  Count , IcoIndex : integer;
  Ico : Ticon;
  ExFile : String;
begin
  Result := -1;
  ExFile := GetExeByOpenFile(FileName);
  IcoIndex := GetExeIcoByOpenFile(FileName);
  Count := ExtractIcon( Application.Handle, PChar(ExFile),$FFFFFFFF);
  Ico := Ticon.Create;
  if( IcoIndex < Count ) then begin
    Ico.Handle := ExtractIcon( Application.Handle, PChar(ExFile), IcoIndex );
    ImageList.AddIcon(Ico);
    Result := ImageList.Count -1;
  end;
  Ico.Free;
end;Function GetStrByOpenFile(FileName:String):String;
var
  Reg : Tregistry;
  FEName , RegNe: String;
begin
  Result := '%SystemRoot%\System32\shell32.dll,0';
  FeName := ansiuppercase(Trim(extractfileext(FileName)));
  if FEName='.EXE' then Result := Trim(FileName)
  else if copy(Trim(FileName),Length(Trim(FileName)),1)='\' then Result := '%SystemRoot%\System32\shell32.dll,3'
  else if FEName='' then Result := '%SystemRoot%\System32\shell32.dll,0'
  else begin
    if copy(FEName,1,1)<>'.' then FEName := '.'+FEName;
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_CLASSES_ROOT;
    if Reg.OpenKey(FEName,True) then begin
      RegNE := Reg.ReadString('')+'\\DefaultIcon';
      Reg.CloseKey;
      if RegNe <> '\\DefaultIcon' then begin
        Reg.OpenKey(RegNE,True);
        Result := Reg.ReadString('');
        Reg.CloseKey;
      end;
    end;
    Reg.Free;
  end;
end;Function GetExeIcoByOpenFile(FileName:String):integer;
var
  Tmp , cStr : String;
begin
  Result := 0;
  Tmp := '';
  cStr := GetStrByOpenFile(FileName);
  if cStr<>'' then
  while True do begin
    if pos(copy(cStr,Length(cStr),1),'-0123456789')>0 then
       begin
         Tmp := copy(cStr,Length(cStr),1) + Tmp;
         cStr := copy(cStr,1,Length(cStr)-1)
       end
    else begin
       if Tmp<>'' then Result := strtoint(Tmp);
       Break;
    end;
  end;
end;Function GetExeByOpenFile(FileName:String):String;
var
  cStr : String;
begin
  cStr := GetStrByOpenFile(FileName);
  Result := cStr;
  if (cStr<>'') and (Pos(',',cStr)>0) then
  while True do begin
    if copy(cStr,Length(cStr),1)<>',' then
       cStr := copy(cStr,1,Length(cStr)-1)
    else begin
       Result := copy(cStr,1,Length(cStr)-1);
       Break;
    end;
  end;
end;end.//使用方法：
AddFileIcoToImgLst('DD.DOC',ImageList);
就把Word的图标加到ImageList中了，就可以直接从ImageList中得到图标了三。
：）

Answer 2

最好把所有Reg.OpenKey(FEName,True) 地方改成Reg.OpenKeyReadonly(FEName),这样不会受用户权限的限制。

Answer 3

那没有关联exe的文件取什么图标？

Answer 4

Function GetStrByOpenFile(FileName:String):String;
var
  Reg : Tregistry;
  FEName , RegNe: String;
begin
  Result := '%SystemRoot%\System32\shell32.dll,0';
 看到这一句没有，没有关联的当然是取这个图标了。

Answer 5

这样取出来的图标都是32x32的，我需要的是16x16的，如果进行强制压缩图标会很难看，有什么好的方法解决，如果文件是在本机当然没问题了，现在我要得到图标的文件在ftp服务器上

Answer 6

to  kiboisme(还是铁棒.....针):
这段代码还有个小问题，如果在注册表中关联的程序加上""就取不到图标了，比如c:\aa.exe在注册表中写成"c:\aa.exe"，这样被关联的文件还是可以用aa.exe打开，但图标却是那种没有被关联的文件的图标，而且用你的代码得不到任何图标，当然解决也很简单，就是判断一下
（Count := ExtractIcon( Application.Handle, PChar(ExFile),$FFFFFFFF);）中的count是否为0，为零就把ExFile赋值为'%SystemRoot%\System32\shell32.dll,0'就可以了。：）

Answer 7

to  kiboisme(还是铁棒.....针):
你也太黑了吧，问题都没帮我解决居然要我结贴？：）
好吧，算了，问到这份上我也该收手了，给分。