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"

Código Delphi [-]
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...

Código Delphi [-]
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:

Código Delphi [-]
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:

Código SQL [-]
Imagen BLOB SUB_TYPE 0 SEGMENT SIZE 16384

La unit es la siguiente:

Código Delphi [-]
unit Data.Graphics;

{ Todo viene de https://delphihaven.wordpress.com/20...aphic-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:

Código Delphi [-]
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