delphi 线程教学第四节：多线程类的改进
第四节：多线程类的改进
1.需要改进的地方
a) 让线程类结束时不自动释放，以便符合 delphi 的用法。即 FreeOnTerminate:=false;
b) 改造 Create 的参数，让它适合访问 COM 组件。如：在线程时空中能够创建 TAdoConnection;
c) 设计一个接口能将一个过程( procedure )塞到线程时空中去运行的功能，这样，不必每次重载 Execute 函数。
d) 设计一个输出信息的接口
下一节，将讲解如何用多个线程同时执行相同的任务
改进后的多线程类
本例源码(delphi xe8版本)下载: FooThread.Zip
unituFooThread;
interface
uses
System.Classes, System.SyncObjs;
type
TOnMsg =procedure(AMsg:string)ofobject;// 定义一个用于输出信息的事件
// 很多编程资料推荐在 String 参数前面加 const ，以提高效率
// 我的理由是为了代码美观。如果有多个参数，加上 const 参数太长了。
// 在以后的使用中，请自己斟酌是否加 const 。
TFooThread =class(TThread)
private
FEvent: TEvent;
FCanAccessCom:Boolean;
FRunningInThread: TThreadMethod;
// TThreadMethod 的定义是 TThreadMethod = Procedure of object;
// 意为这个 Procedure 是写在一个类中的。
// 在其它编程语言中，TThreadMethod 被称为函数指针。
// FRunningInThread 它用来保存将要在线程中运行的代码或 Procedure
procedureDoExecute;
protected
// protected 段中定义的变量与函数，允许在子类中调用。
procedureExecute; override;
procedureDoOnStatusMsg(AMsg:string);
procedureExecProcInThread(AProc: TThreadMethod);
public
constructorCreate(ACanAccessCOM:Boolean); reintroduce;
// reintroduce 是再引入 Create 的参数的意思。
destructorDestroy; override;
procedureStartThread; virtual;
public
OnStatusMsg: TOnMsg;
// 亦可改写为 Property OnStatusMsg:TOnMsg Read FOnMsg write SetOnMsg;
// 太啰嗦了，如果不再对 SetOnMsg 进行操作，建议这样写。
// 如果后期需要改动，原来的代码亦可以不变。
end;
// 未说明之处，请参考面向对象设计基础知识。
implementation
usesActiveX, SysUtils;
constructorTFooThread.Create(ACanAccessCOM:Boolean);
begin
inheritedCreate(false);
FEvent := TEvent.Create(nil,true,false,'');
FreeOnTerminate :=false;
end;
destructorTFooThread.Destroy;
begin
// 此处我们要设计手动 Free 的调用。
Terminate;// 首先要将 Terminated 设置为 true;
FEvent.SetEvent;// 启动线程。
WaitFor;// 此 waitfor 的意思是等待线程退出 Execute
// 此 WaitFor 是 TThread 类的。注意与 FEvent.WaitFor 区别
// 本质上，它们都是操作系统提供的信号的等待功能。
// 有兴趣可以直接参考系统源码 ( delphi 提供的源码 )
FEvent.Free;
inherited;
end;
procedureTFooThread.DoExecute;
begin
FEvent.WaitFor;
FEvent.ResetEvent;
whilenotTerminateddo
begin
try
FRunningInThread;// 因为它是一个 Procedure ，故可直接运行。
except
// 捕捉异常，否则异常发生时代码将退出 Execute ，线程生命周期就结束了。
one: Exceptiondo
begin
DoOnStatusMsg('ThreadErr:'+ e.Message);
end;
end;
FEvent.WaitFor;
FEvent.ResetEvent;
end;
end;
procedureTFooThread.DoOnStatusMsg(AMsg:string);
begin
// 这是引发事件常用的写法。
ifAssigned(OnStatusMsg)then
OnStatusMsg(AMsg);
end;
procedureTFooThread.ExecProcInThread(AProc: TThreadMethod);
begin
FRunningInThread := AProc;
FEvent.SetEvent;// 启动线程。
// 需要说明的是，第一次运行本函数 ExecProcInThread 一般是在主线程时空里运行。
// 第二次运行本函数可以设计为在线程时空中运行，后面章节会讲到。
// 其作用是把 AProc 塞到线程时空中并启动线程。
end;
procedureTFooThread.Execute;
begin
ifFCanAccessComthen
begin
CoInitialize(nil);
// 在线程中初始化 COM ，反正调用了此句，才能在线程中使用 COM
// 这是 windows 操作系统规定的，与 delphi 没有关系。
// 你用 api 操作线程，在线程中访问 COM 同样需要这样做。
try
DoExecute;
finally
CoUninitialize;// 与初始化对应，解除线程访问 COM 的能力。
end;
end
else
DoExecute;
end;
procedureTFooThread.StartThread;
begin
end;
end.
先基于 TFooThread 继承，代码如下。
unituCountThread;
interface
uses
uFooThread;
type
TCountThread =class;
TOnCounted =procedure(Sender: TCountThread)ofobject;
TCountThread =class(TFooThread)
private
procedureCount;
procedureDoOnCounted;
public
procedureStartThread; override;
public
Num:integer;
Total:integer;
OnCounted: TOnCounted;
end;
implementation
{ TCountThread }
procedureTCountThread.Count;
var
i:integer;
begin
DoOnStatusMsg('开始计算...');
Total :=0;
ifNum >0then
fori :=1toNumdo
begin
Total := Total + i;
sleep(10);// 故意变慢，实际代码请删除此行。
// 实际上为确保线程能够及时退出
// 此处还应加上一个判断是否出的标志，请大家自行思考。
// 这又是一个两难的选择。
// 加了判断标志，退出容易了，但效率又低了。
// 所以，编程人员总是在效率与友好性中做出选择。
// 且编且珍惜。
end;
DoOnCounted;//引发 OnCounted 事件，告知调用者。
DoOnStatusMsg('计算完成...');
end;
procedureTCountThread.DoOnCounted;
begin
// if Assigned(OnCounted) then
// 等价于 if OnCounted <> nil then
ifAssigned(OnCounted)then
OnCounted(self);
end;
procedureTCountThread.StartThread;
begin
inherited;
ExecProcInThread(Count);// 把 Count 过程塞到线程中运行。
end;
end.
是不是简短很多？下面是调用。
unituFrmMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, uCountThread;
type
TFrmMain =class(TForm)
memMsg: TMemo;
edtNum: TEdit;
btnWork: TButton;
procedureFormCreate(Sender: TObject);
procedureFormDestroy(Sender: TObject);
procedurebtnWorkClick(Sender: TObject);
private
{ Private declarations }
FCountThread: TCountThread;
// 取名是一直是个有技术含量的事情。
// 推荐去掉类名的 T 换成 F 这样的写法。
procedureDispMsg(AMsg:string);
procedureOnThreadMsg(AMsg:string);
procedureOnCounted(Sender: TCountThread);
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
{$R*.dfm}
{ TFrmMain }
procedureTFrmMain.btnWorkClick(Sender: TObject);
var
n:integer;
begin
btnWork.Enabled :=false;
n := StrToIntDef(edtNum.Text,0);
FCountThread.Num := n;
FCountThread.StartThread;
end;
procedureTFrmMain.DispMsg(AMsg:string);
begin
memMsg.Lines.Add(AMsg);
end;
procedureTFrmMain.FormCreate(Sender: TObject);
begin
FCountThread := TCountThread.Create(false);// 此处不需要访问 Com 所以用 false
FCountThread.OnStatusMsg := self.OnThreadMsg;
// 因为是在线程时空中引发的消息，故这里用了 OnThreadMsg;
FCountThread.OnCounted := self.OnCounted;
end;
procedureTFrmMain.FormDestroy(Sender: TObject);
begin
// 这里要注意，尽管我们在 TFooThread 中的析构函数中
// 写了保证线程退出的函数。那也只是以防万一的。
// 在线程手动 Free 之前，一定要确保线程代码已经退出了 Execute
// 为了友好退出，又需要在计算代码中加入判断是否退出的标志。
// 请参考 TCountThread Count 中的注释。
// 本教程一直反复强调“代码退出Execute”这个概念。
// 用线程，就得负责一切，不可偷懒！
FCountThread.Free;
end;
procedureTFrmMain.OnCounted(Sender: TCountThread);
var
s:string;
begin
s := IntToStr(Sender.Num) +'累加和为:';
s := s + IntToStr(Sender.Total);
OnThreadMsg(s);// 因为这里是线程空间，所以需要用本函数。
// 而不是 DispMsg;
// 网络组件，它的数据到达事件，其实是线程时空。要显示信息
// 也需要 Synchronize; 这是很多初学者易犯的错误。
// 如果在线程时空中，不用 Synchronize 来操作 UI,就会出现时灵时不灵的状态。
// 初学者所谓的运行不稳定，调试时又是正常。往往原因就是如此。
TThread.Synchronize(nil,
procedure
begin
btnWork.Enabled :=true;// 恢复按钮状态。
end);
end;
procedureTFrmMain.OnThreadMsg(AMsg:string);
begin
TThread.Synchronize(nil,
procedure
begin
DispMsg(AMsg);
end);
end;
end.