TThread +缩略图

Question

在以下情况下我需要你的帮助。我知道它已被多次讨论过，应该使用线程，使用同步/关键部分等等。因此，不要因为再次提出这个问题而责怪我，因为在我的情况下，既没有同步，也没有关键部分有助于在TThread中处理TBitmap。

1. 我用的是：

我使用Delphi XE，使用GlobalUseDirect2D的Firemonkey应用程序：= True;

我需要使用GlobalUseDirect2D，因为我画了很多，我需要快速绘图。仍在禁用GlobalUseDirect2D或使用GlobalUseGPUCanvas：= True，我的问题消失了，但这不是一个选项！

1. 我的所作所为：

确定。所以这是一个其他项目的简单实现，但想法是显示图像缩略图。 首先，我构建一个项目列表（TImageData），然后我启动一个线程来加载图像缩略图。 当滚动（使用TScrollBar）时，我调用Arrange方法来排列表单上的项目，而不是调用Invalidate来重新绘制显示区域;

1. 那是什么问题？

问题是某些缩略图是空白或未完全加载（已损坏）。

1. 问题发生时？

经过多次实验后，我发现图像被破坏了;

因此。如果我构建一个项目列表，然后启动缩略图线程，并在线程运行时不对表单执行任何操作（不要更改滚动条位置/不调整表单大小/不移动光标）然后一切都很精细。一切都很好;

如果我构建了一个项目列表，那么启动缩略图线程并在线程运行时开始滚动（更改滚动条位置 - 它调用Arrange + Invalidate方法），我的缩略图（不是全部）变得损坏。

1. 我尝试了什么。

因为我认为这可能是因为我的缩略图线程可以访问Items，同时当我调用Arrange时，主线程也会访问这些项目，这会产生一些干扰。 所以我尝试使用Synchronize和Critical部分，但它没有帮助。 我不知道如何以及在何处使用它们，因为它没有必要。为什么？我发现这种腐败发生的时候。见号6;

1. 确切的问题。

经过多次实验（再次），事实证明它很奇怪：

1. 我建立一个项目清单;
2. 启动缩略图线程;

3. 在线程运行时开始更改ScrollBar的位置  3.1 ScrollBar调用Arrange;  3.2 ScrollBar调用Invalidate;

4. 结果：= BAD THUMBNAILS;

   为什么我说这是＆＃34;怪异的＆＃34;？ 我在表单中添加了另一个滚动条。现在我有2个滚动条。右边一个是调用Arrange + Invalidate的滚动条; 第二个ScrollBar只是没有;

   所以当我这样做时：

   1. 我建立一个项目清单;
   2. 启动缩略图线程; ！ 3.在线程运行时（第二个）开始更改新SCROLLBAR的位置，它什么都不执行!!!

4.Result：=同样的。也就是说，我仍然会损坏缩略图。

这很奇怪，不是吗？至少我不明白为什么会这样。  那么请告诉我如何解决它？

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;

Answer 1

我相信您的问题是您没有意识到TBitmap不是线程安全的。其他一切对我来说都很好。要解决此问题，请更改项目中的以下代码行

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

以便它在Synchronize块中。

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

我在您的项目中尝试了此更改，并没有注意到任何无法加载的位图。

Answer 2

我试图说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;