Форум по 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 Кбайт, 187 просмотров)
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
Эти 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  
Старый 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, время: 16:04.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter