हां, यह निश्चित रूप से एक ऐसा मामला है जहां आपको कार्य करने के लिए धागे की आवश्यकता होती है।
एक छोटा सा उदाहरण थ्रेड को रोकने/फिर से शुरू करने और थ्रेड को रद्द करने के लिए कैसे करें।
प्रगति मुख्य थ्रेड पर पोस्टमेसेज कॉल के माध्यम से भेजी जाती है। रोकें/फिर से शुरू करें और रद्द करें TSimpleEvent सिग्नल के साथ बनाए गए हैं।
संपादित करें:
संपादित करें 2: कैसे धागा भारी काम के लिए कॉल करने के लिए एक प्रक्रिया है पारित करने के लिए दिखा @mghie से टिप्पणी के अनुसार, यहां एक अधिक पूर्ण उदाहरण है।
संपादित करें 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
आपको उस धागे को सिग्नल करने की आवश्यकता है जिसे आप रोकना या रद्द करना चाहते हैं। और धागे को उस सिग्नल की जांच करनी चाहिए। –
या आप निलंबित कर सकते हैं और फिर इसे फिर से शुरू कर सकते हैं। एक वैश्विक var जैसे संकेत बेहतर और अधिक व्यवस्थित है। आप म्यूटेक्स को सिग्नल के रूप में भी इस्तेमाल कर सकते हैं ... –
@ बेंजामिन सस्पेंड और फिर से शुरू करें? ज़रुरी नहीं। उन विंडोज कार्यों का उपयोग नहीं किया जाना चाहिए। –