Cita:
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:
Cita:
[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;
Res := ExtractImage.GetLocation(Buffer, SizeOf(Buffer), Priority, Size, 24, Flags);
if (Res = NOERROR) or (Res = E_PENDING) 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.