Программирование на Delphi

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

:: Меню ::

:: На главную ::

:: FAQ ::

:: Заметки ::

:: Практика ::

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

:: Написать ::

:: MVP ::

:: RSS ::

Как определить день недели?


procedure TForm1.Button1Click(Sender: TObject);
begin
  case DayOfWeek(Date) of
    1: Form1.Caption := 'Воскресенье';
    2: Form1.Caption := 'Понедельник';
    3: Form1.Caption := 'Вторник';
    4: Form1.Caption := 'Среда';
    5: Form1.Caption := 'Четверг';
    6: Form1.Caption := 'Пятница';
    7: Form1.Caption := 'Суббота';
  end;
end;

Как узнать номер недели данного дня в году?


// Способ первый
function WeekOfYear(ADate: TDateTime): Word;
var 
  Day: Word; 
  Month: Word;
  Year: Word; 
  FirstOfYear: TDateTime; 
begin 
  DecodeDate(ADate, Year, Month, Day);
  FirstOfYear := EncodeDate(Year, 1, 1);
  Result := Trunc(ADate - FirstOfYear) div 7 + 1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(WeekOfYear(Date)));
end;

// Способ второй
function WeekOfYear(ADate: TDateTime): Word;
var
  Year: Word;
  Month: Word;
  Day: Word;
begin
  DecodeDate(ADate + 4 - DayOfWeek(ADate + 6), Year, Month, Day);
  Result := 1 + Trunc((ADate - EncodeDate(Year, 1, 5) +
            DayOfWeek(EncodeDate(Year, 1, 3))) / 7);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(WeekOfYear(Date)));
end;

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

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(WeekOfTheYear(Date)));
end;

Как посчитать возраст человека?


// Способ первый
function CalculateAge(Birthday, CurrentDate: TDate): Integer;  
var
  Month, Day, Year,
  CurrentYear,
  CurrentMonth,
  CurrentDay: Word;
begin  
  DecodeDate(Birthday, Year, Month, Day);
  DecodeDate(CurrentDate, CurrentYear, CurrentMonth, CurrentDay);
  if (Year = CurrentYear) and (Month = CurrentMonth) and (Day = CurrentDay) then
    Result := 0;
  else
  begin
    Result := CurrentYear - Year;
    if Month > CurrentMonth then
      Dec(Result)
    else
    begin
      if Month = CurrentMonth then
        if Day > CurrentDay then
          Dec(Result);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Caption := Format('Ваш возраст %d',
             [CalculateAge(StrToDate('28.08.1979'), Date)]);
end;

// Способ второй
function AgeStr(aDate: TDateTime): string;
var
  DaysOld: Double;
  Years, Months: Integer;
begin
  DaysOld := Date - aDate;
  Years := Trunc(DaysOld / 365.25);
  DaysOld := DaysOld - (365.25 * Years);
  Months := Trunc(DaysOld / 30.41);
  Result := Format('%d лет, %d месяцев', [Years, Months]);
end;

Как определить - високосный год или нет?


// Способ первый
function LeapYear(Year: Word): Boolean;
begin
   Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if LeapYear(2004) then
    ShowMessage('Год високосный')
  else
    ShowMessage('Обычный год');
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
  if IsLeapYear(2004) then
    ShowMessage('Год високосный')
  else
    ShowMessage('Обычный год');
end;

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


// Способ первый
function DayOfMonth(dt: TDate): Integer;
var
  Year, Month, Day: Word;
  vis: Boolean;
begin
  DecodeDate(dt, Year, Month, Day);
  Result := Month;
  vis := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
  case Month of
    1, 3, 5, 7, 8, 10, 12: Result := 31;
    4, 6, 9, 11: Result := 30;
    2: if vis then
         Result := 29
       else
         Result := 28;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(DayOfMonth(Now)));
end;

// Способ второй
function DaysOfMonth(mm, yy: Integer): Integer;
begin 
  if mm = 2 then
  begin
    Result := 28;
    if IsLeapYear(yy) then Result := 29;
  end
  else
  begin
    if mm < 8 then
    begin
      if mm mod 2 = 0 then
        Result := 30
      else
        Result := 31;
    end
    else
    begin
      if mm mod 2 = 0 then
        Result := 31
      else
        Result := 30;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(DaysOfMonth(2, 2004)));
end;

// Способ третий
function DaysPerMonth(AMonth, AYear: 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;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(DaysPerMonth(9, 2017)));
end;

// Способ четвертый
uses
  Math;

// Количество дней в месяце для невисокосного года
function DaysOfMonthForNonLeapLears(x: Byte): Byte;
begin
  Result := 28 + (x + Floor(x/8)) mod 2 + 2 mod x + 2 * Floor(1/x);
end;

// Количество дней в месяце для високосного года
function DaysOfMonthForLeapLears(x: Byte): Byte;
begin
  Result := 28 + (x + Floor(x/8)) mod 2 + 2 mod x + 2 * Floor(1/x) + (not x and $D) div $D;
end;

Как получить список часовых поясов?


