Foros Club Delphi - No graba imagen en Firebird

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)

- Firebird e Interbase (https://www.clubdelphi.com/foros/forumdisplay.php?f=19)

- - No graba imagen en Firebird (https://www.clubdelphi.com/foros/showthread.php?t=92036)

No graba imagen en Firebird

Tenog un formulario con un TImage en el que puedo seleccionar el fichero de imagen a asignar para luego grabarlo en una tabla Firebird. Supongamos que el TImage está así:

Un vez cargado dicho TImage para grabarlo en la tabal hago esto:

Código:

for (nItem = 0; nItem < this->ComponentCount; nItem ++)

{

     Source = this->Components[nItem];

     [...]

     fPersona->Query->Close();

     if (Source->ClassNameIs("TImage"))

     {

          TImage *Imagen          = static_cast<TImage*>(Source);

          TMemoryStream *msImagen = new TMemoryStream;



          (Imagen->Picture->Bitmap)->SaveToStream(msImagen);

          msImagen->Seek(0, soFromBeginning);

          if (!lPrueba && msImagen->Size == 0)

               continue;



          if (msImagen == 0)

               fPersona->Query->SQL->Text = "DELETE FROM Instalacion WHERE Etiqueta = :Campo";

          else

          {

               if (lPrueba)

                    fPersona->Query->SQL->Text = "UPDATE Instalacion SET Imagen = :Imagen WHERE Etiqueta = :Campo";

               else

                    fPersona->Query->SQL->Text = "INSERT INTO Instalacion (Etiqueta, Imagen) VALUES (:Campo, :Imagen)";

                    fPersona->Query->ParamByName("Imagen")->LoadFromStream(msImagen, ftBlob);

          }

          fPersona->Query->ParamByName("Campo")->AsString = Source->Name;

     }

     [...]



     try

     {

          fPersona->Query->ExecSQL();

          fPersona->Query->Transaction->Commit();

     }

     catch(...)

     {

          Screen->Cursor = crArrow;

          fPersona->Query->Transaction->Rollback();

          Mensaje(-1, "Se ha producido un error en la actualización de los datos.¦" + ExtractFileName(AnsiString(__FILE__)) + FormatFloat("' - '0", __LINE__), "Volver");

          LisSitSelectItem(NULL, NULL, false);

          return;

     }

}

El problema es que ni me da error ni nada; simplemente, no graba nada.

Hola.

Usando Firebird y estando el campo 'IMAGE' definido así,

Código SQL [-]...
  IMAGE  BLOB SUB_TYPE 0 SEGMENT SIZE 1024
...

de este modo guarda correctamente el contenido del TImage :

Código PHP:


		
			
#include <jpeg.hpp>



// cargar archivo imagen en TImage

void __fastcall TForm1::btnLoadImageClick(TObject *Sender)

{

  if (OpenPictureDialog1->Execute()) {

    Image1->Picture = NULL;

    Image1->Picture->LoadFromFile(OpenPictureDialog1->FileName);

  }

}



// guardar TImage en campo blob

void __fastcall TForm1::btnSaveImageClick(TObject *Sender)

{

  Graphics::TBitmap *Bitmap = new Graphics::TBitmap;

  TStream *Stream = new TMemoryStream;

  try {

    Bitmap->Width  = Image1->Picture->Width;

    Bitmap->Height = Image1->Picture->Height;

    Bitmap->Canvas->Draw(0, 0, Image1->Picture->Graphic);

    Bitmap->SaveToStream(Stream);



    IBQuery1->SQL->Clear();

    IBQuery1->SQL->Add("UPDATE TB_BLOB SET IMAGE = :IMAGE WHERE ID = :ID");

    IBQuery1->ParamByName("ID")->AsInteger = CSpinEdit1->Value;

    IBQuery1->ParamByName("IMAGE")->LoadFromStream(Stream, ftBlob);

    IBQuery1->ExecSQL();

  }

  __finally {

    delete Stream;

    delete Bitmap;

  }

}

Saludos :)

¡Perfecto! Muchas gracias.