Процедура добавления к дате определенного количества дней

[W. Aron]

Вечер добрый. Второй день пытаюсь найти ошибку в программе, но безысходно: С клавиатуры вводится дата (число, месяц, год) и количество дней, которое надо прибавить к текущей дате.
Процедура вполне успешно прибавляет дни...проблема в прибавлении месяцев и, как следствие, год. Вот код:

program updownday;
var a,b,c,d,a1,b1,c1,d1:integer;
procedure Udd (z1,x1,y1,w1:integer; var z,x,y,w:integer);
begin{1}
 begin{2}
  if (w1>31) and (x1<>2) and ((x1=1) or (x1=3) or (x1=5) or (x1=7) or (x1=8) or (x1=10) or (x1=12)) then
   begin
    z1:=(z1+w1)-31;
    x1:=x1+1;
    w1:=0;
   end else

  if (w1>30) and (x1<>2) and ((x1=4) or (x1=6) or (x1=9) or (x1=11)) then
   begin
   z1:=(z1+w1)-30;
   x1:=x1+1;
   w1:=0;
   end else

  if (w1>28) and (x1=2) then
   begin
   z1:=(z1+w1)-28;
   x1:=x1+1;
   w1:=0;
   end else

  if (w1>29) and (x1=2) and (y1 mod 4=0) then
   begin
   z1:=(z1+w1)-29;
   x1:=x1+1;
   w1:=0;
   end else
  begin
  z1:=z1+w1;
  w1:=0;
  end;
 end;{2}
begin
 if x1>12 then
   begin
    y1:=y1+1;
    x1:=1;
   end;
end;
if z1>31 then
begin
w1:=z1; z1:=0;
 begin
  Udd (z1,x1,y1,w1,z,x,y,w);
 end;
end else z:=z1;
x:=x1;
y:=y1;
end;{1}

begin
writeln;
writeln('Date through a blank and Quantity of days');
read(a,b,c,d);
Udd(a,b,c,d,a1,b1,c1,d1);
write(a1,'.',b1,'.',c1);
readln;
ReadLN;
end.

В программе учтены особенности месяцев, и особенно февраля.



___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

[Serge_Bliznykov]

ОМГ...
я бы очень рекомендовал Вам воспользоваться функциями перевода даты в юлианскую (это число дней, прошедших от определённой заданной даты, т.е. ЧИСЛО). прибавление к этому числу нужное количество дней и переведите дату обратно в обычный формат.



примерно так:

{*                    OPDATE.PAS 1.21                    *}
{*     Copyright (c) TurboPower Software 1988, 1992.     *}

function IsLeapYear(Year: Integer): Boolean;
    {-Return True if Year is a leap year}
begin
  IsLeapYear := (Year mod 4 = 0)
    and (Year mod 4000 <> 0) and
    ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;


function DaysInMonth(Month, Year: Integer): Integer;
    {-Return the number of days in the specified month of a given year}
begin
  case Month of
    1, 3, 5, 7, 8, 10, 12:
      DaysInMonth := 31;
    4, 6, 9, 11:
      DaysInMonth := 30;
    2:
      DaysInMonth := 28 + Ord(IsLeapYear(Year));
  else
    DaysInMonth := 0;
  end;
end;

function ValidDate(Day, Month, Year: Integer): Boolean;
    {-Verify that day, month, year is a valid date}
begin

  if (Day < 1) or (Year < 1600) or (Year > 3999) then
    ValidDate := False
  else case Month of
      1..12:
        ValidDate := Day <= DaysInMonth(Month, Year);
    else
      ValidDate := False;
    end
end;


function Date2julian(pDay, pMonth, pYear: integer): longint;
var
  month, day, year: longint;
  ta, tb, tc: longint;
begin
  month := pMonth;
  day := pDay;
  year := pYear;
  if month > 2 then
    month := month - 3
  else
  begin
    month := month + 9;
    year := year - 1;
  end;
  ta := 146097 * (year div 100) div 4;
  tb := 1461 * (year mod 100) div 4;
  tc := (153 * month + 2) div 5 + day + 1721119;
  Date2julian := ta + tb + tc
end;

procedure Julian2date (julian : longint; var pDay, pMonth, pYear : integer);
{Получает значение и возвращает дату в переменные pDay, pMonth, pYear}
var
  x,y,d,m : longint;
