multithreading - 线程中的 Delphi 位图

Question

这是我的代码，在加载一张或多张图像时尝试不阻止 Android 中的应用程序。

经常卡住或无法正确加载。

如果有人知道如何做我需要的事情，我将不胜感激。

这是我的程序:

uses

  System.IOUtils,
  System.Threading,
  System.SyncObjs,

  FMX.Surfaces,

  MyTasks;

procedure TForm1.Button1Click(Sender: TObject);
begin

  AniIndicator1.Enabled := True;
  AniIndicator1.Visible := True;
  Button1.Enabled := False;

  TTask.Run(

    procedure
    var
      VBitmapSurface: TBitmapSurface;
      VFiles: TStringDynArray;
      VFilesIndexes: TArray<NativeInt>;
      VFile: String;
      VIndex: Integer;
      VBitmapData: TBitmapData;
      VMapped: Boolean;
      VCriticalSection: TCriticalSection;
    begin
      VCriticalSection := TCriticalSection.Create;
      VCriticalSection.Acquire;

      VFiles := SearchFiles( [ TPath.GetPicturesPath, TPath.GetCameraPath, TPath.GetSharedPicturesPath, TPath.GetSharedCameraPath ], [ '*.jpg', '*.jpeg' ] ).Value;
      VFilesIndexes := Randomizer( Length( VFiles ) ).Value;
      VFile := VFiles[ VFilesIndexes[ 0 ] ];

      VBitmapSurface := TBitmapSurface.Create;
      try
        if TBitmapCodecManager.LoadFromFile( VFile, VBitmapSurface ) then
        begin
          VMapped := False;
          TThread.Synchronize( nil,
            procedure
            begin
              Image1.Bitmap.SetSize( VBitmapSurface.Width, VBitmapSurface.Height );
              VMapped := Image1.Bitmap.Map( TMapAccess.Write, VBitmapData );
            end
          );
          if VMapped then
          try
            if VBitmapData.Pitch = VBitmapSurface.Pitch then
              Move( VBitmapSurface.Bits^, VBitmapData.Data^, VBitmapSurface.Pitch * VBitmapData.Height )
            else
              for VIndex := 0 to VBitmapSurface.Height - 1 do
                Move( VBitmapSurface.Scanline[ VIndex ]^, Pointer( NativeInt( VBitmapData.Data ) + VIndex * VBitmapData.Pitch )^, VBitmapData.Width * VBitmapSurface.BytesPerPixel );
          finally
            TThread.Synchronize( nil,
              procedure
              begin
                Image1.Bitmap.Unmap( VBitmapData );
              end
            );
          end;

        end;
      finally
        VBitmapSurface.DisposeOf;
      end;

      VCriticalSection.Release;
      VCriticalSection.DisposeOf;

      TThread.Synchronize( nil,
        procedure
        begin
          AniIndicator1.Enabled := False;
          AniIndicator1.Visible := False;
          Button1.Enabled := True;
        end
      );

    end

  );

end;

Answer 1

不幸的是，FMX 位图不是线程安全的，您只能在主线程(或另一个线程的同步部分)中使用它们。