¿Saben de algún componente que realice ésta función?

[TiammatMX]

Empezado por manuc

Hola tiammat,

Me alegro que te ayude...

Una pregunta, manuc, ¿me hace falta algo, alguna unit o función para utilizar el código éste? Por que me marca errores:

[Error][Error] ufrmContenedor.pas(808): Undeclared identifier: 'IExtractImage'
[Error] ufrmContenedor.pas(820): Undeclared identifier: 'CoTaskMemFree'
[Error] ufrmContenedor.pas(828): Incompatible types
[Error] ufrmContenedor.pas(833): Missing operator or semicolon
[Error] ufrmContenedor.pas(837): ')' expected but identifier 'Extract' found
[Error] ufrmContenedor.pas(857): Incompatible types: 'WideString' and 'PWideChar'
[Error] ufrmContenedor.pas(857): Incompatible types: 'WideString' and 'PWideChar'
[Fatal Error] TSDocumentos.dpr(6): Could not compile used unit 'ufrmContenedor.pas'

y como lo tengo implementado es así...

Código Delphi [-]
procedure TfrmContenedor.VisualizaMiniatura(sIDDocumento,sConsPac: string);

  procedure BajaPDF(sNombreArchivo : string);
  var
    qryTemporal : TADOQuery;
    msFlujo : TMemoryStream;
  begin
    qryTemporal := TADOQuery.Create(Self);
    with qryTemporal do
    begin
      Connection := qryDocumentos.Connection;
      SQL.Clear;
      SQL.Add('Select HY11_DocumentoElectronico from HY11_DocumentosPacElec where (E2_CTRL_PAC = '+lblExpediente.Caption+') AND ('+chklstDocumentos.Items.Strings[chklstDocumentos.ItemIndex])+');');
      Open;
      if RecordCount > 0 then
      begin
        msFlujo := TMemoryStream.Create;
        try
          TBlobField(qryTemporal.FieldByName('HY11_DocumentoElectronico')).SaveToStream(msFlujo);
          msFlujo.Position := 0;
          msFlujo.SaveToFile(sNombreArchivo);
        finally
          msFlujo.Free;
          msFlujo.Destroy;
        end;
      end;
      Close;
      Destroy;
    end;
  end;

  function CreaThumbnail(sRuta, sArchivo : 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, sRuta, PDWORD(0)^, ItemIDList, PDWORD(0)^)) then
      Exit;

    Desktop.BindToObject(ItemIDList, nil, IShellFolder, Folder);
    CoTaskMemFree(ItemIDList);

    if LongBool(Folder.ParseDisplayName(0, nil, sArchivo, 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{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;

var
  sFolder, sNombreArchivo : widestring;
  bmImagen : TBitmap;
begin
  sFolder := ObtenerFolder+'\';
  sNombreArchivo := 'TMP'+Trim(lblExpediente.Caption)+Trim(Texto2ID(chklstDocumentos.Items.Strings[chklstDocumentos.ItemIndex]))+'.pdf';
  ShowMessage(Format('La carpeta Mis Documentos para el usuario actual es: "%s"'+CRLF+'y el nombre de archivo temporal será: "%s"',[sFolder,sNombreArchivo]));

  if NOT FileExists(sFolder+sNombreArchivo) then
    BajaPDF(sFolder+sNombreArchivo);

  bmImagen := CreaThumbnail(sFolder,sNombreArchivo,imgMiniatura.Width,imgMiniatura.Height);
  imgMiniatura.Picture.Assign(bmImagen);
  FreeAndNil(bmImagen);
end;

¿Habrá algo que falte? Oriéntame, por favor.