Umiestnenie súboru www.TrSek.com/zadania/semafor.pas

{ SEMAFOR.PAS               Copyright (c) TrSek alias Zdeno Sekerak }
{ Program simuluje semafor z F1.                                    }
{ Potrebuje graficku kniznicu egavga.bgi.                           }
{                                                                   }
{ Datum:30.05.2004                             http://www.trsek.com }

program semafor;
uses crt,graph;

var gd, gm:integer;
    x, y: integer;

{ inicializuje grafiku }
procedure InitGrafika;
begin
  Gd := Detect;
  InitGraph(Gd, Gm, '');
  if GraphResult <> grOk then
  begin
     WriteLn('Nieje mozne inicializovat grafiku asi chyba subor EgaVga.bgi');
     Halt(1);
  end;
end;

{ vyplni kruh na suradniciach pozadovanou farbou }
procedure Vypln(x1, y1:integer; color:integer);
var x,y:integer;
  xd,yd:integer;
begin
  xd := GetMaxX div 16;
  yd := GetMaxY div 16;

  x := (5*xd)*(x1-1) + xd;
  y := (5*yd)*(y1-1) + yd;

  SetColor(color);
  Circle( x+(2*xd), y+(2*yd), 2*yd-10 );

  SetFillStyle(SolidFill, color );
  FloodFill( x+(2*xd), y+(2*yd), color );
end;

{ urobi stvorec na suradniciach }
procedure KresliKruh(x1,y1:integer;color:integer);
var x,y:integer;
  xd,yd:integer;
begin
  xd := GetMaxX div 16;
  yd := GetMaxY div 16;

  x := (5*xd)*(x1-1) + xd;
  y := (5*yd)*(y1-1) + yd;

  SetFillStyle(XHatchFill, LightGray);
  SetColor(DarkGray);
  Bar3d( x, y, x+(4*xd), y+(4*yd), 0, true);

  Vypln(x1,y1,color);
end;

{ vykresli 3 kruhy vedla seba a pocka tim milisekund }
procedure PruhBlik(y:integer;color:integer;tim:integer);
var i:integer;
begin
  for i:=1 to y do
  begin
    Vypln(1,i,color);
    Vypln(2,i,color);
    Vypln(3,i,color);
  end;

  Delay(tim);
end;

begin

  InitGrafika;

  { najprv vsetko v sedom }
  for x:=1 to 3 do
    for y:=1 to 3 do
      KresliKruh(x,y,DarkGray);

  { prva cervena }
  for y:=1 to 3 do
  begin
    Sound(500);
    PruhBlik(1,Red,500);

    NoSound;
    PruhBlik(1,DarkGray,300);
  end;

  { druha magenta }
  for y:=1 to 3 do
  begin
    Sound(500);
    PruhBlik(2,Magenta,500);

    NoSound;
    PruhBlik(2,DarkGray,300);
  end;

  { nakoniec zelena }
  Sound(500);
  PruhBlik(3,Green,500);
  NoSound;

  OutTextXY(40, GetMaxY-10, 'Koniec - stlac Enter');
  Readln;
  CloseGraph;

end.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com