unit TrafficLight;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TLights = (tlRed, tlYellow, tlGreen);
  TTrafficLight = class(TGraphicControl)
  private
    { Private declarations }
    FCurLight: TLights;
    FTimer: TTimer;
    function GetTimerEnabled: Boolean;
    function GetTimerInterval: Integer;
    procedure SetLight(Value: TLights);
    procedure SetTimerEnabled(Value: Boolean);
    procedure SetTimerInterval(const Value: Integer);
    procedure OnTimer(Sender: TObject);
    procedure _OnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    { Published declarations }
    property Height;
    property Width;
    property Light: TLights read FCurLight write SetLight;
    property TimerEnabled: Boolean read GetTimerEnabled write SetTimerEnabled;
    property TimerInterval: Integer read GetTimerInterval write SetTimerInterval;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyComp', [TTrafficLight]);
end;

{ TTrafficLight }

constructor TTrafficLight.Create(aOwner: TComponent);
begin
  inherited;
  FTimer := TTimer.Create(nil);
  Height := 70;
  Width :=  30;
  TimerInterval := 1000;
  TimerEnabled := False;
  Light := tlRed;
  FTimer.OnTimer := OnTimer;
  OnMouseDown := _OnMouseDown;
end;

destructor TTrafficLight.Destroy;
begin
  FTimer.Free;
  inherited;
end;

function TTrafficLight.GetTimerEnabled: Boolean;
begin
  Result := FTimer.Enabled;
end;

function TTrafficLight.GetTimerInterval: Integer;
begin
  Result := FTimer.Interval;
end;

procedure TTrafficLight.Paint;
var
  X,Y: Integer;
begin
  Y := Height div 7;
  X := Width div 3;
  Canvas.Brush.Color := clGray;
  Canvas.Pen.Color := clBlack;
  Canvas.Ellipse(X,Y,2*X,2*Y);
  Canvas.Ellipse(X,3*Y,2*X,4*Y);
  Canvas.Ellipse(X,5*Y,2*X,6*Y);
  Canvas.FrameRect(Rect(0,0,Width,Height));
  X := Width div 2;
  Y := Height div 14;

  case Light of
    tlRed: begin
             Canvas.Brush.Color := clRed;
             Canvas.FloodFill(X,3*Y,clBlack,fsBorder);
           end;
    tlYellow: begin
             Canvas.Brush.Color := clYellow;
             Canvas.FloodFill(X,7*Y,clBlack,fsBorder);
           end;
    tlGreen: begin
             Canvas.Brush.Color := clGreen;
             Canvas.FloodFill(X,11*Y,clBlack,fsBorder);
           end;
  end;
end;

procedure TTrafficLight.SetLight(Value: TLights);
begin
  if Value <> FCurLight then
  begin
    FCurLight := Value;
    Refresh;
  end;
end;

procedure TTrafficLight.SetTimerEnabled(Value: Boolean);
begin
  FTimer.Enabled := Value;
end;

procedure TTrafficLight.SetTimerInterval(const Value: Integer);
begin
  FTimer.Interval := Value;
end;

procedure TTrafficLight.OnTimer(Sender: TObject);
begin
  Light := TLights((Ord(FCurLight) + 1) mod 3);
end;

procedure TTrafficLight._OnMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  HR,HY,HG: HRGN;
  mX,mY: Integer;
begin
  mX := Width div 3;
  mY := Height div 7;

  HR := CreateEllipticRgn(mX,mY,2*mX,2*mY);
  HY := CreateEllipticRgn(mX,3*mY,2*mX,4*mY);
  HG := CreateEllipticRgn(mX,5*mY,2*mX,6*mY);

  if PtInRegion(HR,X,Y) then Light := tlRed;
  if PtInRegion(HY,X,Y) then Light := tlYellow;
  if PtInRegion(HG,X,Y) then Light := tlGreen;

  DeleteObject(HR);
  DeleteObject(HY);
  DeleteObject(HG);
end;

end.
