Uses Graph,Dos,CRT;
var Device,Mode,x,i,y,k,j,code,x1,bb:integer;
    God,Mes,Den,Ned,God3,Mes3,Den3,Ned3,h,m,s,ss,DD2,MM2,GG2:word;
    God1,Den1,Ned1,Mes1,j2,f,N,slovo,nap,o,slovo2,oo,slovo3,ooo,otvet,slovo5,o5,DD1,MM1,GG1,slovo4,o4:string;
    DD,MM,GG:array [1..4] of string;

Procedure Den_Nedeli;
begin
case Ned of
1: Ned1:='Понедельник';
2: Ned1:='Вторник';
3: Ned1:='Среда';
4: Ned1:='Четверг';    {Присваивание переменной Ned1 значения, в зависимости от Ned}
5: Ned1:='Пятница';
6: Ned1:='Суббота';
0: Ned1:='Воскресенье';
end;
end;

Procedure mecyz;
begin
case Mes of
1: Mes1:='Январь';
2: Mes1:='Февраль';
3: Mes1:='Март';
4: Mes1:='Апрель';
5: Mes1:='Май';
6: Mes1:='Июнь';       {Присваивание переменной Mes1 значения, в зависимости от Mes}
7: Mes1:='Июль';
8: Mes1:='Август';
9: Mes1:='Сентябрь';
10: Mes1:='Октябрь';
11: Mes1:='Ноябрь';
12: Mes1:='Декабрь';
end;
end;

Procedure kolichestvo;
begin
case Mes of
1: k:=31;
2: k:=28;
3: k:=31;
4: k:=30;
5: k:=31;                {В зависимости от месяца, присваиваем переменной k кол-во дней в данном месяце}
6: k:=30;
7: k:=31;
8: k:=31;
9: k:=30;
10: k:=31;
11: k:=30;
12: k:=31;
end;
end;

Procedure nedelya;   {Если первый день месяца приходится на понедельник и т.д., то присваиваем переменным x и y}
begin                {соответствующие значения, а так же формируем последующие значения координат}
case Ned3 of
1: begin
               x:=347; y:=170;
               for j:=1 to k do begin
                                str(j,j2);
                                OutTextXY(x,y,j2);
                                val(j2,j,code);
                                if (j=5)or(j=12)or(j=19)or(j=26)or(j=6)or(j=13)or(j=20)or(j=27) then setcolor(4)
                                                                                                else setcolor(0);
                                if j=9 then x:=x+25;
                                if j<>9 then x:=x+32;
                                if j=7 then begin
                                            y:=y+35;
                                            x:=x-223;
                                            end;
                                if (j=14)or(j=21) then begin
                                                       y:=y+32;
                                                       x:=x-223;
                                                       end;
                                if j=28 then begin
                                             y:=y+28;
                                             x:=x-223;
                                             end;
                                end;
               end;
2: begin
               x:=379; y:=170;
               for j:=1 to k do begin
                                str(j,j2);
                                OutTextXY(x,y,j2);
                                val(j2,j,code);
                                if (j=4)or(j=11)or(j=12)or(j=18)or(j=25)or(j=5)or(j=11)or(j=19)or(j=26) then setcolor(4)
                                                                                                        else setcolor(0);
                                if j=9 then x:=x+25;
                                if j<>9 then x:=x+32;
                                if j=6 then begin
                                            y:=y+35;
                                            x:=x-223;
                                            end;
                                if (j=13)or(j=20) then begin
                                                       y:=y+32;
                                                       x:=x-223;
                                                       end;
                                if j=27 then begin
                                             y:=y+28;
                                             x:=x-223;
                                             end;
                                end;
               end;
3: begin
               x:=411; y:=170;
               for j:=1 to k do begin
                                str(j,j2);
                                OutTextXY(x,y,j2);
                                val(j2,j,code);
                                if (j=3)or(j=10)or(j=17)or(j=24)or(j=4)or(j=11)or(j=18)or(j=25) then setcolor(4)
                                                                                                else setcolor(0);
                                if j=9 then x:=x+25;
                                if j<>9 then x:=x+32;
                                if j=5 then begin
                                            y:=y+35;
                                            x:=x-223;
                                            end;
                                if (j=12)or(j=19) then begin
                                                       y:=y+32;
                                                       x:=x-223;
                                                       end;
                                if j=26 then begin
                                             y:=y+28;
                                             x:=x-223;
                                             end;
                                end;
               end;
