unit
uJooThread;
interface
uses
Classes, uFooThread;
type
TJooThread =
class
(TFooThread)
public
procedure
Synchronize(AProc: TThreadMethod);
end
;
implementation
{ TJooThread }
procedure
TJooThread
.
Synchronize(AProc: TThreadMethod);
begin
ExecProcInThread(AProc);
// 再设计一个等待 AProc 执行结果功能。
end
;
end
.
unit
uJooThread;
interface
uses
Classes, SyncObjs, uFooThread, uFooList;
type
PSyncRec = ^TSyncRec;
TSyncRec =
record
Method: TThreadMethod;
// 这是类的方法
Proc: TThreadProcedure;
// 这是匿名方法
// 本例只写了类的方法。需要匿名方法,请自行重载 Sync 与 Queue
Signle: TEvent;
Queue:
boolean
;
end
;
TSyncRecList =
class
(TFooList<PSyncRec>)
//用于装执行代码的 List
protected
procedure
FreeItem(Item: PSyncRec); override;
end
;
TJooThread =
class
(TFooThread)
private
FSyncRecList: TSyncRecList;
procedure
Check;
public
constructor
Create(ACanAccessCom:
boolean
);
destructor
Destroy; override;
procedure
Synchronize(AProc: TThreadMethod);
// 阻塞到 AProc执行完毕才返回。
procedure
Queue(AProc: TThreadMethod);
// 塞入线程后立即返回。
end
;
// 本例就是前面单节讲的知识的综合运用。
// TEvent,FooThread,FooList,全都用上了。
// 并构建了一个新的线程功能。
// 当我写完以后发现,与系统源码中,
// 窗口接收 WM_NULL 消息后的处理UI操作的功能,几乎是一模一样的。
// 不同的是,本例是在线程时空,系统源码是在主线程时空。
implementation
{ TJooThread }
procedure
TJooThread
.
Check;
var
p: PSyncRec;
begin
FSyncRecList
.
Lock;
// 所有要执行的代码,都在这个 List 中了。
// 此处是线程时空,故从List 中取出并执行代码即可。
try
p :=
nil
;
if
FSyncRecList
.
Count >
0
then
// 每次取 List 的第一个来执行。
begin
p := FSyncRecList[
0
];
FSyncRecList
.
Delete(
0
);
end
;
finally
FSyncRecList
.
Unlock;
end
;
if
Assigned(p)
then
begin
if
Assigned(p
.
Method)
then
p
.
Method
else
if
Assigned(p
.
Proc)
then
p
.
Proc();
if
not
p
.
Queue
then
// 如果是阻塞,就置信号。
p
.
Signle
.
SetEvent;
Dispose(p);
ExecProcInThread(Check);
end
;
end
;
constructor
TJooThread
.
Create(ACanAccessCom:
boolean
);
begin
inherited
;
FSyncRecList := TSyncRecList
.
Create;
end
;
destructor
TJooThread
.
Destroy;
begin
FSyncRecList
.
Free;
inherited
;
end
;
procedure
TJooThread
.
Queue(AProc: TThreadMethod);
var
p: PSyncRec;
begin
FSyncRecList
.
Lock;
try
new(p);
FSyncRecList
.
Add(p);
p
.
Method := AProc;
p
.
Queue :=
true
;
ExecProcInThread(Check);
finally
FSyncRecList
.
Unlock;
end
;
end
;
procedure
TJooThread
.
Synchronize(AProc: TThreadMethod);
var
p: PSyncRec;
o: TEvent;
begin
FSyncRecList
.
Lock;
try
new(p);
FSyncRecList
.
Add(p);
p
.
Method := AProc;
o := TEvent
.
Create(
nil
,
true
,
false
,
‘‘
);
p
.
Signle := o;
p
.
Queue :=
false
;
ExecProcInThread(Check);
//触发线程启动
finally
FSyncRecList
.
Unlock;
end
;
o
.
WaitFor;
// 等待 AProc 执行完毕的信号
o
.
Free;
end
;
{ TSyncRecList }
procedure
TSyncRecList
.
FreeItem(Item: PSyncRec);
begin
inherited
;
if
Assigned(Item
.
Signle)
then
Item
.
Signle
.
Free;
Dispose(Item);
end
;
end
.
delphi 线程教学第七节:在多个线程时空中,把各自的代码塞到一个指定的线程时空运行
原文:http://www.cnblogs.com/lackey/p/6337357.html