Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Trucos (https://www.clubdelphi.com/foros/forumdisplay.php?f=52)
-   -   Obtener cualquier thumbnail de la Shell (https://www.clubdelphi.com/foros/showthread.php?t=80862)

cHackAll 29-04-2008 02:07:51

Obtener cualquier thumbnail de la Shell
 
Finalmente consigo optimizar la función para obtener vistas en miniatura directamente desde la Shell, lo que permite obtener pre visualizaciones de cualquier tipo de archivo que el güindos reconozca como ser fotos, videos, películas...

Código Delphi [-]
uses ActiveX, ShlObj, ComObj;

type
 IExtractImage = interface ['{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}'] // http://msdn2.microsoft.com/en-us/library/bb761848(VS.85).aspx
  function GetLocation(pszPathBuffer: LPWSTR; cchMax: DWORD; var pdwPriority: DWORD; const prgSize: SIZE; dwRecClrDepth: DWORD; var pdwFlags: DWORD): HRESULT; stdcall;
  function Extract(var phBmpImage: HBITMAP): HRESULT; stdcall;
 end;

function GetThumbnail(lpPathName, lpFileName: PWideChar; Width, Height: Integer): TBitmap;
var
 Desktop, Folder: IShellFolder;
 ItemIDList: PItemIDList;
 Flags, Priority: Cardinal;
 ExtractImage: IExtractImage;
 Res: HRESULT;
 hBitmap: Windows.HBITMAP;
 Buffer: array[0..MAX_PATH-1] of WideChar;
 Size: TSize;
begin
 Result := nil;
 SHGetDesktopFolder(Desktop);
 if LongBool(Desktop.ParseDisplayName(0, nil, lpPathName, PDWORD(0)^, ItemIDList, PDWORD(0)^)) then Exit;
 Desktop.BindToObject(ItemIDList, nil, IShellFolder, Folder);
 CoTaskMemFree(ItemIDList);
 if LongBool(Folder.ParseDisplayName(0, nil, lpFileName, PDWORD(0)^, ItemIDList, PDWORD(0)^)) then Exit;
 Folder.GetUIObjectOf(0, 1, ItemIDList, IExtractImage, nil, ExtractImage);
 CoTaskMemFree(ItemIDList);
 if not Assigned(ExtractImage) then Exit; // TODO
 Size.cx := Width; Size.cy := Height; Priority := 0;
 Flags := $28{IEIFLAG_SCREEN+IEIFLAG_OFFLINE};
 Res := ExtractImage.GetLocation(Buffer, SizeOf(Buffer), Priority, Size, 24{pf32bit}, Flags);
 if (Res = NOERROR) or (Res = E_PENDING{IEIFLAG_ASYNC}) then
  begin
   if not LongBool(ExtractImage.Extract(hBitmap)) then
    begin
     Result := TBitmap.Create;
     Result.Handle := hBitmap;
    end;
  end;
end;
No lo he verificado pero dicha funcion al obtener el thumbnail desde la shell, muy probablemente este en caché de disco (thumb.db), lo que convierte a éste método en uno de los más veloces.

Tambien cabe la pena revisar su funcionamiento en Vista, cual muy probablemente obtenga imagenes tambien de documentos, páginas Web, PDFs, etc.

El modo de uso:

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
begin
 Image1.Picture.Assign(GetThumbnail('c:\windows\web\wallpaper', 'ascent.jpg', 96, 96));
 Image2.Picture.Assign(GetThumbnail('c:\windows', 'clock.avi', 96, 96));
end;
PD; considerar el comentario del truco 455 en referencia al "Memory leak"!


La franja horaria es GMT +2. Ahora son las 09:22:30.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi