VPF::Как же нам расчитать стаж? - Форум программистов

Rambuz

Дата 26.1.2009, 15:42 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 10
Регистрация: 24.8.2007

Репутация: нет
Всего: нет

Тема не новая и часто такой вопрос поднимается на многих форумах.
А в чем собственно проблема? Ведь на самом деле в стаже учитывается только количество полных лет. Но так уж повелось, что надо обязательно знать точное количество лет, месяцев и дней.
Мне пару недель назад тоже потребовалось посчитать стаж и я взялся за изучение интернета. Там я набрел на мысль по поводу функциии в 1С "РазобратьРазностьДат()", ничего лучше я придумать не смог smile

.
Дело оставалось за малым: найти функцию и переложить ее на Delphi. Чем я и занялся.

Собственно задача состоит из двух этапов.
1. Т.к. в Delphi я не нашел функции добавления месяца к дате, то пришлось написать ее самому.
Итак...

Код


...
uses Math, DateUtils...;
...
// Прибавление к дате месяцев. В ANumberOfMonths будем указывать количество месяцев, 
// можно и отрицательное число, в таком случае месяцы будут отниматься.
function MyIncMonth(const AValue : TDateTime; const ANumberOfMonths : Integer = 1) : TDateTime;
var Ayear, Amonth, Aday : Word;
    year, month, day : Integer;
begin
  Result := AValue;
  DecodeDate(AValue, Ayear, Amonth, Aday);
  {из-за того что тип Word не принимает отрицательных значений
  присваиваем значения переменным типа Integer}
  year := Ayear;
  month := Amonth;
  day := Aday;

  month := month + ANumberOfMonths;
  if month > 12 then
    begin
      while month > 12 do
        begin
          month := month - 12;
          year := year + 1;
        end;
    end
  else
    if month < 0 then
      begin
        while month < 0 do
          begin
            month := month + 12;
            year := year - 1;
          end;
      end
    else
      if month = 0 then
        begin
          month := 12;
          year := year - 1;
        end;
  if Day > DayOf(EndOfTheMonth(EncodeDate(year, month, 01))) then
    Day := DayOf(EndOfTheMonth(EncodeDate(year, month, 01)));
// ну и проверка даты на валидность, как же без этого
  if IsValidDate(year, month, day) then
    Result := EncodeDate(year, month, day);
end;

Кажись работает smile

2. Теперь займемся расчетом нашего стажа

Код


// Вычисление стажа
procedure TDM.CalcStage(Date1, Date2: TDateTime);
{Date1 - начало периода расчета,
Date2 - конец периода расчета, обычно текущая дата}
var
  years, months, days : Word;
  CurDate : TDateTime;
begin
  years := 0;
  months := 0;
  days := 0;
  if Date2 > Date1 then
    begin
      CurDate := Date2;
      if DayOf(CurDate) < DayOf(Date1) then
        begin
          Days := Round(CurDate - MyIncMonth(CurDate, -1))-1;
          CurDate := MyIncMonth(CurDate, -1);
        end;
      if MonthOf(CurDate) < MonthOf(Date1) then
        begin
          CurDate := MyIncMonth(CurDate, -12);
          Months := 12; {Месяцев = 12;}
        end;
      Years := Max(YearOf(CurDate)-YearOf(Date1), 0);
      Months := Max(Months+MonthOf(CurDate)-MonthOf(Date1), 0);
          Days := Max(Days+DayOf(CurDate)-DayOf(Date1), 0);

      {скорректируем отображаемое значение, если "вмешалось" разное количество дней в месяцах}
      if Date1 <> (IncDay(MyIncMonth(Date2, -Years*12-Months),-Days)) then 
        Days := Days + (DayOf(EndOfTheMonth(Date1)) - DayOf(StartOfTheMonth(Date1))) - (DayOf(EndOfTheMonth(MyIncMonth(Date2, -1))) - DayOf(StartOfTheMonth(MyIncMonth(Date2, -1)))); 
    end;

  Result := IntToStr(years)+'-'+IntToStr(months)+'-'+IntToStr(days);
end;

На этом этапе задачу можно считать решенной.
Но на всякий случай ма-а-аленькая полезность в виде функции сложения стажей.
Маленькое замечание, опять же. На самом деле, сложение стажей, как мне кажется, задача более сложная, чем просто вычисление стажа, потому что нет конкретных дат по которым этот стаж расчитывать. Но ПФР рекомендовал брать количество дней в месяце, равным 30. Это вносит погрешность в расчет, но по крайней мере хоть что-то.

Код


{Функция сложения стажей. Если брать количество дней в месяце = 30.
Входные параметры:
CSYears, CSMonths, CSDays - текущий стаж,
SIYears, SIMonths, SIDays - предыдущий стаж }
function TDM.StagePlusStage(CSYears, CSMonths, CSDays, SIYears, SIMonths,
SIDays : Integer) : String;
var
  years, months, days : Integer;
begin
  years := CSYears + SIYears;
  months := CSMonths + SIMonths;
  days := CSDays + SIDays;
  if days >30 then
    while days > 30 do
      begin
        days := days - 30;
        months := months + 1;
      end;
  if months >= 12 then
    while months >= 12 do
      begin
        months := months -12;
        years := years + 1;
      end;

  Result := IntToStr(years)+'-'+IntToStr(months)+'-'+IntToStr(days);
end;

Не могу гарантировать, что код не содержит ошибок, я его вытаскивал из исходников и правил прямо в браузере. На предмет правильности расчетов могу сказать что считает стаж правльно, проверено.

Принимаю ваши предложения и замечания, будет полезно.

Это сообщение отредактировал(а) Rambuz - 26.1.2009, 19:02

Poseidon

Дата 26.1.2009, 20:14 (ссылка)

(голосов:3)

Загрузка ...

Delphi developer

Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 53
Всего: 133

Цитата(Rambuz @ 26.1.2009, 15:42

)

Т.к. в Delphi я не нашел функции добавления месяца к дате, то пришлось написать ее самому.

Видишь суслика? А он есть smile

Модуль DateUtils, функция IncMonth.

А вообще модуль DateUtils предоставляет очень хорошие функции для твоих вечислений: YearsBetween, MonthsBetween, DaysBetween, еще пригодится DaysInYear. Все может быть гораздо проще.

--------------------

Если хочешь, что бы что-то работало - используй написанное,
если хочешь что-то понять - пиши сам...

Rambuz

Дата 27.1.2009, 20:35 (ссылка)

(голосов:2)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 10
Регистрация: 24.8.2007

Репутация: нет
Всего: нет

Хм, действительно, есть такая функция IncMonth, только вот искал я ее в DateUtils, а находится она почему-то в SysUtils!
А с другой стороны самостоятельная работа для общего развития не повредит. smile

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »