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.