Вот скрипт
(*Џа®Ја ¬¬ -Є «Ґ¤ ам*)

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