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