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

[manuc]

Hola tiammat,

Me alegro que te ayude.

Si te refieres a modificar la función para que genere el thumbnail directamente del campo en base de datos ... creo que no sería posible o yo no sabría hacerlo.

Si existe un proceso en tu Software para enviar el fichero a base de datos, yo aprovecharía este proceso para generar el thumbnail y guardarlo en un campo en base de datos.

Depende un poco del tamaño de los ficheros PDF. Si cada vez que quieres generar el thumbnail "extraes" el fichero de base de datos, puede ser que generes un tráfico no necesario, dado que es probable que muchos casos el usuario no llegue a utilizar el PDF.

Pero esto ya depende del criterio de cada uno.

Un saludo!

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

[manuc]

ohh!!

Perdona, fallo mío.

Me faltaba este trozo de código :-) :

Código Delphi [-]
type
 IExtractImage = interface ['{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}'] // http://msdn2.microsoft.com/en-us/lib...48(VS.85).aspx
  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;

Te he preparado una demo, que puedes descargarla aquí: www.applinet.es/descargas/thumbnail_demo.zip

¿Puedes probarlo con añadiendo este código?
Cuéntame como te fue.

Un saludo.

Manuel.

[TiammatMX]

Empezado por manuc

ohh!! ...

¡¡¡¡AAAAAHHHHHHHHH!!!! Gracias a tu participación (The Beatles tenía mucha razón con éso de "with a little help from my friends") la aplicación ha quedado espectacular.

Solamente que en la primera corrida (el TImage "virgen", la memoria sin ningún dato) me arroja una excepción, pero quiero creer que es por que aún no tiene nada...

Muchas gracias, Manuel. No sabes cuánto de lo agradezco.

[manuc]

jaja, me alegro que vaya bien!

Nada, hoy por ti, mañana por mí

Un saludo.

[TiammatMX]

Empezado por manuc

jaja, me alegro que vaya bien!...

Viendo ésto, "bien" es poco...

[roman]

Hola,

¿Se requiere tener instalado el Adobe Acrobat? Porque probé el ejemplo de manuc y no me muestra nada. Yo uso Foxit en lugar de Adobe.

// Saludos