Jump to content

Save image


Mediv

Recommended Posts

// Save record
procedure TAddRecordForm.SaveButtonClick(Sender: TObject);
var   blob: TStream;
begin
     FDSourse.DataSet.Append;
     FDSourse.DataSet.FieldByName('FIRSTNAMEHAMSTER').Value := Trim(FirstNameEdit.Text);
     FDSourse.DataSet.FieldByName('NEXTNAMEHAMSTER').Value  := Trim(LastNameEdit.Text);
     FDSourse.DataSet.FieldByName('NOTE').Value             := Trim(NoteMemo.Text);

     blob := FDSourse.DataSet.CreateBlobStream(FDSourse.DataSet.FieldByName('IMAGE'), bmWrite);
     UniImage.Picture.Graphic.SaveToStream(blob);

     blob.Free;                                 // ERROR: Bitmap image is not valid

     FDSourse.DataSet.Post;

     SaveButton.ModalResult := mrOk;
end;

 

Uploading a picture to the component as in the examples TUniImage Farhad, while maintaining an error in the dataset, in line blob.Free.

Can I save an image from TUniImage or it must first be put into UniHTMLFrame??

Tell me where the error occurred.

Thank you.

Link to comment
Share on other sites

Do you use the TUniFileUpload component? Then you can use the OnCompleted event of this component, see here:

 

http://forums.unigui.com/index.php?/topic/1107-load-picture-into-database/page__p__3528__hl__fileupload__fromsearch__1&do=findComment&comment=3528

 

 

Uploading an image into the application, everything is fine.

 

procedure TAddRecordForm.UniFileUploadCompleted(Sender: TObject;
 AStream: TFileStream);
begin
 if IsImage then
   UniImage.Picture.LoadFromFile(AStream.FileName);
end;

 

Fill out the required fields on the form and save it to the database (TClientDataSet field type ftGraphic).

The image is not saved.

 

Does anyone see a mistake?

Thank you.

 

 

// Save record
procedure TAddRecordForm.SaveButtonClick(Sender: TObject);
var   blob, blob1: TStream;
      BlobField: TField;
      BS: TStream;
begin
     FDSourse.DataSet.Append;
     FDSourse.DataSet.FieldByName('FIRSTNAMEHAMSTER').Value := Trim(FirstNameEdit.Text);
     FDSourse.DataSet.FieldByName('NEXTNAMEHAMSTER').Value  := Trim(LastNameEdit.Text);
     FDSourse.DataSet.FieldByName('NOTE').Value             := Trim(NoteMemo.Text);

     BlobField := FDSourse.DataSet.FieldByName('IMAGE');
     BS        := FDSourse.DataSet.CreateBlobStream(BlobField,bmReadWrite);
     UniImage.Picture.Bitmap.SaveToStream(BS);     
    
     BS.Free;

     FDSourse.DataSet.Post;

     TClientDataSet(FDSourse.DataSet).SaveToFile('hamster.cds',dfBinary);
    
     SaveButton.ModalResult := mrOk;
end;

Link to comment
Share on other sites

What filetype (.bmp, .jpg, .png, ...) do you upload and do you really want to save it as Bitmap?

 

You should delete "BS.Free;".

 

What if you use field type ftBlob instead of ftGraphic?

 

I tried to load the image format jpeg, png, bmp. added another blob type field in the dataset,

I tried to load in this field. Not what does not work, text fields are stored and the image is not.

 

procedure TAddRecordForm.SaveButtonClick(Sender: TObject);
var   BlobField, GraphicField: TField;
      BS, BS1: TStream;
begin
     FDSourse.DataSet.Append;
     FDSourse.DataSet.FieldByName('FIRSTNAMEHAMSTER').Value := Trim(FirstNameEdit.Text);
     FDSourse.DataSet.FieldByName('NEXTNAMEHAMSTER').Value  := Trim(LastNameEdit.Text);
     FDSourse.DataSet.FieldByName('NOTE').Value             := Trim(NoteMemo.Text);

     BlobField := FDSourse.DataSet.FieldByName('IMG');
     BS        := FDSourse.DataSet.CreateBlobStream(BlobField,bmReadWrite);

     GraphicField := FDSourse.DataSet.FieldByName('IMAGE');
     BS1          := FDSourse.DataSet.CreateBlobStream(GraphicField,bmReadWrite);
     UniImage.Picture.Graphic.SaveToStream(BS);
     UniImage.Picture.Graphic.SaveToStream(BS1);

     FDSourse.DataSet.Post;

     TClientDataSet(FDSourse.DataSet).SaveToFile('hamster.cds',dfBinary);

     SaveButton.ModalResult := mrOk;