4: begin
               x:=443; y:=170;
               for j:=1 to k do begin
                                str(j,j2);
                                OutTextXY(x,y,j2);
                                val(j2,j,code);
                                if (j=2)or(j=9)or(j=16)or(j=23)or(j=3)or(j=10)or(j=17)or(j=24)or(j=30) then setcolor(4)
                                                                                                       else setcolor(0);
                                if j=9 then x:=x+25;
                                if j<>9 then x:=x+32;
                                if j=4 then begin
                                            y:=y+35;
                                            x:=x-223;
                                            end;
                                if (j=11)or(j=18) then begin
                                                       y:=y+32;
                                                       x:=x-223;
                                                       end;
                                if j=25 then begin
                                             y:=y+28;
                                             x:=x-223;
                                             end;
                                end;
               end;
5: begin
               x:=475; y:=170;
               for j:=1 to k do begin
                                str(j,j2);
                                OutTextXY(x,y,j2);
                                val(j2,j,code);
                                if (j=2)or(j=9)or(j=16)or(j=23)or(j=1)or(j=8)or(j=15)or(j=22)or(j=29)or(j=30) then setcolor(4)
                                                                                                              else setcolor(0);
                                if j=9 then x:=x+25;
                                if j<>9 then x:=x+32;
                                if j=3 then begin
                                            y:=y+35;
                                            x:=x-223;
                                            end;
                                if (j=10)or(j=17) then begin
                                                       y:=y+32;
                                                       x:=x-223;
                                                       end;
                                if j=24 then begin
                                             y:=y+28;
                                             x:=x-223;
                                             end;
                                end;
               end;
6: begin
               x:=507; y:=170;
               for j:=1 to k do begin
                                if (j=2)or(j=9)or(j=16)or(j=23)or(j=1)or(j=8)or(j=15)or(j=22)or(j=29)or(j=30) then setcolor(4)
                                                                                                              else setcolor(0);
                                str(j,j2);
                                OutTextXY(x,y,j2);
                                val(j2,j,code);
                                if j=9 then x:=x+25;
                                if j<>9 then x:=x+32;
                                if j=2 then begin
                                            y:=y+35;
                                            x:=x-223;
                                            end;
                                if (j=9)or(j=16) then begin
                                                       y:=y+32;
                                                       x:=x-223;
                                                       end;
                                if j=23 then begin
                                             y:=y+28;
                                             x:=x-223;
                                             end;
                                end;
               end;
0: begin
               x:=539; y:=170;
               Line(336,325,560,325);
               x1:=368;
               for i:=1 to 6 do begin
                                Line(x1,320,x1,350);
                                x1:=x1+33;
                                end;
               for j:=1 to k do begin
                                if (j=7)or(j=14)or(j=21)or(j=28)or(j=1)or(j=8)or(j=15)or(j=22)or(j=29) then setcolor(4)
                                                                                                       else setcolor(0);
                                str(j,j2);
                                OutTextXY(x,y,j2);
                                val(j2,j,code);
                                if j=9 then x:=x+25;
                                if j<>9 then x:=x+32;
                                if j=1 then begin
                                            y:=y+35;
                                            x:=x-223;
                                            end;
                                if (j=8)or(j=15) then begin
                                                       y:=y+32;
                                                       x:=x-223;
                                                       end;
                                if j=22 then begin
                                             y:=y+28;
                                             x:=x-223;
                                             end;
                                if j=29 then begin
                                             y:=y+28;
                                             x:=x-226;
                                             end;
                                end;
               end;
end;
end;

Procedure chas(h:byte);   {Формируем длин и расположение часовых, минутных и секундных стрелок на циферблате часов}
begin
SetLineStyle(0,0,ThickWidth);
SetColor(0);
Line(144,220,144+round(50*cos(pi*h/6-pi/2+pi*m/360)),220+round(50*sin(pi*h/6-pi/2+pi*m/360)));
SetColor(15);
Line(144,220,144+round(50*cos(pi*(h-1)/6+pi/2+pi*m/360)),220+round(50*sin(pi*(h-1)/6+pi/2+pi*m/360)));
end;

