|
:: MVP ::
|
|
|
:: RSS ::
|
|
|
Как вычислить дату Пасхи?
// Способ первый
function CalcEaster(Year: Word): string;
var
B, D, E, Q: Integer;
GF: string;
begin
B := 225 - 11 * (Year mod 19);
D := ((B - 21) mod 30) + 21;
if D > 48 then
Dec(D);
E := (Year + (Year div 4) + D + 1) mod 7;
Q := D + 7 - E;
if Q < 32 then
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 < 32 then
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;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(CalcEaster(2014));
end;
// Способ второй
function Easter(Year: Integer): TDateTime;
{Вычисляет и возвращает день Пасхи определенного года.
Скорректировано для предотвращения переполнения целых, если передан год >= 6554}
var
nMonth, nDay, nMoon, nEpact, nSunday,
nGold, nCent, nCorx, nCorz: Integer;
begin
{Номер Золотого Года в 19-летнем метоническом цикле:}
nGold := (Year mod 19) + 1;
{Вычисляем столетие:}
nCent := (Year div 100) + 1;
{Количество лет, в течение которых отслеживаются високосные года...
для синхронизации с движением солнца:}
nCorx := (3 * nCent) div 4 - 12;
{Специальная коррекция для синхронизации Пасхи с орбитой луны:}
nCorz := (8 * nCent + 5) div 25 - 5;
{Находим воскресенье:}
nSunday := (Longint(5) * Year) div 4 - nCorx - 10;
{Предохраняем переполнение года за отметку 6554.
Устанавливаем Epact - определяем момент полной луны:}
nEpact := (11 * nGold + 20 + nCorz - nCorx) mod 30;
if nEpact < 0 then
nEpact := nEpact + 30;
if ((nEpact = 25) and (nGold > 11)) or (nEpact = 24) then
nEpact := nEpact + 1;
{Ищем полную луну:}
nMoon := 44 - nEpact;
if nMoon < 21 then
nMoon := nMoon + 30;
{Позиционируем на воскресенье:}
nMoon := nMoon + 7 - ((nSunday + nMoon) mod 7);
if nMoon > 31 then
begin
nMonth := 4;
nDay := nMoon - 31;
end
else
begin
nMonth := 3;
nDay := nMoon;
end;
Easter := EncodeDate(Year, nMonth, nDay);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(DateToStr(Easter(2014)));
end;
|
Как перевести дату формата ISO 8601 в TDateTime?
// Способ первый
function ISO8601ToDateTime(Value: string): TDateTime;
var
FormatSettings: TFormatSettings;
begin
GetLocaleFormatSettings(GetThreadLocale, FormatSettings);
FormatSettings.DateSeparator := '-';
FormatSettings.ShortDateFormat := 'yyyy-MM-dd';
Result := StrToDate(Value, FormatSettings);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(DateToStr(ISO8601ToDateTime('2014-10-22')));
end;
// Способ второй
uses
XSBuiltIns;
procedure TForm1.Button1Click(Sender: TObject);
var
ADate: TDate;
ADateString: string;
begin
with TXSDate.Create do
try
AsDate := Date; // convert from TDateTime
ADateString := NativeToXS; // convert to WideString
finally
Free;
end;
with TXSDate.Create do
try
XSToNative(ADateString); // convert from WideString
ADate := AsDate; // convert to TDateTime
finally
Free;
end;
end;
|
Как получить номер квартала для указанной даты?
uses
DateUtils;
function GetQuarter(DT: TDateTime): Word;
begin
Result := Trunc((MonthOfTheYear(DT) - 1) / 3) + 1;
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
ShowMessage(FloatToStr(GetQuarter(Now)));
end;
|
Как узнать, с какого дня начинается неделя в системе?
// Способ первый
// 0 - понедельник .. 6 - воскресенье
function GetBeginningOfWeekFromOS: Integer;
var
FDOW: array[0..1] of Char;
begin
Result := 0;
if GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IFIRSTDAYOFWEEK, @FDOW, SizeOf(FDOW)) > 0 then
Result := Ord(FDOW[0]) - Ord('0');
end;
// Способ второй
uses
CommCtrl;
// 0 - понедельник .. 6 - воскресенье
function GetBeginningOfWeekFromOS: Integer;
var
MonthCalendar: TMonthCalendar;
begin
MonthCalendar := TMonthCalendar.Create(nil);
MonthCalendar.Parent := Application.MainForm;
Result := MonthCal_GetFirstDayOfWeek(MonthCalendar.Handle) and $FF;
MonthCalendar.Free;
end;
|
Как получить имена дней недели в системе?
function DaysOfWeek: string;
const
Arr: array [0..6] of Word =
(CAL_SDAYNAME1, CAL_SDAYNAME2, CAL_SDAYNAME3, CAL_SDAYNAME4,
CAL_SDAYNAME5, CAL_SDAYNAME6, CAL_SDAYNAME7);
var
P: PChar;
i: Integer;
begin
Result := '';
for i := Low(Arr) to High(Arr) do
begin
New(P);
GetCalendarInfo(LOCALE_USER_DEFAULT, CAL_GREGORIAN, Arr[i], P, 15, nil);
Result := Result + String(P) + #13;
Dispose(P);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(DaysOfWeek);
end;
|
Как получить краткий и полный формат даты в системе?
function GetWindowsDateFormat(LCTYPE: LCTYPE): string;
var
Buffer: PChar;
Size: Integer;
begin
Size := GetLocaleInfo(LOCALE_USER_DEFAULT, LCType, nil, 0);
GetMem(Buffer, Size);
try
GetLocaleInfo (LOCALE_USER_DEFAULT, LCTYPE, Buffer, Size);
Result := string(Buffer);
finally
FreeMem(Buffer);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
begin
s := 'Короткий формат: ' + GetWindowsDateFormat(LOCALE_SSHORTDATE) + #13;
s := s + 'Полный формат: ' + GetWindowsDateFormat(LOCALE_SLONGDATE);
ShowMessage(s);
end;
|
Как получить часовой пояс системы?
// Способ первый
function GetTimeZoneString: string;
var
TimeZone: TTimeZoneInformation;
BiasHour, BiasMinute: LongInt;
begin
GetTimeZoneInformation(TimeZone);
BiasHour := TimeZone.Bias div -60;
BiasMinute := TimeZone.Bias mod -60;
if BiasHour > 0 then
Result := 'GMT+'
else
Result := 'GMT';
Result := Result + Format('%.d:%.2d', [BiasHour, BiasMinute]);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetTimeZoneString);
end;
// Способ второй
uses
{...,} Math;
type
TUTC = record
ZoneTime: TTime;
ZoneSign: TValueSign;
end;
function GetTimeZone: TUTC;
var
TZ: TTimeZoneInformation;
begin
GetTimeZoneInformation(TZ);
Result.ZoneTime := EncodeTime(Abs(TZ.Bias) div 60, Abs(TZ.Bias) mod 60, 0, 0);
Result.ZoneSign := Sign(TZ.Bias * -1);
end;
procedure TForm1.Button1Click(Sender: TObject);
function UTCToStr(UTC: TUTC): string;
const
SIGN_STR: array[TValueSign] of string = ('-', '', '+');
var
Hour, Min, Sec, MSec: Word;
begin
DecodeTime(UTC.ZoneTime, Hour, Min, Sec, MSec);
Result := SIGN_STR[UTC.ZoneSign] + Format('%d:%.2d', [Hour, Min]);
end;
begin
ShowMessage(UTCToStr(GetTimeZone));
end;
|
Как получить название календарного месяца?
// Способ первый
function GetMonthName(MonthNum: Byte): WideString;
var
cchDate: Integer;
ST: TSystemTime;
begin
Result := '';
GetSystemTime(ST);
ST.wMonth := MonthNum;
cchDate := GetDateFormatW(LOCALE_USER_DEFAULT, 0, @ST, 'MMMM', nil, 0);
if cchDate > 0 then
begin
SetLength(Result, cchDate);
GetDateFormatW(LOCALE_USER_DEFAULT, 0, @ST, 'MMMM', PWideChar(Result), cchDate);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetMonthName(1));
end;
// Способ второй
function GetLocaleInformation(Flag: Integer): string;
var
pcLCA: array[0..20] of Char;
begin
if GetLocaleInfo(LOCALE_SYSTEM_DEFAULT, Flag, pcLCA, 19) <= 0 then
pcLCA[0] := #0;
Result := pcLCA;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Flags:
// LOCALE_SMONTHNAME1 { long name for January }
// LOCALE_SMONTHNAME2 { long name for February }
// LOCALE_SMONTHNAME3 { long name for March }
// LOCALE_SMONTHNAME4 { long name for April }
// LOCALE_SMONTHNAME5 { long name for May }
// LOCALE_SMONTHNAME6 { long name for June }
// LOCALE_SMONTHNAME7 { long name for July }
// LOCALE_SMONTHNAME8 { long name for August }
// LOCALE_SMONTHNAME9 { long name for September }
// LOCALE_SMONTHNAME10 { long name for October }
// LOCALE_SMONTHNAME11 { long name for November }
// LOCALE_SMONTHNAME12 { long name for December }
ShowMessage(GetLocaleInformation(LOCALE_SMONTHNAME1));
end;
|
Как получить дату в формате RFC 822?
procedure TForm1.Button1Click(Sender: TObject);
function FormatDate(dt: TDate; FmtString: string): string;
const
BuffSize = 100;
var
CDT: TSystemTime;
R: Integer;
begin
DateTimeToSystemTime(dt, CDT);
SetLength(Result, BuffSize);
R := GetDateFormat(
LANG_ENGLISH, // locale for which date is to be formatted
0, // flags specifying function options
@CDT, // date to be formatted
PChar(FmtString), // date format string
PChar(Result), // buffer for storing formatted string
BuffSize // size of buffer
);
if R = 0 then
RaiseLastWin32Error
else
SetLength(Result, R-1);
end;
function FormatTime(tm: TTime; FmtString: string): string;
begin
Result := FormatDateTime(FmtString, tm);
end;
function TimeZone: string;
var
TimeZone: TTimeZoneInformation;
BiasHour, BiasMinute: LongInt;
begin
GetTimeZoneInformation(TimeZone);
BiasHour := TimeZone.Bias div -60;
BiasMinute := TimeZone.Bias mod -60;
if BiasHour > 0 then
Result := '+';
Result := Result + Format('%.2d%.2d', [BiasHour, BiasMinute]);
end;
begin
ShowMessage(FormatDate(Date, 'ddd, dd MMM yyyy') + ' ' +
FormatTime(Time, 'hh:mm:ss') + ' ' + TimeZone);
end;
|
|
При использовании материала - ссылка на сайт обязательна
|
|
