home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / DATEUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  17KB  |  632 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997, 1998 Master-Bank          }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DateUtil;
  11.  
  12. {$I RX.INC}
  13. {$B-,V-,R-,Q-}
  14.  
  15. interface
  16.  
  17.   uses RTLConsts;
  18.  
  19. function CurrentYear: Word;
  20. function IsLeapYear(AYear: Integer): Boolean;
  21. function DaysPerMonth(AYear, AMonth: Integer): Integer;
  22. function FirstDayOfPrevMonth: TDateTime;
  23. function LastDayOfPrevMonth: TDateTime;
  24. function FirstDayOfNextMonth: TDateTime;
  25. function ExtractDay(ADate: TDateTime): Word;
  26. function ExtractMonth(ADate: TDateTime): Word;
  27. function ExtractYear(ADate: TDateTime): Word;
  28. function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
  29. function IncDay(ADate: TDateTime; Delta: Integer): TDateTime;
  30. function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
  31. function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
  32. function ValidDate(ADate: TDateTime): Boolean;
  33. procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
  34. function MonthsBetween(Date1, Date2: TDateTime): Double;
  35. function DaysInPeriod(Date1, Date2: TDateTime): Longint;
  36.   { Count days between Date1 and Date2 + 1, so if Date1 = Date2 result = 1 }
  37. function DaysBetween(Date1, Date2: TDateTime): Longint;
  38.   { The same as previous but if Date2 < Date1 result = 0 }
  39.  
  40. function IncTime(ATime: TDateTime; Hours, Minutes, Seconds, MSecs: Integer): TDateTime;
  41. function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
  42. function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
  43. function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
  44. function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
  45. function CutTime(ADate: TDateTime): TDateTime; { Set time to 00:00:00:00 }
  46.  
  47. type
  48.   TDateOrder = (doMDY, doDMY, doYMD);
  49.   TDayOfWeekName = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
  50.   TDaysOfWeek = set of TDayOfWeekName;
  51.  
  52. { String to date conversions }
  53. function GetDateOrder(const DateFormat: string): TDateOrder;
  54. function MonthFromName(const S: string; MaxLen: Byte): Byte;
  55. function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
  56. function StrToDateFmt(const DateFormat, S: string): TDateTime;
  57. function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
  58. function DefDateFormat(FourDigitYear: Boolean): string;
  59. function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string;
  60.  
  61. {$IFDEF WIN32}
  62. function FormatLongDate(Value: TDateTime): string;
  63. function FormatLongDateTime(Value: TDateTime): string;
  64. {$ENDIF}
  65.  
  66. const
  67.   DefaultDateOrder = doDMY;
  68.  
  69. {$IFDEF USE_FOUR_DIGIT_YEAR}
  70. var
  71.   FourDigitYear: Boolean;
  72. {$ELSE}
  73. function FourDigitYear: Boolean;
  74. {$ENDIF USE_FOUR_DIGIT_YEAR}
  75.  
  76. const
  77.   CenturyOffset: Byte = 60;
  78. {$IFDEF WIN32}
  79.   NullDate: TDateTime = {-693594} 0;
  80. {$ELSE}
  81.   NullDate: TDateTime = 0;
  82. {$ENDIF}
  83.  
  84. implementation
  85.  
  86. uses SysUtils, {$IFDEF WIN32} Windows, {$ENDIF} Consts, rxStrUtils;
  87.  
  88. function IsLeapYear(AYear: Integer): Boolean;
  89. begin
  90.   Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
  91. end;
  92.  
  93. function DaysPerMonth(AYear, AMonth: Integer): Integer;
  94. const
  95.   DaysInMonth: array[1..12] of Integer =
  96.     (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  97. begin
  98.   Result := DaysInMonth[AMonth];
  99.   if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
  100. end;
  101.  
  102. function FirstDayOfNextMonth: TDateTime;
  103. var
  104.   Year, Month, Day: Word;
  105. begin
  106.   DecodeDate(Date, Year, Month, Day);
  107.   Day := 1;
  108.   if Month < 12 then Inc(Month)
  109.   else begin
  110.     Inc(Year);
  111.     Month := 1;
  112.   end;
  113.   Result := EncodeDate(Year, Month, Day);
  114. end;
  115.  
  116. function FirstDayOfPrevMonth: TDateTime;
  117. var
  118.   Year, Month, Day: Word;
  119. begin
  120.   DecodeDate(Date, Year, Month, Day);
  121.   Day := 1;
  122.   if Month > 1 then Dec(Month)
  123.   else begin
  124.     Dec(Year);
  125.     Month := 12;
  126.   end;
  127.   Result := EncodeDate(Year, Month, Day);
  128. end;
  129.  
  130. function LastDayOfPrevMonth: TDateTime;
  131. var
  132.   D: TDateTime;
  133.   Year, Month, Day: Word;
  134. begin
  135.   D := FirstDayOfPrevMonth;
  136.   DecodeDate(D, Year, Month, Day);
  137.   Day := DaysPerMonth(Year, Month);
  138.   Result := EncodeDate(Year, Month, Day);
  139. end;
  140.  
  141. function ExtractDay(ADate: TDateTime): Word;
  142. var
  143.   M, Y: Word;
  144. begin
  145.   DecodeDate(ADate, Y, M, Result);
  146. end;
  147.  
  148. function ExtractMonth(ADate: TDateTime): Word;
  149. var
  150.   D, Y: Word;
  151. begin
  152.   DecodeDate(ADate, Y, Result, D);
  153. end;
  154.  
  155. function ExtractYear(ADate: TDateTime): Word;
  156. var
  157.   D, M: Word;
  158. begin
  159.   DecodeDate(ADate, Result, M, D);
  160. end;
  161.  
  162. function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
  163. var
  164.   D, M, Y: Word;
  165.   Day, Month, Year: Longint;
  166. begin
  167.   DecodeDate(ADate, Y, M, D);
  168.   Year := Y; Month := M; Day := D;
  169.   Inc(Year, Years);
  170.   Inc(Year, Months div 12);
  171.   Inc(Month, Months mod 12);
  172.   if Month < 1 then begin
  173.     Inc(Month, 12);
  174.     Dec(Year);
  175.   end
  176.   else if Month > 12 then begin
  177.     Dec(Month, 12);
  178.     Inc(Year);
  179.   end;
  180.   if Day > DaysPerMonth(Year, Month) then Day := DaysPerMonth(Year, Month);
  181.   Result := EncodeDate(Year, Month, Day) + Days + Frac(ADate);
  182. end;
  183.  
  184. procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
  185. { Corrected by Anatoly A. Sanko (2:450/73) }
  186. var
  187.   DtSwap: TDateTime;
  188.   Day1, Day2, Month1, Month2, Year1, Year2: Word;
  189. begin
  190.   if Date1 > Date2 then begin
  191.     DtSwap := Date1;
  192.     Date1 := Date2;
  193.     Date2 := DtSwap;
  194.   end;
  195.   DecodeDate(Date1, Year1, Month1, Day1);
  196.   DecodeDate(Date2, Year2, Month2, Day2);
  197.   Years := Year2 - Year1;
  198.   Months := 0;
  199.   Days := 0;
  200.   if Month2 < Month1 then begin
  201.     Inc(Months, 12);
  202.     Dec(Years);
  203.   end;
  204.   Inc(Months, Month2 - Month1);
  205.   if Day2 < Day1 then begin
  206.     Inc(Days, DaysPerMonth(Year1, Month1));
  207.     if Months = 0 then begin
  208.       Dec(Years);
  209.       Months := 11;
  210.     end
  211.     else Dec(Months);
  212.   end;
  213.   Inc(Days, Day2 - Day1);
  214. end;
  215.  
  216. function IncDay(ADate: TDateTime; Delta: Integer): TDateTime;
  217. begin
  218.   Result := ADate + Delta;
  219. end;
  220.  
  221. function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
  222. begin
  223.   Result := IncDate(ADate, 0, Delta, 0);
  224. end;
  225.  
  226. function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
  227. begin
  228.   Result := IncDate(ADate, 0, 0, Delta);
  229. end;
  230.  
  231. function MonthsBetween(Date1, Date2: TDateTime): Double;
  232. var
  233.   D, M, Y: Word;
  234. begin
  235.   DateDiff(Date1, Date2, D, M, Y);
  236.   Result := 12 * Y + M;
  237.   if (D > 1) and (D < 7) then Result := Result + 0.25
  238.   else if (D >= 7) and (D < 15) then Result := Result + 0.5
  239.   else if (D >= 15) and (D < 21) then Result := Result + 0.75
  240.   else if (D >= 21) then Result := Result + 1;
  241. end;
  242.  
  243. function IsValidDate(Y, M, D: Word): Boolean;
  244. begin
  245.   Result := (Y >= 1) and (Y <= 9999) and (M >= 1) and (M <= 12) and
  246.     (D >= 1) and (D <= DaysPerMonth(Y, M));
  247. end;
  248.  
  249. function ValidDate(ADate: TDateTime): Boolean;
  250. var
  251.   Year, Month, Day: Word;
  252. begin
  253.   try
  254.     DecodeDate(ADate, Year, Month, Day);
  255.     Result := IsValidDate(Year, Month, Day);
  256.   except
  257.     Result := False;
  258.   end;
  259. end;
  260.  
  261. function DaysInPeriod(Date1, Date2: TDateTime): Longint;
  262. begin
  263.   if ValidDate(Date1) and ValidDate(Date2) then
  264.     Result := Abs(Trunc(Date2) - Trunc(Date1)) + 1
  265.   else Result := 0;
  266. end;
  267.  
  268. function DaysBetween(Date1, Date2: TDateTime): Longint;
  269. begin
  270.   Result := Trunc(Date2) - Trunc(Date1) + 1;
  271.   if Result < 0 then Result := 0;
  272. end;
  273.  
  274. function IncTime(ATime: TDateTime; Hours, Minutes, Seconds,
  275.   MSecs: Integer): TDateTime;
  276. begin
  277.   Result := ATime + (Hours div 24) + (((Hours mod 24) * 3600000 +
  278.     Minutes * 60000 + Seconds * 1000 + MSecs) / MSecsPerDay);
  279.   if Result < 0 then Result := Result + 1;
  280. end;
  281.  
  282. function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
  283. begin
  284.   Result := IncTime(ATime, Delta, 0, 0, 0);
  285. end;
  286.  
  287. function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
  288. begin
  289.   Result := IncTime(ATime, 0, Delta, 0, 0);
  290. end;
  291.  
  292. function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
  293. begin
  294.   Result := IncTime(ATime, 0, 0, Delta, 0);
  295. end;
  296.  
  297. function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
  298. begin
  299.   Result := IncTime(ATime, 0, 0, 0, Delta);
  300. end;
  301.  
  302. function CutTime(ADate: TDateTime): TDateTime;
  303. begin
  304.   Result := Trunc(ADate);
  305. end;
  306.  
  307. function CurrentYear: Word; {$IFNDEF WIN32} assembler; {$ENDIF}
  308. {$IFDEF WIN32}
  309. var
  310.   SystemTime: TSystemTime;
  311. begin
  312.   GetLocalTime(SystemTime);
  313.   Result := SystemTime.wYear;
  314. end;
  315. {$ELSE}
  316. asm
  317.         MOV     AH,2AH
  318.         INT     21H
  319.         MOV     AX,CX
  320. end;
  321. {$ENDIF}
  322.  
  323. { String to date conversions. Copied from SYSUTILS.PAS unit. }
  324.  
  325. procedure ScanBlanks(const S: string; var Pos: Integer);
  326. var
  327.   I: Integer;
  328. begin
  329.   I := Pos;
  330.   while (I <= Length(S)) and (S[I] = ' ') do Inc(I);
  331.   Pos := I;
  332. end;
  333.  
  334. function ScanNumber(const S: string; MaxLength: Integer; var Pos: Integer;
  335.   var Number: Longint): Boolean;
  336. var
  337.   I: Integer;
  338.   N: Word;
  339. begin
  340.   Result := False;
  341.   ScanBlanks(S, Pos);
  342.   I := Pos;
  343.   N := 0;
  344.   while (I <= Length(S)) and (Longint(I - Pos) < MaxLength) and
  345.     (S[I] in ['0'..'9']) and (N < 1000) do
  346.   begin
  347.     N := N * 10 + (Ord(S[I]) - Ord('0'));
  348.     Inc(I);
  349.   end;
  350.   if I > Pos then begin
  351.     Pos := I;
  352.     Number := N;
  353.     Result := True;
  354.   end;
  355. end;
  356.  
  357. function ScanChar(const S: string; var Pos: Integer; Ch: Char): Boolean;
  358. begin
  359.   Result := False;
  360.   ScanBlanks(S, Pos);
  361.   if (Pos <= Length(S)) and (S[Pos] = Ch) then begin
  362.     Inc(Pos);
  363.     Result := True;
  364.   end;
  365. end;
  366.  
  367. {$IFDEF RX_D3}
  368. procedure ScanToNumber(const S: string; var Pos: Integer);
  369. begin
  370.   while (Pos <= Length(S)) and not (S[Pos] in ['0'..'9']) do begin
  371.     if S[Pos] in LeadBytes then Inc(Pos);
  372.     Inc(Pos);
  373.   end;
  374. end;
  375. {$ENDIF}
  376.  
  377. function GetDateOrder(const DateFormat: string): TDateOrder;
  378. var
  379.   I: Integer;
  380. begin
  381.   Result := DefaultDateOrder;
  382.   I := 1;
  383.   while I <= Length(DateFormat) do begin
  384.     case Chr(Ord(DateFormat[I]) and $DF) of
  385. {$IFDEF RX_D3}
  386.       'E': Result := doYMD;
  387. {$ENDIF}
  388.       'Y': Result := doYMD;
  389.       'M': Result := doMDY;
  390.       'D': Result := doDMY;
  391.     else
  392.       Inc(I);
  393.       Continue;
  394.     end;
  395.     Exit;
  396.   end;
  397.   Result := DefaultDateOrder; { default }
  398. end;
  399.  
  400. function ExpandYear(Year: Integer): Integer;
  401. var
  402.   N: Longint;
  403. begin
  404.   Result := Year;
  405.   if Result < 100 then begin
  406.     N := CurrentYear - CenturyOffset;
  407.     Inc(Result, N div 100 * 100);
  408.     if (CenturyOffset > 0) and (Result < N) then
  409.       Inc(Result, 100);
  410.   end;
  411. end;
  412.  
  413. function ScanDate(const S, DateFormat: string; var Pos: Integer;
  414.   var Y, M, D: Integer): Boolean;
  415. var
  416.   DateOrder: TDateOrder;
  417.   N1, N2, N3: Longint;
  418. begin
  419.   Result := False;
  420.   Y := 0; M := 0; D := 0;
  421.   DateOrder := GetDateOrder(DateFormat);
  422. {$IFDEF RX_D3}
  423.   if ShortDateFormat[1] = 'g' then { skip over prefix text }
  424.     ScanToNumber(S, Pos);
  425. {$ENDIF RX_D3}
  426.   if not (ScanNumber(S, MaxInt, Pos, N1) and ScanChar(S, Pos, DateSeparator) and
  427.     ScanNumber(S, MaxInt, Pos, N2)) then Exit;
  428.   if ScanChar(S, Pos, DateSeparator) then begin
  429.     if not ScanNumber(S, MaxInt, Pos, N3) then Exit;
  430.     case DateOrder of
  431.       doMDY: begin Y := N3; M := N1; D := N2; end;
  432.       doDMY: begin Y := N3; M := N2; D := N1; end;
  433.       doYMD: begin Y := N1; M := N2; D := N3; end;
  434.     end;
  435.     Y := ExpandYear(Y);
  436.   end
  437.   else begin
  438.     Y := CurrentYear;
  439.     if DateOrder = doDMY then begin
  440.       D := N1; M := N2;
  441.     end
  442.     else begin
  443.       M := N1; D := N2;
  444.     end;
  445.   end;
  446.   ScanChar(S, Pos, DateSeparator);
  447.   ScanBlanks(S, Pos);
  448. {$IFDEF RX_D3}
  449.   if SysLocale.FarEast and (System.Pos('ddd', ShortDateFormat) <> 0) then
  450.   begin { ignore trailing text }
  451.     if ShortTimeFormat[1] in ['0'..'9'] then  { stop at time digit }
  452.       ScanToNumber(S, Pos)
  453.     else  { stop at time prefix }
  454.       repeat
  455.         while (Pos <= Length(S)) and (S[Pos] <> ' ') do Inc(Pos);
  456.         ScanBlanks(S, Pos);
  457.       until (Pos > Length(S)) or
  458.         (AnsiCompareText(TimeAMString, Copy(S, Pos, Length(TimeAMString))) = 0) or
  459.         (AnsiCompareText(TimePMString, Copy(S, Pos, Length(TimePMString))) = 0);
  460.   end;
  461. {$ENDIF RX_D3}
  462.   Result := IsValidDate(Y, M, D) and (Pos > Length(S));
  463. end;
  464.  
  465. function MonthFromName(const S: string; MaxLen: Byte): Byte;
  466. begin
  467.   if Length(S) > 0 then
  468.     for Result := 1 to 12 do begin
  469.       if (Length(LongMonthNames[Result]) > 0) and
  470.         (AnsiCompareText(Copy(S, 1, MaxLen),
  471.         Copy(LongMonthNames[Result], 1, MaxLen)) = 0) then Exit;
  472.     end;
  473.   Result := 0;
  474. end;
  475.  
  476. procedure ExtractMask(const Format, S: string; Ch: Char; Cnt: Integer;
  477.   var I: Integer; Blank, Default: Integer);
  478. var
  479.   Tmp: string[20];
  480.   J, L: Integer;
  481. begin
  482.   I := Default;
  483.   Ch := UpCase(Ch);
  484.   L := Length(Format);
  485.   if Length(S) < L then L := Length(S)
  486.   else if Length(S) > L then Exit;
  487.   J := Pos(MakeStr(Ch, Cnt), AnsiUpperCase(Format));
  488.   if J <= 0 then Exit;
  489.   Tmp := '';
  490.   while (UpCase(Format[J]) = Ch) and (J <= L) do begin
  491.     if S[J] <> ' ' then Tmp := Tmp + S[J];
  492.     Inc(J);
  493.   end;
  494.   if Tmp = '' then I := Blank
  495.   else if Cnt > 1 then begin
  496.     I := MonthFromName(Tmp, Length(Tmp));
  497.     if I = 0 then I := -1;
  498.   end
  499.   else I := StrToIntDef(Tmp, -1);
  500. end;
  501.  
  502. function ScanDateStr(const Format, S: string; var D, M, Y: Integer): Boolean;
  503. var
  504.   Pos: Integer;
  505. begin
  506.   ExtractMask(Format, S, 'm', 3, M, -1, 0); { short month name? }
  507.   if M = 0 then ExtractMask(Format, S, 'm', 1, M, -1, 0);
  508.   ExtractMask(Format, S, 'd', 1, D, -1, 1);
  509.   ExtractMask(Format, S, 'y', 1, Y, -1, CurrentYear);
  510.   Y := ExpandYear(Y);
  511.   Result := IsValidDate(Y, M, D);
  512.   if not Result then begin
  513.     Pos := 1;
  514.     Result := ScanDate(S, Format, Pos, Y, M, D);
  515.   end;
  516. end;
  517.  
  518. function InternalStrToDate(const DateFormat, S: string;
  519.   var Date: TDateTime): Boolean;
  520. var
  521.   D, M, Y: Integer;
  522. begin
  523.   if S = '' then begin
  524.     Date := NullDate;
  525.     Result := True;
  526.   end
  527.   else begin
  528.     Result := ScanDateStr(DateFormat, S, D, M, Y);
  529.     if Result then
  530.     try
  531.       Date := EncodeDate(Y, M, D);
  532.     except
  533.       Result := False;
  534.     end;
  535.   end;
  536. end;
  537.  
  538. function StrToDateFmt(const DateFormat, S: string): TDateTime;
  539. begin
  540.   if not InternalStrToDate(DateFormat, S, Result) then
  541.     raise EConvertError.CreateFmt({$IFDEF RX_D3} SInvalidDate {$ELSE}
  542.       LoadStr(SInvalidDate) {$ENDIF}, [S]);
  543. end;
  544.  
  545. function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
  546. begin
  547.   if not InternalStrToDate(ShortDateFormat, S, Result) then
  548.     Result := Trunc(Default);
  549. end;
  550.  
  551. function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
  552. begin
  553.   if not InternalStrToDate(DateFormat, S, Result) then
  554.     Result := Trunc(Default);
  555. end;
  556.  
  557. function DefDateFormat(FourDigitYear: Boolean): string;
  558. begin
  559.   if FourDigitYear then begin
  560.     case GetDateOrder(ShortDateFormat) of
  561.       doMDY: Result := 'MM/DD/YYYY';
  562.       doDMY: Result := 'DD/MM/YYYY';
  563.       doYMD: Result := 'YYYY/MM/DD';
  564.     end;
  565.   end
  566.   else begin
  567.     case GetDateOrder(ShortDateFormat) of
  568.       doMDY: Result := 'MM/DD/YY';
  569.       doDMY: Result := 'DD/MM/YY';
  570.       doYMD: Result := 'YY/MM/DD';
  571.     end;
  572.   end;
  573. end;
  574.  
  575. function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string;
  576. begin
  577.   if FourDigitYear then begin
  578.     case GetDateOrder(ShortDateFormat) of
  579.       doMDY, doDMY: Result := '!99/99/9999;1;';
  580.       doYMD: Result := '!9999/99/99;1;';
  581.     end;
  582.   end
  583.   else begin
  584.     case GetDateOrder(ShortDateFormat) of
  585.       doMDY, doDMY: Result := '!99/99/99;1;';
  586.       doYMD: Result := '!99/99/99;1;';
  587.     end;
  588.   end;
  589.   if Result <> '' then Result := Result + BlanksChar;
  590. end;
  591.  
  592. {$IFDEF WIN32}
  593.  
  594. function FormatLongDate(Value: TDateTime): string;
  595. var
  596.   Buffer: array[0..1023] of Char;
  597.   SystemTime: TSystemTime;
  598. begin
  599. {$IFDEF RX_D3}
  600.   DateTimeToSystemTime(Value, SystemTime);
  601. {$ELSE}
  602.   with SystemTime do begin
  603.     DecodeDate(Value, wYear, wMonth, wDay);
  604.     DecodeTime(Value, wHour, wMinute, wSecond, wMilliseconds);
  605.   end;
  606. {$ENDIF}
  607.   SetString(Result, Buffer, GetDateFormat(GetThreadLocale, DATE_LONGDATE,
  608.     @SystemTime, nil, Buffer, SizeOf(Buffer) - 1));
  609.   Result := TrimRight(Result);
  610. end;
  611.  
  612. function FormatLongDateTime(Value: TDateTime): string;
  613. begin
  614.   if Value <> NullDate then
  615.     Result := FormatLongDate(Value) + FormatDateTime(' tt', Value)
  616.   else Result := '';
  617. end;
  618.  
  619. {$ENDIF WIN32}
  620.  
  621. {$IFNDEF USE_FOUR_DIGIT_YEAR}
  622. function FourDigitYear: Boolean;
  623. begin
  624.   Result := Pos('YYYY', AnsiUpperCase(ShortDateFormat)) > 0;
  625. end;
  626. {$ENDIF}
  627.  
  628. {$IFDEF USE_FOUR_DIGIT_YEAR}
  629. initialization
  630.   FourDigitYear := Pos('YYYY', AnsiUpperCase(ShortDateFormat)) > 0;
  631. {$ENDIF}
  632. end.