我需要 TThreads 吗?如果是这样，我可以暂停、恢复和停止它们吗? [英] Do I need TThreads? If so can I pause, resume and stop them?

问题描述

我一直想知道是否有更好的方法来编写我的一些程序，尤其是那些需要很长时间才能完成的程序.

I've always wondered is there a better way that I should be writing some of my procedures, particularly ones that take a long time to finish.

我总是在主 GUI 线程之外运行所有东西，我现在理解并意识到这是不好的，因为它会使应用程序无响应，Application.ProcessMessages 在这里没有真正的帮助.

I have always run everything off the Main GUI Thread which I now understand and realise is bad because it will make the Application unresponsive, Application.ProcessMessages will not really help here.

这让我觉得我需要使用 TThreads 进行冗长的操作，例如复制文件.这也让我想知道一些应用程序如何让您完全控制，例如允许您暂停、恢复和/或停止操作.

This makes me think I need to use TThreads for lengthy operations such as copying a file for example. This is also made me wonder how some Applications give you full control, eg allow you to pause, resume and or stop the operation.

在我正在处理的个人项目中，我有大约 3 个冗长的操作，我在其中显示了一个带有 TProgressBar 的对话框表单.虽然这确实有效，但我觉得它可以做得更好.这些进度对话框可能会显示很长时间，以至于您可能想要取消操作并稍后完成作业.

I have about 3 lengthy operations in a personal project I am working on which I display a dialog form with a TProgressBar on. Whilst this does work, I feel it could be done much better. These progress dialogs could be shown for such a long time that you may want to cancel the operation and instead finish the job later.

正如我所说，目前我正在运行 Main Gui Thread，我是否需要使用 TThreads?我不确定如何或从哪里开始实施它们，因为我以前从未与它们合作过.如果我确实需要线程，它们是否提供了我需要的功能，例如暂停、恢复、停止操作等?

As I said, currently I am running of the Main Gui Thread, do I instead need to use TThreads? I am not sure how or where to start implementing them as I have not worked with them before. If I do need threads do they offer what I need such as pausing, resuming, stopping an operation etc?

基本上，我正在寻找一种更好的方法来处理和管理冗长的操作.

Basically I am looking for a better way of handling and managing lengthy operations.

推荐答案

是的，这绝对是您需要线程来完成任务的情况.

Yes, this is definitely a case where you need a thread to do the task.

一个如何暂停/恢复线程和取消线程的小例子.

A little example how to pause/resume a thread and cancel the thread.

通过 PostMessage 调用将进度发送到主线程.暂停/恢复和取消是通过 TSimpleEvent 信号实现的.

Progress is sent to the main thread through a PostMessage call. The pause/resume and cancel are made with TSimpleEvent signals.

根据@mghie 的评论，这里有一个更完整的例子:

As per the comments from @mghie, here is a more complete example:

编辑 2: 展示了如何为线程传递一个过程来调用繁重的工作.

Edit 2: Showing how to pass a procedure for the thread to call for the heavy work.

编辑 3:添加了更多功能和测试单元.

Edit 3: Added some more features and a test unit.

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 恢复线程操作.

Just call MyThread.Paused := true to pause and MyThread.Paused := false to resume the thread operation.

要取消线程，调用MyThread.Free.

要从线程接收发布的消息，请参见以下示例:

To receive the posted messages from the thread, see following example:

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

这篇关于我需要 TThreads 吗?如果是这样，我可以暂停、恢复和停止它们吗?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！