1) Как вычислить конечную дату ?
Задача: У Васи Пупкина неожиданно сломался компьютер. Из-за отсутствия нужных материалов на ремонт понадобится N дней. Определите дату окончания ремонта, если известно, что компьютер сломался в текущем году, и ремонт должен закончиться тоже в этом году...

Function GetInteger(s: String): Integer;
 Var i, Err: Integer;
 Begin
   If s[1] = '0' Then Delete(s, 1, 1);
   Val(s, i, Err); GetInteger := i
 End;

Const
 CurrYear = 2004;
 DayInMonth: Array[1 .. 12] Of Byte =
   (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

(*
{ Тестировалось с этими данными }
Const
 Repair: Integer = 50;
 st: String = '21.06';
*)
Var
 Day, Month, DaysBefore: Integer;
 p, i: Byte;
Var
 Repair: Integer;
 st: String;
begin
 Inc(DayInMonth[2], Byte((CurrYear mod 4) = 0) and
                         not (((CurrYear mod 100) = 0) and ((CurrYear mod 400) <> 0));
 Write('Дата поломки > '); ReadLn(st);
 Write('Длительность ремонта > '); ReadLn(Repair);

 p := Pos('.', st);
 Day := GetInteger( Copy(st, 1, Pred(p)) );
 Month := GetInteger( Copy(st, Succ(p), Length(st)-p) );

 For i := 1 To Pred(Month) Do
   Inc(DaysBefore, DayInMonth[i]);
 Inc(DaysBefore, Day);

 Inc(DaysBefore, Repair);
 i := 1;
 While DaysBefore > DayInMonth[i] Do
   Begin
     Dec(DaysBefore, DayInMonth[i]); Inc(i)
   End;
 WriteLn('Ремонт закончится: ', DaysBefore, '.', i);
end.

by Volvo

Еще один вариант

program Lab8_02_2;
uses crt,dos;
var
 q:char;
 data:record
   day,year,months:word;
 end;
 j:integer;
 week:word;
 m:integer;
 g:word;

const
 month:array[1..12] of string[7] =
   ('января','февраля','марта','апреля','мая','июня','июля',
     'августа','сентябя','октября','ноября','декабря');
 a:array[1..12] of integer =
   (31,29,31,30,31,30,31,31,30,31,30,31);

begin
 repeat
   clrscr;
   getdate(data.year,data.months,data.day,week);
   g:=data.months;
   writeln('Сегодняшняя дата: ',data.day,' ',month[g]);
   writeln('введите число m через которое вы хотите узнать дату:');
   read(m);
   j:=m;
   while j<>0 do begin
     if j>a[data.months]-data.day then begin
       j:=j-(a[data.months]-data.day);
       inc(data.months);
       data.day:=0;
     end

     else begin
       data.day:=data.day+j; break;
     end;
   end;

   g:=data.months;
   writeln('Дата дня и месяц: ',data.day,' ',month[g] );
   write('Вычислить еще ?(Y/N)');
   q:=ReadKey;
 until not (q in ['Y','y']);
end.

by Amro

2) Задача про старокитайский календарь
В старокитайском календаре был принят 60-летний цикл состоящий из 5 двенадцатилетних подциклов. Подциклы обозначались названиями цвета:
• Зеленый
• Красный
• Желтый
• Белый
• Черный
Внутри каждого подцикла годы получили название животных:
• Крыса
• Корова
• Тигр
• Заяц
• Дракон
• Змея
• Лошадь
• Овца
• Обезьяна
• Курица
• Собака
• Свинья
(К примеру 1984–год зеленой крысы - был началом очередного цикла). Написать программу, которая вводит номер некоторого года нашей эры и печатает его название по старояпонскому календарю.

var

  y : array [0..11] of string =

  (
    'Rat',
    'Cow',
    'Tiger',
    'Rabbit',
    'Dragon',
    'Snake',
    'Horse',
    'Sheep',
    'Monkey',
    'Chicken',
    'Dog',
    'Pig'
  );

  d : array[0..4] of string =

  (
    'Green',
    'Red',
    'Yellow',
    'White',
    'Black'
  );


  year:Integer;

begin

   writeln('Input year'); readln(year);

   year := (year mod 60)-4;

   If year<0 then year := year+60;

   writeln(d[year div 12],' ',y[year mod 12]);

end.

by Idea

Модуль для работы с календарем

{
  Calendar.pas 

  Набор функций для работы с датами и вычислений по календарю.
  Автор:  Виктор Осташев
  Fido:   2:5020/1194
  E-mail: v_ostashev@chat.ru
  WWW: _http://ostashev.newmail.ru
}

function datein(low, high, dt : tdate) : boolean;
{ Проверяет нахождение даты в промежутке между low и high }

procedure stringtodate(st : string; var dt : tdate);
{ Преобразует строку в дату }

procedure datetostring(dt : tdate; var st : string);
{ Преобразует дату в строку }

function compdate(d1, d2 : tdate) : integer;
{
  Сравнивает две даты. Возвращает:
    0, если даты равны;
    -1, если первая дата меньше второй;
    1, если вторая дата меньше первой
}

function numofday(dat : tdate; style : tstyle) : longint;
{ Вычисляет условный номер дня для даты dat
   с учетом нового стиля при style=true }

function dayofweek(dat : tdate; style : tstyle) : byte;
{ Вычисляет день недели для даты dat с
   учетом нового стиля при style=true }

function numinyear(dat : tdate; style : tstyle) : word;
{ Вычисляет номер дня от начала года с учетом стиля }

function lenofmonth(month: byte; year: word; style: tstyle): byte;
{ Вычисляет длину месяца с учетом стиля }

procedure numtodate(num: longint; style: tstyle; var dat: tdate);
{ Вычисляет дату по данному номеру дня }

function isleap(year : integer):boolean;
{ Является ли год високосным }

программа исправлена, готовится еще более компактная версия, и фатально короткая версия))
Как определить количество дней прошедших между двумя датами ? Вот такой мой вариант, предлагайте свои, о найденных ошибках сообщайте сюда: Собираем Ошибки!

const
  day_in_month: array [boolean, 1 .. 12] of word = (
   (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
   (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
  );

  day_in_year: array [boolean] of word = (365, 366);

function is_leap(const year: word): boolean;
begin
  is_leap := (year mod 4 = 0) and not((year mod 100 = 0) and (year mod 400 <> 0));
end;

function to_next_month(var year, month, day: word): word;
var
  days: word;
begin
  days := day_in_month[is_leap(year), month] - day + 1;

  if month < 12 then inc(month) else begin
    month := 1;
    inc(year);
  end;

  day := 1;

  to_next_month := days;
end;

function days_between(const start_year, start_month, start_day,
 final_year, final_month, final_day: word): word;
var
  year, month, day, days: word;
begin
  days := 0;

  if (start_year = final_year) and (start_month = final_month) then
    days := final_day - start_day else begin
    year  := start_year;
    month := start_month;
    day   := start_day;

    while (year < final_year) or (month < final_month) do inc(days, to_next_month(year, month, day));

    days := days + final_day - 1;
  end;

  days_between := days;
end;

var
  start_year, start_month, start_day: word;
  final_year, final_month, final_day: word;
begin


  start_year  := 1986;
  start_month := 12;
  start_day   := 19;

  final_year  := 2088;
  final_month := 7;
  final_day   := 15;

  writeln(days_between(start_year, start_month, start_day,
   final_year, final_month, final_day));
end.