Автор: Галимарзанов Фанис

 

Универсальная функция возврата значения элемента даты (год, месяц, день, квартал):

 

Code:

function RetDate(inDate: TDateTime; inTip: integer): integer;

var

xYear, xMonth, xDay: word;

begin

Result := 0;

DecodeDate(inDate, xYear, xMonth, xDay);

case inTip of

1: Result := xYear; // год

2: Result := xMonth; // месяц

3: Result := xDay; // день

4: if xMonth < 4then

Result := 1

else// квартал

if xMonth < 7then

Result := 2

else

if xMonth < 10then

Result := 3

else

Result := 4;

end;

end;

 

 

https://delphiworld.narod

 

 При отображении TDateTimeField в DBGrid с форматированием hh:mm (для показа только времени), любая попытка изменения времени приводит (при передаче данных) к ошибке примерно такого содержания: "'07:00 is not a valid DateTime" (07:00 - неверный DateTime). Я хотел бы посылать данные приблизительно в таком виде "trunc(oldDateTimevalue)+strtoTime(displaytext)"

 

Следующий обработчик события TDateTimeField OnSetText не слишком элегантен, но он работает!

 

Code:

procedure TForm1.Table1Date1SetText(Sender: TField; const Text: String);

var

d: TDateTime;

t: string;

begin

t := Text;

with Sender as TDateTimeField do

begin

if IsNull then

d := SysUtils.Date

else

d := AsDateTime;

AsDateTime := StrToDateTime(Copy(DateToStr(d),1,8)+' '+t);

end;

end;

 

Здесь мы исходим из предположения, что у вас имеется маска редактирования, допускающая формат hh:mm или hh:mm:ss.

 

https://delphiworld.narod

Автор: РевенкоАлексей

Code:

// Колическтво дней в любом месяце любого

// года можно получить с помощью EndOfAMonth

 

var

YYYY, MM, DD: Word;

D: TDateTime;

begin

DecodeDate(Date, YYYY, MM, DD);

D := EndOfAMonth(YYYY, {Номер месяца});

DecodeDate(D, YYYY, MM, DD); // DD - номер последнего дня в месяце

end;

 

https://delphiworld.narod

DelphiWorld 6.0

 

 


Получить число дней в месяце

 

Code:

function DaysOfMonth(mm, yy: Integer): Integer;

begin

if mm = 2then

begin

Result := 28;

if IsLeapYear(yy) then Result := 29;

end

else

begin

if mm < 8then

begin

if (mm mod2) = 0then

Result := 30

else

Result := 31;

end

else

begin

if (mm mod2) = 0then

Result := 31

else

Result := 30;

end;

end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

var

days: Integer;

begin

days := DaysOfMonth(7, 2001);

ShowMessage('July 2001 has ' + IntToStr(days) + ' days');

end;

 

https://delphiworld.narod

DelphiWorld 6.0

 

 


Code:

function LastDayOfCurrentMonth: TDate;

var

y, m, d: Word;

begin

DecodeDate(now, y, m, d);

m := m + 1;

if m 12then

begin

y := y + 1;

m := 1;

end;

Result := EncodeDate(y, m, 1) - 1;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(DateToStr(LastDayOfCurrentMonth));

end;

 

https://delphiworld.narod.

Автор: Mark Lussier

 

Code:

function TtheCalendar.CalcEaster: string;

var

B, D, E, Q: Integer;

 

GF: string;

begin

 

B := 225 - 11 * (Year mod19);

D := ((B - 21) mod30) + 21;

if D > 48then

Dec(D);

E := (Year + (Year div4) + D + 1) mod7;

Q := D + 7 - E;

if Q < 32then

begin

if ShortDateFormat[1] = 'd'then

Result := IntToStr(Q) + '/3/' + IntToStr(Year)

 

else

Result := '3/' + IntToStr(Q) + '/' + IntToStr(Year);

end

else

begin

if ShortDateFormat[1] = 'd'then

Result := IntToStr(Q - 31) + '/4/' + IntToStr(Year)

 

else

Result := '4/' + IntToStr(Q - 31) + '/' + IntToStr(Year);

end;

{вычисление страстной пятницы}

if Q < 32then

begin