end;

Link to comment
Share on other sites

Hi,

 

Here I attached complete demo for, image in the database with dataControls as well as with using non-dataControls...

 

Also, this Saves any file in a database field, displays the image if it is img,

 

Image Supports BMP, JPG, ICO, PNG, GIF.

 

any other binary files are saved without display....

BlobField.rar

Link to comment
Share on other sites

Dear Mediv

 

In your test project....

 


unit FormAddRecord;
.
.
type
 TAddRecordForm = class(TUniForm)
 .
 .
 private
   IsImage  : Boolean;
   FDSourse : TDataSource;
   pStream: TMemoryStream; // pStream: TFileStream;
 public
 end;
implementation
{$R *.dfm}
uses
 uniGUIVars, MainModule, ServerModule,  DateUtils, EncdDecd;

function AddRecordForm: TAddRecordForm;
begin
 Result := TAddRecordForm(UniMainModule.GetFormInstance(TAddRecordForm));
end;

// Load
procedure TAddRecordForm.UniFileUploadCompleted(Sender: TObject; AStream: TFileStream);
begin
 if IsImage then
   begin
     UniImage.Picture.LoadFromFile(AStream.FileName);

//    pStream := AStream;
     pStream:=TMemoryStream.Create;
     pStream.CopyFrom(AStream,AStream.Size);
   end;
end;

// Save record
procedure TAddRecordForm.SaveButtonClick(Sender: TObject);
var
  BlobField: TBlobField;
begin
if pStream<>nil then begin
     FDSourse.DataSet.Append;
     .
     .
     BlobField := FDSourse.DataSet.FieldByName('IMG');
     BlobField.LoadFromStream(pStream);
     FDSourse.DataSet.Post;
     .
     .
     pStream.Free;
     pStream:=nil;
end;
end;

end.

Link to comment
Share on other sites

Thank you very much for your help.

It works, loaded bmp, loading jpg, png error:

Bitmap image is not valid

// Save record
procedure TAddRecordForm.SaveButtonClick(Sender: TObject);
var
  BlobField: TBlobField;
begin
 if mStream <> nil then
   begin
     FDSourse.DataSet.Append;
     FDSourse.DataSet.FieldByName('FIRSTNAMEHAMSTER').Value := Trim(FirstNameEdit.Text);
     FDSourse.DataSet.FieldByName('NEXTNAMEHAMSTER').Value  := Trim(LastNameEdit.Text);
     FDSourse.DataSet.FieldByName('NOTE').Value             := Trim(NoteMemo.Text);

     BlobField := TBlobField(FDSourse.DataSet.FieldByName('IMG'));
     BlobField.LoadFromStream(mStream);                                // ERROR: Bitmap image is not valid
     
     FDSourse.DataSet.Post;
     TClientDataSet(FDSourse.DataSet).SaveToFile('hamster.cds',dfBinary);
  
     mStream.Free;
     mStream:=nil;
   end;

//
 ModalResult := mrOk;
end;

Link to comment
Share on other sites

Dear Mediv,

 

ERROR: Bitmap image is not valid

is due to TUniDbImage, if the blob field do not contain BMP, or if the blob field contain other img files like JPG or PNG,

or if the blob field contain other binary files which do not have Bitmap image, and hence the ERROR: Bitmap image is not valid.

 

Try using TUniImage and display the Picture using ShowImage Procedure below, may call in AfterScroll event of the DS.

I have used ShowImage Procedure in my BlobField demo project.

 

procedure TMainForm.ShowImage(BlobFld: TField; UniImage: TUniImage);
var
  m: TStream;
  G: TGraphic;
  FirstBytes: AnsiString;
  bValidImg:Boolean;
  Icon: TIcon ;
