delphi TThread类多线程

1. 注意事项

要记住Execute()需要经常地检查Terminated属性的值，来确认是否要提前退出。尽管这将意味着当使用线程工作的时候，你必须关心更多的事情，但它能确保在线程结束时，能够完成必要的清除

在某些紧急情况下，你可以使用Win32 API函数 TerminateThread()来终止一个线程。但是，除非没有别的办法了，否则不要使用它。例如，当线程代码陷入死循环中

如果选择这个函数，应该考虑到它的负面影响。首先，此函数在Windows NT与在Windows95/98下并不相同。在Windows95/98下，这个函数能够自动清除线程所占用的栈；而在Windows NT下，在进程被终止前栈仍被保留。其次，无论线程代码中是否有try...finally块，这个函数都会使线程立即终止执行。这意味着，被线程打开的文件没有被关闭、由线程申请的内存也没有被释放等情况。而且，这个函数在终止线程的时候也不通知DLL，当DLL关闭的时候，这也容易出现enti问题

# 2. 线程类

unit UnitThread;

interface

uses

Vcl.Forms, Vcl.Dialogs, System.SysUtils, System.Classes;

type

TMyThread = class(TThread)

protected

procedure Execute; override;

end;

implementation

uses

UnitMain;

{ TMyThread }

procedure TMyThread.Execute;

var

I: Integer;

begin

FreeOnTerminate := False;

I := 1;

while True do begin

if FreeOnTerminate then

Exit;

Synchronize(

procedure

begin

form1.lbl1.Caption := '线程ID：' + Self.ThreadID.ToString + '：' + I.ToString;

end);

TThread.Sleep(300);

I := I + 1;

end;

end.

Copied!

# 3. 界面类

unit UnitMain;

interface

uses

System.Generics.Collections, UnitThread, Winapi.Windows, Winapi.Messages,

System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls,

Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type

TForm1 = class(TForm)

btn1: TButton;

btn2: TButton;

btn3: TButton;

lbl1: TLabel;

btn4: TButton;

btn5: TButton;

btn6: TButton;

lbl2: TLabel;

btn7: TButton;

procedure btn1Click(Sender: TObject);

procedure btn2Click(Sender: TObject);

procedure btn3Click(Sender: TObject);

procedure btn4Click(Sender: TObject);

procedure btn5Click(Sender: TObject);

procedure btn6Click(Sender: TObject);

procedure btn7Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

Thread: TMyThread;

ThreadList: TList;

implementation

{$R *.dfm}

{启动线程}

procedure TForm1.btn1Click(Sender: TObject);

begin

Thread := TMyThread.Create(True);

Thread.Start;

end;

{暂停线程}

procedure TForm1.btn2Click(Sender: TObject);

begin

Thread.Suspended := True;

end;

{继续线程}

procedure TForm1.btn3Click(Sender: TObject);

begin

Thread.Resume;

end;

{批量启动多个线程}

procedure TForm1.btn4Click(Sender: TObject);

begin

ThreadList := TList.Create;

TThread.CreateAnonymousThread(

procedure

var

I: Integer;

Mthread: TMyThread;

begin

for I := 0 to 10 do begin

Mthread := TMyThread.Create(True);

Mthread.Start;

ThreadList.Add(Mthread);

Form1.lbl2.Caption := I.ToString;

TThread.Sleep(200);

end;

end).Start;

end;

{批量暂停多个线程}

procedure TForm1.btn5Click(Sender: TObject);

begin

TThread.CreateAnonymousThread(

procedure

var

I: Integer;

begin

for I := 0 to ThreadList.Count do begin

ThreadList[I].Suspended := True;

end;

end).Start;

end;

{批量继续多个线程}

procedure TForm1.btn6Click(Sender: TObject);

begin

TThread.CreateAnonymousThread(

procedure

var

I: Integer;

begin

for I := 0 to ThreadList.Count do begin

ThreadList[I].Resume;

end;

end).Start;

end;

{批量终止多个线程}

procedure TForm1.btn7Click(Sender: TObject);

begin

TThread.CreateAnonymousThread(

procedure

var

I: Integer;

begin

for I := 0 to ThreadList.Count do begin

ThreadList[I].FreeOnTerminate := True;

// TerminateThread(ThreadList[I].Handle, 0);

end;

end).Start;

end;

end.

Copied!

# 4. 临界区代码

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);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

CS.Free;{释放临界体}

end;

end.

Copied!

# 5. 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;

procedure TForm1.btn1Click(Sender: TObject);

begin

f:=0;

Repaint;

Mutex:=TMutex.Create(False); {参数为是否让创建者拥有该互斥体，一般为False}

MyThread:=TMyThread.Create(False);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

Mutex.Free;{释放互斥体}

end;

end.

Copied!

# 6. Semaphore(信号或叫信号量)

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;

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);

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.

Copied!

# 7. 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;

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.

推荐分享

delphi TThread类 多线程

delphi TThread类多线程