lazarus/components/lazreport/source/addons/addfunction/frFuncDate.pas
jesus d0a347df28 Added LazReport components
git-svn-id: trunk@11950 -
2007-09-06 19:47:34 +00:00

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.