Procedure minuta(m:byte);
begin
SetLineStyle(0,0,NormWidth);
SetColor(0);
Line(144,220,144+round(70*cos(pi*m/30-pi/2)),220+round(70*sin(pi*m/30-pi/2)));
SetColor(15);
Line(144,220,144+round(70*cos(pi*(m-1)/30-pi/2)),220+round(70*sin(pi*(m-1)/30-pi/2)));
end;

Procedure secunda(s:byte);
begin
SetLineStyle(0,0,NormWidth);
SetColor(4);
Line(144,220,144+round(90*cos(pi*s/30-pi/2)),220+round(90*sin(pi*s/30-pi/2)));
SetColor(15);
Line(144,220,144+round(90*cos(pi*(s-1)/30-pi/2)),220+round(90*sin(pi*(s-1)/30-pi/2)));
end;

Procedure zalivka;   {Заливка экрана}
begin
SetFillStyle(1,1);
FloodFill(1,1,14);
SetFillStyle(1,15);
FloodFill(1,1,14);
end;

begin
Device:=0;
InitGraph(Device,Mode,'');
SetFillStyle(1,15);
FloodFill(1,1,14);
SetLineStyle(0,0,ThickWidth);
SetColor(7);
Rectangle(64,15,576,75);
GetDate(God,Mes,Den,Ned);
Str(God,God1);
Str(Den,Den1);
SetTextStyle(1,0,3);
SetColor(2);                   {Рисование будущего окна календаря}
OutTextXY(330,20,God1);
Den_Nedeli;
OutTextXY(330,42,Ned1);
SetTextStyle(1,0,5);
SetColor(2);
OutTextXY(275,20,Den1);
SetLineStyle(0,0,NormWidth);
SetColor(0);
Circle(144,220,105);
Line(304,165,592,165);
SetLineStyle(1,0,NormWidth);
SetColor(8);
x:=368;
for i:=1 to 6 do begin
                 Line(x,165,x,320);
                 x:=x+33;
                 end;
y:=197;
for i:=1 to 4 do begin
                 Line(336,y,560,y);
                 y:=y+32;
                 end;
SetTextStyle(1,0,2);
SetColor(0);                          {Рисование календарной сетки}
OutTextXY(335,143,'Пн');
OutTextXY(372,143,'Вт');
OutTextXY(402,143,'Ср');
OutTextXY(431,143,'Чт');
OutTextXY(466,143,'Пт');
SetColor(4);
OutTextXY(500,143,'Сб');
OutTextXY(532,143,'Вс');
SetTextStyle(1,0,2);
SetColor(2);
OutTextXY(375,115,God1);
mecyz;
OutTextXY(455,115,Mes1);
SetDate(God,Mes,1);
GetDate(God3,Mes3,Den3,Ned3);
SetDate(God,Mes,Den);
SetTextStyle(1,0,2);
SetColor(0);
kolichestvo;
nedelya;
SetColor(5);
SetTextStyle(7,0,2);
OutTextXY(134+round(100*cos(pi/3)),215-round(100*sin(pi/3)),'1');
OutTextXY(134+round(100*cos(pi/6)),213-round(100*sin(pi/6)),'2');
OutTextXY(235,210,'3');
OutTextXY(136+round(100*cos(pi/6)),208+round(100*sin(pi/6)),'4');
OutTextXY(136+round(100*cos(pi/3)),205+round(100*sin(pi/3)),'5');    {Нанесение значений на циферблат часов}
OutTextXY(139,305,'6');
OutTextXY(142-round(100*cos(pi/3)),205+round(100*sin(pi/3)),'7');
OutTextXY(144-round(100*cos(pi/6)),207+round(100*sin(pi/6)),'8');
OutTextXY(42,210,'9');
OutTextXY(136-round(100*cos(pi/6)),213-round(100*sin(pi/6)),'10');
OutTextXY(134-round(100*cos(pi/3)),215-round(100*sin(pi/3)),'11');
OutTextXY(132,115,'12');
SetColor(1);
SetTextStyle(7,0,4);
OutTextXY(230,380,'Календарь');
repeat
GetTime(h,m,s,ss);
GetDate(God,Mes,Den,Ned);
chas(h);
minuta(m);
secunda(s);
if KeyPressed then N:=ReadKey;
until N=#27;
CloseGraph;
end.