我需要 TThreads 吗？如果是这样，我可以暂停、恢复和停止它们吗？
Posted
技术标签:
【中文标题】我需要 TThreads 吗？如果是这样，我可以暂停、恢复和停止它们吗？【英文标题】：Do I need TThreads? If so can I pause, resume and stop them? 【发布时间】：2012-07-01 22:24:54 【问题描述】：我一直想知道是否有更好的方法来编写我的一些程序，尤其是那些需要很长时间才能完成的程序。
我总是在主 GUI 线程上运行所有东西，我现在理解并意识到这是不好的，因为它会使应用程序无响应，Application.ProcessMessages 在这里没有真正的帮助。
这让我觉得我需要使用 TThreads 进行冗长的操作，例如复制文件。这也让我想知道某些应用程序如何让您完全控制，例如允许您暂停、恢复和或停止操作。
在我正在处理的个人项目中，我有大约 3 个冗长的操作，我会显示一个带有 TProgressBar 的对话框表单。虽然这确实有效，但我觉得它可以做得更好。这些进度对话框可能会显示很长时间，以至于您可能希望取消操作并稍后完成工作。
正如我所说，目前我正在运行 Main Gui Thread，我是否需要使用 TThreads？我不确定如何或从哪里开始实施它们，因为我以前没有与它们合作过。如果我确实需要线程，它们是否会提供我需要的功能，例如暂停、恢复、停止操作等？
基本上，我正在寻找一种更好的方式来处理和管理冗长的操作。
【问题讨论】：
您需要向线程发出信号，表明您要暂停或取消。并且线程必须检查那个信号。 或者您可以暂停然后恢复它。像全局变量这样的信号更好，更有条理。您也可以使用 Mutex 作为信号... @Benjamin 暂停和恢复？并不真地。不应使用这些 Windows 功能。 @BenjaminWeiss 不是这样。TThread.Suspend：暂停正在运行的线程。 Suspend 旨在供调试器使用，并于 2010 年在 RAD Studio XE 中被弃用。 可靠地执行此操作的唯一方法是让线程定期检查暂停或取消信号。
@Benjamin 然后阅读 SuspendThread 的文档。它说同样的话。想想看。你认为 TThread.Suspend 是如何实现的？继续，猜测调用了哪个 Windows API。
【参考方案1】：
是的，这绝对是你需要一个线程来完成任务的情况。
一个如何暂停/恢复线程和取消线程的小例子。
进度通过 PostMessage 调用发送到主线程。
暂停/恢复和取消是使用TSimpleEvent 信号进行的。
编辑：根据@mghie 的cmets，这是一个更完整的示例：
编辑 2： 展示如何为线程传递一个过程以调用繁重的工作。
编辑 3：添加了更多功能和测试单元。
unit WorkerThread;
interface
uses Windows, Classes, SyncObjs;
type
TWorkFunction = function: boolean of object;
TWorkerThread = Class(TThread)
private
FCancelFlag: TSimpleEvent;
FDoWorkFlag: TSimpleEvent;
FOwnerFormHandle: HWND;
FWorkFunc: TWorkFunction; // Function method to call
FCallbackMsg: integer; // PostMessage id
FProgress: integer;
procedure SetPaused(doPause: boolean);
function GetPaused: boolean;
procedure Execute; override;
public
Constructor Create(WindowHandle: HWND; callbackMsg: integer;
myWorkFunc: TWorkFunction);
Destructor Destroy; override;
function StartNewWork(newWorkFunc: TWorkFunction): boolean;
property Paused: boolean read GetPaused write SetPaused;
end;
implementation
constructor TWorkerThread.Create(WindowHandle: HWND; callbackMsg: integer;
myWorkFunc: TWorkFunction);
begin
inherited Create(false);
FOwnerFormHandle := WindowHandle;
FDoWorkFlag := TSimpleEvent.Create;
FCancelFlag := TSimpleEvent.Create;
FWorkFunc := myWorkFunc;
FCallbackMsg := callbackMsg;
Self.FreeOnTerminate := false; // Main thread controls for thread destruction
if Assigned(FWorkFunc) then
FDoWorkFlag.SetEvent; // Activate work at start
end;
destructor TWorkerThread.Destroy; // Call MyWorkerThread.Free to cancel the thread
begin
FDoWorkFlag.ResetEvent; // Stop ongoing work
FCancelFlag.SetEvent; // Set cancel flag
Waitfor; // Synchronize
FCancelFlag.Free;
FDoWorkFlag.Free;
inherited;
end;
procedure TWorkerThread.SetPaused(doPause: boolean);
begin
if doPause then
FDoWorkFlag.ResetEvent
else
FDoWorkFlag.SetEvent;
end;
function TWorkerThread.StartNewWork(newWorkFunc: TWorkFunction): boolean;
begin
Result := Self.Paused; // Must be paused !
if Result then
begin
FWorkFunc := newWorkFunc;
FProgress := 0; // Reset progress counter
if Assigned(FWorkFunc) then
FDoWorkFlag.SetEvent; // Start work
end;
end;
procedure TWorkerThread.Execute;
- PostMessage LParam:
0 : Work in progress, progress counter in WParam
1 : Work is ready
2 : Thread is closing
var
readyFlag: boolean;
waitList: array [0 .. 1] of THandle;
begin
FProgress := 0;
waitList[0] := FDoWorkFlag.Handle;
waitList[1] := FCancelFlag.Handle;
while not Terminated do
begin
if (WaitForMultipleObjects(2, @waitList[0], false, INFINITE) <>
WAIT_OBJECT_0) then
break; // Terminate thread when FCancelFlag is signaled
// Do some work
readyFlag := FWorkFunc;
if readyFlag then // work is done, pause thread
Self.Paused := true;
Inc(FProgress);
// Inform main thread about progress
PostMessage(FOwnerFormHandle, FCallbackMsg, WPARAM(FProgress),
LPARAM(readyFlag));
end;
PostMessage(FOwnerFormHandle, FCallbackMsg, 0, LPARAM(2)); // Closing thread
end;
function TWorkerThread.GetPaused: boolean;
begin
Result := (FDoWorkFlag.Waitfor(0) <> wrSignaled);
end;
end.
只需调用MyThread.Paused := true 暂停和MyThread.Paused := false 恢复线程操作。
要取消线程，请调用MyThread.Free。
要接收线程发布的消息，请参见以下示例：
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, WorkerThread;
const
WM_MyProgress = WM_USER + 0; // The unique message id
type
TForm1 = class(TForm)
Label1: TLabel;
btnStartTask: TButton;
btnPauseResume: TButton;
btnCancelTask: TButton;
Label2: TLabel;
procedure btnStartTaskClick(Sender: TObject);
procedure btnPauseResumeClick(Sender: TObject);
procedure btnCancelTaskClick(Sender: TObject);
private
Private declarations
MyThread: TWorkerThread;
workLoopIx: integer;
function HeavyWork: boolean;
procedure OnMyProgressMsg(var Msg: TMessage); message WM_MyProgress;
public
Public declarations
end;
var
Form1: TForm1;
implementation
$R *.dfm
TForm1
const
cWorkLoopMax = 500;
function TForm1.HeavyWork: boolean; // True when ready
var
i, j: integer;
begin
j := 0;
for i := 0 to 10000000 do
Inc(j);
Inc(workLoopIx);
Result := (workLoopIx >= cWorkLoopMax);
end;
procedure TForm1.btnStartTaskClick(Sender: TObject);
begin
if not Assigned(MyThread) then
begin
workLoopIx := 0;
btnStartTask.Enabled := false;
btnPauseResume.Enabled := true;
btnCancelTask.Enabled := true;
MyThread := TWorkerThread.Create(Self.Handle, WM_MyProgress, HeavyWork);
end;
end;
procedure TForm1.btnPauseResumeClick(Sender: TObject);
begin
if Assigned(MyThread) then
MyThread.Paused := not MyThread.Paused;
end;
procedure TForm1.btnCancelTaskClick(Sender: TObject);
begin
if Assigned(MyThread) then
begin
FreeAndNil(MyThread);
btnStartTask.Enabled := true;
btnPauseResume.Enabled := false;
btnCancelTask.Enabled := false;
end;
end;
procedure TForm1.OnMyProgressMsg(var Msg: TMessage);
begin
Msg.Msg := 1;
case Msg.LParam of
0:
Label1.Caption := Format('%5.1f %%', [100.0 * Msg.WParam / cWorkLoopMax]);
1:
begin
Label1.Caption := 'Task done';
btnCancelTaskClick(Self);
end;
2:
Label1.Caption := 'Task terminated';
end;
end;
end.
还有形式：
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 163
ClientWidth = 328
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 120
TextHeight = 16
object Label1: TLabel
Left = 79
Top = 18
Width = 51
Height = 16
Caption = 'Task idle'
end
object Label2: TLabel
Left = 32
Top = 18
Width = 41
Height = 16
Caption = 'Status:'
end
object btnStartTask: TButton
Left = 32
Top = 40
Width = 137
Height = 25
Caption = 'Start'
TabOrder = 0
OnClick = btnStartTaskClick
end
object btnPauseResume: TButton
Left = 32
Top = 71
Width = 137
Height = 25
Caption = 'Pause/Resume'
Enabled = False
TabOrder = 1
OnClick = btnPauseResumeClick
end
object btnCancelTask: TButton
Left = 32
Top = 102
Width = 137
Height = 25
Caption = 'Cancel'
Enabled = False
TabOrder = 2
OnClick = btnCancelTaskClick
end
end
【讨论】：
这实际上没有示例代码那么好。您暂停的线程仍会每秒唤醒数十次。以及如何同步线程关闭和外部拥有的事件对象的销毁？只需向他们发出信号，稍等一下并希望最好？您要么需要对共享对象使用引用计数，要么在释放事件之前释放线程（即不使用FreeOnTerminate）以正确方式执行此操作。
@JonasWielicki、Suspend 和 Resume 从未缩进供除调试器之外的任何其他进程使用。自 Delphi-XE 以来，它们已被弃用。见documentation。
@LU RD：确实，我可能应该将构造函数参数修改为 HWND 而不是表单引用；仍然可以传递表单句柄，也可以传递帮助窗口的句柄。
@Blobby，添加了一个如何通过繁重工作的程序的示例。
@Blobby，没错。您可以根据需要创建任意数量的工作过程，前提是它们具有相同的调用结构。声明各种格式的程序类型见DocWiki Procedural_Types。【参考方案2】：
您还可以使用更高级别的库进行线程处理，例如：
http://andy.jgknet.de/blog/bugfix-units/asynccalls-29-asynchronous-function-calls/ http://otl.17slon.com/【讨论】：
【参考方案3】：如果answer by LU RD 中的示例代码对您来说过于复杂，那么a Delphi implementation of the .net BackgroundWorker class 可能更符合您的喜好。
使用它，您可以将组件拖放到表单上并为其各种事件添加处理程序（OnWork、OnWorkProgress、OnWorkFeedback 和 OnWorkComplete）。该组件将在后台执行OnWork 事件处理程序，同时从GUI 线程执行其他事件处理程序（负责必要的上下文切换和同步）。但是，在 OnWork 事件处理程序中编写代码仍然需要彻底了解从辅助线程中可以做什么和不能做什么。
【讨论】：
【参考方案4】：很多年前，一个叫 Martin Harvey 的人写了一篇关于多线程的有用介绍。他的教程可以在Embarcadero CC site 找到 - 看起来他已经上传了一个示例类，它可以做你正在寻找的事情，但我没有看过它，所以不能确定。
【讨论】：
以上是关于我需要 TThreads 吗？如果是这样，我可以暂停、恢复和停止它们吗？的主要内容，如果未能解决你的问题，请参考以下文章