среда, 8 декабря 2010 г.

Функция, возвращающая возраст человека (или животного, или просто возраст)

На днях перебирал свои старые исходники и наткнулся на такую функцию. Функция возвращает возраст на указанную дату по дню рождения. Возможно такая функция уже реализована где-то в общедоступных библиотеках, но на тот момент (где-то 2005 год) я такого не нашёл.

Плюс функция, для форматирования возраста в строковом представлении (на русском языке).

Вот код:

unit DelphiNotesAge;

interface

type
// склонение числа - 0 (ноль), 1 (один) или 2 (два)
TNumDeclination = (ndZero, ndOne, ndTwo);

// возвращает склонение числа
function GetNumDeclination(Num: Integer): TNumDeclination;

type
T3Strs = array [TNumDeclination] of string;

const
sYears: T3Strs = ('лет', 'год', 'года');
sMonths: T3Strs = ('месяцев', 'месяц', 'месяца');
sDays: T3Strs = ('дней', 'день', 'дня');

sShortYears: T3Strs = ('л.', 'г.', 'г.');
sShortMonths: T3Strs = ('мес.', 'мес.', 'мес.');
sShortDays: T3Strs = ('д.', 'д.', 'д.');

type
TAgeFormat = (afFull, afRoundDays, afRoundMonths);
// afFull : 15 лет 7 месяцев 24 дня
// afRoundDays : 15 лет 8 месяцев
// afRoundMonths : 16 лет

// считает возраст (количество лет, месяцев и дней между Birthday и Today)
procedure DecodeAge(const Birthday, Today: TDateTime;
var Years, Months, Days: Word);
// форматирует возраст в виде строки
function FormatAge(const Birthday, Today: TDateTime; const sY, sM, sD: T3Strs;
Format: TAgeFormat = afFull): string; overload;
function FormatAge(const Birthday, Today: TDateTime; Short: Boolean = False;
Format: TAgeFormat = afFull): string; overload;

implementation

uses
SysUtils;

function GetNumDeclination(Num: Integer): TNumDeclination;
begin
num := num mod 100;
if num > 20 then
num := num mod 10;

case num of
1: Result := ndOne;
2, 3, 4: Result := ndTwo;
else Result := ndZero; //0, 5..20:
end;
end;

procedure DecodeAge(const Birthday, Today: TDateTime; var Years, Months, Days: Word);
var
BY, BM, BD,
TY, TM, TD: Word;
dY, dM, dD: Integer;
begin
if Birthday <= Today then
begin
DecodeDate(Birthday, BY, BM, BD);
DecodeDate(Today, TY, TM, TD);
end else
begin
DecodeDate(Today, BY, BM, BD);
DecodeDate(Birthday, TY, TM, TD);
end;

dY := TY - BY;
dM := TM - BM;
dD := TD - BD;

if dD < 0 then
begin
// отнимаем один месяц
dec(dM);

// корректируем кол-во дней: добавляем кол-во дней предыдущего месяца (чтобы "выйти из нуля")
dec(TM);
if TM = 0 then
TM := 12;
dD := dD + MonthDays[IsLeapYear(TY), TM];
end;
if dM < 0 then
begin
// отнимаем 1 год
dec(dY);
// корректируем кол-во месяцев: добавляем 12 месяцев (что составляет один год)
dM := dM + 12;
end;
// if dY < 0 then raise ERangeError.Create('');

Years := dY;
Months := dM;
Days := dD;
end;

function FormatAge(const Birthday, Today: TDateTime; const sY, sM, sD: T3Strs;
Format: TAgeFormat = afFull): string;
function Add(const Left, Right: string): string;
begin
if Left <> ''
then Result := Left + ' ' + Right
else Result := Right;
end;
var
Y, M, D: Word;
begin
DecodeAge(Birthday, Today, Y, M, D);

if Format in [afRoundDays, afRoundMonths] then
begin
// Round Date To Month:
if D >= 15 then
begin
inc(M);
if M >= 12 then
begin
M := M - 12;
inc(Y);
end;
end;
D := 0;

if Format = afRoundMonths then
begin
// Round Date To Year:
if M >= 6 then
begin
inc(Y);
end;
M := 0;
end;
end;

Result := '';
if Y > 0 then
Result := Add(IntToStr(Y), sY[GetNumDeclination(Y)]);
if M > 0 then
Result := Add(Result, Add(IntToStr(M), sM[GetNumDeclination(M)]));
if D > 0 then
Result := Add(Result, Add(IntToStr(D), sD[GetNumDeclination(D)]));
end;

function FormatAge(const Birthday, Today: TDateTime; Short: Boolean = False;
Format: TAgeFormat = afFull): string;
begin
if Short
then Result := FormatAge(Birthday, Today, sShortYears, sShortMonths, sShortDays, Format)
else Result := FormatAge(Birthday, Today, sYears, sMonths, sDays, Format);
end;

end.

Пример использования:

  // Проверка склонения:
FormatAge(Now, Now - 3); // 3 дня
FormatAge(Now, Now - 300); // 9 месяцев 27 дней
FormatAge(Now, Now - 2984); // 8 лет 2 месяца 1 день
FormatAge(Now, Now - 395); // 1 год 1 месяц

// Краткий/полный формат:
FormatAge(Now, Now - 10100); // 27 лет 7 месяцев 24 дня
FormatAge(Now - 10100, Now, True);// 27 л. 7 мес. 24 д.

// Округление:
FormatAge(Now - 10100, Now, False, afFull); //27 лет 7 месяцев 24 дня
FormatAge(Now - 10100, Now, False, afRoundDays); //27 лет 8 месяцев
FormatAge(Now - 10100, Now, False, afRoundMonths);//28 лет

5 коммент.:

Aleksey Timohin комментирует...

Приятный код. Любо-дорого читать. =)
Ещё бы hard-coded strings в resourcestring-и вынести - так вообще был бы идеальный. ;)

Николай Зверев комментирует...

Ну на самом деле, просто вынести в resourcestring - этого недостаточно. На разных языках числительные по-разному влияют на склонения слов. В английском языке всё просто - есть единственное число (1 year) и множественное число (5 years).
В русском языке числительный влияют ещё и на падеж (у нас можно выделить три формы - 1 год, 2 года, 5 лет - см. GetNumDeclination). Есть языки, где всё гораздо сложнее...
Поэтому я в заметке не зря сослался на русский язык. Для большинства наших программистов этого будет достаточно. А кому надо будет, тот сможет реализовать и другие варианты FormatAge.

Aleksey Timohin комментирует...

Резонно. О том, что этот код будет работать правильно только для русского языка я и не подумал.

Анонимный комментирует...

Нужная функция! Спасибо.

Елена комментирует...

Спасибо!!!
----------
Полькина Елена

Отправить комментарий

.

.