Multithreading 线程是冻结的主要形式
我想运行多线程。每个线程都应该将JPEG转换为位图。转换工作,但我的整个应用程序总是使用12%-13%的CPU。我有一个8核的CPU,所以整个应用程序似乎只使用一个内核。另外,当线程工作时,主窗体被冻结并且没有响应Multithreading 线程是冻结的主要形式,multithreading,delphi,delphi-7,Multithreading,Delphi,Delphi 7,我想运行多线程。每个线程都应该将JPEG转换为位图。转换工作,但我的整个应用程序总是使用12%-13%的CPU。我有一个8核的CPU,所以整个应用程序似乎只使用一个内核。另外,当线程工作时,主窗体被冻结并且没有响应 unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Jpeg, Dialogs, StdCtrls; type T
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版本
您的代码还有其他几个问题
VCL的TBitmap类不是完全线程安全的。在工作线程中使用TBitmap时,必须锁定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组件,并让它们为您处理图形
您正在主线程的上下文中手动调用线程的Execute方法。不要那样做!这就是为什么你的用户界面冻结。您正在以挂起状态创建线程,并且从未恢复它们 您需要更改此行:
MT.Execute;
为此:
MT.Resume;
或者这个:
MT.Start;
取决于您使用的Delphi版本
您的代码还有其他几个问题
VCL的TBitmap类不是完全线程安全的。在工作线程中使用TBitmap时,必须锁定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组件,并让它们为您处理图形
它确实有用!谢谢。你知道吗,有没有可能,如何在没有TBitmap的情况下将JPEG转换成位图?@Tom这是一个完全不同的无关问题。请不要期望它能在另一个答案的评论中得到回答。@Jerrydoge我希望它不能很快得到回答。但是你是对的。@Tom你为什么要把它转换成BMP呢?你可以按原样在表单上绘制原始JPG。这是可以做到的,只是不能用TJpeg。看看外部DLL,比如LibJpeg或者LibJpeg Turbo或者OpenCV。它们在内存缓冲区上工作。但是要注意:即使您设法找到Delphi的导入单位,也会有一个相当陡峭的学习曲线。另一方面:你为什么要这么做?如果TJPEG/TBitmap适合您,请坚持使用它。话虽如此:LibJpeg-Turbo的速度要快得多,所以如果性能成为一个问题,这肯定是一条路要走。它确实有帮助!谢谢。你知道吗,,
顺便问一下,如何在没有TBitmap的情况下将JPEG转换成位图?@Tom这是一个完全不同的无关问题。请不要期望它能在另一个答案的评论中得到回答。@Jerrydoge我希望它不能很快得到回答。但是你是对的。@Tom你为什么要把它转换成BMP呢?你可以按原样在表单上绘制原始JPG。这是可以做到的,只是不能用TJpeg。看看外部DLL,比如LibJpeg或者LibJpeg Turbo或者OpenCV。它们在内存缓冲区上工作。但是要注意:即使您设法找到Delphi的导入单位,也会有一个相当陡峭的学习曲线。另一方面:你为什么要这么做?如果TJPEG/TBitmap适合您,请坚持使用它。话虽如此,LibJpeg-Turbo的速度要快得多,所以如果性能成为一个问题,这肯定是一条路要走。你必须学会保护你的对象。永远不要写X:=TX.Create;{大量代码}X.Free。始终写入X:=TX.Create;尝试{大量代码}最终X.Free;终止似乎有一次,你完全忘记了自由。你必须学会保护你的物品。永远不要写X:=TX.Create;{大量代码}X.Free。始终写入X:=TX.Create;尝试{大量代码}最终X.Free;终止似乎有一次,你完全忘记了自由。