FAQ VCL
Дата и время

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как представить TDateTime в виде лет/месяцев/недель/дней/часов/минут/секунд/милисекунд?

// Способ первый
uses
  {...,} System.TimeSpan;

procedure TForm1.Button1Click(Sender: TObject);
begin
   // 0 дней 2:30:00
   // Перевод в дни
   ShowMessage(Trunc(TTimeSpan.Create(0, 2, 30, 0, 0).TotalDays).ToString);
   // Перевод в часы
   ShowMessage(Trunc(TTimeSpan.Create(0, 2, 30, 0, 0).TotalHours).ToString);
   // Перевод в минуты
   ShowMessage(Trunc(TTimeSpan.Create(0, 2, 30, 0, 0).TotalMinutes).ToString);
   // Перевод в секунды
   ShowMessage(Trunc(TTimeSpan.Create(0, 2, 30, 0, 0).TotalSeconds).ToString);
   // Перевод в милисекунды
   ShowMessage(TTimeSpan.Create(0, 2, 30, 0, 0).TotalMilliseconds.ToString);
end;

// Способ второй
uses
  {...,} System.DateUtils;

procedure TForm1.Button2Click(Sender: TObject);
begin
   // Перевод в года
   ShowMessage(YearsBetween(0, Now).ToString);
   // Перевод в месяцы
   ShowMessage(MonthsBetween(0, Now).ToString);
   // Перевод в недели
   ShowMessage(WeeksBetween(0, Now).ToString);
   // Перевод в дни
   ShowMessage(DaysBetween(0, Now).ToString);
   // Перевод в часы
   ShowMessage(HoursBetween(0, Now).ToString);
   // Перевод в минуты
   ShowMessage(MinutesBetween(0, Now).ToString);
   // Перевод в секунды
   ShowMessage(SecondsBetween(0, Now).ToString);
   // Перевод в милисекунды
   ShowMessage(MilliSecondsBetween(0, Now).ToString);
end;


Как вывести дату в формате "27 Февреля 2009" (со склонением месяца)?

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);

  function FormatDate(Year, Month, Day: Dword): string;
  const
    Mes: array[1..12] of string = (
      'января', 'февраля', 'марта', 'апреля', 'мая', 'июня',
      'июля', 'августа', 'сентября', 'октября', 'ноября', 'декабря');
  begin
     Result := IntToStr(Day) + ' ' + Mes[Month] + ' ' + IntToStr(Year) + ' г.';
  end;

begin
   ShowMessage(FormatDate(2017, 05, 30));
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);

  function FormatDate(Year, Month, Day: Dword): string;
  var
    SysTime: TSystemTime;
    Buffer: array[0..1023] of Char;
  begin
     SysTime.wYear := Year;
     SysTime.wMonth := Month;
     SysTime.wDay := Day;
     SetString(Result, Buffer, GetDateFormat(LOCALE_SYSTEM_DEFAULT,
        DATE_LONGDATE, @SysTime, nil, Buffer, SizeOf(Buffer)));
  end;

begin
   ShowMessage(FormatDate(2017, 05, 30));
end;

// Способ третий
function GetFormatDate(dt: TDate; Format: string): string;
var
  cchDate: Integer;
  st: TSystemTime;
  y, m, d: Word;
begin
   Result := '';
   GetSystemTime(st);
   DecodeDate(dt, y, m, d);

   st.wYear := y;
   st.wMonth := m;
   st.wDay := d;

   cchDate := GetDateFormat(LOCALE_USER_DEFAULT, 0, @st, PChar(Format), nil, 0);
   if cchDate > 0 then
   begin
      SetLength(Result, cchDate-1); // убираем символ #0 в конце строки
      GetDateFormatW(LOCALE_USER_DEFAULT, 0, @st, PChar(Format), PWideChar(Result), cchDate);
   end;
end;

procedure TForm1.Button1Click(Sender TObject);
begin
   ShowMessage(GetFormatDate(Date, 'd MMMM'));
   ShowMessage(GetFormatDate(Date + 1, 'dd MMMM yyyy'));
end;


Как прибавить час к текущему времени?

// Способ первый
procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Label1.Caption := TimeToStr(Time);
   Label2.Caption := TimeToStr(Time + 1/24);
end;

// Способ второй
uses
  DateUtils;

procedure TForm1.Button1Click(Sender: TObject);
begin
   Label1.Caption := TimeToStr(Time);
   Label2.Caption := TimeToStr(IncHour(Time));
   // Похожие функции в DateUtils:
   //  • IncYear
   //  • IncWeek
   //  • IncDay
   //  • IncMinute
   //  • IncSecond
   //  • IncMilliSecond
end;


Как получить первый день предыдущего месяца?

function FirstDayOfPrevMonth: TDateTime;
var
  Year, Month, Day: Word;
begin
   DecodeDate(Date, Year, Month, Day);
   Day := 1;
   if Month > 1 then
      Dec(Month)
   else
   begin
      Dec(Year);
      Month := 12;
   end;
   Result := EncodeDate(Year, Month, Day);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(DateToStr(FirstDayOfPrevMonth));
end;


Как получить первый день следующего месяца?

function FirstDayOfNextMonth: TDateTime;
var
  Year, Month, Day: Word;