begin
  x := 4 * julian - 6884477;
  y := (x div 146097) * 100;
  d := (x MOD 146097) div 4;
  x := 4 * d + 3;
  y := (x div 1461) + y;
  d := (x MOD 1461) div 4 + 1;
  x := 5 * d - 3;
  m := x div 153 + 1;
  d := (x MOD 153) div 5 + 1;
  if m < 11 then
    pMonth := m + 2
  else
    pMonth := m - 10;
  pDay := d;
  pYear := y + m div 11;
end;

var
  a, b, c, q, a1, b1, c1 : integer;
  D1 : Longint;
begin
  WriteLn('Введите дату (три числа: день месяц год) : ');
  Readln(a, b, c);
  if not ValidDate(a, b, c) then begin
    WriteLn('Ошибка! Вы ввели не существующую дату!');
    WriteLn('Bye!');
    Readln;
    Halt(1);
  end;
  WriteLn('Введите количество дней, которое нужно добавить: ');
  Readln(q);

  Julian2date ( Date2julian(a, b, c) + q, a1, b1, c1);


  write('Полученная дата: ',a1,'.',b1,'.',c1);

  Readln;
end.

[W. Aron]

Вот значит как... Спасибо большое, буду разбираться, поскольку с процедурами и функциями у меня туговато)

[Serge_Bliznykov]

Угу. пожалуйста!

и ещё, когда будете разбираться, то функции IsLeapYear и DaysInMonth (вообще полезные весьма) в данном коде используются только для работы функции ValidDate - которая проверяет, нормальную ли дату внёс пользователь.

в принципе, если эту проверку написать по другому (или вообще выкинуть) - тогда код уменьшится...

[W. Aron]

В начале я никак не понимал работу вот этой строчки в функции ValidDate:

if (Day < 1) or (Year < 1600) or (Year > 3999) then
    ValidDate := False

А теперь хочу уточнить: в этой функции ведь специально присваивается значение False для правильной даты? Поскольку в основной программе стоит

if not ValidDate(a, b, c)

то оно становится истинным и идет переход к вводу дней, на которые надо прибавить дату, так?
И процедуры Date2julian и Julian2date. Пока я хочу сам в них разобраться))
Но если не получится, то прошу пожалуйста объяснить откуда такие большие числа и такие вычисления...

[Serge_Bliznykov]

то оно становится истинным и идет переход к вводу дней, на которые надо прибавить дату, так?

всё с точность до наоборот.
ValidDate (в переводе с английского "валидная" = корректная дата) принимает значение True (истина) только в том случае, когда дата корректная/допустимая.

Очевидно, что когда дата имеет номер дня меньше единицы, или года до 1600 или год больше 3999 - то дата - недопустимая.
фунция вернёт False.
if Not ValidDate (Not False - это True):
- если дата не является допустимой, то
then begin
WriteLn('Ошибка! Вы ввели не существующую дату!');
программа выдаст сообщение об ошибке...

И процедуры Date2julian и Julian2date. Пока я хочу сам в них разобраться))
Но если не получится, то прошу пожалуйста объяснить откуда такие большие числа и такие вычисления...

даже и не пытайтесь.
Эти вычисления сделаны за нас с Вами (кем именно я не знаю и даже боюсь предположить...). И суть этих "магических" манипуляций в том, что они работают! А уж как их вывели, почему использовались именно такие константы и вычисления - это весьма замудрённая задачка. и не стоит расшибать лоб в поисках вывода. Этим формулам точно десятилетия (и я не удивлюсь, если им столетия!).
сошлитесь на то, что Вы их нашли в интернете. (кстати, это действительно так, я взял эти функции в интернете). Или в книжке (помню много лет назад видел книжку, посвящённую календарям, там присутствовали формулы перевода даты. Не поручусь, что формулы и константы на 100% были такими же, но было что-то весьма и весьма похожее!

[W. Aron]

Ай... Вот что значит слишком увлекся)) я брал все три параметра (сказывается дискретная математика), в то время как программа берет один из трех, что Вы мне собственно и напомнили.
Что же до формул, то тут я их тоже на одном из сайтов про юлианский календарь нашел. Просто само понятие юлианский календарь оказалось для меня новым), и еще я хотел найти в этих функциях где прибавляются добавленные дни, что бы отнять их, например (0:29-момент когда я нашел, где это. аж самому смешно со своей глупости).
ta, tb, tc получается для разбиения формулы переведения даты...

Спасибо, что терпеливо мне все разъяснили. Сейчас я очень жалею, что информатики в школе как таковой считай и не было, а нам тогда было все равно есть она или нет...