unit UnTrafficLight;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DateUtils;
type
TTrafficLight = class(TObject)
private
{ Private declarations }
fLightRed,
fLightYellow,
fLightGreen,
fStop
: boolean;
fCanvas: TCanvas;
public
{ Public declarations }
property LightRed : boolean read fLightRed;
property LightYellow : boolean read fLightYellow;
property LightGreen : boolean read fLightGreen;
constructor Create(Canvas : TCanvas);
procedure DrawLight(LightColor: TColor; clear: boolean = false);
procedure ClearTrafficLight;
procedure ShowState;
procedure Wait(time: integer);
procedure StopCycle;
procedure StartLightCycle;
end;
implementation
constructor TTrafficLight.Create(Canvas : TCanvas);
begin
inherited Create;
fCanvas := Canvas;
fCanvas.Brush.Style := bsSolid;
fLightRed := false;
fLightYellow := false;
fLightGreen := false;
ShowState;
end;
procedure TTrafficLight.DrawLight(LightColor: TColor; clear: boolean = false);
begin
if clear then fCanvas.Brush.Color := clSilver
else fCanvas.Brush.Color := LightColor;
case LightColor of
clRed : fcanvas.Ellipse(35,20,85,70);
clYellow : fcanvas.Ellipse(35,90,85,140);
clGreen : fcanvas.Ellipse(35,160,85,210);
end;
end;
procedure TTrafficLight.ClearTrafficLight;
begin
DrawLight(clRed, true);
DrawLight(clYellow, true);
DrawLight(clGreen, true);
end;
procedure TTrafficLight.ShowState;
begin
DrawLight(clRed, not fLightRed);
DrawLight(clYellow, not fLightYellow);
DrawLight(clGreen, not fLightGreen);
end;
procedure TTrafficLight.Wait(time: integer);
var h: THandle;
begin
h:=CreateEvent(nil,true,false,'');
WaitForSingleObject(h,time);
CloseHandle(h);
end;
procedure TTrafficLight.StopCycle;
begin
fStop := true;
ClearTrafficLight;
end;
procedure TTrafficLight.StartLightCycle;
var start : TDateTime;
begin
fStop := false;
While not fStop do
begin
Application.ProcessMessages;
If fStop then exit;
// Исходное состояние - красный свет
fLightRed := true;
fLightYellow := false;
fLightGreen := false;
ShowState;
Start := now;
While SecondsBetween(Start,now) < 15 do
begin
if fStop then exit;
ShowState;
Application.ProcessMessages;
Wait(50);
end;
// Включаем желтый и красный, горим 2 секунды
fLightRed := true;
fLightYellow := true;
fLightGreen := false;
ShowState;
Start := now;
While SecondsBetween(Start,now) < 2 do
begin
if fStop then exit;
ShowState;
Application.ProcessMessages;
Wait(50);
end;
// Включаем зеленый, горим 30 секунд
fLightRed := false;
fLightYellow := false;
fLightGreen := true;
ShowState;
Start := now;
While SecondsBetween(Start,now) < 30 do
begin
if fStop then exit;
ShowState;
Application.ProcessMessages;
Wait(50);
end;
// Зеленый мигает 3 секунд
Start := now;
While SecondsBetween(Start,now) < 3 do
begin
fLightGreen := not fLightGreen;
if fStop then exit;
ShowState;
Application.ProcessMessages;
Wait(500);
end;
// Включаем желтый, горим 3 секунд
fLightRed := false;
fLightYellow := true;
fLightGreen := false;
ShowState;
Start := now;
While SecondsBetween(Start,now) < 2 do
begin
if fStop then exit;
ShowState;
Application.ProcessMessages;
Wait(50);
end;
end;
fLightRed := false;
fLightYellow := false;
fLightGreen := false;
end;
end.