Can somebody tell smth new abot format of output.
Or better about my program

const dnimes:array[1..12] of longint=(31,28,31,30,31,30,31,31,30,31,30,31);
var max,kol,den,perdeny,i,j,d,m,y:longint;
    a:array[1..7,1..33] of char;
    r:real;
function koldnye(ye:longint):longint;
begin
  if ye mod 400=0 then koldnye:=366
  else if ye mod 100=0 then koldnye:=365
       else if ye mod 4=0 then koldnye:=366
            else koldnye:=365;
end;
function koldnmes(ye,mes:longint):longint;
var h:longint;
begin
  if mes<>2 then koldnmes:=dnimes[mes]
  else if ye mod 400=0 then koldnmes:=dnimes[mes]+1
       else if ye mod 100=0 then koldnmes:=dnimes[mes]
            else if ye mod 4=0 then koldnmes:=dnimes[mes]+1
                 else koldnmes:=dnimes[mes];
end;
begin
  assign(output,'out.txt');rewrite(output);
  read(d);
  read(m);
  read(y);
  for i:=1 to 7 do
    for j:=4 to 33 do
      a[i,j]:=' ';
  a[1,1]:='m';a[1,2]:='o';a[1,3]:='n';
  a[2,1]:='t';a[2,2]:='u';a[2,3]:='e';
  a[3,1]:='w';a[3,2]:='e';a[3,3]:='d';
  a[4,1]:='t';a[4,2]:='h';a[4,3]:='u';
  a[5,1]:='f';a[5,2]:='r';a[5,3]:='i';
  a[6,1]:='s';a[6,2]:='a';a[6,3]:='t';
  a[7,1]:='s';a[7,2]:='u';a[7,3]:='n';
  perdeny:=6;
  if y>=2005 then
    for i:=2005 to y-1 do
      perdeny:=(perdeny+koldnye(i)-1) mod 7+1
  else
    for i:=2004 downto y do
      perdeny:=(perdeny+371-koldnye(i)-1) mod 7+1;
  for i:=1 to m-1 do
    perdeny:=(perdeny-1+dnimes[i]) mod 7+1;
  den:=perdeny;kol:=1;
  for i:=1 to koldnmes(y,m) do begin
    if i=d then
      {if i>=10 then} begin
        a[den,3+5*kol]:=']';
        a[den,5*kol]:='[';
      end;
{      else begin
        a[den,3+5*kol]:=']';
        a[den,1+5*kol]:='[';
      end;}
    if i<=9 then begin
      a[den,2+5*kol]:=chr(i+ord('0'));;
      if den=7 then begin inc(kol);den:=1;end
      else den:=den+1;
    end
    else begin
      a[den,2+5*kol]:=chr(i mod 10+ord('0'));
      a[den,1+5*kol]:=chr(i div 10+ord('0'));
      if den=7 then begin inc(kol);den:=1;end
      else den:=den+1;
    end;
  end;
  {if kol=5 then r:=r/(r-r);}
{  max:=1;
  for i:=1 to 7 do begin
    j:=33;
    while a[i,j]=' ' do dec(j);
    for max:=1 to j do
      write(a[i,max]);
    writeln;
  end;}
  for i:=1 to 7 do begin
    for j:=1 to 33 do
      write(a[i,j]);
    writeln;
  end;
end.

Edited by author 12.03.2005 02:50

Edited by author 12.03.2005 02:51