您的位置:首页 > 编程语言 > Delphi

delphi 线程的使用

2013-10-29 21:04 337 查看
unit untWorkThread;

interface

uses
Windows,Classes,SysUtils;

type
TWorkItem=class
end;
TProcessWork=procedure (Sender:TObject;Work:TWorkItem) of Object;
TWorkThread=class(TThread)
private
FCriticalSection:TRTLCriticalSection;
hEvent:Cardinal;
FList:TList;
FProcessWork:TProcessWork;
procedure ProcessWork(Work:TWorkItem);
function GetWork(var AWork:TWorkItem):Boolean;
protected
procedure Execute;override;
public
procedure AddWork(AWork:TWorkItem);
constructor Create;
destructor Destroy; override;
property OnProcessWork:TProcessWork read FProcessWork write FProcessWork;
end;

implementation

{TWorkThread}

constructor TWorkThread.Create;
begin
InitializeCriticalSection(FCriticalSection);
hEvent:=CreateEvent(nil,False,False,nil);
FList:=TList.Create;
Self.FreeOnTerminate:=False;
inherited Create(False);
end;

destructor TWorkThread.Destroy;
var
i:Integer;
begin
for i:=FList.Count-1 downto 0 do TWorkItem(FList.Items[i]).Free;
DeleteCriticalSection(FCriticalSection);
FList.Free;
CloseHandle(hEvent);
end;

function TWorkThread.GetWork(var AWork:TWorkItem):Boolean;
begin
Result:=False;
EnterCriticalSection(FCriticalSection);
try
if FList.Count>0 then
begin
AWork:=TWorkItem(FList.Items[0]);
FList.Delete(0);
Result:=True;
end;
finally
LeaveCriticalSection(FCriticalSection);
end;
end;

procedure TWorkThread.Execute;
var
Work:TWorkItem;
begin
while not Self.Terminated do
begin
WaitForSingleObject(hEvent,INFINITE);
while GetWork(Work) do
begin
ProcessWork(Work);
Work.Free;
end;
end;
end;

procedure TWorkThread.ProcessWork(Work:TWorkItem);
begin
if Assigned(FProcessWork) then FProcessWork(Self,Work);
end;

procedure TWorkThread.AddWork(AWork:TWorkItem);
begin
EnterCriticalSection(FCriticalSection);
try
FList.Add(AWork);
finally
LeaveCriticalSection(FCriticalSection);
end;
SetEvent(hEvent);
end;

end.
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: