TThread + Миниатюры

Мне нужна ваша помощь в следующей ситуации. Я знаю, что это обсуждалось много-много раз, как нужно работать с потоками, использовать Синхронизировать / Критические разделы и так далее. Поэтому не вините меня за то, что я снова задал этот вопрос, потому что в моей ситуации ни синхронизация, ни критические разделы не помогают работать с TBitmap в TThread.

  1. Что я использую:

Я использую Delphi XE, приложение Firemonkey с GlobalUseDirect2D:= True;

Мне нужно использовать GlobalUseDirect2D, потому что я много рисую и мне нужно быстрое рисование. Все еще отключение GlobalUseDirect2D или использование GlobalUseGPUCanvas:= True, моя проблема исчезает, но это не вариант!

  1. Что я делаю:

Хорошо. Так что это простая реализация какого-то другого проекта, но идея состоит в том, чтобы отображать миниатюры изображений. Сначала я создаю список элементов (TImageData), а затем запускаю поток для загрузки миниатюр изображений. При прокрутке (используя TScrollBar) я вызываю метод Arrange, чтобы расположить элементы в форме, а затем вызываю Invalidate, чтобы перерисовать область отображения;

  1. Так в чем проблема?

Проблема в том, что некоторые миниатюры либо пустые, либо не полностью загружены (повреждены).

  1. Когда возникает проблема?

После многих экспериментов я узнал, когда изображения становятся поврежденными;

Так. Если я создаю список элементов, затем запускаю поток миниатюр и ничего не делаю с формой во время работы потока (не изменяйте положение полосы прокрутки / не изменяйте размер формы / не перемещайте курсор), тогда ВСЕ ЕЩЕ ХОРОШО. Все загружено хорошо;

Если я создаю список элементов, затем запускаю поток миниатюр и запускаю прокрутку во время работы потока (изменяя положение полосы прокрутки - он вызывает методы Arrange + Invalidate), мои миниатюры (не все) становятся поврежденными.

  1. Что я пробовал

Так как я думал, что это может быть потому, что мой поток миниатюр получает доступ к элементам, и в то же время, когда я вызываю Arrange, основной поток также обращается к этим элементам, он создает некоторые помехи. Поэтому я попытался использовать разделы Synchronize и Critical, но это не помогло. Я не буду показывать, как и где именно я их использовал, потому что в этом нет необходимости. Зачем? Я узнал, когда происходит эта коррупция. Смотрите номер 6;

  1. Точная проблема.

После многих экспериментов (еще раз) выясняется, что это странно:

  1. Я строю список предметов;
  2. Начать ветку миниатюр;

  3. Начните изменять позицию ScrollBar во время работы потока 3.1 ScrollBar вызывает Arrange; 3.2 ScrollBar вызывает Invalidate;

  4. Результат: = ПЛОХИЕ ПАЛАТЫ;

    Почему я сказал, что это "странно"? Я добавил еще одну полосу прокрутки в форму. Теперь у меня есть 2 полосы прокрутки. одна справа - полоса прокрутки, которая вызывает Arrange + Invalidate; Второй ScrollBar просто НИЧЕГО не делает;

    Итак, когда я делаю:

    1. Я строю список предметов;
    2. Начать ветку миниатюр;!!! 3. Начните менять положение НОВОГО СКРОЛБАРКА во время работы потока (второй), который ничего не выполняет!!!

4.Результат: = ЖЕ. То есть я все еще получаю испорченные миниатюры.

ЭТО странно, не правда ли? По крайней мере, я не понимаю, почему это происходит. Так скажите пожалуйста как это исправить?

  1. А вот ссылка для загрузки этого примера приложения, просто измените путь к множеству изображений.jpeg и попробуйте сами. https://www.dropbox.com/s/spc8k4d4qry4979/WeirdApp.rar?dl=0

и видео, где я показываю, что я имею в виду: 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;
Источник

2 ответа

Я считаю, что ваша проблема в том, что вы не понимаете, что TBitmap не является поточно-ориентированным. Все остальное выглядит хорошо для меня. Чтобы исправить это, измените следующую строку кода в вашем проекте

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

так что он находится в блоке синхронизации.

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

Я попробовал это изменение в вашем проекте и не заметил никаких растровых изображений, которые не загружаются.

Источник

Я пытался сказать, что проблема была с FIREMONKEY Bitmap, и никто меня не слушал. Тем не менее я нашел решение, и я был прав:)

Итак, как я уже говорил, когда я использовал VCL.Graphics.TBitmap, у меня не было проблем с загрузкой миниатюр изображений и их отображением, как в этом примере. Я использовал TBitmap.Canvas.Lock, я использовал Synchronize.
С Firemonkey таким образом он не работал, и проблема скрывалась в TBitmap.LoadThumbnailFromFile метод.

когда я пытался

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

Затем миниатюра была загружена в основной поток, и мое приложение зависало, пока все миниатюры не были загружены, но миниатюры были загружены правильно;

Если вы посмотрите на метод LoadThumbnailFromFile:

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;

Оказывается, что Assign(Surf) вызвал проблему!!!

Все, что вам нужно сделать, это просто Synchronize это, и только это, но не весь LoadThumbnailFromFile Способ;

Как это:

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;

Просто поменяй TImageThread.Execute в моем примере и попробуй сам; Таким образом, приложение загружает миниатюры РЕАЛЬНО в фоновом потоке, но все изображения загружаются правильно, и вы можете прокручивать / изменять размер приложения во время загрузки миниатюр.

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;
Источник
Другие вопросы по тегам