[NumLock]

Получение эскиза (миниатюры) файла/папки с использованием IExtractImage.

Код:

unit ThumbnailImage;

interface

uses
  ActiveX, ShlObj, Windows, SysUtils;

type
  IExtractImage = interface
    ['{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}']
    function GetLocation(pszPathBuffer: LPWSTR; cchMax: DWORD;
      var pdwPriority: DWORD; var prgSize: TSize; dwRecClrDepth: DWORD;
      var pdwFlags: DWORD): HRESULT; stdcall;
    function Extract(var phBmpImage: HBITMAP): HRESULT; stdcall;
  end;

const
  IEIFLAG_OFFLINE = $008;
  IEIFLAG_SCREEN = $020;
  IEIFLAG_QUALITY = $200;

function GetThumbnailImage(const DisplayName: String;
  Width: Integer; Height: Integer): HBITMAP;

implementation

function GetThumbnailImage(const DisplayName: String;
  Width: Integer; Height: Integer): HBITMAP;
var
  FilePath: String;
  FileName: String;
  DesktopFolder: IShellFolder;
  Eaten: ULONG;
  DirectoryItemIDList: PItemIDList;
  Attributes: ULONG;
  ShellFolder: IShellFolder;
  ExtractImage: IExtractImage;
  PathBuffer: array [0..MAX_PATH-1] of WideChar;
  Priority: DWORD;
  Size: TSize;
  Flags: DWORD;
  ColorDepth: DWORD;
  Res: HRESULT;
begin
  Result:=0;
  FilePath:=ExcludeTrailingPathDelimiter(ExtractFilePath(DisplayName));
  if FilePath[Length(FilePath)]=':' then
    FilePath:=IncludeTrailingPathDelimiter(FilePath);
  FileName:=ExtractFileName(DisplayName);
  SHGetDesktopFolder(DesktopFolder);
  DesktopFolder.ParseDisplayName(0, nil, StringToOleStr(FilePath),
    Eaten, DirectoryItemIDList, Attributes);
  DesktopFolder.BindToObject(DirectoryItemIDList, nil,
    IShellFolder, ShellFolder);
  CoTaskMemFree(DirectoryItemIDList);
  ShellFolder.ParseDisplayName(0, nil,
    StringToOleStr(ExtractFileName(FileName)),
    Eaten, DirectoryItemIDList, Attributes);
  ShellFolder.GetUIObjectOf(0, 1,
    DirectoryItemIDList, IExtractImage, nil, ExtractImage);
  CoTaskMemFree(DirectoryItemIDList);
  if Assigned(ExtractImage) then
  begin
    Priority:=0;
    Size.cx:=Width;
    Size.cy:=Height;
    Flags:=IEIFLAG_SCREEN or IEIFLAG_OFFLINE or IEIFLAG_QUALITY;
    ColorDepth:=32;
    Res:=ExtractImage.GetLocation(@PathBuffer[0], Length(PathBuffer),
      Priority, Size, ColorDepth, Flags);
    if (Res=NOERROR) or (Res=E_PENDING) then
      if not Succeeded(ExtractImage.Extract(Result)) then
        Result:=0;
  end;
end;

end.

IExtractIcon в следующий раз.

[uni]

У всех работает пример или нет? У меня при выборе папки вылетает с ошибкой "Invalid Image size", т.е. вроде как функция не возвращает картинки и далее получаем такое сообщение.

[NumLock]

запускай не из под Delphi, либо флажок "Stop..." убери.

[uni]

Зачот. Придётся логгером отдельно трассировать на ошибки-то? Надо бы потоки прикрутить или фильтрацию по типам, а то я с дуру на мусорную папку указал, так минуту ждал пока превьюшки появятся.

А можно по-подробнее о том, почему это не работает в самой среде? И что ещё за стоп-флажок? Что-то не помню такого.

Вот так бы выглядело чуть по-лучше и тормозов бы поменьше ещё.

[NumLock]

зачем логгером? просто проверять результат функции GetThumbnailImage по-человечески, а не как я в примере набросал:

Код:

          try
            ImageList1.Add(Bitmap, nil);
          except
            Bitmap.LoadFromResourceName(HInstance, 'FOLDER');
            ImageList1.Add(Bitmap, nil);
          end;

[uni]

Век живи, как говорится, никогда не обращал на эту штуку внимания. Попробовал тут в XE3 завести, думал, может заведётся, ан нет, пишет, что ресурса FOLDER не найдено.

Спасибо за исходник. Осталось только понять что там каждая из функций делает.

Так вот прикольней смотрится, но не для всех дельфей, к сожалению:

[NumLock]

для Unicode версий нужно, как обычно, String смотреть и их приведения/не привидения к Wide. а так все в MSDN есть. проблем не должно быть.

[uni]

Не могу понять в чём отличие запуска функции в отдельном потоке (не работает). Картинки перестают доставаться. Вместо них показываются заглушки папочные. Begin и EndUpdate тоже можно было бы сразу добавить и мигания не будет, и быстрее загрузка будет.

Я ступил по поводу XE3, т.е. начал новый проект, а про ресурсы-то забыл. После копирования файла с описанием этого самого ресурса всё заработало. Осталось только понять как это делать в потоке, чтобы интерфейс не тупил.

[uni]

Я опять забыл, что в потоке-то своя локальная память потока, поэтому, когда мы работаем с COM, то нужно делать OleInitialize( nil ) и OleUninitialize прямо в функции потока. Вот в этом разница. Я, кстати, не заметил, в примере есть OleUninitialize? Вроде как его вызов обязателен.

А так всё работает.

[petrovichtim]

Добрый день. Выложите пожалуйста ваш исходник на xe3

[uni]

Вот, кажется это он.

[dimonsky]

Запустил все вложенные в этой теме примеры. На моих двух ПК - вместо превью картинок - изображения папок.

[poiuyt555]

Здравствуйте.
Спасибо большое за пример!
1) А как понять, что GetThumbnailImage не нашла изображение (например у *.pas файла)?
У таких файлов HBITMAP был все равно ненулевой и по нему я не смог отличить.

2) Как сделать превью у txt или doc файлов?

3) Здесь можно выбирать размер картинки получаемой, напр. 64*64.
А как остальные файлы (не картинки, напр. pas) - к ним получить иконку такого же размера?
shGetFileInfo на сколько я понимаю, дает только 16*16 или 32*32