Показать сообщение отдельно
  #9  
Старый 30.05.2011, 00:03
Аватар для KOOL
KOOL KOOL вне форума
Активный
 
Регистрация: 06.01.2008
Адрес: Рязань
Сообщения: 306
Версия Delphi: 2009
Репутация: 6150
По умолчанию

1 января - 1-й день, значит, чтобы узнать дату k-го дня, надо прибавить к нему k-1 дней. Например, вот так:
Код:
procedure DateDaysSum(var D1:Date; Days:integer);
var buf:word;
begin
  if Days>0 then
    begin
      repeat
        if (D1.D+Days>29) and (D1.M=2) and (((D1.Y mod 100=0) and (D1.Y mod 400=0))or((D1.Y mod 4=0)and(D1.Y mod 100<>0)))then
          begin
            Days:=Days-(29-D1.D+1);
            D1.D:=1;
            D1.M:=D1.M+1;
          end
        else
          if (D1.D+Days>28) and (D1.M=2) and((D1.Y mod 4<>0)or((D1.Y mod 100=0)and(D1.Y mod 400<>0)))then
            begin
              Days:=Days-(28-D1.D+1);
              D1.D:=1;
              D1.M:=D1.M+1;
            end
          else
            if ((D1.D+Days>30) and (D1.M in [4, 6, 9, 11]))then
              begin
                Days:=Days-(30-D1.D+1);
                D1.D:=1;
               D1.M:=D1.M+1;
              end
            else
              if ((D1.D+Days>31) and (D1.M in [1, 3, 5, 7, 8, 10, 12]))then
                begin
                  Days:=Days-(31-D1.D+1);
                  D1.D:=1;
                  D1.M:=D1.M+1;
                end
              else
                begin
                  D1.D:=Days+1;
                  Days:=0;
                end;
        if D1.M>12 then
          begin
            buf:=(12-D1.M+1) mod 12 + 1;
            D1.M:=buf;
            D1.Y:=D1.Y+1;
          end;
      until Days<=0;
    end;
end;
Выдергиваем из процедуры. Если числовое значение года не нужно и он всегда невисокосный - убираем проверку на него. Никаких массивов и процедур(хотя с ними было бы гораздо проще). Ну и в Date и проверке месяца заменить на перечисляемые типы:
Код:
type месяц = ( янв=1, фев, мар, апр, май, июн, июл, авг, сен, окт, ноя, дек );
     Date=record
       Y: word;
       M: месяц;
       D: 1..31;
     end;
__________________
РГРТУ - ФВТ - Системы Автоматизированного ПРоектирования. ت
Ответить с цитированием