I made an app only to take photos and send these to the server. in those photos, I edit the date in the right bottom corner. If a user takes more than 9 photos the app freezes in the process and asks if you want to close the app. You can choose between close app or wait. Click on wait and the process works all the photos saved to the server. But it's annoying and not professional to get this message. Below is the code and maybe some of you can spot the mistake I made.
I use the Tcameracomponent for making photos. A TMSFMXtableview(TV1) to show the photos in the app. And I use the Timage for linking to the Tcameracomponent.
This is the code for the save button onclick.
procedure TFMmain.Button10Click(Sender: TObject);
VAR
B: TBitmap;
R : TRectf;
LMemStream: TMemoryStream;
i2,I,AN, NewWidth, NewHeight : Integer;
lExtensie : string;
Scale : double;
Fid : Integer;
begin
Cameracomponent1.Active := false;
button11.Visible := false;
button10.Visible := true;
if TV1.Items.Count>0 then
begin
for I := 0 to tv1.Items.Count-1 do
begin
B:= TV1.Items.Items[i].Bitmap;
R.Create(B.Width - 250, B.Height - 100, B.Width, B.Height);
B.Canvas.BeginScene;
try
B.Canvas.Font.Size := 40;
b.Canvas.Fill.Color := TAlphaColorRec.red;
B.Canvas.FillText(
R, DateToStr(Now), False, 100, [TFillTextFlag.RightToLeft],
TTextAlign.Center);
finally
B.Canvas.EndScene;
end;
LMemStream := TMemoryStream.Create;
try
TV1.Items.Items[i].Bitmap.SaveToStream(LMemStream);
storedprocFotoUp.Params[0].AsStream :=LMemStream;
LMemStream.Position := 0;
storedprocFotoUp.ExecProc;
finally
Lmemstream.Free;
end;
end;
tv1.Items.Clear;
button11.Visible := true;
button10.Visible := true;
Cameracomponent1.Active := true;
end
else
begin
button11.Visible := true;
button10.Visible := true;
Cameracomponent1.Active := true;
end;
end;
end;
The storedprocfotoup is a procedure on the server side.
Procedure TServermodule.SavePhotoToServer(Stream: TStream);
const
BufSize = $8000;
var
Today : TDateTime;
Mem: TMemoryStream;
BytesRead, Vnr,Fnr: Integer;
Buffer: PByte;
fFilename, lExtensie, DT, Time: String;
begin
Today := NOW;
Flocation:= 'C:\test\';
lExtensie := '.jpg';
Time:= IntToStr(Yearof(Today)) IntToStr(Monthof(Today)) IntToStr(Dayof(Today)) IntToStr(Hourof(Today)) IntToStr(Minuteof(today)) IntToStr(MilliSecondof(today));
fFilename := 'F' Tijd lExtensie;
// save file to server
Mem := TMemoryStream.Create;
Mem.Position :=0;
GetMem(Buffer, BufSize);
try
repeat
BytesRead := Stream.Read(Pointer(Buffer)^, BufSize);
if BytesRead > 0 then
Mem.WriteBuffer(Pointer(Buffer)^, BytesRead);
until BytesRead < BufSize;
Mem.SaveToFile(Flocation fFilename);
finally
FreeMem(Buffer, BufSize);
Mem.Free;
end;
end;
I hope I provided enough information.
CodePudding user response：
First, comment about your server side processing that could be much simpler and will consume less memory.
SavePhotoToServer has a TStream parameter, so you can just take that stream and save it to a file, you don't need to copy data to another stream.
Procedure TServermodule.SavePhotoToServer(Stream: TStream);
var
...
f: TFileStream;
begin
...
f := TFileStream.Create(Flocation fFilename, fmCreate or fmShareExclusive);
try
f.CopyFrom(Stream, 0);
finally
f.Free;
end;
end;
Next thing you don't need is checking for TV1.Items.Count>0 and then doing everything in a for loop. If there are no items then nothing in for loop will execute, so this check is redundant.
Eventually, if you do want to check whether there is some work to do or not, simpler way to do that is checking that first and exiting the procedure before you disable buttons.
procedure TFMmain.Button10Click(Sender: TObject);
begin
if TV1.Items.Count>0 then
Exit;
Cameracomponent1.Active := false;
...
end;
And now to the hardest part. You need to call code that uploads to the server in the background thread. Otherwise your application will freeze.
Sending single image is simple, even sending the multiple ones would not be that complicated, but you want to know when that work is finished so you can enable your UI again.
To do that I will use additional Boolean flag Processing, to make the code clearer, and two separate procedures StartProcessing and EndProcessing which will wrap all UI intialization and finalization code.
One of the additional problems is determining which parts of the code can be safely put in the background thread and which don't.
Working with TBitmap in background threads is generally not thread safe, but from what I have seen it should be thread-safe on Android. This means you can save bitmap to stream in the background thread. This will also simplify the rest of the code.
Processing logic will be split in two parts. First will draw what is needed on the bitmaps, and background thread will handle saving bitmaps to stream and sending them.
Please not, that touching UI from the background thread is not thread-safe. In this case I will directly access UI component, because the rest of the code will ensure that this list is not modified while the thread is running.
Generally, proper thread-safe code would create copies of the bitmaps in the main thread (we cannot just take the reference because bitmaps can be modified or released in the meantime), stored in separate non UI collection and then it would pass that collection to the background thread for sending. Copying bitmaps takes time and making shortcut should work in this occasion.
Another problem, specific for Android is that user can switch from your application to another one at any time and this can also interfere with your application logic. For this part I will use FormCloseQuery, but I have to note that I am not sure how reliable it works on Android as the OS can kill your application regardless.
So when all of the above is applied, your code workflow would look like following:
procedure TFMmain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := not Processing;
end;
function TFMmain.StartProcessing: Boolean;
begin
Result := not Processing;
if Result then
begin
Processing := True;
// other UI logic
Cameracomponent1.Active := False;
...
end;
end;
procedure TFMmain.EndProcessing;
begin
Processing := False;
// other UI logic
Cameracomponent1.Active := True;
end;
procedure TFMmain.Button10Click(Sender: TObject);
begin
if not StartProcessing then
Exit;
try
// prepare bitmaps
for I := 0 to tv1.Items.Count-1 do
begin
B:= TV1.Items.Items[i].Bitmap;
R.Create(B.Width - 250, B.Height - 100, B.Width, B.Height);
B.Canvas.BeginScene;
try
B.Canvas.Font.Size := 40;
b.Canvas.Fill.Color := TAlphaColorRec.red;
B.Canvas.FillText(
R, DateToStr(Now), False, 100, [TFillTextFlag.RightToLeft],
TTextAlign.Center);
finally
B.Canvas.EndScene;
end;
end;
// run in background thread
TTask.Run(
procedure
var
I: Integer;
LMemStream: TMemoryStream;
begin
try
// iterating through UI component is not
// generally thread-safe and this kind of code
// can work only in limited scenario
for I := 0 to tv1.Items.Count-1 do
begin
LMemStream := TMemoryStream.Create;
TThread.Synchronize(nil,
procedure
begin
TV1.Items.Items[i].Bitmap.SaveToStream(LMemStream);
end);
storedprocFotoUp.Params[0].AsStream :=LMemStream;
LMemStream.Position := 0;
storedprocFotoUp.ExecProc;
end;
finally
TThread.Queue(nil,
procedure
begin
EndProcessing;
end);
end;
end);
except
EndProcessing;
raise;
end;
end;