我一直想知道是否有更好的方法来编写我的一些程序,特别是那些需要很长时间才能完成的程序.
我总是运行主GUI线程中的所有东西,我现在理解并意识到这很糟糕,因为它会使应用程序无响应,Application.ProcessMessages在这里不会真正有用.
这让我觉得我需要使用TThreads进行冗长的操作,例如复制文件.这也让我想知道一些应用程序如何为您提供完全控制,例如允许您暂停,恢复或停止操作.
我正在处理的个人项目中有大约3个冗长的操作,我在其上显示一个带有TProgressBar的对话框.虽然这确实有效,但我觉得它可以做得更好.这些进度对话框可能会显示很长时间,您可能希望取消操作,然后再完成作业.
正如我所说,目前我正在运行Main Gui Thread,我是否需要使用TThreads？我不知道如何或在何处开始实施它们,因为我之前没有使用它们.如果我确实需要线程,他们提供我需要的东西,如暂停,恢复,停止操作等？
基本上我正在寻找一种更好的处理和管理冗长操作的方法.
LU *_* RD 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