Program simuluje semafór z F1

Kategórie: Zadání z Pascalu
Program: Semafor.pas
Soubor exe: Semafor.exe
Potřebné: Egavga.bgi

{ 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.