Jan Doggen
Reputation: 9106
Images don't get stored in table after resize
I want to resize images stored in a database, but after the resize they don't store (as shown by other program accessing them).
This is the code:
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
Even if I split this into separate TStreams for reading/writing it does not work:
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, here's the resize code (old, working elsewhere):
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;
Possibly relevant TFDConnection.FetchOptions and TFDConnection.UpdateOptions are default:
Table structure:
CREATE TABLE <OWNER>TT_EMP_PHOTO
(
TT_EMP_ID INTEGER DEFAULT 0 NOT NULL,
TT_PHOTO BLOB SUB_TYPE 0 SEGMENT SIZE 80,
TT_PHOTO_TYPE INTEGER,
TT_INFO BLOB SUB_TYPE TEXT SEGMENT SIZE 80,
TT_TAG INTEGER,
TT_TAGTYPE INTEGER,
TT_TAGDATE TIMESTAMP
);
Table contains correct data (other programs* can read/write the images).
There are already a lot of questions about saving images on SO, but going through them I do not see: What am I overlooking?
Delphi Tokyo 10.2.1, Win32 app, Firebird 2.5.3.26778
* They use TClientDataSets and picture components, so the code does not directly compare.
FDMonitor output for the Post statement:
>> 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"]
Upvotes: 0
Views: 287
Answers (1)
A. Fornés
Reputation: 203
I would replace
lBlobStream := CreateBlobStream(lPhotoField, bmReadWrite);
with lBlobStream: TMemoryStream and then this:
lBlobStream.Clear;
lPhotoField.SaveToStream(lBlobStream);
lBlobStream.Position := 0;
then
try
lJPGImage.LoadFromStream(lBlobStream);
...
and at the beginning of the procedure:
lBlobStream:= TMemoryStream.Create;
and at the end
lBlobStream.free;
I checked your code with Delphi XE7, Firebird 2.1 and it did not work, but this worked for me:
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
Upvotes: 1
Related Questions
- Resize images and save output
- How to resize a picture?
- How to resize image using Skia4Delphi
- Why uploaded photo is much smaller than saved - Delphi 10.3.2, firemonkey
- Delphi JPEG resize and Compress
- Error when saving resized image to Database
- Resizing an image in Delphi XE
- Saving and loading jpeg images to database not working DELPHI
- Why do I get JPEG error 42 when it's stored in a database?
- DBImage does not Refresh programmatically