Григорианский календарь (Pascal)

[Mish92(21-09)]

Здравствуйте! Помогите, пожалуйста сделать григорианский календарь на паскале!
"Составить программу,реализующая григорианский календарь нового стиля (1582-4903 гг.). Программа должна выводить на экран по введенным месяцу и году календарь, например, в следующем виде:

Месяц Год
пн 1 8 15 22 29
вт 2 9 16 23 30
ср 3 10 17 24 31
чт 4 11 18 25
пт 5 12 19 26
сб 6 13 20 27
вс 7 14 21 28

А также программа по введенной пользователем дате должна выводить на экран соответствующий день недели."

[SuperVisor]

Наработки, вопросы, предложения.... Что не получается? Что подсказать?

[Mish92(21-09)]

Вот текст, только там надо доработать, чтобы выводил день недели:

program Calendar;
uses Crt;
const month_offset:array[1..12] of integer = (0, 31, 61, 92, 122, 153, 184,
214, 245, 275, 306, 337);
const month_size:array[1..12] of integer = (31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
const names:array[0..6] of string = ('sun','mon','tue','wed','thu','fri','sat');
const monthnames:array[1..12] of string = ('january', 'february', 'march', 'april', 'may', 
     'june', 'july', 'august', 'september', 'october', 'november', 'december');
const celllength = 4;
type TTable = array[1..16] of string;
     PTable = ^TTable;
function Weekday(d,m,y:integer):byte;
         begin
              m:=m-2;
              if m<=0 then begin m:=m+12; dec(y) end;
              Weekday:=(d+month_offset[m]+y+y div 4-y div 100+y div 400+2) mod 7;
         end;
function formated(Str:String;Len:integer):String;
         var a:integer;
         begin
              a:=Len-length(str);
              while a>0 do
                    begin
                         Str:='.'+Str;
                         a:=a-1;
                    end;
              formated:=Str;
         end;
function Inttostr(x:integer):string;
         begin
              IntToStr:=chr(x div 10 + 48)+chr(x mod 10 + 48);
         end;
function ShowMonth(d,m,y:word; light:boolean):PTable;
         var Res:TTable;
         var firstday: byte;
         var p,c,lastday:integer;
         begin
              firstday:=Weekday(1,m,y);
              for p:=0 to firstday-1 do
                  begin
                       Res[p+1]:=names[p]+Formated('',celllength);
                       c:=8-firstday+p;
                       lastday:=month_size[m];
                       if m=2 then
                          if (y mod 4 <> 0) or ((y mod 100 = 0) and (y mod 400 <> 0))
                             then lastday:=28
                             else lastday:=29;
                       while c<=LastDay do
                             begin
                                  if (c<>d) or not light
                                     then
                                         if (c-7=d) and light
                                            then Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength-1)
                                            else Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength)
                                     else Res[p+1]:=Res[p+1]+Formated('['+Inttostr(c),celllength)+']';
                                  c:=c+7;
                             end;
                  end;
              for p:=firstday to 6 do
                  begin
                       Res[p+1]:=names[p];
                       c:=p-firstday+1;
                       lastday:=month_size[m];
                       if m=2 then
                          if (y mod 4 <> 0) or ((y mod 100 = 0) and (y mod 400 <> 0))
                             then lastday:=28
                             else lastday:=29;
                       while c<=lastday do
                             begin
                                  if (c<>d) or not light
                                     then
                                         if (c-7=d) and light
                                            then Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength-1)
                                            else Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength)
                                     else Res[p+1]:=Res[p+1]+Formated('['+Inttostr(c),celllength)+']';
                                  c:=c+7;
                             end;
                  end;
              ShowMonth:=@Res;
         end;
var P:PTable; a:integer;
var year : integer;
var day, mon : byte;
begin
clrscr;
write('> Enter a number of year: '); readln(year);
for mon:=1 to 12 do
    begin
    if keypressed then ReadKey;
    for day:=1 to 31 do
        begin
             P:=ShowMonth(day,mon,year,true);
             clrscr;
             writeln('>  ',monthnames[mon],' ',year);
             writeln;
             a:=0;
             repeat
                   a:=a+1;
                   if P^[a] <> '' then
                      writeln('> '+P^[a]);
             until P^[a] = '';
             if not keypressed then Delay(65535);
        end
    end
end.

Там кстати выход неработает

[ОДИНОЧЕСТВО В СЕТИ]

а она чего его не выводит что ли? по моему выводит!

[Alex Cones]

Офф:

writeln('> for cyberforum from messager. '); writeln;

Слушай, ну удалил бы хоть, а то палишься немного.

[Mish92(21-09)]

Помогите соединить вот эти две проги:
В посте номер №3 и вот эту:

Program Calendar;
Uses    Crt;
Var     D, M, Y, W: Integer;
Const   Z: Array[0..6] of String[12]=('ВОСКРЕСЕНЬЕ', 'ПОНЕДЕЛЬНИК', 'ВТОРНИК', 'СРЕДА', 'ЧЕТВЕРГ', 'ПЯТНИЦА', 'СУББОТА');
Begin
Clrscr;
Writeln('*** Определение дня недели ***');
Writeln('*** по введенной вами дате ***');
Writeln;
Write('Введите день месяца:   ');
Readln(D);
Write('Введите номер месяца:  ');
Readln(M);
Write('Введите полностью год: ');
Readln(Y);
Writeln;
If M > 2	Then		M := M - 2
		Else	Begin	M := M + 10;
				Y := Y - 1;
			End;
W := D + (13 * M - 1) Div 5 + (Y Mod 100) Div 4 + Y Mod 100;
W := ( W + Y Div 400 - 2 * (Y Div 100) ) Mod 7;
If W < 0 Then W := W + 7;
Writeln('Введенной вами дате соответствует: ',Z[W]);
Readln;
End.