Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > API de Windows
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

 
 
Herramientas Buscar en Tema Desplegado
  #2  
Antiguo 20-10-2011
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.211
Poder: 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
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Exportar de Delphi a Calc Libreoffice Ibeth Varios 3 17-09-2011 01:18:24
Primera versión estable de LibreOffice rretamar Noticias 17 15-09-2011 22:30:07
Abrir Archivo con LibreOffice MarioATamborini API de Windows 1 16-08-2011 22:44:09
extraccion de la extension de un archivo srangel PHP 5 14-01-2010 17:11:48
Imagenes en miniatura Mary Carmen G. Gráficos 5 19-01-2009 16:10:44


La franja horaria es GMT +2. Ahora son las 20:51:52.


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