23.11.2012, 11:01
|
|
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 в следующий раз.
__________________
Пишу программы за еду.
__________________
|