Esto me funciona con Firebird.
Código Delphi
[-]
procedure TFFicha.cargafoto;
var
BS: TStream;
Graphic: TGraphic;
begin
if FDM.qunafichafoto.isnull then Image1.picture.graphic:=nil else
begin
BS := FDM.ficha.CreateBlobStream(FDM.qunaficha.FieldByName('foto'), bmRead);
try
Graphic := TJPEGImage.Create;
try
Graphic.LoadFromStream(BS);
Image1.Picture := nil;
Image1.picture.graphic := Graphic;
Finally
Graphic.Free;
end;
Finally
BS.free;
end;
end;
end;
procedure TFFicha.SpeedButton1Click(Sender: TObject);
begin
if OpenPictureDialog1.execute then
if OpenPicturedialog1.filename <> '' then
begin
Image1.Picture.LoadFromFile(OpenPicturedialog1.filename);
if not (FDM.IBT1.InTransaction) then
FDM.IBT1.StartTransaction;
try
FDM.MODIFOTO.Parambyname('mcod').asinteger:=FDM.Qfichascodigo.asinteger; FDM.MODIFOTO.Parambyname('mfoto').LoadFromFile(OpenPictureDialog1.filename,ftBlob);
FDM.MODIFOTO.ExecProc;
FDM.IBT1.Commit;
except
FDM.IBT1.Rollback;
raise Exception.Create('Error al grabar foto');
end;
FDM.Qfichas.open;
end;
end;
procedure TFFicha.SpeedButton3Click(Sender: TObject);
begin
Image1.Picture := nil;
if not (FDM.IBT1.InTransaction) then
FDM.IBT1.StartTransaction;
try
FDM.MODIFOTO.Parambyname('mcod').asinteger:=FDM.Qfichascodigo.asinteger;
FDM.MODIFOTO.Parambyname('mfoto').value:=null;
FDM.MODIFOTO.ExecProc;
FDM.IBT1.Commit;
except
FDM.IBT1.Rollback;
raise Exception.Create('Error al eliminar foto');
end;
FDM.Qfichas.open;
end;
Saludos.