Pascal/Turbo Pascal - Calendario

program calendario;

uses

   crt, dos;

 type

   dato = record

          hayo : word;

          mese : word;

          dias : word;

          dise :  word;

        end;

      fech = array[1..2] of word;

   var

     dia, mes, ayo, disem : word;

     fecha : dato;

     cont : integer;

     fh : fech;

  procedure guardafecha;

  begin

      getdate(ayo, mes, dia, disem);

      fecha.hayo := ayo;

      fecha.mese := mes;

      fecha.dias := dia;

      fecha.dise := disem;

  end;

  procedure ponfechaanterior;

  begin

      setdate(fecha.hayo, fecha.mese, fecha.dias);

  end;

  procedure entrafecha(var fh : fech);

  var

    di, ay : word;

    x, y : integer;

  begin

      x := 20;

      y := 2;

      gotoxy(x,y);write('Entre Fecha Mes y A¤o');

      gotoxy(32,y + 1);readln(fh[1]);

      gotoxy(38,y + 1);readln(fh[2]);

  end;

  procedure ponfechaconsulta;

  const

     meses : array[1..12] of string[10] = (

     'Enero','Febrero','Marzo','Abril','Mayo','Junio',

     'Julio','Agosto','Septiembre','Octubre','Noviembre','Diciembre');

  var

    t, di, me, ay, id, ds : word;

    cadi, came : string[2];

    caay : string[4];

    x1, y1, erro : integer;

    salir : boolean;

   begin

      entrafecha(fh);

      guardafecha;

      setdate(fh[2],fh[1],1);

      id := 1;

      salir := false;

      y1 := 7;

      x1 := 20;

      gotoxy(x1 + 3,y1 - 1);write('Los Domingos [',meses[fh[1]],'] Son');

     repeat

     t := id;

     setdate(fh[2],fh[1],t);

     getdate(ay,me,t,ds);

     if ds = 0 then

     x1 := x1 + 4;

     if ds = 0 then

     begin

       textcolor(4);

       gotoxy(x1 - 4,y1 + 1);write(t);

       textcolor(15);

     end;

     id := id + 1;

     until (id > 31) or (salir = true);

     ponfechaanterior;

   end;

   begin

       clrscr;

       ponfechaconsulta;

       readln;

   end.

program ful;

  uses

     crt;

  var

    k, j, x, y : integer;

  begin

     clrscr;

      for j := 0 to 9 do

      begin

         writeln ('Ronda: k');

         writeln('J = ',j);

       for k := 0 to 9 do

       begin

        write('K = ',k,'   ');

        x := k + j;

        y := 20 - k - 1 + j;

        y := y mod 20;

        writeln(x,'  ',y);

     end;

     readkey;

     clrscr;

    end;

  end.