23

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

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

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

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

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

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

4

4 回答 4

17

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

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

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

编辑：根据@mghie 的评论，这是一个更完整的示例：

编辑 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
于 2012-06-30T22:55:53.883 回答
6

您还可以使用更高级别的库进行线程处理，例如：

于 2012-07-01T07:17:31.197 回答
3

如果LU RD 答案中的示例代码对您来说太复杂了，那么您可能更喜欢.net BackgroundWorker 类的 Delphi 实现。

使用它，您可以将组件拖放到表单上并为其各种事件（OnWork、OnWorkProgress和）添加处理程序。该组件将在后台执行事件处理程序，同时从 GUI 线程执行其他事件处理程序（负责必要的上下文切换和同步）。但是，在事件处理程序中编写代码仍然需要彻底了解从辅助线程中可以做什么和不能做什么。OnWorkFeedbackOnWorkCompleteOnWorkOnWork

于 2012-07-01T17:29:15.227 回答
0

许多年前，一个叫 Martin Harvey 的人写了一篇关于多线程的有用介绍。他的教程可以在Embarcadero CC 网站上找到——看起来他已经上传了一个示例类，它可以做你正在寻找的事情，但我没有看过它，所以不能肯定地说。

于 2012-07-01T10:42:48.193 回答