Image 调整大小后,图像不会存储在表中

Image 调整大小后,图像不会存储在表中,image,delphi,firedac,delphi-10.2-tokyo,Image,Delphi,Firedac,Delphi 10.2 Tokyo,我想调整存储在数据库中的图像的大小,但在调整大小后,它们不会像其他访问它们的程序所显示的那样存储 代码如下: procedure ScaleImages(ATableName,APicFieldName,ATypeFieldName: String); const cMaxPicDim = 512; cCompressQual = 70; var lJPGImage : TJpegImage; lBMPImage : TBitmap; lBlobStrea

我想调整存储在数据库中的图像的大小,但在调整大小后,它们不会像其他访问它们的程序所显示的那样存储

代码如下:

procedure ScaleImages(ATableName,APicFieldName,ATypeFieldName: String);
const
   cMaxPicDim    = 512;
   cCompressQual = 70;
var
   lJPGImage  : TJpegImage;
   lBMPImage  : TBitmap;
   lBlobStream: TStream;
   lPhotoField: TBlobField;
   lTypeField : TField;
begin
   with QueryMiscUpdate do  // TFDQuery connected to TFDConnection to FireBird database
   begin
      Close;
      UpdateOptions.RequestLive := true;
      SQL.Text := 'select * from ' + ATableName;
      Open;
      lPhotoField := TBlobField(FieldByname(APicFieldName));
      lTypeField  := FieldByName(ATypeFieldName);
      while not eof do
      begin
         if not lPhotoField.IsNull then
         begin
            case lTypeField.asInteger of
               JPGCLASSTYPE: begin
                                lJPGImage := TJpegImage.Create;
                                Edit;
                                lBlobStream := CreateBlobStream(lPhotoField, bmReadWrite);
                                try
                                   try
                                      lJPGImage.LoadFromStream(lBlobStream);  // Width=3872, Height=2592
                                      ResizeJPGImageWithoutAlpha(lJPGImage, cMaxPicDim, cCompressQual); // lJPGImage.Width=512, Height=342
                                      // lBlobStream.Position := 0; Makes no difference
                                      lJPGImage.SaveToStream(lBlobStream);
                                   except
                                      on E:Exception do ShowMessage(E.Message); // debugging
                                   end;
                                finally
                                   lBlobStream.Free;  // *Before* the post, https://stackoverflow.com/a/46099989/512728
                                   Post;
                                   lJPGImage.Free;
                                end;
                             end;
               // other formats...              
            end; // case
         end; // if not lPhotoField.IsNull
         Next;
      end; // while not eof
      Close;
   end;
end; // ScaleImages
即使我将其拆分为单独的TStream进行读/写,它也不起作用:

begin
   lJPGImage := TJpegImage.Create;
   lLoadStream := CreateBlobStream(lPhotoField, bmRead);
   try
      try
         lJPGImage.LoadFromStream(lLoadStream);
         ResizeJPGImageWithoutAlpha(lJPGImage, cMaxPicDim, cCompressQual);
         Edit;
         lSaveStream := CreateBlobStream(lPhotoField, bmWrite);
         lJPGImage.SaveToStream(lSaveStream);
      except
         on E:Exception do ShowMessage(E.Message); // debugging
      end;
   finally
      lLoadStream.Free;
      lSaveStream.Free;
      Post;
      lJPGImage.Free;
   end;
end;
FWIW,这是旧的调整大小代码,在别处工作:

procedure ResizeJPGImageWithoutAlpha(var AJPGImage: TJPegImage; AMaxDimension, ACompressionQuality: Integer);
var
   lBitmap   : TBitmap;
   lFactor   : Real;
   lNewWidth,
   lNewHeight: Integer;
