{ **** UBPFD *********** by delphibase.endimus.com **** >> Получение иконки для зарегистрированного расширения по его имени
Функции в качестве параметра передаётся имя файла и в случае удачного выполнения она (функция) возвращает handle'р иконки (HICON). В случае, если в реестре небыло найдено расширения предложеного файла, функция возвращает 0.
Также при успешном выполнении необходимо освободить хендлер. Для этого используется функция DestroyIcon(Handle:HICON).
Зависимости: модуль Registry, модуль ShellAPI, модуль SysUtils и стандартные функции Pos, Delete, Copy, ExtractFileExt, ExtractIcon, StrToInt.
Автор: Poirot, poirot@rol.ru, Нижний Новгород Copyright: Poirot (частично из Delphi 5. Руководство разработчика) Дата: 16 июня 2002 г. ***************************************************** }
function GetRegistryIconHandle(FileName: string): HICON; var R: TRegistry; Alias, //псевдвним для расширения в реестре IconPath: string; //путь для файла с иконкой IconNum, //номер иконки в файле QPos: Integer; //позиция запятой в записи реестра begin IconNum := 0;
R := TRegistry.Create;
try R.RootKey := HKEY_CLASSES_ROOT;
//чтение псевданима if R.OpenKey('\' + ExtractFileExt(FileName), True) then Alias := R.ReadString(''); R.CloseKey;
//чтение записи об иконке if R.OpenKey('\' + Alias + '\DefaultIcon', True) then IconPath := R.ReadString(''); R.CloseKey;
//поиск запятой QPos := Pos(',', IconPath);
//чтение номера иконки в файле если она имеется if QPos <> 0 then begin IconNum := StrToInt(Copy(IconPath, QPos + 1, 4)); IconPath := Copy(IconPath, 1, QPos - 1) end;
finally R.Free; end;
//передача хендлера иконки как рещультат выполнения Result := ExtractIcon(hInstance, PChar(IconPath), IconNum); end;
|