DELPHI 多线程（TThread类的实现）

之前学习了用API实现，让我们再学习下用DELPHI的TThread类。

先新建一个普通的工程，再新建一个线程类File>>New>>Othre>>Delphi File>Thread Object，取个名字，DELPHI会自动生成一个单元，我们只需往里简单添加功能代码，和在要使用的单元里实例引用即可。

为了节省篇幅，现把TMyThread类集成主窗体单元里，在窗体单元里声明类也是可以的。

例：用工作线程在窗体输出0~500000的数字。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMyThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override; {执行}
    procedure Run; {声明多一个过程，把功能代码写在这里再给Execute调用}
  end;
  TForm1 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;



var
  Form1: TForm1;


implementation

{$R *.dfm}

var
  MyThread:TMyThread; {声明一个线程类对象]

procedure TMyThread.Execute;
begin
  { Place thread code here }
  FreeOnTerminate:=True; {加上这句线程用完了会自动注释}
  Run;
end;

procedure TMyThread.Run;
var
  i:integer;
begin
  for i := 0 to 500000 do
  begin
    Form1.Canvas.Lock;
    Form1.Canvas.TextOut(10,10,IntToStr(i));
    Form1.Canvas.Unlock;
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  MyThread:=TMyThread.Create(False); {实例化这个类，为False时立即运行，为True时可加MyThread.Resume用来启动}
end;

CriticalSection(临界区)

 uses SyncObjs;用TCriticalSection类的方法处理。

例：用三个线程，按顺序给ListBox添加0~99.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMyThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override; {执行}
    procedure Run;  {运行}
  end;
  TForm1 = class(TForm)
    btn1: TButton;
    lst1: TListBox;
    procedure btn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;



var
  Form1: TForm1;


implementation

{$R *.dfm}

uses SyncObjs;

var
  MyThread:TMyThread;   {声明线程}
  CS:TCriticalSection; {声明临界}


procedure TMyThread.Execute;
begin
  { Place thread code here }
  FreeOnTerminate:=True; {加上这句线程用完了会自动注释}
  Run;     {运行}
end;

procedure TMyThread.Run;
var
  i:integer;
begin
  CS.Enter;  {我要用了，其它人等下}
  for i := 0 to 100 - 1 do
  begin
    Form1.lst1.Items.Add(IntToStr(i));
  end;
  CS.Leave;  {我用完了，下一个}
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  CS:=TCriticalSection.Create;     {实例化临界}
  MyThread:=TMyThread.Create(False); {实例化这个类，为False时立即运行，为True时可加MyThread.Resume用来启动}
  MyThread:=TMyThread.Create(False);
  MyThread:=TMyThread.Create(False);
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
  CS.Free;{释放临界体}
end;

end.

Mutex (互斥对象)

uses SyncObjs;用TMutex类的方法处理(把释放语句放在循环内外可以决定执行顺序)

例：互斥输出三个0~2000的数字到窗体在不同位置。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMyThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override; {执行}
    procedure Run;  {运行}
  end;
  TForm1 = class(TForm)
    btn1: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;



var
  Form1: TForm1;


implementation

{$R *.dfm}

uses SyncObjs;

var
  MyThread:TMyThread;   {声明线程}
  Mutex:TMutex; {声明互斥体}
  f:integer;


procedure TMyThread.Execute;
begin
  { Place thread code here }
  FreeOnTerminate:=True; {加上这句线程用完了会自动注释}
  Run;     {运行}
end;

procedure TMyThread.Run;
var
  i,y:integer;
begin
  Inc(f);
  y:=20*f;
  for i := 0 to 2000  do
  begin
    if Mutex.WaitFor(INFINITE)=wrSignaled then   {判断函数，能用时就用}
    begin
      Form1.Canvas.Lock;
      Form1.Canvas.TextOut(10,y,IntToStr(i));
      Form1.Canvas.Unlock;
      Sleep(1);
      Mutex.Release; {释放，谁来接下去用}
    end;
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  f:=0;
  Repaint;
  Mutex:=TMutex.Create(False);  {参数为是否让创建者拥有该互斥体，一般为False}
  MyThread:=TMyThread.Create(False);
  MyThread:=TMyThread.Create(False);
  MyThread:=TMyThread.Create(False);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Mutex.Free;{释放互斥体}
