delphi – 我需要TThreads吗?如果是这样,我可以暂停,恢复并停止他们?

前端之家收集整理的这篇文章主要介绍了delphi – 我需要TThreads吗?如果是这样,我可以暂停,恢复并停止他们?前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。
我一直想知道有没有更好的方法,我应该写一些我的程序,特别是那些需要很长时间才能完成的程序。

我总是从主GUI线程运行所有的东西,我现在明白并认识到这是坏的,因为它会使应用程序无响应,Application.ProcessMessages在这里不会真的有帮助。

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

我在一个个人项目中有大约3个冗长的操作,我正在使用一个TProgressBar来显示一个对话框。虽然这样做有效,但我觉得可以做得更好。这些进度对话框可能会显示很长时间,您可能希望取消操作,稍后再完成该作业。

正如我所说,目前我运行的主要线程,我需要使用TThreads吗?我不知道如何或在哪里开始实施它们,因为我以前没有和他们一起工作。如果我需要线程,他们提供我需要的,如暂停,恢复,停止操作等?

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

解决方法

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

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

进度通过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,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
原文链接:https://www.f2er.com/delphi/103573.html

猜你在找的Delphi相关文章