begin
  UniImage.Picture.Graphic := nil;
  if BlobFld.IsNull then begin
     Exit;
  end;
  m := BlobFld.DataSet.CreateBlobStream(BlobFld, bmRead);
  if m <> nil then begin
     G := nil; 
     bValidImg:=True;
     try
        SetLength(FirstBytes, 8);
        m.Read(FirstBytes[1], 8);
        if Copy(FirstBytes, 1, 2) = 'BM' then
           G := TBitmap.Create
        else if FirstBytes = #137'PNG'#13#10#26#10 then
           G := TPngImage.Create
        else if Copy(FirstBytes, 1, 3) = 'GIF' then
           G := TGIFImage.Create
        else if Copy(FirstBytes, 1, 2) = #$FF#$D8 then
           G := TJPEGImage.Create
        else
           bValidImg:=False;
        if bValidImg then begin
           try
              UniImage.Picture.Graphic := G;
              m.Seek(0,0);
              UniImage.Picture.Graphic.LoadFromStream(m);
           finally
              G.Free;
           end;
        end else begin
           if Copy(FirstBytes, 1, 4) = #0#0#1#0 then begin
              Icon := TIcon.Create;
              try
                 m.Seek(0,0);
                 Icon.LoadFromStream(m);
                 UniImage.Picture.Bitmap.Width := Icon.Width;
                 UniImage.Picture.Bitmap.Height:= Icon.Height;
                 UniImage.Picture.Bitmap.Canvas.Draw(0,0,Icon);
              finally
                 Icon.Free;
              end;
           end;
        end;
     finally
        m.Free;
     end;
  end;
end;

 

Regards

Link to comment
Share on other sites

Hi,

 

ERROR: Bitmap image is not valid is due to TUniDbImage, if the blob field do not contain image,

Try TUniImage and display the Picture using ShowImage Procedure in Mainform in my DemoProject.

 

Regards

Thank you very much for your time. I'll try.

Link to comment
Share on other sites

 
     UniImage.Picture.Graphic := TJPEGImage.Create

 

Could this produce a memory leak? I Think so, if i read this note from embarcadero:

 

Note: When assigning the Graphic property, TPicture assigns the properties of a another TGraphic object. It does not take ownership of the specified object.

 

TPicture seems to use assign to make a copy (and not take ownership) of the created JpegImage-Object so that this is never be freed?!

Link to comment
Share on other sites

very good. thank you. but on the main module used for the scroll event adotable work. Can you help?

(I use sql server database)

if so, then you may update the Image on some other Event like UniFormCreate, OnCellClick or BtnClick by calling procedure like ShowImage above,

here, ShowImage dose nothing but just displays the picture if possible. AfterScroll event is one good event to update the controls and if your Query/Table is on MainModule you need to find when the image can be loaded/displayed and where the procedure can be called.

 

now, if in the MainModule, AfterScroll event is not in use and is nil then you can try like :

unit Unit1;
interface
uses
type
 TUniForm1 = class(TUniForm)
   UniImage1: TUniImage;

   procedure UniFormClose(Sender: TObject; var Action: TCloseAction);
   procedure UniFormCreate(Sender: TObject);
   procedure myAfterScroll(DataSet: TDataSet);  // Attn.
 private
 public
 end;
implementation
{$R *.dfm}
uses MainModule, uniGUIApplication;

procedure TUniForm1.myAfterScroll(DataSet: TDataSet);
begin
  ShowImage(UniMainModule.QryMainImg1, UniImage1);
end;
procedure TUniForm1.UniFormClose(Sender: TObject; var Action: TCloseAction);
begin
  UniMainModule.QryMain.AfterScroll:=nil;
end;
procedure TUniForm1.UniFormCreate(Sender: TObject);
begin
  UniMainModule.QryMain.AfterScroll:=myAfterScroll;
end;
end.

Link to comment
Share on other sites

I have used ShowImage Procedure in my BlobField demo project.

Jesus people, you are writing for a web browser. Just drop an image file somewhere and link to it with <img src=...> tag, thats all. Browser knows about image formats way more than you.

That ShowImage procedure is the worst piece of code for web. So much mess for doing so little.

It's only usefulness is when app needs to work with both web and VCL the same way. If it is not your aim, don't do that.

Link to comment
Share on other sites

Jesus people, you are writing for a web browser. Just drop an image file somewhere and link to it with <img src=...> tag, thats all. Browser knows about image formats way more than you.

That ShowImage procedure is the worst piece of code for web. So much mess for doing so little.

It's only usefulness is when app needs to work with both web and VCL the same way. If it is not your aim, don't do that.

 

Thanks Zilav, this is very good hint for me, I just set the UniImage.URL, fantastic property.

