Ver Mensaje Individual
  #2  
Antiguo 20-10-2011
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.211
Reputación: 22
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
Supongo que tienes OpenOffice instalado, si no es así no funcionará.

Asumiendo que está correctamente instalado, prueba de esta manera:

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 CreateThumbnail(Path, FileName: PWCHAR; Width,  Height: Cardinal; var pBitmap: HBITMAP): HRESULT;
var
   pIExtractImage: IExtractImage ;
   Desktop, Folder: IShellFolder;
   pidList: PITEMIDLIST;
   Flags: Cardinal;
   Size: TSize;
   szBuffer: array [0..MAX_PATH] of WCHAR;
begin
   Flags:= $004; //IEIFLAG_ASPECT;
   Size.cx:= Width; Size.cy:= Height;
   Result:= E_ABORT;
   if SUCCEEDED(SHGetDesktopFolder(Desktop)) then
   begin
      if SUCCEEDED(Desktop.ParseDisplayName(0, nil, Path, PDWORD(0)^, pidList, PDWORD(0)^)) then
      begin
         if SUCCEEDED(Desktop.BindToObject(pidList, nil, IShellFolder, Folder)) then
         begin
            CoTaskMemFree(pidList);
            if SUCCEEDED(Folder.ParseDisplayName(0, nil, FileName, PDWORD(0)^, pidList, PDWORD(0)^))then
            begin
               Result:= Folder.GetUIObjectOf(0, 1, pidList, IExtractImage, nil, pIExtractImage);
               CoTaskMemFree(pidList);
               if SUCCEEDED(Result) then
               begin
                  Result:= pIExtractImage.GetLocation(szBuffer, MAX_PATH, PDWORD(0)^, size, 24, Flags);
                  if SUCCEEDED(Result) or (Result = E_PENDING) then
                     Result:= pIExtractImage.Extract(pBitmap);
               end;
            end;
         end;
      end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: HBITMAP;
begin
  CreateThumbnail('C:\', 'Ejemplo.odt', 96, 96, Bitmap);
  Image1.Picture.Bitmap.Handle:= Bitmap;
end;

Saludos.
Responder Con Cita