begin
   if (AJPGImage.Width <= 128) and (AJPGImage.Height <= 128) then Exit;

   if AJPGImage.Width > AJPGImage.Height then
      if AJPGImage.Width > AMaxDimension then
         lFactor := AJPGImage.Width
      else
         lFactor := 0
   else
      if AJPGImage.Height > AMaxDimension then
         lFactor := AJPGImage.Height
      else
         lFactor := 0;
   if lFactor <> 0 then
   begin
      lFactor    := lFactor / AMaxDimension;
      lNewWidth  := Trunc(AJPGImage.Width  / lFactor);
      lNewHeight := Trunc(AJPGImage.Height / lFactor);
      lBitmap    := TBitmap.Create;
      try
         lBitmap.Width := lNewWidth;
         lBitmap.Height:= lNewHeight;
         lBitmap.Canvas.StretchDraw(lBitmap.Canvas.Cliprect, AJPGImage);
         // Convert back to JPEG
         AJPGImage.Assign(lBitmap);
      finally
         lBitmap.free;
      end;
   end
   else
      AJPGImage.DIBNeeded;
      // Decompress the jpeg image into a bitmap.
      // DIBNeeded is used when the jpeg image needs a bitmap representation of its image.
      // Compress will not work without that (width/height become 0). The resize code already caused a bitmap.
   AJPGImage.CompressionQuality := ACompressionQuality;
   AJPGImage.Compress;
end;
表中包含正确的数据,其他程序*可以读取/写入图像

关于在SO上保存图像,已经有很多问题了,但仔细查看,我看不到:我忽略了什么

Delphi东京10.2.1,Win32应用程序,Firebird 2.5.3.26778

*它们使用TclientDataSet和picture组件,因此代码不会直接进行比较

Post语句的FDMonitor输出:

>> TFDCustomCommand.Prepare [Command="select * from tt_emp_photo"]
     . CreateCommand [ConnectionDef=""]
     . Adapter DataModuleData.QueryMiscUpdate registered with client
     . Preprocessed [CMD="select * from tt_emp_photo", FROM="tt_emp_photo", VP=0, VPE=0, OBP=0, CK=1]
