(*ண - *)

uses crt;
Label 1,2;
var y,m: longint;
kol,n,i,j,d,l: integer;
m1,dn: string;

function day(y,m: integer): byte;
(*,
 ࢮ ᫮ m y*)
var d: byte;
i,k: integer;
Begin
k:=5;
For I:=2000 to y-1 do
if (I mod 4)=0 then k:=k+366
else k:=k+365;
if m>1 then k:=k+31;
if m>2 then begin if (y mod 4)=0 then k:=k+29 else k:=k+28 end;
if m>3 then k:=k+31;
if m>4 then k:=k+30;
if m>5 then k:=k+31;
if m>6 then k:=k+30;
if m>7 then k:=k+31;
if m>8 then k:=k+31;
if m>9 then k:=k+30;
if m>10 then k:=k+31;
if m>11 then k:=k+30;
d:=(k mod 7)+1;
Day:=d;
end;

Begin
clrscr;
TextColor(Lightred);
Gotoxy(15,1);
Writeln('-.'); writeln;
y:=0; m:=0;
While (y>99999) or (y<1) do begin
textcolor(lightgreen);
TextBackground(Black);
Write(' , - ');
TextColor(green+blink);
readln(y);
if (y>99999) or (y<1) then begin
TextColor(14+blink);
TextBackground(5);
Writeln(' ! ');
TextColor(15);
TextBackground(Blue);
Writeln(' ');
Writeln(' 1 99999 ');
TextBackground(Black);
end;



if (y<1918) and (y>0) then begin
TextColor(14+blink);
TextBackground(5);
Writeln(' ! 㤥 ! ');
TextColor(15);
TextBackground(Blue);
Writeln('室 ਣ ᪨ ');
Writeln(' ⢫ 14 䥢 1918 ');
TextBackground(Black);
end;
end;
While (m<1) or (m>12) do begin
TextColor(lightgreen);
TextBackground(Black);
write(' 騩 - ');
TextColor(green+blink);
readln(m);
if (m>12) or (m<1) then begin
TextColor(14+blink);
TextBackground(5);
Writeln(' ! ');
TextColor(15);
TextBackground(Blue);
Writeln(' ');
Writeln(' 1 12 ');
end;
end;

if m=1 then begin m1:=' '; kol:=31; end;
if m=2 then begin m1:=' '; kol:=28; if (y mod 4)=0 then kol:=29; end;
if m=3 then begin m1:=' '; kol:=31; end;
if m=4 then begin m1:='५'; kol:=30; end;
if m=5 then begin m1:=' '; kol:=31; end;
if m=6 then begin m1:=''; kol:=30; end;
if m=7 then begin m1:=''; kol:=31; end;
if m=8 then begin m1:=''; kol:=31; end;
if m=9 then begin m1:=''; kol:=30; end;
if m=10 then begin m1:=''; kol:=31; end;
if m=11 then begin m1:=''; kol:=30; end;
if m=12 then begin m1:=' '; kol:=31; end;
if kol=31 then dn:='' else dn:='';

TextColor(yellow);
TextBackground(black);
writeln;
Writeln(' ',m1,' ',y,' ',' (',kol,' ',dn,').');

TextColor(Lightred);
TextBackground(Black);
Writeln(' ________________________________');
Write(' ');
TextColor(White);
TextBackground(blue);
Write(' ');
TextColor(Lightred);
Writeln(' ');
TextBackground(black);
Write(' ');
TextBackground(blue);
Writeln(' -------------------------- ');
TextBackground(black);

y:=(y mod 28)+2016;
d:=day(y,m);
n:=kol+d+5;
L:=1;

For I:=1 to (n div 7) do begin
TextColor(Lightred);
TextBackground(black);
Write(' ');
TextColor(Lightred);
TextBackground(blue);
Write(' ');
For j:=1 to 7 do begin
TextBackground(blue);
if j<6 then TextColor(White)
else TextColor(Lightred);
If (i=1) and (j<d) then write(' ')
else begin
If l<10 then write(l,' ')
else
If l>kol then write(' ')
else write(l,' ');
L:=l+1 end;
end;
writeln;
end;
NormVideo;
readln;
end.

- http://letitbit.net/download/6525.ad653bf9...lendar.rar.html