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; 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.