<< TFDCustomCommand.Prepare [Command="select * from tt_emp_photo"]
>> Lock [ARow.Table.Name="tt_emp_photo"]
    >> StartTransaction [ConnectionDef=""]
         . isc_start_multiple [count=1, params="write,read_committed,rec_version,wait"]
    << StartTransaction [ConnectionDef=""]
     . CreateCommand [ConnectionDef=""]
     . Adapter tt_emp_photo: TFDDAptTableAdapter($04542520).Lock: TFDPhysIBCommand($04491A90) registered with client
     . Preprocessed [CMD="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG, A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = ? FOR UPDATE WITH LOCK", FROM="TT_EMP_PHOTO", VP=0, VPE=0, OBP=0, CK=1]
    >> ProcessRequest [ARow.Table.Name="tt_emp_photo"]
        >> tt_emp_photo: TFDDAptTableAdapter($04542520).Lock: TFDPhysIBCommand($04491A90).Prepare [Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG, A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
             . Preprocessed [CMD="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG, A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = ? FOR UPDATE WITH LOCK", FROM="TT_EMP_PHOTO", VP=0, VPE=0, OBP=0, CK=1]
             . isc_dsql_allocate_statement [db_handle=$00000021]
             . isc_dsql_prepare [tra_handle=$00000059, stmt_handle=$0000005A, sql="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = ? FOR UPDATE WITH LOCK", dialect=3]
             . isc_dsql_sql_info [stmt_handle=$0000005A, info=21]
             . isc_dsql_describe [stmt_handle=$0000005A, dialect=3]
             . isc_dsql_describe_bind [stmt_handle=$0000005A, dialect=3]
        << Prepare [Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
        >> Open [Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
            >> DataModuleDatabase.FDConnectionTimeTell.Sent
                 . Var [N=0, Name="OLD_TT_EMP_ID", Type=SQL_LONG, Prec=0, Scale=0, Size=4, Data(0)=1]
            << Sent
             . isc_dsql_execute2 [tra_handle=$00000059, stmt_handle=$0000005A, dialect=3]
        << tt_emp_photo: TFDDAptTableAdapter($04542520).Lock: TFDPhysIBCommand($04491A90).Open [Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
        >> Define(TFDDatSTable) [ATable="Table", Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
             . Col add [Index=1, SrcName="TT_EMP_ID", SrcType=Int32, SrcSize=0, SrcPrec=0, SrcScale=0, Type=Int32, Size=0, Prec=0, Scale=0, OrigTabName="TT_EMP_PHOTO", OrigColName="TT_EMP_ID"]
             . Col add [Index=2, SrcName="TT_PHOTO", SrcType=Blob, SrcSize=0, SrcPrec=0, SrcScale=0, Type=Blob, Size=0, Prec=0, Scale=0, OrigTabName="TT_EMP_PHOTO", OrigColName="TT_PHOTO"]
             . Col add [Index=3, SrcName="TT_PHOTO_TYPE", SrcType=Int32, SrcSize=0, SrcPrec=0, SrcScale=0, Type=Int32, Size=0, Prec=0, Scale=0, OrigTabName="TT_EMP_PHOTO", OrigColName="TT_PHOTO_TYPE"]
             . Col add [Index=4, SrcName="TT_INFO", SrcType=Memo, SrcSize=0, SrcPrec=0, SrcScale=0, Type=Memo, Size=0, Prec=0, Scale=0, OrigTabName="TT_EMP_PHOTO", OrigColName="TT_INFO"]
             . Col add [Index=5, SrcName="TT_TAG", SrcType=Int32, SrcSize=0, SrcPrec=0, SrcScale=0, Type=Int32, Size=0, Prec=0, Scale=0, OrigTabName="TT_EMP_PHOTO", OrigColName="TT_TAG"]
             . Col add [Index=6, SrcName="TT_TAGTYPE", SrcType=Int32, SrcSize=0, SrcPrec=0, SrcScale=0, Type=Int32, Size=0, Prec=0, Scale=0, OrigTabName="TT_EMP_PHOTO", OrigColName="TT_TAGTYPE"]
             . Col add [Index=7, SrcName="TT_TAGDATE", SrcType=DateTimeStamp, SrcSize=0, SrcPrec=0, SrcScale=0, Type=DateTime, Size=0, Prec=0, Scale=0, OrigTabName="TT_EMP_PHOTO", OrigColName="TT_TAGDATE"]
        << Define(TFDDatSTable) [ATable="tt_emp_photo", Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
        >> Fetch [ATable="tt_emp_photo", Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
             . isc_dsql_fetch [stmt_handle=$0000005A, dialect=3]
            >> DataModuleDatabase.FDConnectionTimeTell.Fetched
                 . Var [N=0, Type=SQL_LONG, Prec=0, Scale=0, Size=4, Data=1]
                 . Var [N=1, Type=SQL_BLOB, Prec=0, Scale=0, Size=8, Data=<BLOB> (179,3)]
                 . Var [N=2, Type=SQL_LONG, Prec=0, Scale=0, Size=4, Data=1]
                 . Var [N=3, Type=SQL_BLOB, Prec=0, Scale=0, Size=8, Data=<BLOB> (179,1)]
                 . Var [N=4, Type=SQL_LONG, Prec=0, Scale=0, Size=4, Data=NULL]
                 . Var [N=5, Type=SQL_LONG, Prec=0, Scale=0, Size=4, Data=NULL]
                 . Var [N=6, Type=SQL_TIMESTAMP, Prec=0, Scale=0, Size=8, Data=NULL]
            << Fetched
             . isc_open_blob2 [db_handle=$00000021, tra_handle=$00000059, blob_id.high=179, blob_id.low=3]
             . isc_blob_info [blob_handle=$0000005B, items="num_segments;max_segment;total_length;type"]
             . isc_get_segment [blob_handle=$0000005B]
             [.. repeats 30+ times ..]
             . isc_close_blob [blob_handle=$0000005B]
             . isc_open_blob2 [db_handle=$00000021, tra_handle=$00000059, blob_id.high=179, blob_id.low=1]
             . isc_blob_info [blob_handle=$0000005C, items="num_segments;max_segment;total_length;type"]
             . isc_get_segment [blob_handle=$0000005C]
             . isc_close_blob [blob_handle=$0000005C]
        << tt_emp_photo: TFDDAptTableAdapter($04542520).Lock: TFDPhysIBCommand($04491A90).Fetch [ATable="tt_emp_photo", Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK", RowsAffected=1]
         . Eof reached [ATable="tt_emp_photo", Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
        >> Close [Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
             . isc_dsql_free_statement [stmt_handle=$0000005A, option="DSQL_close"]
        << DataModuleDatabase.FDConnectionTimeTell.Close [Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
        >> tt_emp_photo: TFDDAptTableAdapter($04542520).Lock: TFDPhysIBCommand($04491A90).Open [Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
        << Open [Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
    << ProcessRequest [ARow.Table.Name="tt_emp_photo"]
<< Lock [ARow.Table.Name="tt_emp_photo"]
>> Unprepare [Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
     . isc_dsql_free_statement [stmt_handle=$0000005A, option="DSQL_drop"]
<< Unprepare [Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
 . Destroy [Command="SELECT A.TT_EMP_ID, A.TT_PHOTO, A.TT_PHOTO_TYPE, A.TT_INFO, A.TT_TAG,    A.TT_TAGTYPE, A.TT_TAGDATE FROM TT_EMP_PHOTO A WHERE A.TT_EMP_ID = :OLD_TT_EMP_ID FOR UPDATE WITH LOCK"]
 . Adapter tt_emp_photo: TFDDAptTableAdapter($04542520).Lock: TFDPhysIBCommand($04491A90) unregistered with client
>> Update [ARow.Table.Name="tt_emp_photo"]
     . CreateCommand [ConnectionDef=""]
     . Adapter tt_emp_photo: TFDDAptTableAdapter($04542520).Update: TFDPhysIBCommand($04491A90) registered with client
     . Preprocessed [CMD="UPDATE TT_EMP_PHOTO SET TT_PHOTO = ? WHERE TT_EMP_ID = ?", FROM="", VP=0, VPE=0, OBP=0, CK=7]
    >> ProcessRequest [ARow.Table.Name="tt_emp_photo"]
        >> tt_emp_photo: TFDDAptTableAdapter($04542520).Update: TFDPhysIBCommand($04491A90).Prepare [Command="UPDATE TT_EMP_PHOTO SET TT_PHOTO = :NEW_TT_PHOTO WHERE TT_EMP_ID = :OLD_TT_EMP_ID"]
             . Preprocessed [CMD="UPDATE TT_EMP_PHOTO SET TT_PHOTO = ? WHERE TT_EMP_ID = ?", FROM="", VP=0, VPE=0, OBP=0, CK=7]
             . isc_dsql_allocate_statement [db_handle=$00000021]
             . isc_dsql_prepare [tra_handle=$00000059, stmt_handle=$0000005D, sql="UPDATE TT_EMP_PHOTO SET TT_PHOTO = ? WHERE TT_EMP_ID = ?", dialect=3]
             . isc_dsql_sql_info [stmt_handle=$0000005D, info=21]
             . isc_dsql_describe_bind [stmt_handle=$0000005D, dialect=3]
             . isc_dsql_describe_bind [stmt_handle=$0000005D, dialect=3]
        << Prepare [Command="UPDATE TT_EMP_PHOTO SET TT_PHOTO = :NEW_TT_PHOTO WHERE TT_EMP_ID = :OLD_TT_EMP_ID"]
        >> Execute [Command="UPDATE TT_EMP_PHOTO SET TT_PHOTO = :NEW_TT_PHOTO WHERE TT_EMP_ID = :OLD_TT_EMP_ID", ATimes=0, AOffset=0]
             . isc_create_blob2 [db_handle=$00000021, tra_handle=$00000059]
             . isc_blob_info [blob_handle=$0000005E, items="num_segments;max_segment;total_length;type"]
             . isc_put_segment [blob_handle=$0000005E]
             . isc_put_segment [blob_handle=$0000005E]
             . isc_put_segment [blob_handle=$0000005E]
             . isc_put_segment [blob_handle=$0000005E]
             . isc_put_segment [blob_handle=$0000005E]
             . isc_put_segment [blob_handle=$0000005E]
             . isc_put_segment [blob_handle=$0000005E]
             . isc_put_segment [blob_handle=$0000005E]
             . isc_put_segment [blob_handle=$0000005E]
             . isc_close_blob [blob_handle=$0000005E]
            >> DataModuleDatabase.FDConnectionTimeTell.Sent
                 . Var [N=0, Name="NEW_TT_PHOTO", Type=SQL_BLOB, Prec=0, Scale=0, Size=8, Data(0)=<BLOB> (0,3)]
                 . Var [N=1, Name="OLD_TT_EMP_ID", Type=SQL_LONG, Prec=0, Scale=0, Size=4, Data(0)=1]
            << Sent
             . isc_dsql_execute2 [tra_handle=$00000059, stmt_handle=$0000005D, dialect=3]
             . isc_dsql_sql_info [stmt_handle=$0000005D, info=23]
        << tt_emp_photo: TFDDAptTableAdapter($04542520).Update: TFDPhysIBCommand($04491A90).Execute [Command="UPDATE TT_EMP_PHOTO SET TT_PHOTO = :NEW_TT_PHOTO WHERE TT_EMP_ID = :OLD_TT_EMP_ID", ATimes=1, AOffset=0, RowsAffected=1, RowsAffectedReal=True, ErrorAction=5]
        >> Open [Command="UPDATE TT_EMP_PHOTO SET TT_PHOTO = :NEW_TT_PHOTO WHERE TT_EMP_ID = :OLD_TT_EMP_ID"]
        << Open [Command="UPDATE TT_EMP_PHOTO SET TT_PHOTO = :NEW_TT_PHOTO WHERE TT_EMP_ID = :OLD_TT_EMP_ID"]
    << ProcessRequest [ARow.Table.Name="tt_emp_photo"]
<< Update [ARow.Table.Name="tt_emp_photo"]
>> Unprepare [Command="UPDATE TT_EMP_PHOTO SET TT_PHOTO = :NEW_TT_PHOTO WHERE TT_EMP_ID = :OLD_TT_EMP_ID"]
     . isc_dsql_free_statement [stmt_handle=$0000005D, option="DSQL_drop"]
<< Unprepare [Command="UPDATE TT_EMP_PHOTO SET TT_PHOTO = :NEW_TT_PHOTO WHERE TT_EMP_ID = :OLD_TT_EMP_ID"]
 . Destroy [Command="UPDATE TT_EMP_PHOTO SET TT_PHOTO = :NEW_TT_PHOTO WHERE TT_EMP_ID = :OLD_TT_EMP_ID"]
 . Adapter tt_emp_photo: TFDDAptTableAdapter($04542520).Update: TFDPhysIBCommand($04491A90) unregistered with client
>> UnLock [ARow.Table.Name="tt_emp_photo"]
    >> DataModuleDatabase.FDConnectionTimeTell.Commit [ConnectionDef="", Retaining=False]
         . isc_commit_transaction [tra_handle=$00000059]
    << Commit [ConnectionDef="", Retaining=False]
<< UnLock [ARow.Table.Name="tt_emp_photo"]
我会取代

lBlobStream := CreateBlobStream(lPhotoField, bmReadWrite);
使用lBlobStream:TMemoryStream,然后执行以下操作:

lBlobStream.Clear; 
lPhotoField.SaveToStream(lBlobStream);
lBlobStream.Position := 0;
然后

在程序开始时:

  lBlobStream:= TMemoryStream.Create;
最后呢

  lBlobStream.free;
我用Delphi XE7、Firebird 2.1检查了您的代码,但它不起作用,但这对我来说很有效:

procedure TForm1.ScaleImages(ATableName,APicFieldName,ATypeFieldName: String);
const
   cMaxPicDim    = 512;
   cCompressQual = 70;
var
   lJPGImage  : TJpegImage;
   lBMPImage  : TBitmap;
   //lBlobStream: TStream;
   lBlobStream: TMemoryStream;
   lPhotoField: TBlobField;
   lTypeField : TField;
begin
   lBlobStream:= TMemoryStream.Create;
   with QueryMiscUpdate do  // TFDQuery connected to TFDConnection to FireBird database
   begin
      Close;
      UpdateOptions.RequestLive := true;
      SQL.Text := 'select * from ' + ATableName;
      Open;
      lPhotoField := TBlobField(FieldByname(APicFieldName));
      lTypeField  := FieldByName(ATypeFieldName);
      while not eof do
      begin
       if not lPhotoField.IsNull then
         begin

            lJPGImage := TJpegImage.Create;
            Edit;
            lBlobStream.Clear;
            lPhotoField.SaveToStream(lBlobStream);
            lBlobStream.Position:= 0;
            //lBlobStream := CreateBlobStream(lPhotoField, bmReadWrite);
            try
               try
                  lJPGImage.LoadFromStream(lBlobStream);  // Width=3872, Height=2592
                  ResizeJPGImageWithoutAlpha(lJPGImage, cMaxPicDim, cCompressQual); // lJPGImage.Width=512, Height=342
                  // lBlobStream.Position := 0; Makes no difference
                  lBlobStream.Clear; //<-- If I remove this, it doesn't work
                  lJPGImage.SaveToStream(lBlobStream);
                  lBlobStream.Position:= 0;
                  lPhotoField.LoadFromStream(lBlobStream);
               except
                  on E:Exception do ShowMessage(E.Message); // debugging
               end;
            finally
               //lBlobStream.Free;  // *Before* the post, https://stackoverflow.com/a/46099989/512728
               Post;
               lJPGImage.Free;
            end;

               // other formats...
            //end; // case
         end; // if not lPhotoField.IsNull
         Next;
      end; // while not eof
      Close;
   end;
 lBlobStream.Free;
end; // ScaleImages

帖子是否会导致任何数据库活动被触发更新语句?@nil我正在跟踪发生了什么,但哦,该死,听起来运气不好。我想说您的代码看起来很可靠,因此我对DB组件级别发生的事情很感兴趣。也许还有其他一些评测选项可以使用,比如SQL Server Profiler for MS SQL?您是否尝试过创建一个单独的TMemoryStream,然后使用TBlobField.SaveToStream和TBlobField.LoadFromStream?我想这就是@A.Fornés的建议。@nil Trace补充了这个问题……这很有效,谢谢。我还没有把你的答案标记为正确答案,因为我仍然很好奇是否有人找到了它不起作用的原因。我在代码的其他地方使用TStream在TclientDataSet上执行相同的图像收缩,在那里它可以工作……可能是第二个lBlobStream.Clear;给你一些关于这个问题的线索。正如我在代码中指出的,如果我删除它,它将不起作用。
  lBlobStream.free;
procedure TForm1.ScaleImages(ATableName,APicFieldName,ATypeFieldName: String);
const
   cMaxPicDim    = 512;
   cCompressQual = 70;
var
   lJPGImage  : TJpegImage;
   lBMPImage  : TBitmap;
   //lBlobStream: TStream;
   lBlobStream: TMemoryStream;
   lPhotoField: TBlobField;
   lTypeField : TField;
begin
   lBlobStream:= TMemoryStream.Create;
   with QueryMiscUpdate do  // TFDQuery connected to TFDConnection to FireBird database
   begin
      Close;
      UpdateOptions.RequestLive := true;
      SQL.Text := 'select * from ' + ATableName;
      Open;
      lPhotoField := TBlobField(FieldByname(APicFieldName));
      lTypeField  := FieldByName(ATypeFieldName);
      while not eof do
      begin
       if not lPhotoField.IsNull then
         begin

            lJPGImage := TJpegImage.Create;
            Edit;
            lBlobStream.Clear;
            lPhotoField.SaveToStream(lBlobStream);
            lBlobStream.Position:= 0;
            //lBlobStream := CreateBlobStream(lPhotoField, bmReadWrite);
            try
               try
                  lJPGImage.LoadFromStream(lBlobStream);  // Width=3872, Height=2592
                  ResizeJPGImageWithoutAlpha(lJPGImage, cMaxPicDim, cCompressQual); // lJPGImage.Width=512, Height=342
                  // lBlobStream.Position := 0; Makes no difference
                  lBlobStream.Clear; //<-- If I remove this, it doesn't work
                  lJPGImage.SaveToStream(lBlobStream);
                  lBlobStream.Position:= 0;
                  lPhotoField.LoadFromStream(lBlobStream);
               except
                  on E:Exception do ShowMessage(E.Message); // debugging
               end;
            finally
               //lBlobStream.Free;  // *Before* the post, https://stackoverflow.com/a/46099989/512728
               Post;
               lJPGImage.Free;
            end;

               // other formats...
            //end; // case
         end; // if not lPhotoField.IsNull
         Next;
      end; // while not eof
      Close;
   end;
 lBlobStream.Free;
end; // ScaleImages