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}'] 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; Size.cx := Width; Size.cy := Height; Priority := 0;
Flags := $28;
Res := ExtractImage.GetLocation(Buffer, SizeOf(Buffer), Priority, Size, 24, Flags);
if (Res = NOERROR) or (Res = E_PENDING) 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"!