mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-29 13:02:42 +02:00
320 lines
10 KiB
ObjectPascal
320 lines
10 KiB
ObjectPascal
{*******************************************************}
|
|
{ }
|
|
{ Add FastReport Date Lbrary }
|
|
{ }
|
|
{ Copyright (c) 1995, 1996 AO ROSNO }
|
|
{ Copyright (c) 1997, 1998 Master-Bank }
|
|
{ }
|
|
{ Copyright (c) 2001 by Stalker SoftWare }
|
|
{ }
|
|
{*******************************************************}
|
|
unit frFuncDate;
|
|
|
|
interface
|
|
|
|
{$B-,V-,R-,Q-,H+}
|
|
{.$I FR.inc}
|
|
|
|
uses
|
|
SysUtils;
|
|
|
|
// RxLib
|
|
function frDaysPerMonth(nYear, nMonth: Integer): Integer;
|
|
function frFirstDayOfNextMonth(dDate:TDateTime): TDateTime;
|
|
function frFirstDayOfPrevMonth(dDate:TDateTime): TDateTime;
|
|
function frLastDayOfPrevMonth(dDate:TDateTime): TDateTime;
|
|
function frIncYear(dDate: TDateTime; nDelta: Integer): TDateTime;
|
|
function frIncDay(dDate: TDateTime; nDelta: Integer): TDateTime;
|
|
|
|
function frIncDate(dDate: TDateTime; nDays, nMonths, nYears: Integer): TDateTime;
|
|
|
|
function frIncDateEx(dDate: TDateTime; cDelta :String) :TDateTime;
|
|
function frIncTimeEx(dTime: TDateTime; cDelta :String): TDateTime;
|
|
procedure frDateDiffEx(dDate1, dDate2: TDateTime; var cDelta :String);
|
|
|
|
// StLib
|
|
function frIsRangeDate(dBegDate, dEndDate, dDate: TDateTime) :Boolean;
|
|
function frStrToDateDef(cDate: String; dDefault: TDateTime): TDateTime;
|
|
function frValidDate(cDate :String) :Boolean;
|
|
function frIsLeapYear(AYear: Integer): Boolean;
|
|
function frIncMonth(dDate: TDateTime; nDelta: Integer): TDateTime;
|
|
|
|
implementation
|
|
|
|
uses
|
|
frFuncStr;
|
|
|
|
function frIsLeapYear(AYear: Integer): Boolean;
|
|
begin
|
|
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
|
|
end;
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Function returns days per month for specified year. }
|
|
{ nYear - year, nMonth - month }
|
|
{--------------------------------------------------------------------}
|
|
function frDaysPerMonth(nYear, nMonth: Integer): Integer;
|
|
const
|
|
DaysInMonth: array[1..12] of Integer =
|
|
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
|
|
|
|
begin
|
|
|
|
Result := DaysInMonth[nMonth];
|
|
if (nMonth = 2) and frIsLeapYear(nYear) then Inc(Result); // leap-year Feb is special
|
|
|
|
end; { frDaysPerMonth }
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Function return first day of the next month from date dDate }
|
|
{ in TDateTime format. }
|
|
{--------------------------------------------------------------------}
|
|
function frFirstDayOfNextMonth(dDate:TDateTime): TDateTime;
|
|
var
|
|
Year, Month, Day: Word;
|
|
|
|
begin
|
|
|
|
DecodeDate(dDate, Year, Month, Day);
|
|
Day := 1;
|
|
if Month < 12 then
|
|
Inc(Month)
|
|
else begin
|
|
Inc(Year);
|
|
Month := 1;
|
|
end; { if }
|
|
Result := EncodeDate(Year, Month, Day);
|
|
|
|
end; { frFirstDayOfNextMonth }
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Function return first day of the previous month from date dDate }
|
|
{ in TDateTime format. }
|
|
{--------------------------------------------------------------------}
|
|
function frFirstDayOfPrevMonth(dDate:TDateTime): TDateTime;
|
|
var
|
|
Year, Month, Day: Word;
|
|
|
|
begin
|
|
|
|
DecodeDate(dDate, Year, Month, Day);
|
|
Day := 1;
|
|
if Month > 1 then
|
|
Dec(Month)
|
|
else begin
|
|
Dec(Year);
|
|
Month := 12;
|
|
end;
|
|
Result := EncodeDate(Year, Month, Day);
|
|
|
|
end; { frFirstDayOfPrevMonth }
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Function return last day of the previous month from date dDate }
|
|
{ in TDateTime format. }
|
|
{--------------------------------------------------------------------}
|
|
function frLastDayOfPrevMonth(dDate:TDateTime): TDateTime;
|
|
var
|
|
D: TDateTime;
|
|
Year, Month, Day: Word;
|
|
|
|
begin
|
|
|
|
D := frFirstDayOfPrevMonth(dDate);
|
|
DecodeDate(D, Year, Month, Day);
|
|
Day := frDaysPerMonth(Year, Month);
|
|
Result := EncodeDate(Year, Month, Day);
|
|
|
|
end; { frLastDayOfPrevMonth }
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Increase date dDate on specified count days, months, years, }
|
|
{ returns result date. }
|
|
{--------------------------------------------------------------------}
|
|
function frIncDate(dDate: TDateTime; nDays, nMonths, nYears: Integer): TDateTime;
|
|
var
|
|
D, M, Y: Word;
|
|
Day, Month, Year: LongInt;
|
|
|
|
begin
|
|
|
|
DecodeDate(dDate, Y, M, D);
|
|
Year := Y; Month := M; Day := D;
|
|
Inc(Year, nYears);
|
|
Inc(Year, nMonths div 12);
|
|
Inc(Month, nMonths mod 12);
|
|
|
|
if Month < 1 then begin
|
|
Inc(Month, 12);
|
|
Dec(Year);
|
|
end
|
|
else
|
|
if Month > 12 then begin
|
|
Dec(Month, 12);
|
|
Inc(Year);
|
|
end; { if }
|
|
|
|
if Day > frDaysPerMonth(Year, Month) then Day := frDaysPerMonth(Year, Month);
|
|
Result := EncodeDate(Year, Month, Day) + nDays + Frac(dDate);
|
|
|
|
end; { frIncDate }
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Increase date dDate on specified count days nDelta }
|
|
{--------------------------------------------------------------------}
|
|
function frIncDay(dDate: TDateTime; nDelta: Integer): TDateTime;
|
|
begin
|
|
Result := dDate + nDelta;
|
|
end; { frIncDay }
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Increase date dDate on specified count years nDelta }
|
|
{--------------------------------------------------------------------}
|
|
function frIncYear(dDate: TDateTime; nDelta: Integer): TDateTime;
|
|
begin
|
|
Result := frIncDate(dDate, 0, 0, nDelta);
|
|
end; { frIncYear }
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Increase date dDate on specified count months nDelta }
|
|
{--------------------------------------------------------------------}
|
|
function frIncMonth(dDate: TDateTime; nDelta: Integer): TDateTime;
|
|
begin
|
|
Result := frIncDate(dDate, 0, nDelta, 0);
|
|
end; { frIncYear }
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Detect difference before dates Date1 and Date2 in days, }
|
|
{ months, years. }
|
|
{--------------------------------------------------------------------}
|
|
procedure frDateDiffEx(dDate1, dDate2: TDateTime; var cDelta :String);
|
|
{ Corrected by Anatoly A. Sanko (2:450/73) }
|
|
var
|
|
DtSwap: TDateTime;
|
|
Day1, Day2, Month1, Month2, Year1, Year2: Word;
|
|
Days, Months, Years: Word;
|
|
|
|
begin
|
|
|
|
if dDate1 > dDate2 then begin
|
|
DtSwap := dDate1;
|
|
dDate1 := dDate2;
|
|
dDate2 := DtSwap;
|
|
end;
|
|
DecodeDate(dDate1, Year1, Month1, Day1);
|
|
DecodeDate(dDate2, Year2, Month2, Day2);
|
|
Years := Year2 - Year1;
|
|
Months := 0;
|
|
Days := 0;
|
|
if Month2 < Month1 then begin
|
|
Inc(Months, 12);
|
|
Dec(Years);
|
|
end;
|
|
Inc(Months, Month2 - Month1);
|
|
if Day2 < Day1 then begin
|
|
Inc(Days, frDaysPerMonth(Year1, Month1));
|
|
if Months = 0 then begin
|
|
Dec(Years);
|
|
Months := 11;
|
|
end
|
|
else Dec(Months);
|
|
end;
|
|
Inc(Days, Day2 - Day1);
|
|
|
|
// Compile string for result
|
|
cDelta := IntToStr(Days)+';'+IntToStr(Months)+';'+IntToStr(Years);
|
|
|
|
end; { frDateDiffEx }
|
|
|
|
{----------------------------------------------------------------}
|
|
{ Return True if specified date be in given range }
|
|
{ vBegDate - Begin range }
|
|
{ vEndDate - End range }
|
|
{ vDate - Checked date }
|
|
{----------------------------------------------------------------}
|
|
function frIsRangeDate(dBegDate, dEndDate, dDate: TDateTime) :Boolean;
|
|
begin
|
|
|
|
if (dDate >= dBegDate) and (dDate <= dEndDate) then
|
|
Result := True
|
|
else
|
|
Result := False
|
|
|
|
end; { frIsDiapDate }
|
|
|
|
{----------------------------------------------------------------}
|
|
{ Convert string into date. }
|
|
{----------------------------------------------------------------}
|
|
function frStrToDateDef(cDate: String; dDefault: TDateTime): TDateTime;
|
|
begin
|
|
|
|
try
|
|
Result := StrToDate(cDate)
|
|
except
|
|
Result := dDefault;
|
|
end; { try }
|
|
|
|
end; { frStrToDateDef }
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Return True, if cDate really date }
|
|
{--------------------------------------------------------------------}
|
|
function frValidDate(cDate :String) :Boolean;
|
|
begin
|
|
|
|
Result := True;
|
|
try
|
|
StrToDate(cDate)
|
|
except
|
|
Result := False;
|
|
end; { try }
|
|
|
|
end; { frValidDate }
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Increase date dDate on specified count days, months, years, }
|
|
{ extracting them from string cDelta and return this date }
|
|
{ as result. }
|
|
{--------------------------------------------------------------------}
|
|
function frIncDateEx(dDate: TDateTime; cDelta :String) :TDateTime;
|
|
var
|
|
nDay, nMonth, nYear: LongInt;
|
|
|
|
begin
|
|
|
|
// Split string on parts
|
|
nDay := StrToInt(frExtractWord(1,cDelta,[';']));
|
|
nMonth := StrToInt(frExtractWord(2,cDelta,[';']));
|
|
nYear := StrToInt(frExtractWord(3,cDelta,[';']));
|
|
|
|
Result := frIncDate(dDate, nDay, nMonth, nYear);
|
|
|
|
end; { frIncDateEx }
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ Increase time ATime on specified count hours, minuts, seconds, }
|
|
{ and milliseconds, extracting his from string cDelta }
|
|
{--------------------------------------------------------------------}
|
|
function frIncTimeEx(dTime: TDateTime; cDelta :String): TDateTime;
|
|
var
|
|
nHours, nMinutes, nSeconds, nMSecs: Integer;
|
|
|
|
begin
|
|
|
|
// Split string on parts
|
|
nHours := StrToInt(frExtractWord(1,cDelta,[';']));
|
|
nMinutes := StrToInt(frExtractWord(2,cDelta,[';']));
|
|
nSeconds := StrToInt(frExtractWord(3,cDelta,[';']));
|
|
nMSecs := StrToInt(frExtractWord(4,cDelta,[';']));
|
|
|
|
|
|
Result := dTime + (nHours div 24) + (((nHours mod 24) * 3600000 +
|
|
nMinutes * 60000 + nSeconds * 1000 + nMSecs) / MSecsPerDay);
|
|
|
|
if Result < 0 then Result := Result + 1;
|
|
|
|
end; { frIncTimeEx }
|
|
|
|
|
|
end.
|