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;