Útkereszteződés

Készítsük el egy négyes útkereszteződés teljes lámparendszerének vezérlését. A gépjárműforgalom mind a négy irányból külön vezérelt legyen, azaz csak az adott irányból közlekedhetnek a járművek. Legyen egy lámpa a gyalogosoknak, ha ez zöldre vált, akkor gépjárműforgalom egyáltalán ne legyen, a gyalogosoké az útkereszteződés, minden gyalogos oda és ott megy ahova és ahol akar (régen ilyen volt Debrecenben a Csonka templomnál).

Programozás-technikai megkötések:

- Az útkereszteződést grafikusan jelenítsük meg, vízszintes és függőleges útfelület, felezővonal, gyalogos átkelőhely, járdák, és a kimaradó rész zöld terület.

- A látvány a megjelenítő ablaktól részben független legyen, átméretezés után újrarajzolódjon. Az út, a gyalogos átkelőhely és a járda rögzített szélességű legyen (konstansként megadott).

- Hozzunk létre egyetlen objektum-osztályt az öt lámpának (ebből az első négy háromlencsés, az ötödik kétlencsés);

- A lámpa objektumok szintén grafikus megjelenésűek, rögzített lencseméret és lámpaméret mellett (konstansként megadott).

- A lámpa objektumoknak legyen típusa (1-5) és legyen olyan mezője, mely a működési fázisát tartalmazza (0-49). A lámpák inicializáló metódusa állítsa be a működési fázist (az elsőtől az ötödikig csökkenő fázisértékekkel).

- A lámpákat időzítő üzemeltesse.

A program futási képe az animáció indítása előtt:

A futási kép animáció közben:

A program listája:

unit UUtket;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
  TfmUtker = class(TForm)
    btKilepes: TButton;
    tiIdozito: TTimer;
    btStart: TButton;
