delphi 获取系统注册的文件图标

最新推荐文章于 2019-09-02 15:30:00 发布

fyl_077

最新推荐文章于 2019-09-02 15:30:00 发布

阅读量894

点赞数

分类专栏： delphi开发

delphi开发专栏收录该内容

62 篇文章

订阅专栏

var
  Icon:TICON;
  Key : string;
  App : string;
  Index : Integer;
begin
  FileName:=Edit6.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;
  Edit5.Text := Key;
end;