Главный модуль программы (часть 20) - GetSHIcon

Рубрика: Исходники
Среда, 21 апреля 2010 г.
Просмотров: 147
последняя версия: 3.0.9 build 961 beta
от 07 декабря 2007 г.
function TForm1.GetSHIcon(FName: AnsiString; fType: string): HICON;
var
  ext, defaultIcon: string;
  xReg: TRegistry;
  xList: TstringList;
  i: integer;
  w: word;
  hIns: THandle;
  ListIco2: HICON;
  res: boolean;
begin
 // result:= 0;
 // ExtractAssociatedIcon(handle, PChar('c:\' + FName), w);
 // result:= w;

  result:= 0;
  xReg:= TRegistry.Create;
  try
    xReg.RootKey:= HKEY_CLASSES_ROOT;
    ext:= ExtractFileExt(FName);
    res:= xReg.OpenKey('\' + ext, false);
    if not res then exit;
    xList:= TstringList.Create;
    try
      xReg.GetValueNames(xList);
      //for i:=0 to xList.Count-1 do tmp:= xList[i]; end;
      if xList.Count<= 0 then defaultIcon:= 'Folder'//;//exit;
      else defaultIcon:= xReg.ReadString('');
      if (defaultIcon = '') then exit;
      if not xReg.OpenKeyReadOnly('\' + defaultIcon + '\DefaultIcon') then exit;
      defaultIcon:= xReg.ReadString('');
      if defaultIcon = ''
        then
          exit;
      for i:= length(defaultIcon) downto 1 do
        if defaultIcon[i] = ',' then begin
                                       w:= StrToInt(Copy(defaultIcon, i+1, length(defaultIcon)-i));
                                       defaultIcon:= Copy(defaultIcon, 1, i-1);
                                       break;
                                     end;
      hIns:= LoadLibrary(PChar(defaultIcon));
      ExtractIconEx(Pchar(defaultIcon), w, ListIco2, result, 1);
      FreeLibrary(hIns);
    finally
      xList.Free;
    end;
  finally
    xReg.CloseKey;
    xReg.Free;
  end;
  //rKey:= RegOpenKey(HKEY_CLASSES_ROOT, ext);
end;
Rambler's Top100