end;

end.

Semaphore(信号或叫信号量)

 {DELPHI2007不支持信号量，DELPHI2009才开始支持}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses SyncObjs;
var
  f: Integer;
  MySemaphore: TSemaphore;

function MyThreadFun(p: Pointer): DWORD; stdcall;
var
  i,y: Integer;
begin
  Inc(f);
  y := 20 * f;
  if MySemaphore.WaitFor(INFINITE) = wrSignaled then
  begin
    for i := 0 to 1000 do
    begin
      Form1.Canvas.Lock;
      Form1.Canvas.TextOut(20, y, IntToStr(i));
      Form1.Canvas.Unlock;
      Sleep(1);
    end;
  end;
  MySemaphore.Release;
  Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ThreadID: DWORD;
begin
  if Assigned(MySemaphore) then MySemaphore.Free;
  MySemaphore := TSemaphore.Create(nil, StrToInt(Edit1.Text), 5, ''); {创建，参数一为安全默认为nil，参数2可以填写运行多少线程，参数3是运行总数，参数4可命名用于多进程}

  Self.Repaint;
  f := 0;
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
end;

{让 Edit 只接受 1 2 3 4 5 五个数}
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if not CharInSet(Key, ['1'..'5']) then Key := #0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := '1';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(MySemaphore) then MySemaphore.Free;
end;

end.

 Event (事件对象)

注：相比API的处理方式，此类没有启动步进一次后暂停的方法。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMyThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
    procedure Run;
  end;

  TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    btn3: TButton;
    btn4: TButton;
    procedure btn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses SyncObjs;

var
  f:integer;
  MyEvent:TEvent;
  MyThread:TMyThread;

{ TMyThread }


procedure TMyThread.Execute;
begin
  inherited;
  FreeOnTerminate:=True; {线程使用完自己注销}
  Run;
end;

procedure TMyThread.Run;
var
  i,y:integer;
begin
  Inc(f);
  y:=20*f;

  for i := 0 to 20000 do
  begin
    if MyEvent.WaitFor(INFINITE)=wrSignaled then    {判断事件在用没，配合事件的启动和暂停，对事件相关线程起统一控制}
    begin
      Form1.Canvas.lock;
      Form1.Canvas.TextOut(10,y,IntToStr(i));
      Form1.Canvas.Unlock;
      Sleep(1);
    end;

  end;

end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  Repaint;
  f:=0;
  if Assigned(MyEvent) then MyEvent.Free;    {如果有，就先销毁}

  {参数1安全设置，一般为空；参数2为True时可手动控制暂停，为Flase时对象控制一次后立即暂停
  参数3为True时对象建立后即可运行，为false时对象建立后控制为暂停状态，参数4为对象名称，用于跨进程，不用时默认''}
  MyEvent:=TEvent.Create(nil,True,True,'');   {创建事件}

end;

procedure TForm1.btn2Click(Sender: TObject);
var
  ID:DWORD;
begin
  MyThread:=TMyThread.Create(False);      {创建线程}
end;

procedure TForm1.btn3Click(Sender: TObject);
begin
  MyEvent.SetEvent;    {启动}  {事件类没有PulseEvent启动一次后轻描谈写}
end;

procedure TForm1.btn4Click(Sender: TObject);
begin
  MyEvent.ResetEvent;  {暂停}
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   btn1.Caption:='创建事件';
   btn2.Caption:='创建线程';
   btn3.Caption:='启动';
   btn4.Caption:='暂停';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyEvent.Free;        {释放}
end;

end.

总结：

多线程用TThread类以及Uses syncobjs后使用的 TCriticalSection (临界区)，TMutex(互斥体)，TSemaphore (信号对象，D2009才开始有)，TEvent (事件对象)很多都是引用了API的方法进行了一定的简化，不过也有部分功能的缺失，如Event (事件对象)缺少了启动步进一次后暂停的功能，不过基本在同步上已经够用了，另外在TThread类声明的Execute过程里，加上FreeOnTerminate := True;这句会让线程执行完后自动释放，还可以把功能代码的方法套在Synchronize()里，用于同步一些非线程安全的控件对象，避免多个线程同时对一个对象操作引发的问题。