|
:: 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
if ( Year mod 4 = 0 ) and
( ( Year mod 100 <> 0 ) or ( Year mod 400 = 0 ) ) then
Result := true
else
Result := false;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if LeapYear( 2004 ) then
ShowMessage( 'Год високосный' )
else
ShowMessage( 'Обычный год' );
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;
if (Year mod 4 = 0) and
((Year mod 100 <> 0) or (Year mod 400 = 0)) then
vis := true
else
vis := false;
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
reg : TRegistry;
ts : TStrings;
i : integer;
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;
|
|
При использовании материала - ссылка на сайт обязательна
|
|
