ulight.pas

来自「智能交通系统演示」· PAS 代码 · 共 127 行

unit uLight;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Graphics;

type
  TLightState=(lsRed, lsGreen, lsLeft, lsRight);
  TLight = class(TImage)
  private
    { Private declarations }
    FState: TLightState;
    FPicGreen: TPicture;
    FPicRed: TPicture;
    FPicLeft: TPicture;
    FPicRight: TPicture;
    procedure FSetPicGreen(APic: TPicture);
    procedure FSetPicRed(APic: TPicture);
    procedure FSetPicLeft(APic: TPicture);
    procedure FSetPicRight(APic: TPicture);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;
    procedure GreenOn;
    procedure RedOn;
    procedure LeftOn;
    procedure RightOn;
  published
    { Published declarations }
    property State: TLightState read FState;
    property PicGreen: TPicture read FPicGreen write FSetPicGreen;
    property PicRed: TPicture read FPicRed write FSetPicRed;
    property PicLeft: TPicture read FPicLeft write FSetPicLeft;
    property PicRight: TPicture read FPicRight write FSetPicRight;
  end;

procedure Register;

implementation

constructor TLight.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPicGreen := TPicture.Create;
  FPicRed := TPicture.Create;
  FPicLeft := TPicture.Create;
  FPicRight := TPicture.Create;
end;

destructor TLight.Destroy;
begin
  FreeAndNil(FPicGreen);
  FreeAndNil(FPicRed);
  FreeAndNil(FPicLeft);
  FreeAndNil(FPicRight);
  inherited;
end;

procedure TLight.GreenOn;
begin
  if Assigned(FPicGreen) then
    Picture := FPicGreen;
  Invalidate;
  FState := lsGreen;
end;

procedure TLight.RedOn;
begin
  if Assigned(FPicRed) then
    Picture := FPicRed;
  Invalidate;
  FState := lsRed;
end;

procedure TLight.LeftOn;
begin
  if Assigned(FPicLeft) then
    Picture := FPicLeft;
  Invalidate;
  FState := lsLeft;
end;

procedure TLight.RightOn;
begin
  if Assigned(FPicRight) then
    Picture := FPicRight;
  Invalidate;
  FState := lsRight;
end;

procedure TLight.FSetPicGreen(APic: TPicture);
begin
  FPicGreen.Assign(APic);
  Invalidate;
end;

procedure TLight.FSetPicRed(APic: TPicture);
begin
  FPicRed.Assign(APic);
  Invalidate;
end;

procedure TLight.FSetPicLeft(APic: TPicture);
begin
  FPicLeft.Assign(APic);
  Invalidate;
end;

procedure TLight.FSetPicRight(APic: TPicture);
begin
  FPicRight.Assign(APic);
  Invalidate;
end;



procedure Register;
begin
  RegisterComponents('Transport', [TLight]);
end;

end.