Search code examples
androiddelphifiremonkey

App freezes when uploading pictures to server


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.


Solution

  • 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;