Кран-смеситель

uses graphABC,Events;
var v: byte;
 
procedure Rakovina;
begin
setpencolor(clblack);
arc(200,200,150,180,0);
line(50,200,350,200);
arc(200,90,60,0,180);
arc(200,90,20,0,180);
line(140,88,140,200);
line(180,88,180,200);
line(220,88,260,88);
end;
 
procedure Kran(xx,c: integer);
begin
setbrushcolor(clwhite);
rectangle(xx-5,160,xx+5,200);
setbrushcolor(c);
circle(xx,150,20);
end;
 
procedure Voda;
var i: byte;
    xx,yy: integer;
begin
if v=0 then
   begin
   setbrushcolor(clblue);
   setpencolor(claqua);
   end else
       begin
       setbrushcolor(clred);
       setpencolor(clcream);
       end;
rectangle(220,90,260,200);
for i:=1 to 100 do
    begin
    xx:=random(40)+220;
    yy:=random(90)+90;
    line(xx,yy,xx,yy+10+random(10));
    end;
end;
 
procedure MouseDown(x,y,mb: integer);
begin
  if (x>=80) and (x<=120)
     and (y>=130) and (y<=170) then v:=0;
  if (x>=280) and (x<=320)
     and (y>=130) and (y<=170) then v:=1;
end;
 
 
begin
v:=0;
repeat
setwindowsize(400,400);
Rakovina;
Kran(100,clblue);
Kran(300,clred);
Voda;
OnMouseDown:=MouseDown;
sleep(50);
redraw;
until false;
end.

uses graphABC,Events;      //подключены модули графики и событий
var v: byte;
 
procedure Rakovina;        //процедура рисования раковины
begin
setpencolor(clblack);     //цвет пера - черный
arc(200,200,150,180,0);   //арка (большая)
line(50,200,350,200);
arc(200,90,60,0,180);     //арки крана
arc(200,90,20,0,180);
line(140,88,140,200);
line(180,88,180,200);
line(220,88,260,88);
end;
 
procedure Kran(xx,c: integer);    //процедура рисования крана, две входных переменных
begin                             //переменная для позиции по х, так как один кран слева, второй справа,
                                  //вторая переменная - для цвета
setbrushcolor(clwhite);           //цвет кисти - белый
rectangle(xx-5,160,xx+5,200);     //прямоугольник - ножка
setbrushcolor(c);                 //цвет пера в зависимости от крана
circle(xx,150,20);                //круг-вентиль
end;
 
procedure Voda;                   //процедура рисования воды
var i: byte;                      //вспомогательная переменная-счетчик, для рисования линий, имитирующих течение воды
    xx,yy: integer;               //вспомогательные переменные координат, для рисования линий, имитирующих течение воды
begin
if v=0 then                       //если переменная, отвечающая за тип воды, равна 0, (рисуем холодную воду)
   begin
   setbrushcolor(clblue);         //цвет кисти синий
   setpencolor(claqua);           //цвет пера - светлосиний
   end else                       //иначе (рисуем горячую воду)
       begin
       setbrushcolor(clred);      //цвет кисти - красный
       setpencolor(clcream);      //цвет пера - кремовый
       end;
rectangle(220,90,260,200);        //прямоугольник - основной массив воды
for i:=1 to 100 do                //в цикле с параметром от 1 до 100
    begin
    xx:=random(40)+220;           //случайные координаты по х от 220 до 260
    yy:=random(90)+90;            //случайные координаты по у от 90 до 180
    line(xx,yy,xx,yy+10+random(10)); //линия - штрих текущей воды
    end;
end;
 
procedure MouseDown(x,y,mb: integer);   //процедура - обработчик нажатия клавиши мыши
begin
  if (x>=80) and (x<=120)               //если кликнули по левому крану (то есть по х и по у попали в пределы координат этого крана)
     and (y>=130) and (y<=170) then v:=0;  //то переменной v (тип воды) присвоить значение 0 (вода холодная)
  if (x>=280) and (x<=320)              //если кликнули по правому крану (то есть по х и по у попали в пределы координат этого крана)
     and (y>=130) and (y<=170) then v:=1;  //то переменной v (тип воды) присвоить значение 1 (вода горячая)
end;
 
 
begin
v:=0;                       //начальное значение для типа воды - 0 - холодная
repeat                      //бесконечный цикл с постусловием
setwindowsize(400,400);     //размер окна
Rakovina;                   //процедура рисования раковины
Kran(100,clblue);           //кран холодной воды
Kran(300,clred);            //кран горячей воды
Voda;                       //вода
OnMouseDown:=MouseDown;     //обработка клика мышью
sleep(50);                  //задержка
redraw;                     //перерисовка
until false;
end.