线程冻结主窗体

Question

我想运行多线程。每个线程都应将 JPEG 转换为位图。转换有效，但我的整个应用程序始终使用 CPU 的 12%-13%。我有一个 8 核 CPU 所以看起来整个应用程序只使用一个核。此外，当线程正在工作时，主窗体被冻结并且没有响应。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Jpeg, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Str: TMemoryStream;
    procedure OnTerminate(Sender: TObject);
  end;

  TMakeThumbThread= class(TThread)
  private
    FStream: TStream;
  public
    FBmp: TBitmap;    
    constructor Create(Str: TStream);
    procedure Execute; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TMakeThumbThread.Create(Str: TStream);
begin
  inherited Create(True);
  FStream := Str;
  FreeOnTerminate := True;
end;

procedure TMakeThumbThread.Execute;
var Jpg: TJpegImage;
begin
  FBmp := TBitmap.Create;
  FBmp.PixelFormat := pf32bit;
  FBmp.Width := 300;
  FBmp.Height := 200;

  Jpg := TJpegImage.Create;
  FStream.Position := 0;
  Jpg.LoadFromStream(FStream);
  FBmp.Canvas.Draw(0,0, Jpg);
  Jpg.Free;

  DoTerminate;
  FBmp.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var F: TFileStream;
    i: Integer;
    MT: TMakeThumbThread;
begin
  Str := TMemoryStream.Create;
  F := TFileStream.Create('test.jpg', fmOpenRead or fmShareDenyWrite);
  Str.CopyFrom(F, F.Size);
  F.Free;

  for i:=0 to 500 do begin
    MT := TMakeThumbThread.Create(Str);
    MT.OnTerminate := OnTerminate;
    MT.Execute;
  end;
end;

procedure TForm1.OnTerminate(Sender: TObject);
var Bmp: TBitmap;
begin
  Bmp := TMakeThumbThread(Sender).FBmp;
  Form1.Canvas.Draw(1,1, Bmp );
end;

end.

Answer 1

您正在主线程的上下文中手动调用线程的 Execute() 方法。不要那样做！这就是为什么您的 UI 冻结了。您正在以挂起状态创建线程并且永远不会恢复它们。

您需要更改此行：

MT.Execute;

对此：

MT.Resume;

或者这个：

MT.Start;

取决于您使用的 Delphi 版本。

您的代码还有其他几个问题。

VCL 的TBitmapclass 并不是完全线程安全的。在工作线程中使用 TBitmap 时，您必须 Lock() TBitmap.Canvas，以防止主线程意外地从 TBitmap 中夺走 GDI 资源。
您正在与多个线程共享一个 TMemoryStream，让它们同时加载同一个 JPG 图像。除非您使用同步对象（如 TCriticalSection 或 TMutex 包装对 TMemoryStream 的访问，否则这将不起作用。或者，另一种选择是使用 TCustomMemoryStream 创建共享单个内存块的多个流。否则，您最好直接将 JPG 文件名传递给每个线程并让 Execute() 调用 TJpegImage.LoadFromFile() 而不是 TJpegImage.LoadFromStream().
您在 Execute() 的末尾调用 FBmp.Free()，但随后您在 OnTerminate 事件处理程序中访问 FBmp。您需要将对 FBmp.Free() 的调用延迟到 OnTerminate 事件处理程序退出之后，例如在线程的析构函数中。
您正在从窗体的 OnPaint 事件外部直接在 TForm.Canvas 上绘制位图。因此，一旦您的表单因任何原因需要重绘，您绘制的图像就会丢失。如果您希望图像在表单的生命周期内保持不变，则需要保存它们并在 OnPaint 事件触发时绘制它们。或者，您可以简单地将它们分配给 TImage 个组件，让它们为您处理绘图。

线程冻结主窗体

Threads are freezing main form

delphi

multithreading

delphi-7