Получение иконки для зарегистрированного расширения по его имени

Советы » ICO » Получение иконки для зарегистрированного расширения по его имени

{ **** 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

;

Пример использования:

GetRegistryIconHandle('c:winntwin.ini');

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com