* check for frac(dt) being slightly lower than a whole number. Patch by Werner P

Resolves #40140
This commit is contained in:
marcoonthegit 2023-04-23 12:32:53 +02:00
parent facf28fb29
commit 8d0b822a27

View File

@ -1005,6 +1005,14 @@ var
var
Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
function FullDays(ADateTime: TDateTime): Integer;
begin
if ADateTime < 0 then ADateTime := -ADateTime;
Result := trunc(ADateTime);
if (frac(ADateTime) > 0.9) and (Hour = 0) and (Minute = 0) and (Second = 0) and (Millisecond = 0) then
inc(Result);
end;
procedure StoreFormat(const FormatStr: string; Nesting: Integer; TimeFlag: Boolean);
var
Token, lastformattoken, prevlasttoken: char;
@ -1110,7 +1118,7 @@ var
end;
'M': begin
if isInterval and ((prevlasttoken = 'H') or TimeFlag) then
StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
StoreInt(Minute + (Hour + FullDays(DateTime)*24)*60, 0)
else
if (lastformattoken = 'H') or TimeFlag then
begin
@ -1143,7 +1151,7 @@ var
end ;
'H':
if isInterval then
StoreInt(Hour + trunc(abs(DateTime))*24, Count)
StoreInt(Hour + FullDays(DateTime)*24, Count)
else
if Clock12 then
begin
@ -1161,14 +1169,14 @@ var
StoreInt(Hour, 2);
end;
'N': if isInterval then
StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, Count)
StoreInt(Minute + (Hour + FullDays(DateTime)*24)*60, Count)
else
if Count = 1 then
StoreInt(Minute, 0)
else
StoreInt(Minute, 2);
'S': if isInterval then
StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, Count)
StoreInt(Second + (Minute + (Hour + FullDays(DateTime)*24)*60)*60, Count)
else
if Count = 1 then
StoreInt(Second, 0)
@ -1250,6 +1258,8 @@ begin
StoreFormat('C', 0, False);
ResultBuffer[ResultLen] := #0;
result := StrPas(@ResultBuffer[0]);
if (DateTime < 0) and (fdoInterval in Options) then
result := '-' + result;
end ;