begin
   DecodeDate(Date, Year, Month, Day);
   Day := 1;
   if Month < 12 then
      Inc(Month)
   else
   begin
      Inc(Year);
      Month := 1;
   end;
   Result := EncodeDate(Year, Month, Day);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(DateToStr(FirstDayOfNextMonth));
end;


Как посчитать разницу между двумя датами?

procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);

  function DaysPerMonth(AYear, AMonth: Integer): Integer;
  const
    DaysInMonth: array[1..12] of Integer =
      (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  begin
     Result := DaysInMonth[AMonth];
     if (AMonth = 2) and IsLeapYear(AYear) then
        Inc(Result);
  end;

var
  DtSwap: TDateTime;
  Day1, Day2, Month1, Month2, Year1, Year2: Word;
begin
   if Date1 > Date2 then
   begin
      DtSwap := Date1;
      Date1 := Date2;
      Date2 := DtSwap;
   end;
   DecodeDate(Date1, Year1, Month1, Day1);
   DecodeDate(Date2, Year2, Month2, Day2);
   Years := Year2 - Year1;
   Months := 0;
   Days := 0;
   if Month2 < Month1 then
   begin
      Inc(Months, 12);
      Dec(Years);
   end;
   Inc(Months, Month2 - Month1);
   if Day2 < Day1 then
   begin
      Inc(Days, DaysPerMonth(Year1, Month1));
      if Months = 0 then
      begin
         Dec(Years);
         Months := 11;
      end
      else
         Dec(Months);
   end;
   Inc(Days, Day2 - Day1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Days, Months, Years: Word;
begin
   DateDiff(DateTimePicker1.Date, DateTimePicker2.DateTime, Days, Months, Years);
   ShowMessage(Format('Days: %d'#13'Months: %d'#13'Years: %d', [Days, Months, Years]));
end;


Как увеличить дату на определенное количество дней/месяцев/лет?

function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;

  function DaysPerMonth(AYear, AMonth: Integer): Integer;
  const
    DaysInMonth: array[1..12] of Integer =
      (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  begin
     Result := DaysInMonth[AMonth];
     if (AMonth = 2) and IsLeapYear(AYear) then
        Inc(Result);
  end;

var
  D, M, Y: Word;
  Day, Month, Year: Longint;
begin
   DecodeDate(ADate, Y, M, D);
   Year := Y;
   Month := M;
   Day := D;
   Inc(Year, Years);
   Inc(Year, Months div 12);
   Inc(Month, Months mod 12);
   if Month < 1 then
   begin
      Inc(Month, 12);
      Dec(Year);
   end
   else
   if Month > 12 then
   begin
      Dec(Month, 12);
      Inc(Year);
   end;
   if Day > DaysPerMonth(Year, Month) then
      Day := DaysPerMonth(Year, Month);
   Result := EncodeDate(Year, Month, Day) + Days + Frac(ADate);
end;

function IncDay(ADate: TDateTime; Delta: Integer): TDateTime;
begin
   Result := IncDate(ADate, Delta, 0, 0);
end;

function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
begin
   Result := IncDate(ADate, 0, Delta, 0);
end;

function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
begin
   Result := IncDate(ADate, 0, 0, Delta);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(DateToStr(IncDate(DateTimePicker1.Date, 1, 1, 1)));
end;


Как увеличить время на определенное количество часов/минут/секунд/милисекунд?

function IncTime(ATime: TDateTime; Hours, Minutes, Seconds,
  MSecs: Integer): TDateTime;
begin
   Result := ATime + (Hours div 24) + (((Hours mod 24) * 3600000 +
      Minutes * 60000 + Seconds * 1000 + MSecs) / MSecsPerDay);
   if Result < 0 then Result := Result + 1;
end;

function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
begin
   Result := IncTime(ATime, Delta, 0, 0, 0);
end;

function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
begin
   Result := IncTime(ATime, 0, Delta, 0, 0);
end;

function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
begin
   Result := IncTime(ATime, 0, 0, Delta, 0);
end;

function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
begin
   Result := IncTime(ATime, 0, 0, 0, Delta);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(DateTimeToStr(IncTime(DateTimePicker1.Date, 1, 1, 1, 0)));
end;


Как проверить дату на корректность?

function IsValidDate(D, M, Y: Word): Boolean;

  function DaysPerMonth(AYear, AMonth: Integer): Integer;
  const
    DaysInMonth: array[1..12] of Integer =
      (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  begin
     Result := DaysInMonth[AMonth];
     if (AMonth = 2) and IsLeapYear(AYear) then
        Inc(Result);
  end;

begin
   Result := (Y >= 1) and (Y <= 9999) and (M >= 1) and (M <= 12) and
      (D >= 1) and (D <= DaysPerMonth(Y, M));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if IsValidDate(29, 02, 2020) then
      ShowMessage('Верная дата')
   else
      ShowMessage('Неверная дата');
end;


Как узнать количество дней в заданном периоде?

function DaysInPeriod(Date1, Date2: TDateTime): Longint;
begin
   Result := Abs(Trunc(Date2) - Trunc(Date1)) + 1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(IntToStr(DaysInPeriod(DateTimePicker1.Date, DateTimePicker2.Date)));
end;

При использовании материала - ссылка на сайт обязательна