Получение системной иконки, ассоциированной с файлом в данной системеDelphi , Графика и Игры , ICOПолучение системной иконки, ассоциированной с файлом в данной системе
Автор: Дмитрий Баранов { **** UBPFD *********** by delphibase.endimus.com **** >> Получение системной иконки, ассоциированной с файлом в данной системе Функция позволяет получить такую же иконку любой директории или любого файла, какую вы видите в "проводнике". Размеры - 16 * 16 (по умолчанию) или 32 * 32 (второй параметр - itLarge) Зависимости: Юниты VCL + ComObj, ActiveX, ShellApi, ShlObj; Автор: Дмитрий Баранов, kda@pisem.net, Москва Copyright: Взято из MSDN Дата: 20 мая 2002 г. ***************************************************** } type TIconType = (itSmall, itLarge); function GetIcon(const FileName: string; const IconType: TIconType = itSmall): TIcon; var FileInfo: TShFileInfo; ImageList: TImageList; IT: DWORD; begin // CoInitialize; лучше - поместите вызов этой ф. в раздел initialization IT := SHGFI_SMALLICON; Result := TIcon.Create; ImageList := TImageList.Create(nil); if (IconType = itLarge) then begin IT := SHGFI_LARGEICON; ImageList.Height := 32; ImageList.Width := 32; end; FillChar(FileInfo, Sizeof(FileInfo), #0); ImageList.ShareImages := true; ImageList.Handle := SHGetFileInfo( PChar(FileName), SFGAO_SHARE, FileInfo, sizeof(FileInfo), IT or SHGFI_SYSICONINDEX ); ImageList.GetIcon(FileInfo.iIcon, Result); ImageList.Free; { Не забывайте освободить полученную иконку } end; Пример использования: procedure TForm1.Button1Click(Sender: TObject); var Icon: TIcon; begin Self.Icon := GetIcon('C:\'); end; Код на языке Delphi! Функция Разбивка кода:
Обратите внимание, что этот код требует следующих модулей: Функция получения системной иконки, ассоциированной с файлом в данной системе, позволяет получать иконку любой директории или файла, какую видят в "проводнике", размером 16*16 или 32*32 пикселей. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |