delphi 线程的使用

时间:2023-03-10 07:07:37
delphi 线程的使用
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- downto 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> then
begin
AWork:=TWorkItem(FList.Items[]);
FList.Delete();
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.