uses
  {...,} Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  ts: TStrings;
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones', False);
  if reg.HasSubKeys then
  begin
    ts := TStringList.Create;
    reg.GetKeyNames(ts);
    reg.CloseKey;
    for i := 0 to ts.Count-1 do
    begin
      reg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\' + ts.Strings[i], False);
      Memo1.Lines.Add(ts.Strings[i]);
      Memo1.Lines.Add(reg.ReadString('Display'));
      Memo1.Lines.Add(reg.ReadString('Std'));
      Memo1.Lines.Add(reg.ReadString('Dlt'));
      Memo1.Lines.Add('----------------------');
      reg.CloseKey;
    end;
    ts.Free;
  end
  else
    reg.CloseKey;
  reg.Free;
end;

Как узнать текущую дату и время по Гринвичу?


// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
  lt, st: TSystemTime;
begin
  GetLocalTime(lt);
  GetSystemTime(st);
  with lt do
    Memo1.Lines.Add(Format('Local Time = %.2d.%.2d.%.2d %d:%.2d:%.2d',
                           [wDay, wMonth, wYear, wHour, wMinute, wSecond]));
  with st do
    Memo1.Lines.Add(Format('GMT Time = %.2d.%.2d.%.2d %d:%.2d:%.2d',
                           [wDay, wMonth, wYear, wHour, wMinute, wSecond]));
end;

// Способ второй
function GetDateTimeGTM(AValue: TDateTime; AZoneMin: Integer = 0): TDateTime;
var
  TZ: _TIME_ZONE_INFORMATION;
  corMinutes: Integer;
begin
  GetTimeZoneInformation(TZ);
  if TZ.Bias + AZoneMin  < 0 then
    corMinutes:= (TZ.Bias + AZoneMin) * -1
  else
    corMinutes:= TZ.Bias + AZoneMin ;
  if TZ.Bias + AZoneMin  < 0 then
    Result := AValue + EncodeTime(corMinutes div 60, corMinutes mod 60, 0, 0) * -1
  else
    Result := AValue + EncodeTime(corMinutes div 60, corMinutes mod 60, 0, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(DateTimeToStr(GetDateTimeGTM(Now)));
end;

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


// Способ первый
function LastDayOfMonth(lmDate: TDateTime): TDateTime;
var
  y, m, d: Word;
begin
  DecodeDate(lmDate, y, m, d);
  m := m + 1;
  if m = 12 then
  begin
    y := y + 1;
    m := 1;
  end;
  Result := EncodeDate(y, m, 1) - 1;
end;

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

// Способ второй
function LastMDay(lmDate: TDateTime): TDateTime;

  function FirstMDay(fmDate: TDateTime): TDateTime;
  var
    fiYear, fiMonth, fiDay: Word;
  begin
    if fmDate = 0 then
      Result := fmDate
    else
    begin
      DecodeDate(fmDate, fiYear, fiMonth, fiDay);
      Result := EncodeDate(fiYear, fiMonth, 1);
    end;
  end;

begin
  if lmDate = 0 then
    Result := lmDate
  else
    Result := FirstMDay(FirstMDay(lmDate) + 35) - 1;
end;

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

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


// Способ первый
function GetDays( ADate: TDate ): Extended;
var
  FirstOfYear: TDateTime;
begin
  FirstOfYear := EncodeDate(StrToInt(FormatDateTime('yyyy', Now)) - 1, 12, 31);
  Result := ADate - FirstOfYear;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage('Сегодня ' + FloatToStr(GetDays(Date)) + ' день в году.');
end;

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

function GetDays(ADate: TDate): Extended;
var
  N1, N2, N3: Integer;
  Year, Month, Day: Word;
begin
  DecodeDate(ADate, Year, Month, Day);
  N1 := Floor(275 * Month / 9);
  N2 := Floor((Month + 9) / 12);
  N3 := 1 + Floor((Year - 4 * Floor(Year / 4) + 2) / 3);
  Result := N1 - (N2 * N3) + Day - 30;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('Сегодня ' + FloatToStr(GetDays(Date)) + ' день в году.');
end;

Как перевести григорианскую дату в юлианскую?


function DateToJD(DT: TDateTime): Double;
var
  dD, dM, dY: Word;
  tH, tM, tS, tSS: Word;
begin
  DecodeDate(DT, dY, dM, dD);
  DecodeTime(DT, tH, tM, tS, tSS);
  // Внимание! Эта формула действует только для дат между 1801 и 2099.
  // Более отдалённые даты потребуют более сложных преобразований.
  Result := 1461 * (dY + 4800 + (dM - 14) / 12) / 4 +
            367 * (dM - 2 - 12 * ((dM - 14) / 12)) / 12 -
            3 * ((dY + 4900 + (dM - 14) / 12) / 100) / 4 +
            dD - 32075;
  //Result := Trunc(Result) + ((tH + ((tM/60) + tS) / 60) - 12) / 24;
  Result := Trunc(Result) + ((tH - 12) / 24) + (tM / 1440) + (tS / 86400);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  JD: Double;
begin
  JD := DateToJD(EncodeDate(1970, 1, 1) + EncodeTime(0, 0, 0, 0));
  ShowMessage(FloatToStr(JD));
end;

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