{ TThread }

EThread = class(Exception);

TThreadMethod = procedure of object;

TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,tpTimeCritical);

TThread = class

private

FHandle: THandle;

FThreadID: THandle;

FTerminated: Boolean;

FSuspended: Boolean;

FFreeOnTerminate: Boolean;

FFinished: Boolean;

FReturnValue: Integer;

FOnTerminate: TNotifyEvent;

FMethod: TThreadMethod;

FSynchronizeException: TObject;

procedure CallOnTerminate;

function GetPriority: TThreadPriority;

procedure SetPriority(Value: TThreadPriority);

procedure SetSuspended(Value: Boolean);

protected

procedure DoTerminate; virtual;

procedure Execute; virtual; abstract;

procedure Synchronize(Method: TThreadMethod);

property ReturnValue: Integer read FReturnValue write FReturnValue;

property Terminated: Boolean read FTerminated;

public

constructor Create(CreateSuspended: Boolean);

destructor Destroy; override;

procedure Resume;

procedure Suspend;

procedure Terminate;

function WaitFor: LongWord;

property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;

property Handle: THandle read FHandle;

property Priority: TThreadPriority read GetPriority write SetPriority;

property Suspended: Boolean read FSuspended write SetSuspended;

property ThreadID: THandle read FThreadID;

property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;

end;

准确地说，TThread对象是一个带有线程实例的不可见窗体对象（长宽都为0），我把这个窗体叫做线程窗体。这个线程窗体有该TThread类的所有对象共享。TThread在构造的时候线程是否第一次创建，如果是就创建线程窗体，然后增加线程计数，最后才建立线程实例。同理，TThread对象在销毁的时候，先减少线程计数，然后判断计数是否为0，如果是就销毁线程窗体。

为什么要建立一个线程窗体呢？答案就是TThread中的同步函数Synchronize()的需要。线程对象存取其他VCL的属性时与其他线程的同步机制是通过消息队列来实现的。当线程函数执行Synchronize()时，他就向线程窗体发送一条CM_EXECPROC消息。因为线程窗体是进程的一个窗体（虽然它不可见），所以发向线程窗体的消息都会进入进程消息队列，而消息队列的串行处理的特性保证不会出现访问冲突。这是一个简单而有效的解决方案。我不知道有没有人在控制台程序中应用多线程，如果有的话，TThread类可能就不太适合了。这种情况下要么直接应用线程函数，要么自己写一个新的TNewThread类了。

Delphi是在TThread类的外面声明了一个局部函数ThreadProc。这个函数就是Windows SDK中介绍的线程函数，其声明如下：

function ThreadProc(Thread: TThread): Integer;

var

FreeThread: Boolean;

begin

try

Thread.Execute;

finally

FreeThread := Thread.FFreeOnTerminate;

Result := Thread.FReturnValue;

Thread.FFinished := True;

Thread.DoTerminate;

if FreeThread then Thread.Free;

EndThread(Result);

end;

end;

Delphi没有将线程函数作为TThread的一个成员函数，我想把ThreadProc放到TThread的Proctected段中TThread的灵活性可能会更好一点，不过现在的方法也不错。可以看到ThreadProc以TThread对象作为Parameter参数。这样可以保证TThread对象进入线程的堆栈中，一个TThread对象不破坏另一个同类型TThread对象的数据。当然，创建线程的线程还是可以访问新线程中的数据的，Terminate过程就是这样做的。所以TThread的数据还是可能被其他线程破坏的。所以外部线程要访问线程的数据要小心处理，Terminate()是一个比较典型的：外部线程只写，内部线程只读就能很好的工作，如果两个线程都又读又写就可能导致逻辑混乱。

TThread类在构造线程实例是没有直接调用CreateThread() API函数，而是使用了一个BeginThread()函数。不知是什么原因，该函数并没有相应的Delphi Help文档，只是在“TThreadFunc type”的介绍中一笔带过。可能是Borland认为它的参数在以后还会修改吧。不过该函数和CreateThread() API的参数是一模一样的。这是一个让人兴奋的地方，因为BeginThread()加入了Windows API没有的异常处理功能。有意思的是，Delphi在BeginThread()由创建了一个新的线程函数，而把原来的线程函数和参数打包成TThreadRec作为新函数的Parameter。有关Delphi5中BeginThread的定义如下：

type

PThreadRec = ^TThreadRec;

TThreadRec = record

Func: TThreadFunc;

Parameter: Pointer;

end;

function ThreadWrapper(Parameter: Pointer): Integer; stdcall;

asm

CALL _FpuInit

XOR ECX,ECX

PUSH EBP

PUSH offset _ExceptionHandler //新增加的Delphi的异常机制

MOV EDX,FS:[ECX]

PUSH EDX

MOV EAX,Parameter

MOV FS:[ECX],ESP

MOV ECX,[EAX].TThreadRec.Parameter

MOV EDX,[EAX].TThreadRec.Func

PUSH ECX

PUSH EDX

CALL _FreeMem

POP EDX

POP EAX

CALL EDX //调用原来的线程函数

XOR EDX,EDX

POP ECX

MOV FS:[EDX],ECX

POP ECX

POP EBP

end;

function BeginThread(SecurityAttributes: Pointer; StackSize: LongWord;

ThreadFunc: TThreadFunc; Parameter: Pointer; CreationFlags: LongWord;

var ThreadId: LongWord): Integer;

var

P: PThreadRec;

begin

New(P);

P.Func := ThreadFunc;

P.Parameter := Parameter;

IsMultiThread := TRUE;

Result := CreateThread(SecurityAttributes, StackSize, @ThreadWrapper, P,CreationFlags, ThreadID);

end;

让人觉得美中不足的地方是TThread类在调用BeginThread时传递的SercurityAttributes和StackSize参数分别是nil和0，使BeginThread()在调用CreateThread()时使用了缺省的安全设置和默认堆栈大小。有关这两个参数代表什么意义请查阅Windows SDK文档。