|
:: 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;
|
|
При использовании материала - ссылка на сайт обязательна
|
|
