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

第四节：多线程类的改进

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.