Delphi Bitmap in Thread

This is my code trying not to block the app in Android when loading one or more images.

Everyone so often freezes or does not load properly.

If anyone knows a way to do what I need it would be grateful.

This is my procedure:

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;

      

+3


source to share


1 answer


Unfortunately FMX bitmaps are not thread safe, you can only use them on the main thread (or in a synchronized portion of another thread).



0


source







All Articles