Savetostream en Delphi XE5

[mjjj]

Estimados, estoy migrando una aplicación desde Delphi 2010 a Delohi XE5, pero tengo un problema al intentar guardar un imagen ya sea en memoria o en el disco duro.
Este código funciona perfecto en 2010, pero en XE5 me arroja un error... "Stream read error"


var
MS: TMemoryStream;
FS: TFileStream;
begin
MS := TMemoryStream.Create;
try
TBlobField(ibquery1.FieldByName('foto')).SaveToStream(MS);
if ms.Size = 0 then exit; //no imagen
ms.Position := 0;

Image1.Picture.Bitmap.LoadFromStream(MS);
finally
MS.Free;
end;


La imagen guardada es un BMP.
Espero me puedan ayudar.
Gracias

[duilioisola]

Prueba tratando de generar el stream desde un archivo.
Puede que en XE5 el driver que necesita para leer desde un Blob no funcione correctamente con la versión de la base de datos que tienes...

Prueba también a grabar en un archivo el stream para ver si lo que obtienes es un BMP correcto.

[mjjj]

Estimado, al cargar el stream desde un archivo funcionó perfecto.
El tema es que sigo sin poder rescatar la imagen de la base de dato...
Alguna idea??

[Lepe]

mmm ni idea.

¿Pudiera ser el moldeo de tipos?

Revisa en XE5 el tipo tblobfield, quizás ya tenga implementado el savetostream y te ahorras el moldeo.

Es que otra cosa no veo, el código debería funcionar.

Suerte

[ecfisa]

Hola mjjj.

Tratándose de XE5 tampoco tengo idea, pero intentá de este otro modo a ver si te resulta...

procedure BlobToImage(aDataSet: TIBCustomDataSet; const aFieldName: string; Image: TImage);
var
Stream: TStream;
begin
with aDataSet do
if not FieldByName(aFieldName).IsNull then
begin
Stream := CreateBlobStream(FieldByName(aFieldName) , bmRead);
try
Image.Picture.Bitmap.LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
end;


LLamada ejemplo:

procedure TForm1.Button1Click(Sender: TObject);
begin
BlobToImage(IBQuery1, 'IMAGE', Image1);
end;


Saludos :)

[AgustinOrtu]

Yo empleo esta unit en XE7, me conecto por FireDAC a una BD Firebird 2.5 y el campo en cuestion esta definido asi:


Imagen BLOB SUB_TYPE 0 SEGMENT SIZE 16384


La unit es la siguiente:

unit Data.Graphics;

{ Todo viene de https://delphihaven.wordpress.com/2011/01/22/tip-detecting-graphic-formats/
Estas funciones leen el contenido de un BLOB y determinan que tipo de TGraphicClass debe usarse para leer mostrar
una imagen (JPEG, BMP, etc)
Gracias !! }

interface

uses
System.SysUtils, System.Classes, Vcl.Consts, Vcl.Graphics, Vcl.Imaging.GIFImg, Vcl.Imaging.JPEG,
Vcl.Imaging.PngImage, Data.DB;

const
MinGraphicSize = 44; // we may test up to & including the 11th longword

function FindGraphicClass(const Buffer; const BufferSize: Int64; out GraphicClass: TGraphicClass): Boolean; overload;
function FindGraphicClass(Stream: TStream; out GraphicClass: TGraphicClass): Boolean; overload;

procedure LoadPictureFromBlobField(Field: TBlobField; Dest: TPicture);

implementation

procedure LoadPictureFromBlobField(Field: TBlobField; Dest: TPicture);
var
Graphic: TGraphic;
GraphicClass: TGraphicClass;
Stream: TMemoryStream;
begin
Graphic := NIL;
Stream := TMemoryStream.Create;
try
Field.SaveToStream(Stream);
if Stream.Size = 0 then
begin
Dest.Assign(NIL);
Exit;
end;
if not (FindGraphicClass(Stream.Memory^, Stream.Size, GraphicClass)) then
raise EInvalidGraphic.Create(SInvalidImage);
Graphic := GraphicClass.Create;
Stream.Position := 0;
Graphic.LoadFromStream(Stream);
Dest.Assign(Graphic);
finally
Stream.Free;
Graphic.Free;
end;
end;

function FindGraphicClass(const Buffer; const BufferSize: Int64; out GraphicClass: TGraphicClass): Boolean;
var
LongWords: array [Byte] of LongWord absolute Buffer;
Words: array [Byte] of Word absolute Buffer;
begin
GraphicClass := NIL;
Result := False;
if BufferSize < MinGraphicSize then
Exit;
case Words[0] of
$4D42: GraphicClass := TBitmap;
$D8FF: GraphicClass := TJPEGImage;
$4949:
if Words[1] = $002A then
GraphicClass := TWicImage; // i.e., TIFF
$4D4D:
if Words[1] = $2A00 then
GraphicClass := TWicImage; // i.e., TIFF
else
if Int64(Buffer) = $A1A0A0D474E5089 then
GraphicClass := TPNGImage
else if LongWords[0] = $9AC6CDD7 then
GraphicClass := TMetafile
else if (LongWords[0] = 1) and (LongWords[10] = $464D4520) then
GraphicClass := TMetafile
else if StrLComp(PAnsiChar(@Buffer), 'GIF', 3) = 0 then
GraphicClass := TGIFImage
else if Words[1] = 1 then
GraphicClass := TIcon;
end;
Result := GraphicClass <> NIL;
end;

function FindGraphicClass(Stream: TStream; out GraphicClass: TGraphicClass): Boolean;
var
Buffer: PByte;
CurPos: Int64;
BytesRead: Integer;
begin
if Stream is TCustomMemoryStream then
begin
Buffer := TCustomMemoryStream(Stream).Memory;
CurPos := Stream.Position;
Inc(Buffer, CurPos);
Result := FindGraphicClass(Buffer^, Stream.Size - CurPos, GraphicClass);
Exit;
end;
GetMem(Buffer, MinGraphicSize);
try
BytesRead := Stream.Read(Buffer^, MinGraphicSize);
Stream.Seek( - BytesRead, soCurrent);
Result := FindGraphicClass(Buffer^, BytesRead, GraphicClass);
finally
FreeMem(Buffer);
end;
end;

end.

Ejemplo de uso:


var
Image1: TImage;
begin
LoadPictureFromBlobField(TBlobField(DataSet.FieldByName('CampoBlob')), Image1.Picture);
end;


Con esto podes cargar indistintamente un bmp, jpg, jpeg, gif, ico o png