Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Разное > Исходники и статьи
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 23.11.2012, 11:01
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
Хорошо [ Исходник ] - Получение эскиза файла/папки



Получение эскиза (миниатюры) файла/папки с использованием 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 в следующий раз.
Вложения
Тип файла: rar ThumbnailImage.rar (6.7 Кбайт, 190 просмотров)
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
Эти 3 пользователя(ей) сказали Спасибо NumLock за это полезное сообщение:
alexpac26 (05.12.2012), bend55omsk (24.09.2021), poiuyt555 (29.03.2013)
  #2  
Старый 30.11.2012, 13:54
Аватар для uni
uni uni вне форума
Прохожий
 
Регистрация: 30.11.2012
Сообщения: 9
Репутация: 10
По умолчанию

У всех работает пример или нет? У меня при выборе папки вылетает с ошибкой "Invalid Image size", т.е. вроде как функция не возвращает картинки и далее получаем такое сообщение.
Ответить с цитированием
  #3  
Старый 30.11.2012, 13:59
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

запускай не из под Delphi, либо флажок "Stop..." убери.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #4  
Старый 30.11.2012, 14:03
Аватар для uni
uni uni вне форума
Прохожий
 
Регистрация: 30.11.2012
Сообщения: 9
Репутация: 10
По умолчанию

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

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

Вот так бы выглядело чуть по-лучше и тормозов бы поменьше ещё.
Изображения
Тип файла: png Thumbnails viewer.PNG (177.8 Кбайт, 65 просмотров)
__________________
Россия навсегда!

Последний раз редактировалось uni, 30.11.2012 в 14:30.
Ответить с цитированием
  #5  
Старый 30.11.2012, 14:28
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

зачем логгером? просто проверять результат функции GetThumbnailImage по-человечески, а не как я в примере набросал:
Код:
          try
            ImageList1.Add(Bitmap, nil);
          except
            Bitmap.LoadFromResourceName(HInstance, 'FOLDER');
            ImageList1.Add(Bitmap, nil);
          end;

__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #6  
Старый 30.11.2012, 14:34
Аватар для uni
uni uni вне форума
Прохожий
 
Регистрация: 30.11.2012
Сообщения: 9
Репутация: 10
По умолчанию

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

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

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

__________________
Россия навсегда!

Последний раз редактировалось uni, 30.11.2012 в 14:38.
Ответить с цитированием
  #7  
Старый 30.11.2012, 14:44
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

для Unicode версий нужно, как обычно, String смотреть и их приведения/не привидения к Wide. а так все в MSDN есть. проблем не должно быть.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #8  
Старый 30.11.2012, 15:54
Аватар для uni
uni uni вне форума
Прохожий
 
Регистрация: 30.11.2012
Сообщения: 9
Репутация: 10
По умолчанию

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

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

__________________
Россия навсегда!

Последний раз редактировалось uni, 30.11.2012 в 17:24.
Ответить с цитированием
  #9  
Старый 01.12.2012, 03:36
Аватар для uni
uni uni вне форума
Прохожий
 
Регистрация: 30.11.2012
Сообщения: 9
Репутация: 10
По умолчанию

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

А так всё работает.
__________________
Россия навсегда!
Ответить с цитированием
  #10  
Старый 14.01.2013, 09:36
petrovichtim petrovichtim вне форума
Прохожий
 
Регистрация: 14.01.2013
Адрес: Москва
Сообщения: 2
Версия Delphi: Delphi7
Репутация: 10
По умолчанию

Добрый день. Выложите пожалуйста ваш исходник на xe3
Ответить с цитированием
  #11  
Старый 09.02.2013, 20:24
Аватар для uni
uni uni вне форума
Прохожий
 
Регистрация: 30.11.2012
Сообщения: 9
Репутация: 10
По умолчанию

Вот, кажется это он.
Вложения
Тип файла: zip ThumbnailViewer_20130209.zip (87.3 Кбайт, 136 просмотров)
__________________
Россия навсегда!
Ответить с цитированием
  #12  
Старый 17.02.2013, 00:43
dimonsky dimonsky вне форума
Прохожий
 
Регистрация: 17.02.2013
Сообщения: 3
Репутация: 10
По умолчанию

Запустил все вложенные в этой теме примеры. На моих двух ПК - вместо превью картинок - изображения папок.
Ответить с цитированием
  #13  
Старый 27.03.2013, 13:27
poiuyt555 poiuyt555 вне форума
Прохожий
 
Регистрация: 27.03.2013
Сообщения: 1
Версия Delphi: Delphi 6
Репутация: 10
По умолчанию Спасибо большое за пример!

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

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

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

Последний раз редактировалось poiuyt555, 27.03.2013 в 13:49.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 02:43.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter