unit SimulatedEvent;
{ Martin Harvey 4/6/2000 }
interface
uses Windows;
type
 TSimulatedEvent = class
 private
 FBlockCount: integer;
 FSignalled: boolean;
 FDataSection: TRTLCriticalSection;
 FBlockSem: THandle;
 protected
 public
 constructor Create(CreateSignalled: boolean);
 destructor Destroy; override;
 procedure SetEvent;
 procedure ResetEvent;
 procedure PulseEvent;
 procedure WaitFor;
 published
 end;
implementation
constructor TSimulatedEvent.Create(CreateSignalled: boolean);
begin
 inherited Create;
 FSignalled := CreateSignalled;
 InitializeCriticalSection(FDataSection);
 FBlockSem := CreateSemaphore(nil, 0, High(Integer), nil);
end;
destructor TSimulatedEvent.Destroy;
begin
 DeleteCriticalSection(FDataSection);
 CloseHandle(FBlockSem);
 inherited Destroy;
end;
 
procedure TSimulatedEvent.SetEvent;
begin
 EnterCriticalSection(FDataSection);
 FSignalled := true;
 while FBlockCount > 0 do
 begin
 ReleaseSemaphore(FBlockSem, 1, nil);
 Dec(FBlockCount);
 end;
 LeaveCriticalSection(FDataSection);
end;
 
procedure TSimulatedEvent.ResetEvent;
begin
 EnterCriticalSection(FDataSection);
 FSignalled := false;
 LeaveCriticalSection(FDataSection);
end;
 
procedure TSimulatedEvent.PulseEvent;
begin
 EnterCriticalSection(FDataSection);
 while FBlockCount > 0 do
 begin
 ReleaseSemaphore(FBlockSem, 1, nil);
 Dec(FBlockCount);
 end;
 LeaveCriticalSection(FDataSection);
end;
 
procedure TSimulatedEvent.WaitFor;
begin
 EnterCriticalSection(FDataSection);
 if FSignalled then
 begin
 Dec(FBlockCOunt);
 ReleaseSemaphore(FBlockSem, 1, nil);
 end;
 Inc(FBlockCount);
 LeaveCriticalSection(FDataSection);
 WaitForSingleObject(FBlockSem, INFINITE);
end;
end.