我想运行多个线程。每个线程都应将 JPEG 转换为位图。转换有效,但我的整个应用程序始终使用 12%-13% 的 CPU。我有一个 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.
最佳答案
您正在手动调用线程的 Execute()
主线程上下文中的方法。不要那样做!这就是你的用户界面卡住的原因。您正在创建处于暂停状态的线程并且永远不会恢复它们。
您需要更改此行:
MT.Execute;
对此:
MT.Resume;
或这个:
MT.Start;
取决于您使用的 Delphi 版本。
您的代码还有其他几个问题。
TBitmap
类不是完全线程安全的。你必须 Lock()
TBitmap.Canvas
使用 TBitmap
时在工作线程中,以防止主线程将 GDI 资源从 TBitmap
不料。 TMemoryStream
使用多个线程让它们同时加载相同的 JPG 图像。除非您包装对 TMemoryStream
的访问权限,否则这将不起作用。带有同步对象,如 TCriticalSection
或 TMutex
.或者,另一种选择是使用 TCustomMemoryStream
创建共享单个内存块的多个流。否则,最好将 JPG 文件名传递给每个线程并让 Execute()
调用TJpegImage.LoadFromFile()
而不是 TJpegImage.LoadFromStream()
. FBmp.Free()
在 Execute()
结尾,但是您正在访问 FBmp
之后在 OnTerminate
事件处理程序。您需要延迟调用 FBmp.Free()
直到 OnTerminate
之后事件处理程序退出,例如在线程的析构函数中。 TForm.Canvas
上直接绘制位图来自表单的OnPaint
之外事件。因此,一旦您的表单出于任何原因需要重新绘制自身,您绘制的图像就会丢失。如果您希望图像在表单的生命周期内保持不变,您需要保存它们并在 OnPaint
时绘制它们。事件触发。或者,您可以简单地将它们分配给 TImage
组件并让他们为您处理绘图。 关于multithreading - 线程卡住主窗体,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/60254622/