procedure TMainForm.SetImageUrl(BlobFld: TField; UniImage: TUniImage; fileName: String);
var
  Tmp,TmpFile:String;
begin
  Tmp:= 'Tmp_' +UnitName +IntToStr(BlobFld.DataSet.RecNo) +fileName;
  TmpFile:= UniServerModule.LocalCachePath +Tmp;
  if (not FileExists(PChar(TmpFile))) then
     TBlobField(BlobFld).SaveToFile(PChar(TmpFile));
  try
     UniImage.Url:= '';
     UniImage.Refresh;
     UniImage.Url:= UniServerModule.LocalCacheURL +Tmp;
  except
  end;
end;

Link to comment
Share on other sites

I used 'TCargaImagenEnDataSet' to save into a TDataSet then contents of a TUniImage component.

 

And to render into a TUniImage from a TDataSet.FieldByName(..)

 

In general works perfectly well for 'almost' any kind of Image (BitMap,JPG,PNG) .. sometimes, very rare, not :-)

 

Greetings

 

PD: I can't upload the files so .. here they are.

 

For rendering from TDataSet into TUniImage

------------------------------------------

 

unit cCargaImagenDeDataSet;

 

interface

 

uses

Classes, Db, Graphics, ExtCtrls, axCtrls, uniImage;

 

type

TCargaImagenDeDataSet = class

private

oDataSet: TDataSet;

cNombreDeCampo: String;

oImagen: TUniImage;

oGrafico: TOleGraphic;

oOrigen: TImage;

oBitMap: TBitMap;

oMemoria: TStream;

function Grafico: TOleGraphic;

function Origen: TImage;

function BitMap: TBitMap;

function Memoria: TStream;

procedure SeteaGrafico;

procedure SeteaOrigen;

procedure SeteaBitmap;

procedure SeteaImagen;

function ImagenNoNula: Boolean;

procedure Ejecuta;

procedure Inicio;

procedure Proceso;

procedure Fin;

public

constructor Create(const oDataSetPar: TDataSet; const cNombreDeCampoPar: String; const oImagenPar: TUniImage);

procedure Carga; overload;

class procedure Carga(const oDataSetPar: TDataSet; const cNombreDeCampoPar: String; const oImagenPar: TUniImage); overload;

end;

 

implementation

 

{ TCargaImagenDeDataSet }

 

procedure TCargaImagenDeDataSet.Carga;

begin

if ImagenNoNula then

Ejecuta;

end;

 

function TCargaImagenDeDataSet.BitMap: TBitMap;

begin

if oBitMap=nil then

oBitMap:=TBitMap.Create;

Result:=oBitMap;

end;

 

class procedure TCargaImagenDeDataSet.Carga(const oDataSetPar: TDataSet;

const cNombreDeCampoPar: String; const oImagenPar: TUniImage);

begin

with TCargaImagenDeDataSet.Create(oDataSetPar,cNombreDeCampoPar,oImagenPar) do

try

Carga;

finally

Free;

end;

end;

 

constructor TCargaImagenDeDataSet.Create(const oDataSetPar: TDataSet;

const cNombreDeCampoPar: String; const oImagenPar: TUniImage);

begin

inherited Create;

oDataSet:=oDataSetPar;

cNombreDeCampo:=cNombreDeCampoPar;

oImagen:=oImagenPar;

end;

 

procedure TCargaImagenDeDataSet.Ejecuta;

begin

Inicio;

try

Proceso;

finally

Fin;

end;

end;

 

procedure TCargaImagenDeDataSet.Fin;

begin

if oMemoria<>nil then

oMemoria.Free;

if oGrafico<>nil then

oGrafico.Free;

if oOrigen<>nil then

oOrigen.Free;

if oBitMap<>nil then

oBitMap.Free;

end;

 

function TCargaImagenDeDataSet.ImagenNoNula: Boolean;

begin

Result:=(0<Memoria.Size);

end;

 

procedure TCargaImagenDeDataSet.Inicio;

begin

with oDataSet do

if not (State in [dsInsert,dsEdit]) then

Edit;

end;

 

procedure TCargaImagenDeDataSet.Proceso;

begin

SeteaGrafico;

SeteaOrigen;

SeteaBitmap;

SeteaImagen;

end;

 

procedure TCargaImagenDeDataSet.SeteaGrafico;

begin

Grafico.LoadFromStream(Memoria);

