delphi 线程教学第四节：多线程类的改进

转载自：https://www.cnblogs.com/lackey/p/6305768.html

第四节：多线程类的改进

 

1.需要改进的地方

 

a) 让线程类结束时不自动释放，以便符合 delphi 的用法。即 FreeOnTerminate:=false;

b) 改造 Create 的参数，让它适合访问 COM 组件。如：在线程时空中能够创建 TAdoConnection;

c) 设计一个接口能将一个过程( procedure )塞到线程时空中去运行的功能，这样，不必每次重载 Execute 函数。

d) 设计一个输出信息的接口

 

下一节，将讲解如何用多个线程同时执行相同的任务

 

改进后的多线程类

本例源码(delphi xe8版本)下载: FooThread.Zip

 

unit uFooThread;
interface
uses
  System.Classes, System.SyncObjs;
 
type
  TOnMsg = procedure(AMsg: string) of object; // 定义一个用于输出信息的事件
 
  // 很多编程资料推荐在 String 参数前面加 const ，以提高效率
  // 我的理由是为了代码美观。如果有多个参数，加上 const 参数太长了。
  // 在以后的使用中，请自己斟酌是否加 const 。
  TFooThread = class(TThread)
  private
    FEvent: TEvent;
    FCanAccessCom: Boolean;
    FRunningInThread: TThreadMethod;
    // TThreadMethod 的定义是 TThreadMethod = Procedure of object;
    // 意为这个 Procedure 是写在一个类中的。
    // 在其它编程语言中，TThreadMethod 被称为函数指针。
    // FRunningInThread 它用来保存将要在线程中运行的代码或 Procedure
    procedure DoExecute;
  protected
    // protected 段中定义的变量与函数，允许在子类中调用。
    procedure Execute; override;
    procedure DoOnStatusMsg(AMsg: string);
    procedure ExecProcInThread(AProc: TThreadMethod);
  public
    constructor Create(ACanAccessCOM: Boolean); reintroduce;
    // reintroduce 是再引入 Create 的参数的意思。
    destructor Destroy; override;
    procedure StartThread; virtual;
  public
    OnStatusMsg: TOnMsg;
    // 亦可改写为 Property OnStatusMsg:TOnMsg Read FOnMsg write SetOnMsg;
    // 太啰嗦了，如果不再对 SetOnMsg 进行操作，建议这样写。
    // 如果后期需要改动，原来的代码亦可以不变。
  end;
  // 未说明之处，请参考面向对象设计基础知识。
 
implementation
 
uses ActiveX, SysUtils;
 
constructor TFooThread.Create(ACanAccessCOM: Boolean);
begin
  inherited Create(false);
  FEvent := TEvent.Create(nil, true, false, '');
  FreeOnTerminate := false;
end;
 
destructor TFooThread.Destroy;
begin
  // 此处我们要设计手动 Free 的调用。
  Terminate; // 首先要将 Terminated 设置为 true;
  FEvent.SetEvent; // 启动线程。
  WaitFor; // 此 waitfor 的意思是等待线程退出 Execute
  // 此 WaitFor 是 TThread 类的。注意与 FEvent.WaitFor 区别
  // 本质上，它们都是操作系统提供的信号的等待功能。
  // 有兴趣可以直接参考系统源码 ( delphi 提供的源码 )
  FEvent.Free;
  inherited;
end;
 
procedure TFooThread.DoExecute;
begin
  FEvent.WaitFor;
  FEvent.ResetEvent;
  while not Terminated do
  begin
 
    try
      FRunningInThread; // 因为它是一个 Procedure ，故可直接运行。
    except
      // 捕捉异常，否则异常发生时代码将退出 Execute ，线程生命周期就结束了。
      on e: Exception do
      begin
        DoOnStatusMsg('ThreadErr:' + e.Message);
      end;
    end;
 
    FEvent.WaitFor;
    FEvent.ResetEvent;
 
  end;
end;
 
procedure TFooThread.DoOnStatusMsg(AMsg: string);
begin
  // 这是引发事件常用的写法。
  if Assigned(OnStatusMsg) then
    OnStatusMsg(AMsg);
end;
 
procedure TFooThread.ExecProcInThread(AProc: TThreadMethod);
begin
  FRunningInThread := AProc;
  FEvent.SetEvent; // 启动线程。
  // 需要说明的是，第一次运行本函数 ExecProcInThread 一般是在主线程时空里运行。
  // 第二次运行本函数可以设计为在线程时空中运行，后面章节会讲到。
  // 其作用是把 AProc 塞到线程时空中并启动线程。