procedure FormCreate(Sender: TObject);
procedure btKilepesClick(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure tiIdozitoTimer(Sender: TObject);
procedure btStartClick(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

  TLampa=Class
    Ft, Fa: Integer;
Procedure Init(It: Integer);
Procedure SetFazis(Ia: Integer);
Function GetFazis: Integer;
Procedure Show;
End;

Const  Us=120;
       Js=60;
       Zs=80;
       Cs=14;
       Ct=24;
       Ls=14;
       Lr=12;
var
  fmUtker: TfmUtker;
  Xk, Yk: Integer;
  Lt: Array[1..5] Of TLampa;
  Start: Boolean;

implementation

{$R *.dfm}

Procedure TLampa.Init(It: Integer);
Begin
  Ft:= It;
End;

Procedure TLampa.SetFazis(Ia: LongInt);
Begin
  Fa:= Ia;
End;

Function TLampa.GetFazis: Integer;
Begin
  GetFazis:= Fa;
End;

Procedure TLampa.Show;
Begin
With fmUtker.Canvas Do
Begin
With Pen Do
Begin
Color:= clWhite;
      Width:= 1;
End;
    Brush.Color:= clBlack;
Case Ft Of
      1: With Brush Do Begin
           Rectangle(Xk-Us-2*Ls,Yk-Us-7*Lr,Xk-Us,Yk-Us);
If Fa In [0..41] Then Color:= clRed Else Color:= clBlack;
           Ellipse(Xk-Us-2*Lr-2,Yk-Us-2*Lr-2,Xk-Us-2,Yk-Us     -2);
If Fa In [41,49] Then Color:= clYellow Else Color:= clBlack;
           Ellipse(Xk-Us-2*Lr-2,Yk-Us-4*Lr-2,Xk-Us-2,Yk-Us-2*Lr-2);
If Fa In [42..48] Then Color:= clGreen Else Color:= clBlack;
           Ellipse(Xk-Us-2*Lr-2,Yk-Us-6*Lr-2,Xk-Us-2,Yk-Us-4*Lr-2);
End;
      2: With Brush Do Begin
           Rectangle(Xk+Us,Yk-Us-2*Ls,Xk+Us+7*Lr,Yk-Us);
If Fa In [0..41] Then Color:= clRed Else Color:= clBlack;
           Ellipse(Xk+Us+2,     Yk-Us-2*Lr-2,Xk+Us+2*Lr+2,Yk-Us-2);
If Fa In [41,49] Then Color:= clYellow Else Color:= clBlack;
           Ellipse(Xk+Us+2*Lr+2,Yk-Us-2*Lr-2,Xk+Us+4*Lr+2,Yk-Us-2);
If Fa In [42..48] Then Color:= clGreen Else Color:= clBlack;
           Ellipse(Xk+Us+4*Lr+2,Yk-Us-2*Lr-2,Xk+Us+6*Lr+2,Yk-Us-2);
End;
      3: With Brush Do Begin
Rectangle(Xk+Us,Yk+Us,Xk+Us+2*Ls,Yk+Us+7*Lr);
If Fa In [0..41] Then Color:= clRed Else Color:= clBlack;
           Ellipse(Xk+Us+2,Yk+Us+2,     Xk+Us+2*Lr+2,Yk+Us+2*Lr+2);
If Fa In [41,49] Then Color:= clYellow Else Color:= clBlack;
           Ellipse(Xk+Us+2,Yk+Us+2*Lr+2,Xk+Us+2*Lr+2,Yk+Us+4*Lr+2);
If Fa In [42..48] Then Color:= clGreen Else Color:= clBlack;
           Ellipse(Xk+Us+2,Yk+Us+4*Lr+2,Xk+Us+2*Lr+2,Yk+Us+6*Lr+2);
End;
      4: With Brush Do Begin
           Rectangle(Xk-Us-7*Lr,Yk+Us,Xk-Us,Yk+Us+2*Ls);
If Fa In [0..41] Then Color:= clRed Else Color:= clBlack;
           Ellipse(Xk-Us-2*Lr-2,Yk+Us+2,Xk-Us-2,     Yk+Us+2*Lr+2);
If Fa In [41,49] Then Color:= clYellow Else Color:= clBlack;
           Ellipse(Xk-Us-4*Lr-2,Yk+Us+2,Xk-Us-2*Lr-2,Yk+Us+2*Lr+2);
If Fa In [42..48] Then Color:= clGreen Else Color:= clBlack;
           Ellipse(Xk-Us-6*Lr-2,Yk+Us+2,Xk-Us-4*Lr-2,Yk+Us+2*Lr+2);
End;
      5: With Brush Do Begin
           Rectangle(Xk-Ls,Yk-Ls,Xk+Ls,Yk+3*Lr+6);
If Fa In [0..41] Then Color:= clRed Else Color:= clBlack;
Ellipse(Xk-Ls+2,Yk-Ls+2,Xk+Ls-2,Yk+  Ls-2);
If Fa In [42..49] Then Color:= clGreen Else Color:= clBlack;
           Ellipse(Xk-Ls+2,Yk+Ls-2,Xk+Ls-2,Yk+3*Ls-6);
End;
End;
End;
End;

procedure TfmUtker.btKilepesClick(Sender: TObject);
begin
  Close;
end;

procedure TfmUtker.FormCreate(Sender: TObject);
begin
  Xk:= ClientWidth Div 2;
  Yk:= ClientHeight Div 2;
  Start:= False;
end;

procedure TfmUtker.btStartClick(Sender: TObject);
begin
  Start:= True;
end;

procedure TfmUtker.FormPaint(Sender: TObject);
Var I: Word;
begin
With Canvas Do
Begin
Pen.Color:= clBlack;
    Brush.Color:= clBtnFace;
    Rectangle(0,0,2*Xk-1,2*Yk-1);
    MoveTo(0,Yk-Us); LineTo(Xk-Us,Yk-Us); LineTo(Xk-Us,0);
    MoveTo(0,Yk+Us); LineTo(Xk-Us,Yk+Us); LineTo(Xk-Us,2*Yk);
    MoveTo(2*Xk,Yk-Us); LineTo(Xk+Us,Yk-Us); LineTo(Xk+Us,0);
    MoveTo(2*Xk,Yk+Us); LineTo(Xk+Us,Yk+Us); LineTo(Xk+Us,2*Yk);

    MoveTo(0,Yk-Us-Js); LineTo(Xk-Us-Js,Yk-Us-Js); LineTo(Xk-Us-Js,0);
    MoveTo(0,Yk+Us+Js); LineTo(Xk-Us-Js,Yk+Us+Js); LineTo(Xk-Us-Js,2*Yk);
    MoveTo(2*Xk,Yk-Us-Js); LineTo(Xk+Us+Js,Yk-Us-Js); LineTo(Xk+Us+Js,0);
MoveTo(2*Xk,Yk+Us+Js); LineTo(Xk+Us+Js,Yk+Us+Js); LineTo(Xk+Us+Js,2*Yk);

    Brush.Color:= clGreen;
    FloodFill(10,10,clBlack,fsBorder);
    FloodFill(2*Xk-10,10,clBlack,fsBorder);
    FloodFill(2*Xk-10,2*Yk-10,clBlack,fsBorder);
    FloodFill(10,2*Yk-10,clBlack,fsBorder);

    Brush.Color:= RGB(120,120,255);
    FloodFill(Xk-Us-Js Div 2,10,clBlack,fsBorder);
    FloodFill(Xk+Us+Js Div 2,10,clBlack,fsBorder);
    FloodFill(Xk-Us-Js Div 2,Yk+Us+Js Div 2,clBlack,fsBorder);
    FloodFill(Xk+Us+Js Div 2,Yk+Us+Js Div 2,clBlack,fsBorder);

    Pen.Color:= clWhite;
    Brush.Color:= clWhite;
For I:= 0 To (2*Us Div Ct)-1 Do
Begin
      Rectangle(Xk-Us+Cs Div 2+I*Ct,   Yk-Us-Zs,
                Xk-Us+Cs Div 2+I*Ct+Cs,Yk-Us);
      Rectangle(Xk-Us+Cs Div 2+I*Ct,   Yk+Us,
                Xk-Us+Cs Div 2+I*Ct+Cs,Yk+Us+Zs);
End;
For I:= 0 To (2*Us Div Ct)-1 Do
Begin
      Rectangle(Xk-Us-Zs,Yk-Us+Cs Div 2+I*Ct,
                Xk-Us,   Yk-Us+Cs Div 2+I*Ct+Cs);
      Rectangle(Xk+Us,   Yk-Us+Cs Div 2+I*Ct,
                Xk+Us+Zs,Yk-Us+Cs Div 2+I*Ct+Cs);
End;
    Pen.Width:= 6;
    MoveTo(0,Yk); LineTo(Xk-Us-Zs,Yk); MoveTo(Xk,0); LineTo(Xk,Yk-Us-Zs);
MoveTo(2*Xk,Yk); LineTo(Xk+Us+Zs,Yk); MoveTo(Xk,2*Yk); LineTo(Xk,Yk+Us+Zs);
For I:= 1 To 5 Do
Begin
      Lt[I]:= TLampa.Create;
      Lt[I].Init(I);
      Lt[I].Show;
      Lt[I].SetFazis((5-I)*10);
End;
End;
end;

procedure TfmUtker.FormResize(Sender: TObject);
begin
  Xk:= ClientWidth Div 2;
  Yk:= ClientHeight Div 2;
  FormPaint(Sender);
end;

procedure TfmUtker.tiIdozitoTimer(Sender: TObject);
Var I, S: Integer;
begin
If Not Start Then Exit;
For I:= 1 To 5 Do With Lt[I] Do
Begin
    S:= GetFazis; Inc(S); S:= S Mod 50; SetFazis(S); Show;
End;
end;

end.