end;

 

function TCargaImagenDeDataSet.Memoria: TStream;

begin

if oMemoria=nil then

with oDataSet do

oMemoria:=CreateBlobStream(FieldByName(cNombreDeCampo),bmRead);

Result:=oMemoria;

end;

 

function TCargaImagenDeDataSet.Grafico: TOleGraphic;

begin

if oGrafico=nil then

oGrafico:=TOleGraphic.Create;

Result:=oGrafico;

end;

 

procedure TCargaImagenDeDataSet.SeteaOrigen;

begin

Origen.Picture.Assign(Grafico);

end;

 

function TCargaImagenDeDataSet.Origen: TImage;

begin

if oOrigen=nil then

oOrigen:=TImage.Create(nil);

Result:=oOrigen;

end;

 

procedure TCargaImagenDeDataSet.SeteaBitmap;

begin

with BitMap do

begin

Width:=Origen.Picture.Width;

Height:=Origen.Picture.Height;

Canvas.Draw(0,0,Origen.Picture.Graphic);

end;

end;

 

procedure TCargaImagenDeDataSet.SeteaImagen;

begin

oImagen.Picture.Bitmap:=BitMap;

end;

 

end.

 

 

For saving TUniImage in TDataSet.TField

---------------------------------------

 

 

unit cCargaImagenEnDataSet;

 

interface

 

uses

Classes, Db, Graphics, ExtCtrls, axCtrls, uniImage;

 

type

TCargaImagenEnDataSet = class

private

oDataSet: TDataSet;

cNombreDeCampo: String;

oImagen: TUniImage;

oArchivo: TFileStream;

oMemoria: TStream;

procedure Inicio;

procedure Proceso;

procedure Fin;

procedure SeteaImagen;

procedure SeteaMemoria;

function Memoria: TStream;

public

constructor Create(const oDataSetPar: TDataSet; const cNombreDeCampoPar: String;

const oArchivoPar: TFileStream; const oImagenPar: TUniImage);

procedure Carga; overload;

class procedure Carga(const oDataSetPar: TDataSet; const cNombreDeCampoPar: String;

const oArchivoPar: TFileStream; const oImagenPar: TUniImage); overload;

end;

 

implementation

 

{ TCargaImagenEnDataSet }

 

procedure TCargaImagenEnDataSet.Carga;

begin

Inicio;

try

Proceso;

finally

Fin;

end;

end;

 

class procedure TCargaImagenEnDataSet.Carga(const oDataSetPar: TDataSet;

const cNombreDeCampoPar: String; const oArchivoPar: TFileStream; const oImagenPar: TUniImage);

begin

with TCargaImagenEnDataSet.Create(oDataSetPar,cNombreDeCampoPar,oArchivoPar,oImagenPar) do

try

Carga;

finally

Free;

end;

end;

 

constructor TCargaImagenEnDataSet.Create(const oDataSetPar: TDataSet;

const cNombreDeCampoPar: String; const oArchivoPar: TFileStream; const oImagenPar: TUniImage);

begin

inherited Create;

oDataSet:=oDataSetPar;

cNombreDeCampo:=cNombreDeCampoPar;

oArchivo:=oArchivoPar;

oImagen:=oImagenPar;

end;

 

procedure TCargaImagenEnDataSet.Fin;

begin

if oMemoria<>nil then

oMemoria.Free;

end;

 

procedure TCargaImagenEnDataSet.Inicio;

begin

with oDataSet do

if not (State in [dsInsert,dsEdit]) then

Edit;

end;

 

function TCargaImagenEnDataSet.Memoria: TStream;

begin

if oMemoria=nil then

with oDataSet do

oMemoria:=CreateBlobStream(FieldByName(cNombreDeCampo),bmWrite);

Result:=oMemoria;

end;

 

procedure TCargaImagenEnDataSet.Proceso;

begin

SeteaImagen;

SeteaMemoria;

end;

 

procedure TCargaImagenEnDataSet.SeteaImagen;

begin

oImagen.Picture.LoadFromFile(oArchivo.FileName);

end;

 

procedure TCargaImagenEnDataSet.SeteaMemoria;

begin

oImagen.Picture.Graphic.SaveToStream(Memoria);

end;

 

end.

Link to comment
Share on other sites

Please sign in to comment

You will be able to leave a comment after signing in



Sign In Now
×
×
  • Create New...