end;
 
procedure TFooThread.Execute;
begin
 
  if FCanAccessCom then
  begin
    CoInitialize(nil);
    // 在线程中初始化 COM ，反正调用了此句，才能在线程中使用 COM
    // 这是 windows 操作系统规定的，与 delphi 没有关系。
    // 你用 api 操作线程，在线程中访问 COM 同样需要这样做。
    try
      DoExecute;
    finally
      CoUninitialize; // 与初始化对应，解除线程访问 COM 的能力。
    end;
  end
  else
    DoExecute;
end;
 
procedure TFooThread.StartThread;
begin
end;
 
end.

　　

 

先基于 TFooThread 继承，代码如下。

 

unit uCountThread;
interface
uses
  uFooThread;
type
  TCountThread = class;
  TOnCounted = procedure(Sender: TCountThread) of object;
  TCountThread = class(TFooThread)
  private
    procedure Count;
    procedure DoOnCounted;
  public
    procedure StartThread; override;
  public
    Num: integer;
    Total: integer;
    OnCounted: TOnCounted;
  end;
 
implementation
 
{ TCountThread }
 
procedure TCountThread.Count;
var
  i: integer;
begin
  DoOnStatusMsg('开始计算...');
  Total := 0;
  if Num > 0 then
    for i := 1 to Num do
    begin
      Total := Total + i;
      sleep(10); // 故意变慢，实际代码请删除此行。
      // 实际上为确保线程能够及时退出
      // 此处还应加上一个判断是否出的标志，请大家自行思考。
      // 这又是一个两难的选择。
      // 加了判断标志，退出容易了，但效率又低了。
      // 所以，编程人员总是在效率与友好性中做出选择。
      // 且编且珍惜。
    end;
  DoOnCounted; //引发 OnCounted 事件，告知调用者。
  DoOnStatusMsg('计算完成...');
end;
 
procedure TCountThread.DoOnCounted;
begin
  // if Assigned(OnCounted) then
  // 等价于 if OnCounted <> nil then
  if Assigned(OnCounted) then
    OnCounted(self);
end;
 
procedure TCountThread.StartThread;
begin
  inherited;
  ExecProcInThread(Count); // 把 Count 过程塞到线程中运行。
end;
 
end.

 

是不是简短很多？下面是调用。

 

unit uFrmMain;
 
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;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnWorkClick(Sender: TObject);
  private
    { Private declarations }
    FCountThread: TCountThread;
    // 取名是一直是个有技术含量的事情。
    // 推荐去掉类名的 T 换成 F 这样的写法。
    procedure DispMsg(AMsg: string);
    procedure OnThreadMsg(AMsg: string);
    procedure OnCounted(Sender: TCountThread);
  public
    { Public declarations }
  end;
 
var
  FrmMain: TFrmMain;
 
implementation
 
{$R *.dfm}
{ TFrmMain }
 
procedure TFrmMain.btnWorkClick(Sender: TObject);
var
  n: integer;
begin
  btnWork.Enabled := false;
  n := StrToIntDef(edtNum.Text, 0);
  FCountThread.Num := n;
  FCountThread.StartThread;
end;
 
procedure TFrmMain.DispMsg(AMsg: string);
begin
  memMsg.Lines.Add(AMsg);
end;
 
procedure TFrmMain.FormCreate(Sender: TObject);
begin
  FCountThread := TCountThread.Create(false); // 此处不需要访问 Com 所以用 false
  FCountThread.OnStatusMsg := self.OnThreadMsg; 
// 因为是在线程时空中引发的消息，故这里用了 OnThreadMsg;
  FCountThread.OnCounted := self.OnCounted;
end;
 
procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  // 这里要注意，尽管我们在 TFooThread 中的析构函数中
  // 写了保证线程退出的函数。那也只是以防万一的。
  // 在线程手动 Free 之前，一定要确保线程代码已经退出了 Execute
 
  // 为了友好退出，又需要在计算代码中加入判断是否退出的标志。
  // 请参考 TCountThread Count 中的注释。
 
  // 本教程一直反复强调“代码退出Execute”这个概念。
  // 用线程，就得负责一切，不可偷懒！
 
  FCountThread.Free;
end;
 
procedure TFrmMain.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;
 
procedure TFrmMain.OnThreadMsg(AMsg: string);
begin
  TThread.Synchronize(nil,
    procedure
    begin
      DispMsg(AMsg);
    end);
end;
 
end.