TThread + Thumbnails

Question

I need your help in the following situation. I know it's been discussed many many times, the way one should work with threads, using Synchronize / Critical Sections and so on. So do not blame me for asking this question again, because in my situation neither synchronize, nor Critical Sections help to deal with TBitmap in a TThread.

1. What I use:

I'm using Delphi XE, Firemonkey Application with GlobalUseDirect2D:= True;

I NEED to use GlobalUseDirect2D because I draw a lot and I need fast drawing. Still Disabling GlobalUseDirect2D or using GlobalUseGPUCanvas:= True, my problem disappears, but that is not an option!

2. What I Do:

Ok. So this is a simple implementation of some other project, but the idea is to display image thumbnails. First I build a list of items (TImageData) and then I start a Thread to load image thumbnails. When scrolling (using TScrollBar) I call Arrange method to arrange items on a form and than call Invalidate to repaint the displaying area;

3. So what is the problem?

The problem is that some thumbnails are either blank or not fully loaded (corrupted).

4. When the problem occures?

After many experiments I found out when the images become corrupted;

So. If I build a list of items, then start the thumbnails thread and do nothing with the form while the thread is running (do not change scrollbar position / do not resize the form / do not move cursor) then EVERYTHING IS FINE. All is loaded well;

In case I build a list of items, then start the thumbnails thread and start scrolling while the thread is running(changing scrollbar position - it calls Arrange + Invalidate methods), My thumbnails (not all) become corrupted.

5. What I tried.

Since I thought it might be because my Thumbnail Thread gets access to Items and at the same time when I call Arrange, main thread also accesses these items, it makes some interference. So I tried using Synchronize and Critical sections, but it did not help. I won't show how and where exactly I used them, because there is no need in it. Why? I found out when this corruption occures. See number 6;

6. The exact problem.

After many experiments (once again) it turns out that it is weird:

1. I Build a list of Items;
2. Start a Thumbnails Thread;

3. Start changing ScrollBar's position while the thread is running 3.1 ScrollBar calls Arrange; 3.2 ScrollBar calls Invalidate;

4. Result:= BAD THUMBNAILS;

   Why I said it was "weird"? I added another scrollbar to the form. Now I have 2 scrollbars. one to the right is the scrollbar that calls Arrange + Invalidate; The second ScrollBar simply does NOTHING;

   So when I do:

   1. I Build a list of Items;
   2. Start a Thumbnails Thread; !!! 3. Start changing position of THE NEW SCROLLBAR while the thread is running (the second one), which performs nothing!!!

4.Result:= THE SAME. That is, I still get corrupted thumbnails.

IT's weird, is not it???? Atleast I do not understand why this happens. So please tell me how to fix it?

7. And here is a link to download this sample application, just change the path to where you have many .jpeg images and try it yourself. https://www.dropbox.com/s/spc8k4d4qry4979/WeirdApp.rar?dl=0

and the Video where I show what I mean : https://youtu.be/dfe111odrUM

type
TImageData = class (TObject)
public
idPath:String;
idImage:TBitmap;
idloaded:Boolean;
x, y:Single;
w, h:Integer;
iCriticalSection:TRTLCriticalSection;
constructor Create;
destructor destroy; override;
end;



 TImageThread = class(TThread)
  private
    tfileslist:TObjectList;
    ttChangeHandle: THandle;
    ttShutdownHandle: THandle;
    ttPaused:Boolean;
    ttCriticalSection:TCriticalSection;
    procedure DoFolderItemChange;
  protected
    procedure Execute; override;
  public
    constructor Create(fileslist:TObjectList); reintroduce;
    destructor  Destroy; override;
    procedure  Shutdown;
    procedure  Reset;
  end;



procedure TForm1.Button1Click(Sender: TObject);
var
  SR: TSearchRec;
  ImageData:TImageData;
  path:String;
begin
  Path:= 'D:\Images\';
  if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then
  begin
    repeat
      if (SR.Attr <> faDirectory) and (Pos ('.jpg', SR.Name) > 0) then
      begin
        ImageData:= TImageData.Create;
        ImageData.idPath:=  Path + SR.Name;
        datalist.Add(ImageData);

      end;
    until FindNext(SR) <> 0;
   FindClose(SR);
  end;

  arrange;
  ImageThread.Reset;


end;




procedure TImageThread.Execute;
var
  Events: array[0..1] of THandle;
  WaitResult: DWORD;

 ImageData:TImageData;
 I:Integer;
begin
    Events[0] := ttChangeHandle;
    Events[1] := ttShutdownHandle;
    while not Terminated do begin
        WaitResult := WaitForMultipleObjects(2, @Events[0], FALSE, INFINITE);
        if WaitResult = WAIT_OBJECT_0 then begin

          if Assigned(tfileslist) then begin

           for I:= 0 to tfileslist.Count - 1 do begin
            ImageData:= TImageData(tfileslist.Items[I]);

           try
            ImageData.idImage.LoadThumbnailFromFile(ImageData.idPath, 128, 128);

           except
             on E : Exception do
             begin
               //ShowMessage('Exception class name = '+E.ClassName);
               ShowMessage(ImageData.idPath +  ' ----- Exception message = '+E.Message);
             end;
           end;

            ImageData.idloaded:= True;
           end;

          end;
        end;


  self.Synchronize(nil, procedure ()
   begin
     Form1.Button1.Text:= 'DONE';
     beep;

   end);


      end;
end;


