将图片上传到服务器时应用程序冻结

Question

我做了一个应用程序，只是为了拍照并将这些照片发送到服务器。在那些照片中，我在右下角编辑了日期。如果用户拍摄的照片超过 9 张，应用程序会在此过程中冻结并询问您是否要关闭该应用程序。您可以选择关闭应用程序或等待。单击等待，该过程会处理所有保存到服务器的照片。但是收到这条消息很烦人，也不专业。下面是代码，也许你们中的一些人可以发现我犯的错误。

我用Tcamera组件拍照片。用于在应用程序中显示照片的 TMSFMXtableview(TV1)。我使用 Timage 链接到 Tcamera 组件。

这是点击保存按钮的代码。

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;

storedprocfotoup是服务器端的一个过程。

Procedure TServermodule.SavePhotoToServer(Stream: TStream);
const
   BufSize = 00;
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;

希望我提供了足够的信息。

Answer 1

首先，评论一下您的服务器端处理可能会更简单并且消耗更少的内存。

SavePhotoToServer 有一个 TStream 参数，因此您可以只获取该流并将其保存到文件中，不需要将数据复制到另一个流。

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;

接下来您不需要检查 TV1.Items.Count>0，然后在 for 循环中执行所有操作。如果没有项目，则 for 循环中的任何内容都不会执行，因此此检查是多余的。

最后，如果您确实想检查是否有一些工作要做，更简单的方法是先检查并退出程序，然后再禁用按钮。

procedure TFMmain.Button10Click(Sender: TObject);
begin
  if TV1.Items.Count>0 then 
    Exit;

  Cameracomponent1.Active := false;
  ...
end;

现在到了最难的部分。您需要在后台线程中调用上传到服务器的代码。否则您的应用程序将冻结。

发送单张图片很简单，即使发送多张图片也不会那么复杂，但您想知道该工作何时完成，以便您可以再次启用您的 UI。

为此，我将使用额外的布尔标志 Processing，使代码更清晰，并使用两个单独的过程 StartProcessing 和 EndProcessing 来包装所有 UI初始化和完成代码。

另一个问题是确定代码的哪些部分可以安全地放在后台线程中，哪些不能。

在后台线程中使用 TBitmap 通常不是线程安全的，但据我所见，它在 Android 上应该是线程安全的。这意味着您可以将位图保存到后台线程中的流中。这也将简化其余代码。

处理逻辑将分为两部分。首先会在位图上绘制需要的内容，后台线程会处理将位图保存到流中并发送它们。

请注意，从后台线程触摸 UI 不是线程安全的。在这种情况下，我将直接访问 UI 组件，因为其余代码将确保在线程为运行.

时不修改此列表

通常，适当的线程安全代码会在主线程中创建位图的副本（我们不能只获取引用，因为位图可以同时修改或释放），存储在单独的非 UI集合，然后它将那个集合传递给后台线程进行发送。复制位图需要时间，在这种情况下应该可以制作快捷方式。

另一个特定于 Android 的问题是用户可以随时从您的应用程序切换到另一个应用程序，这也会干扰您的应用程序逻辑。对于这一部分，我将使用 FormCloseQuery，但我必须注意，我不确定它在 Android 上的可靠性如何，因为 OS 无论如何都会终止您的应用程序。

因此，当应用以上所有内容时，您的代码工作流将如下所示：

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;

将图片上传到服务器时应用程序冻结

App freezes when uploading pictures to server

delphi

android

firemonkey