if ShortDateFormat[1] = 'd'then

GF := IntToStr(Q - 2) + '/3/' + IntToStr(Year)

else

GF := '3/' + IntToStr(Q - 2) + '/' + IntToStr(Year);

end

else

begin

if ShortDateFormat[1] = 'd'then

GF := IntToStr(Q - 31 - 2) + '/4/' + IntToStr(Year)

 

else

GF := '4/' + IntToStr(Q - 31 - 2) + '/' + IntToStr(Year);

end;

 

end;

 

https://delphiworld.narod

DelphiWorld 6.0

  


 

Code:

function Easter(Year: Integer): TDateTime;

{----------------------------------------------------------------}

{ Вычисляет и возвращает день Пасхи определенного года. }

{ Идея принадлежит Mark Lussier, AppVision <MLussier@>. }

{ Скорректировано для предотвращения переполнения целых, если по }

{ ошибке передан год с числом 6554 или более. }

{----------------------------------------------------------------}

 

var

nMonth, nDay, nMoon, nEpact, nSunday,

nGold, nCent, nCorx, nCorz: Integer;

begin

{ Номер Золотого Года в 19-летнем Metonic-цикле: }

nGold := (Year mod19) + 1;

{ Вычисляем столетие: }

nCent := (Year div100) + 1;

{ Количество лет, в течение которых отслеживаются високосные года... }

{ для синхронизации с движением солнца: }

nCorx := (3 * nCent) div4 - 12;

{ Специальная коррекция для синхронизации Пасхи с орбитой луны: }

nCorz := (8 * nCent + 5) div25 - 5;

{ Находим воскресенье: }

nSunday := (Longint(5) * Year) div4 - nCorx - 10;

{ ^ Предохраняем переполнение года за отметку 6554}

{ Устанавливаем Epact - определяем момент полной луны: }

nEpact := (11 * nGold + 20 + nCorz - nCorx) mod30;

if nEpact < 0then

nEpact := nEpact + 30;

if ((nEpact = 25) and (nGold > 11)) or (nEpact = 24) then

nEpact := nEpact + 1;

{ Ищем полную луну: }

nMoon := 44 - nEpact;

if nMoon < 21then

nMoon := nMoon + 30;

{ Позиционируем на воскресенье: }

nMoon := nMoon + 7 - ((nSunday + nMoon) mod7);

if nMoon > l 31then

begin

nMonth := 4;

nDay := nMoon - 31;

end

else

begin

nMonth := 3;

nDay := nMoon;

end;

Easter := EncodeDate(Year, nMonth, nDay);

end; {Easter}

 

https://delphiworld.narod

DelphiWorld 6.0

 

 


 

Примечание от Vit: что-то настораживает меня тот факт что автор кода имеет "западную" фамилию, почти наверняка код этот вычисляет время наступления католической Пасхи или иудейского праздника Пейсах (неправильно именуемого в просторечье "еврейской пасхой"), а вовсе не православной Пасхи. Православная пасха обычно сдвинута на неделю вперёд, но бывают и исключения (доподлинно алгоритм вычисления мне неизвестен), а потому пользоваться кодом надо с оглядкой...

Code:

function julian(year, month, day: Integer): real;

var

yr, mth: Integer;

noleap, leap, days, yrs: Real;

begin

if year < 0then yr := year + 1else yr := year;

mth := month;

if (month < 3) then

begin

mth := mth + 12;

yr := yr - 1;

end;

yrs := 365.25 * yr;

if ((yrs < 0) and (frac(yrs) <> 0)) then yrs := int(yrs) - 1else yrs := int(yrs);

days := int(yrs) + int(30.6001 * (mth + 1)) + day - 723244.0;

if days < -145068.0then julian := days

else

begin

yrs := yr / 100.0;

if ((yrs < 0) and (frac(yrs) <> 0)) then yrs := int(yrs) - 1;

noleap := int(yrs);

yrs := noleap / 4.0;

if ((yrs < 0) and (frac(yrs) <> 0)) then yrs := int(yrs) - 1;

leap := 2 - noleap + int(yrs);

julian := days + leap;

end;

end;

 

 

 

Взято с Delphi Knowledge Base: https://www.baltsoft.