procedure TForm1.ScrollBar1Change(Sender: TObject);
begin

arrange;
Invalidate;

end; 


procedure TForm1.arrange;
var
  I:Integer;
  ImageData, ImageDataP:TImageData;
begin

  for I:= 0 to datalist.Count - 1 do begin

   ImageData:= TImageData(datalist.Items[I]);

   if I = 0 then begin
     ImageData.x:= 50;
     ImageData.y:= 50 - ScrollBar1.Value;
   end else begin
     ImageDataP:= TImageData(datalist.Items[I - 1]);
     ImageData.x:= ImageDataP.x + 128;
     ImageData.y:= ImageDataP.y;

     if ImageData.x + 128 > Width then begin
      ImageData.x:= 50;
      ImageData.y:= ImageDataP.y + 128 + 10;
     end;
   end;

   end;



end; 



procedure TForm1.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
  I:Integer;
  ImageData:TImageData;
begin
  Canvas.BeginScene();

  try
   for I:= 0 to datalist.Count - 1 do begin

            ImageData:= TImageData(datalist.Items[I]);

            if  Assigned(ImageData.idImage) and ImageData.idloaded then begin

              Canvas.DrawBitmap(ImageData.idImage, RectF(0, 0, ImageData.idImage.Width, ImageData.idImage.Height),
              RectF(ImageData.x, ImageData.y, ImageData.x + 128, ImageData.y + 128), 1, True );

            end;

   end;


  finally
  Canvas.EndScene;

  end;

end;

Answer 1

I believe your problem is that you do not realize that TBitmap is not thread-safe. Everything else looks good to me. To remedy this, change the following line of code in your project

    ImageData.idImage.LoadThumbnailFromFile(ImageData.idPath, 256, 256);

so that it is within a Synchronize block.

 Synchronize(nil, procedure ()
 begin
    ImageData.idImage.LoadThumbnailFromFile(ImageData.idPath, 256, 256);
 end);

I tried this change in your project and did not notice any bitmaps that fail to load.

Answer 2

I tried to say that problem was with FIREMONKEY Bitmap, and no one listened to me. Still I found the solution and I was RIGHT :)

So, as I said before, when I used VCL.Graphics.TBitmap I had no problems loading image thumbnails and displaying them the way I did in this example. I used TBitmap.Canvas.Lock , I used Synchronize.
With Firemonkey this way it did not work, and the problem hided in the TBitmap.LoadThumbnailFromFile method.

when I tried

Synchronize(nil, procedure ()
 begin
    ImageData.idImage.LoadThumbnailFromFile(ImageData.idPath, 128, 128);
 end);

Then the thumbnail was loaded in the main thread and my application froze until all the thumbnails were loaded, but thumbnails were loaded correctly;

If you have a look at the LoadThumbnailFromFile method:

procedure TBitmap.LoadThumbnailFromFile(const AFileName: string; const AFitWidth, AFitHeight: Single;
  const UseEmbedded: Boolean = True);
var
  Surf: TBitmapSurface;
begin
  Surf := TBitmapSurface.Create;
  try
    if TBitmapCodecManager.LoadThumbnailFromFile(AFileName, AFitWidth, AFitHeight, UseEmbedded, Surf) then
      Assign(Surf)
    else
      raise EThumbnailLoadingFailed.CreateFMT(SThumbnailLoadingFailedNamed, [AFileName]);
  finally
    Surf.Free;
  end;
end;

it turns out that Assign(Surf) caused the problem!!!

All you have to do is just Synchronize it, and only it, BUT NOT the whole LoadThumbnailFromFile method;

Like This:

procedure GetThumbnail(DestBMP:TBitmap; W, H:Integer; Path:String; Thread:TThread);
var
  Surf: TBitmapSurface;
begin
  Surf := TBitmapSurface.Create;
  try
    if TBitmapCodecManager.LoadThumbnailFromFile(Path, W, H, False, Surf) then
    begin
    Thread.Synchronize(nil, procedure ()
      begin
       DestBMP.Assign(Surf) ;
       end);
    end;
  finally
    Surf.Free;
  end;
end;

Just change TImageThread.Execute in my example and try it yourself; This way application loads thumbnails REALLY in a background thread, still all images are loaded correctly and you can scroll/resize the application while thumbnails are loading.

procedure TImageThread.Execute;
var
  Events: array[0..1] of THandle;
  WaitResult: DWORD;

 ImageData:TImageData;
 I:Integer;
   Surf: TBitmapSurface;
begin
    Events[0] := ttChangeHandle;
    Events[1] := ttShutdownHandle;
    while not Terminated do begin
        WaitResult := WaitForMultipleObjects(2, @Events[0], FALSE, INFINITE);
        if WaitResult = WAIT_OBJECT_0 then begin

          if Assigned(tfileslist) then begin

           for I:= 0 to tfileslist.Count - 1 do begin
            ImageData:= TImageData(tfileslist.Items[I]);
           try

          GetThumbnail(ImageData.idImage, 128, 128, ImageData.idPath,Self);
          ImageData.idloaded:= True;

           except
             on E : Exception do
             begin
               //ShowMessage('Exception class name = '+E.ClassName);
               ShowMessage(ImageData.idPath +  ' ----- Exception message = '+E.Message);
             end;
           end;

           end;

          end;
        end;


  self.Synchronize(nil, procedure ()
   begin
     Form1.Button1.Text:= 'DONE';
     beep;

   end);

      end;
end;