|
我们经常遇到在Form下操作界面，例如由线程控制的进度条等，让线程的执行可以和Form界面融合，不必传进窗体句柄，这个时候可以用回调函数的方法来定义线程的成员函数。
注意：原则上Delphi的多线程环境下，对界面的输出不能在其它线程中随意进行，否则会导致与界面（主）线程本身的刷新操作形成冲突，导致一些看似无规律的问题。比较保险的方式就是将要刷新的内容通过消息或其它通信机制传给界面线程，由界面线程去完成实际的刷新操作。
所以，在我们使用回调函数把线程的可执行代码转移到Tform或其他类下时，只要不是直接操作VCL控件，一般可以参考下面代码，可以安全执行。下面的代码就是一个可以自动执行线程成员事件OnExecute指向的代码片段，你只需要给线程实例对象的OnExecute
赋值即可让其执行。
用法说明：在Form下定义一个成员函数
TForm1= class(TForm)
........
public
procedure MyExecuteJob( AThreadSelf:TThread;var
State : TJobState);
end;
//实现部分
procedure TForm1.MyExecuteJob( AThreadSelf:TThread;var State :
TJobState);
在线程创建的时候；即可赋值，例如：
var
AutoChooseThread : TAutoChooseThread ;
procedure Tfrm_AutoChoose.StartChooseJob;
begin
if not
Assigned(AutoChooseThread) then
begin
AutoChooseThread :=
TAutoChooseThread.Create(True);
AutoChooseThread.OnJObComplete :=
OnJObComplete;
AutoChooseThread.OnBeforeJobRun :=
OnBeforeJobRun;
AutoChooseThread.OnProgress := OnProgress;
AutoChooseThread.OnExecute := MyExecuteJob;
end;
end;
以上使用说明，需要完成其他回调只要按照如上方式即可。需要注意到地方。例如：MyExecuteJob函数
在Form1中定义了，那么传入了两个参数，一个是线程本身，一个是线程状态。如果MyExecuteJob函数中有大量循环操作，不能立即返回，需要不断判断线程状态，如果发现是JsStop或JsDestroy那么就需要Exit一下，退出函数。否则调用FreeJob();或StopJob();是不能立即奏效的。
//线程回调函数类型定义
TJobState =
(JsStop,JsRunning,JsComplete,JsCreate,JsDestroy); //枚举任务状态
TOnJObComplete =
procedure (Sender : TObject) of Object; //当完毕
TOnJObRun =
procedure(Sender:TObject) of object; //开始
TOnProgress = procedure(
MaxValue,CurValue:DWORD) of object; //进度
TOnExecute = procedure(
AThreadSelf:TThread;var State : TJobState) of object; //任务执行
//自动选择任务，线程处理定义，和GUI可以高度融合的方式
TAutoChooseThread =
class(TThread)
private
FOnJObComplete :
TOnJObComplete;
FOnJObRun : TOnJObRun;
FOnProgress :
TOnProgress;
FOnExecute : TOnExecute;
FState :
TJobState;
public
property OnJObComplete : TOnJObComplete
read FOnJObComplete write FOnJObComplete;
property OnBeforeJobRun :
TOnJObRun read FOnJObRun write FOnJObRun;
property OnProgress :
TOnProgress read FOnProgress write FOnProgress;
property OnExecute :
TOnExecute read FOnExecute write FOnExecute;
property State :
TJobState read FState;
procedure StartJob();
procedure
StopJob();
procedure FreeJob();
procedure
Execute();override;
constructor
Create(isCreateSuspend:Boolean);
destructor Destroy; override;
end;
//线程实现代码
constructor
TAutoChooseThread.Create(isCreateSuspend:Boolean);
begin
FreeOnTerminate
:= True;
FState := JsCreate;
inherited
Create(isCreateSuspend);
end;
destructor TAutoChooseThread.Destroy;
begin
inherited;
end;
procedure TAutoChooseThread.Execute;
begin
while not Terminated
do
begin
//当任务执行前
if Assigned( FOnJobRun ) then
begin
FOnJObRun(Self);
end;
//执行任务
if Assigned( FOnExecute ) then
begin
//执行任务
FState := JsRunning;
FOnExecute(self,FState);
//如果任务成功完成
if FState = JsComplete
then
begin
if Assigned(FOnJObComplete)
then
begin
FOnJObComplete(Self);
end;
end;
//如果任务销毁
if FState = JsDestroy then
begin
Exit;
end;
end;
Suspend;
Sleep(1);
end;
end;
procedure TAutoChooseThread.FreeJob;
begin
Terminate;
FState :=
JsDestroy;
Resume();
end;
procedure TAutoChooseThread.StartJob;
begin
Resume();
FState :=
JsRunning;
end;
procedure TAutoChooseThread.StopJob;
begin
FState :=
JsStop;
end;
procedure Tfrm_AutoChoose.OnBeforeJobRun(Sender: TObject);
begin
sGroupBox_Pocessing.Visible := True;
sGauge1.Progress := 0;
qry_FactorOfFlower.Close;
end;
procedure Tfrm_AutoChoose.OnExecute(AThreadSelf: TThread; var State:
TJobState);
var
MaxValue,CurValue:DWORD;
begin
//执行任务
MaxValue := 1000;
sGauge1.MaxValue := MaxValue;
for CurValue := 0 to
MaxValue - 1 do
begin
if TAutoChooseThread(AThreadSelf).State =
JsStop then
begin
sGroupBox_Pocessing.Visible :=
False;
sPanel_Result.Visible := False;
qry_FactorOfFlower.Close;
Exit;
end;
sGauge1.Progress := CurValue;
end;
State := JsComplete;
end;
procedure Tfrm_AutoChoose.OnJObComplete(Sender: TObject);
begin
sPanel_Result.Visible := True;
end;
procedure Tfrm_AutoChoose.OnProgress(MaxValue, CurValue: DWORD);
begin
end;
procedure Tfrm_AutoChoose.FormDestroy(Sender: TObject);
begin
inherited;
if Assigned( AutoChooseThread ) then
begin
AutoChooseThread.FreeJob();
end;
end;
|
