RxFPC:start reorder source folder structure

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5699 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2017-01-25 09:56:51 +00:00
parent ae7af2e50b
commit 735529f5ea
82 changed files with 386 additions and 720 deletions
--- a/components/rx/trunk/rxtools/rxdateutil.pas
+++ b/components/rx/trunk/rxtools/rxdateutil.pas
@ -0,0 +1,649 @@
+{ DateUtil unit
+
+  Copyright (C) 2005-2017 Lagunov Aleksey alexs@yandex.ru and Lazarus team
+  original conception from rx library for Delphi (c)
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+unit rxdateutil;
+
+{$I rx.inc}
+
+interface
+
+function CurrentYear: Word;
+function IsLeapYear(AYear: Integer): Boolean;
+function DaysPerMonth(AYear, AMonth: Integer): Integer;
+function FirstDayOfPrevMonth: TDateTime;
+function LastDayOfPrevMonth: TDateTime;
+function FirstDayOfNextMonth: TDateTime;
+function ExtractDay(ADate: TDateTime): Word;
+function ExtractMonth(ADate: TDateTime): Word;
+function ExtractYear(ADate: TDateTime): Word;
+function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
+function IncDay(ADate: TDateTime; Delta: Integer): TDateTime;
+function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
+function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
+function ValidDate(ADate: TDateTime): Boolean;
+procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
+function MonthsBetween(Date1, Date2: TDateTime): Double;
+function DaysInPeriod(Date1, Date2: TDateTime): Longint;
+  { Count days between Date1 and Date2 + 1, so if Date1 = Date2 result = 1 }
+function DaysBetween(Date1, Date2: TDateTime): Longint;
+  { The same as previous but if Date2 < Date1 result = 0 }
+
+function IncTime(ATime: TDateTime; Hours, Minutes, Seconds, MSecs: Integer): TDateTime;
+function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
+function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
+function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
+function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
+function CutTime(ADate: TDateTime): TDateTime; { Set time to 00:00:00:00 }
+
+type
+  TDateOrder = (doMDY, doDMY, doYMD);
+  TDayOfWeekName = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
+  TDaysOfWeek = set of TDayOfWeekName;
+
+{ String to date conversions }
+function GetDateOrder(const DateFormat: string): TDateOrder;
+function MonthFromName(const S: string; MaxLen: Byte): Byte;
+function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
+function StrToDateFmt(const DateFormat, S: string): TDateTime;
+function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
+function DefDateFormat(FourDigitYear: Boolean): string;
+function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string;
+function NvlDate(DateValue, DefaultValue: TDateTime): TDateTime;
+
+{$IFDEF WIN32}
+function FormatLongDate(Value: TDateTime): string;
+function FormatLongDateTime(Value: TDateTime): string;
+{$ENDIF}
+
+const
+  DefaultDateOrder = doDMY;
+
+{$IFDEF USE_FOUR_DIGIT_YEAR}
+var
+  FourDigitYear: Boolean;
+{$ELSE}
+function FourDigitYear: Boolean;
+{$ENDIF USE_FOUR_DIGIT_YEAR}
+
+const
+  CenturyOffset: Byte = 60;
+  NullDate: TDateTime = 0;
+
+implementation
+
+uses SysUtils, RXStrUtils, rxdconst{, DBConsts }{$IFDEF WIN32}, Windows{$ENDIF};
+
+
+function NvlDate(DateValue, DefaultValue: TDateTime): TDateTime;
+begin
+  if DateValue = NullDate then Result := DefaultValue
+  else Result := DateValue;
+end;
+
+function IsLeapYear(AYear: Integer): Boolean;
+begin
+  Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
+end;
+
+function DaysPerMonth(AYear, AMonth: 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); { leap-year Feb is special }
+end;
+
+function FirstDayOfNextMonth: TDateTime;
+var
+  Year, Month, Day: Word;
+begin
+  DecodeDate(Date, Year, Month, Day);
+  Day := 1;
+  if Month < 12 then Inc(Month)
+  else begin
+    Inc(Year);
+    Month := 1;
+  end;
+  Result := EncodeDate(Year, Month, Day);
+end;
+
+function FirstDayOfPrevMonth: TDateTime;
+var
+  Year, Month, Day: Word;
+begin
+  DecodeDate(Date, Year, Month, Day);
+  Day := 1;
+  if Month > 1 then Dec(Month)
+  else begin
+    Dec(Year);
+    Month := 12;
+  end;
+  Result := EncodeDate(Year, Month, Day);
+end;
+
+function LastDayOfPrevMonth: TDateTime;
+var
+  D: TDateTime;
+  Year, Month, Day: Word;
+begin
+  D := FirstDayOfPrevMonth;
+  DecodeDate(D, Year, Month, Day);
+  Day := DaysPerMonth(Year, Month);
+  Result := EncodeDate(Year, Month, Day);
+end;
+
+function ExtractDay(ADate: TDateTime): Word;
+var
+  M, Y: Word;
+begin
+  DecodeDate(ADate, Y, M, Result);
+end;
+
+function ExtractMonth(ADate: TDateTime): Word;
+var
+  D, Y: Word;
+begin
+  DecodeDate(ADate, Y, Result, D);
+end;
+
+function ExtractYear(ADate: TDateTime): Word;
+var
+  D, M: Word;
+begin
+  DecodeDate(ADate, Result, M, D);
+end;
+
+function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
+var
+  D, M, Y: Word;
+  Day, Month, Year: Longint;
+begin
+  DecodeDate(ADate, Y, M, D);
+  Year := Y; Month := M; Day := D;
+  Inc(Year, Years);
+  Inc(Year, Months div 12);
+  Inc(Month, Months 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 Day > DaysPerMonth(Year, Month) then Day := DaysPerMonth(Year, Month);
+  Result := EncodeDate(Year, Month, Day) + Days + Frac(ADate);
+end;
+
+procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
+{ Corrected by Anatoly A. Sanko (2:450/73) }
+var
+  DtSwap: TDateTime;
+  Day1, Day2, Month1, Month2, Year1, Year2: Word;
+begin
+  if Date1 > Date2 then begin
+    DtSwap := Date1;
+    Date1 := Date2;
+    Date2 := DtSwap;
+  end;
+  DecodeDate(Date1, Year1, Month1, Day1);
+  DecodeDate(Date2, 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, DaysPerMonth(Year1, Month1));
+    if Months = 0 then begin
+      Dec(Years);
+      Months := 11;
+    end
+    else Dec(Months);
+  end;
+  Inc(Days, Day2 - Day1);
+end;
+
+function IncDay(ADate: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := ADate + Delta;
+end;
+
+function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncDate(ADate, 0, Delta, 0);
+end;
+
+function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncDate(ADate, 0, 0, Delta);
+end;
+
+function MonthsBetween(Date1, Date2: TDateTime): Double;
+var
+  D, M, Y: Word;
+begin
+  DateDiff(Date1, Date2, D, M, Y);
+  Result := 12 * Y + M;
+  if (D > 1) and (D < 7) then Result := Result + 0.25
+  else if (D >= 7) and (D < 15) then Result := Result + 0.5
+  else if (D >= 15) and (D < 21) then Result := Result + 0.75
+  else if (D >= 21) then Result := Result + 1;
+end;
+
+function IsValidDate(Y, M, D: Word): Boolean;
+begin
+  Result := (Y >= 1) and (Y <= 9999) and (M >= 1) and (M <= 12) and
+    (D >= 1) and (D <= DaysPerMonth(Y, M));
+end;
+
+function ValidDate(ADate: TDateTime): Boolean;
+var
+  Year, Month, Day: Word;
+begin
+  try
+    DecodeDate(ADate, Year, Month, Day);
+    Result := IsValidDate(Year, Month, Day);
+  except
+    Result := False;
+  end;
+end;
+
+function DaysInPeriod(Date1, Date2: TDateTime): Longint;
+begin
+  if ValidDate(Date1) and ValidDate(Date2) then
+    Result := Abs(Trunc(Date2) - Trunc(Date1)) + 1
+  else Result := 0;
+end;
+
+function DaysBetween(Date1, Date2: TDateTime): Longint;
+begin
+  Result := Trunc(Date2) - Trunc(Date1) + 1;
+  if Result < 0 then Result := 0;
+end;
+
+function IncTime(ATime: TDateTime; Hours, Minutes, Seconds,
+  MSecs: Integer): TDateTime;
+begin
+  Result := ATime + (Hours div 24) + (((Hours mod 24) * 3600000 +
+    Minutes * 60000 + Seconds * 1000 + MSecs) / MSecsPerDay);
+  if Result < 0 then Result := Result + 1;
+end;
+
+function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncTime(ATime, Delta, 0, 0, 0);
+end;
+
+function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncTime(ATime, 0, Delta, 0, 0);
+end;
+
+function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncTime(ATime, 0, 0, Delta, 0);
+end;
+
+function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncTime(ATime, 0, 0, 0, Delta);
+end;
+
+function CutTime(ADate: TDateTime): TDateTime;
+begin
+  Result := Trunc(ADate);
+end;
+
+function CurrentYear: Word;
+var
+  SystemTime: TSystemTime;
+begin
+  GetLocalTime(SystemTime);
+  Result := SystemTime.Year;
+end;
+
+{ String to date conversions. Copied from SYSUTILS.PAS unit. }
+
+procedure ScanBlanks(const S: string; var Pos: Integer);
+var
+  I: Integer;
+begin
+  I := Pos;
+  while (I <= Length(S)) and (S[I] = ' ') do Inc(I);
+  Pos := I;
+end;
+
+function ScanNumber(const S: string; MaxLength: Integer; var Pos: Integer;
+  var Number: Longint): Boolean;
+var
+  I: Integer;
+  N: Word;
+begin
+  Result := False;
+  ScanBlanks(S, Pos);
+  I := Pos;
+  N := 0;
+  while (I <= Length(S)) and (Longint(I - Pos) < MaxLength) and
+    (S[I] in ['0'..'9']) and (N < 1000) do
+  begin
+    N := N * 10 + (Ord(S[I]) - Ord('0'));
+    Inc(I);
+  end;
+  if I > Pos then begin
+    Pos := I;
+    Number := N;
+    Result := True;
+  end;
+end;
+
+function ScanChar(const S: string; var Pos: Integer; Ch: Char): Boolean;
+begin
+  Result := False;
+  ScanBlanks(S, Pos);
+  if (Pos <= Length(S)) and (S[Pos] = Ch) then begin
+    Inc(Pos);
+    Result := True;
+  end;
+end;
+
+{$IFDEF RX_D3}
+procedure ScanToNumber(const S: string; var Pos: Integer);
+begin
+  while (Pos <= Length(S)) and not (S[Pos] in ['0'..'9']) do begin
+    if S[Pos] in LeadBytes then Inc(Pos);
+    Inc(Pos);
+  end;
+end;
+{$ENDIF}
+
+function GetDateOrder(const DateFormat: string): TDateOrder;
+var
+  I: Integer;
+begin
+  Result := DefaultDateOrder;
+  I := 1;
+  while I <= Length(DateFormat) do begin
+    case Chr(Ord(DateFormat[I]) and $DF) of
+{$IFDEF RX_D3}
+      'E': Result := doYMD;
+{$ENDIF}
+      'Y': Result := doYMD;
+      'M': Result := doMDY;
+      'D': Result := doDMY;
+    else
+      Inc(I);
+      Continue;
+    end;
+    Exit;
+  end;
+  Result := DefaultDateOrder; { default }
+end;
+
+function ExpandYear(Year: Integer): Integer;
+var
+  N: Longint;
+begin
+  Result := Year;
+  if Result < 100 then begin
+    N := CurrentYear - CenturyOffset;
+    Inc(Result, N div 100 * 100);
+    if (CenturyOffset > 0) and (Result < N) then
+      Inc(Result, 100);
+  end;
+end;
+
+function ScanDate(const S, DateFormat: string; var Pos: Integer;
+  var Y, M, D: Integer): Boolean;
+var
+  DateOrder: TDateOrder;
+  N1, N2, N3: Longint;
+begin
+  Result := False;
+  Y := 0; M := 0; D := 0;
+  DateOrder := GetDateOrder(DateFormat);
+  if DefaultFormatSettings.ShortDateFormat[1] = 'g' then { skip over prefix text }
+    ScanToNumber(S, Pos);
+  if not (ScanNumber(S, MaxInt, Pos, N1) and ScanChar(S, Pos, DateSeparator) and
+    ScanNumber(S, MaxInt, Pos, N2)) then Exit;
+  if ScanChar(S, Pos, DateSeparator) then begin
+    if not ScanNumber(S, MaxInt, Pos, N3) then Exit;
+    case DateOrder of
+      doMDY: begin Y := N3; M := N1; D := N2; end;
+      doDMY: begin Y := N3; M := N2; D := N1; end;
+      doYMD: begin Y := N1; M := N2; D := N3; end;
+    end;
+    Y := ExpandYear(Y);
+  end
+  else begin
+    Y := CurrentYear;
+    if DateOrder = doDMY then begin
+      D := N1; M := N2;
+    end
+    else begin
+      M := N1; D := N2;
+    end;
+  end;
+  ScanChar(S, Pos, DefaultFormatSettings.DateSeparator);
+  ScanBlanks(S, Pos);
+(*
+{$IFDEF RX_D3}
+  if SysLocale.FarEast and (System.Pos('ddd', ShortDateFormat) <> 0) then
+  begin { ignore trailing text }
+    if ShortTimeFormat[1] in ['0'..'9'] then  { stop at time digit }
+      ScanToNumber(S, Pos)
+    else  { stop at time prefix }
+      repeat
+        while (Pos <= Length(S)) and (S[Pos] <> ' ') do Inc(Pos);
+        ScanBlanks(S, Pos);
+      until (Pos > Length(S)) or
+        (AnsiCompareText(TimeAMString, Copy(S, Pos, Length(TimeAMString))) = 0) or
+        (AnsiCompareText(TimePMString, Copy(S, Pos, Length(TimePMString))) = 0);
+  end;
+{$ENDIF RX_D3}
+*)
+  Result := IsValidDate(Y, M, D) and (Pos > Length(S));
+end;
+
+function MonthFromName(const S: string; MaxLen: Byte): Byte;
+begin
+  if Length(S) > 0 then
+    for Result := 1 to 12 do begin
+      if (Length(DefaultFormatSettings.LongMonthNames[Result]) > 0) and
+        (AnsiCompareText(Copy(S, 1, MaxLen),
+        Copy(DefaultFormatSettings.LongMonthNames[Result], 1, MaxLen)) = 0) then Exit;
+    end;
+  Result := 0;
+end;
+
+procedure ExtractMask(const Format, S: string; Ch: Char; Cnt: Integer;
+  var I: Integer; Blank, Default: Integer);
+var
+  Tmp: string[20];
+  J, L: Integer;
+begin
+  I := Default;
+  Ch := UpCase(Ch);
+  L := Length(Format);
+  if Length(S) < L then L := Length(S)
+  else if Length(S) > L then Exit;
+  J := Pos(MakeStr(Ch, Cnt), AnsiUpperCase(Format));
+  if J <= 0 then Exit;
+  Tmp := '';
+  while (UpCase(Format[J]) = Ch) and (J <= L) do begin
+    if S[J] <> ' ' then Tmp := Tmp + S[J];
+    Inc(J);
+  end;
+  if Tmp = '' then I := Blank
+  else if Cnt > 1 then begin
+    I := MonthFromName(Tmp, Length(Tmp));
+    if I = 0 then I := -1;
+  end
+  else I := StrToIntDef(Tmp, -1);
+end;
+
+function ScanDateStr(const Format, S: string; var D, M, Y: Integer): Boolean;
+var
+  Pos: Integer;
+begin
+  ExtractMask(Format, S, 'm', 3, M, -1, 0); { short month name? }
+  if M = 0 then ExtractMask(Format, S, 'm', 1, M, -1, 0);
+  ExtractMask(Format, S, 'd', 1, D, -1, 1);
+  ExtractMask(Format, S, 'y', 1, Y, -1, CurrentYear);
+  Y := ExpandYear(Y);
+  Result := IsValidDate(Y, M, D);
+  if not Result then begin
+    Pos := 1;
+    Result := ScanDate(S, Format, Pos, Y, M, D);
+  end;
+end;
+
+function InternalStrToDate(const DateFormat, S: string;
+  var Date: TDateTime): Boolean;
+var
+  D, M, Y: Integer;
+begin
+  if S = '' then begin
+    Date := NullDate;
+    Result := True;
+  end
+  else begin
+    Result := ScanDateStr(DateFormat, S, D, M, Y);
+    if Result then
+    try
+      Date := EncodeDate(Y, M, D);
+    except
+      Result := False;
+    end;
+  end;
+end;
+
+function StrToDateFmt(const DateFormat, S: string): TDateTime;
+begin
+  if not InternalStrToDate(DateFormat, S, Result) then
+    raise EConvertError.CreateFmt({$IFDEF RX_D3} SInvalidDate {$ELSE}
+      LoadStr(SInvalidDate) {$ENDIF}, [S]);
+end;
+
+function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
+begin
+  if not InternalStrToDate(DefaultFormatSettings.ShortDateFormat, S, Result) then
+    Result := Trunc(Default);
+end;
+
+function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
+begin
+  if not InternalStrToDate(DateFormat, S, Result) then
+    Result := Trunc(Default);
+end;
+
+function DefDateFormat(FourDigitYear: Boolean): string;
+begin
+  if FourDigitYear then begin
+    case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
+      doMDY: Result := 'MM/DD/YYYY';
+      doDMY: Result := 'DD/MM/YYYY';
+      doYMD: Result := 'YYYY/MM/DD';
+    end;
+  end
+  else begin
+    case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
+      doMDY: Result := 'MM/DD/YY';
+      doDMY: Result := 'DD/MM/YY';
+      doYMD: Result := 'YY/MM/DD';
+    end;
+  end;
+end;
+
+function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string;
+begin
+  if FourDigitYear then begin
+    case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
+      doMDY, doDMY: Result := '!99/99/9999;1;';
+      doYMD: Result := '!9999/99/99;1;';
+    end;
+  end
+  else begin
+    case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
+      doMDY, doDMY: Result := '!99/99/99;1;';
+      doYMD: Result := '!99/99/99;1;';
+    end;
+  end;
+  if Result <> '' then Result := Result + BlanksChar;
+end;
+
+
+{$IFDEF WIN32}
+
+function FormatLongDate(Value: TDateTime): string;
+var
+  Buffer: array[0..1023] of Char;
+  SystemTime: TSystemTime;
+begin
+{$IFDEF RX_D3}
+  DateTimeToSystemTime(Value, SystemTime);
+{$ELSE}
+  with SystemTime do
+  begin
+    DecodeDate(Value, wYear, wMonth, wDay);
+    DecodeTime(Value, wHour, wMinute, wSecond, wMilliseconds);
+  end;
+{$ENDIF}
+  SetString(Result, Buffer, GetDateFormat(GetThreadLocale, DATE_LONGDATE,
+    @SystemTime, nil, Buffer, SizeOf(Buffer) - 1));
+  Result := TrimRight(Result);
+end;
+
+function FormatLongDateTime(Value: TDateTime): string;
+begin
+  if Value <> NullDate then
+    Result := FormatLongDate(Value) + FormatDateTime(' tt', Value)
+  else Result := '';
+end;
+
+{$ENDIF WIN32}
+
+{$IFNDEF USE_FOUR_DIGIT_YEAR}
+function FourDigitYear: Boolean;
+begin
+  Result := Pos('YYYY', AnsiUpperCase(DefaultFormatSettings.ShortDateFormat)) > 0;
+end;
+{$ENDIF}
+
+{$IFDEF USE_FOUR_DIGIT_YEAR}
+initialization
+  FourDigitYear := Pos('YYYY', AnsiUpperCase(ShortDateFormat)) > 0;
+{$ENDIF}
+end.