На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Модераторы: jack128, Rouse_, Krid
  
    > Получить иконку с помощью IExtractIcon
      ExpandedWrap disabled
        uses Windows,ShlObj;
         
        function EGGetIcon(FileName:PChar; iconSize:Integer):HICON;
        var
         tmpIcon:HICON;
         deskFolder,appObject:IShellFolder;
         pidlLocal, pidlRelative: PItemIDList;
         extractIcon:IExtractIcon;
         iconLocation:array[0..MAX_PATH-1] of Char;
         iconIndex:integer;
         pchEaten,dwAttrib,iconFlags:Cardinal;
         hr:HRESULT;
        begin
           Result:=0;
         
           if FAILED(SHGetDesktopFolder(deskFolder)) then exit;
         
           if FAILED(deskFolder.ParseDisplayName(0, nil, FileName, pchEaten, pidlLocal, dwAttrib)) then exit;
         
           pidlRelative := ILClone(ILFindLastID(pidlLocal));
           ILRemoveLastID(pidlLocal);
         
           hr := deskFolder.BindToObject(pidlLocal, nil, IID_IShellFolder, appObject);
           ILFree(pidlLocal);
           if FAILED(hr) then exit;
         
           hr := appObject.GetUIObjectOf(0, 1, pidlRelative, IID_IExtractIconW, nil,extractIcon);
           ILFree(pidlRelative);
           if FAILED(hr) then exit;
         
           if FAILED(extractIcon.GetIconLocation(0, iconLocation, MAX_PATH, iconIndex, iconFlags)) then exit;
         
           if (iconSize = 16) then
            hr := extractIcon.Extract(iconLocation, iconIndex, tmpIcon, Result, MAKELONG(32, 16))
           else
            hr := extractIcon.Extract(iconLocation, iconIndex, Result, tmpIcon, MAKELONG(iconSize, 16));
           if SUCCEEDED(hr) then DestroyIcon(tmpIcon);
        end;
         
        procedure TForm1.Button1Click(Sender: TObject);
        var
         icon:HICON;
        begin
         icon:=EGGetIcon('C:\WINDOWS\MEDIA\ding.wav',32);
         Image1.Picture.Icon.Handle:=icon
        end;
        Failed, Succeeded - ?
          Цитата Fr0sT @
          Failed, Succeeded - ?

          uses Windows :)
          0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
          0 пользователей:


          Рейтинг@Mail.ru
          [ Script execution time: 0,0224 ]   [ 16 queries used ]   [ Generated: 28.03.24, 13:32 GMT ]