Patches to TZTimeField and TZDateTimeField GetText
Posted: 15.11.2020, 18:57
Here's the TZTimeField patch:
Here's the TZDateTimeField patch:
I've tested these with MySQL and Oracle timestamps, multiple scales, both simple and non-simple date formats (with/without AM/PM indicators.)
-Mark
Code: Select all
procedure TZTimeField.GetText(var Text: string; DisplayText: Boolean);
var
Frmt: string;
Delim, Sep: Char;
DT: TDateTime;
T: TZTime;
I,J: LengthInt;
Fraction: Cardinal;
B: Boolean;
P: PChar;
Millis: Word;
begin
if FilledValueWasNull(T)
then Text := ''
else begin
B := DisplayText and (DisplayFormat <> '');
if B then begin
Frmt := DisplayFormat;
Sep := #0;
end else begin
Frmt := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}LongTimeFormat;
Sep := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}TimeSeparator;
end;
if (Frmt <> FLastFormat[B]) or (not B and (Sep <> FLastTimeSep)) then begin
FLastFormat[B] := Frmt;
if not B then begin
FLastTimeSep := Sep;
if FindFirstTimeFormatDelimiter(Frmt, Delim) and (Delim <> Sep) then
Frmt := ZSysUtils.ReplaceChar(Delim, Sep, Frmt);
end;
FSimpleFormat[b] := IsSimpleTimeFormat(Frmt);
if FAdjSecFracFmt and (FScale > 0)
then FFractionFormat[b] := ConvertAsFractionFormat(Frmt, FScale, not FSimpleFormat[b], FFractionLen[b])
else FFractionFormat[b] := Frmt;
end;
if FSimpleFormat[b] then begin
P := @FBuff[0];
Fraction := t.Fractions;
if not FAdjSecFracFmt then
Fraction := RoundNanoFractionTo(Fraction, FScale);
I := {$IFDEF UNICODE}TimeToUni{$ELSE}TimeToRaw{$ENDIF}(
T.Hour, T.Minute, T.Second, Fraction, P, FFractionFormat[B], False, T.IsNegative);
System.SetString(Text, P, I);
end else begin
if FAdjSecFracFmt
then Millis := 0
else Millis := RoundNanoFractionToMillis(T.Fractions);
if TryEncodeTime(T.Hour, T.Minute, T.Second, Millis, DT) then begin
//let the compiler do the complex stuff i.e. AM/PM and user defined additional tokens, week days etc.
DateTimeToString(Text, FFractionFormat[b], DT);
if FAdjSecFracFmt then begin
//if shortformat the position may be variable. no chance to cache that info
I := ZFastCode.Pos(MilliReplaceUnQuoted[FScale], Text);
if I > 0 then begin
P := Pointer(Text);
Inc(P, I-1);
Fraction := t.Fractions;
Fraction := RoundNanoFractionTo(Fraction, FScale);
Fraction := Fraction div FractionLength2NanoSecondMulTable[FScale];
{$IFDEF UNICODE}IntToUnicode{$ELSE}IntToRaw{$ENDIF}(Fraction, P, Byte(FScale));
if FScale > FFractionLen[B] then begin
J := I+FScale;
P := Pointer(Text);
Inc(P, j-2);
Millis := 0;
while (J>I) and (P^ = ('0')) do begin
Inc(Millis);
Dec(J);
Dec(P);
end;
if Millis > 0 then
Delete(Text, J, Millis);
end;
end;
end;
end else begin
if DisplayText
then Text := FInvalidText
else Text := '';
Exit;
end;
if T.IsNegative then
Text := '-'+Text;
end;
end;
end;
Code: Select all
procedure TZDateTimeField.GetText(var Text: string; DisplayText: Boolean);
var
Frmt: string;
DT, D: TDateTime;
Delim: Char;
TS: TZTimeStamp;
I,J: LengthInt;
Fraction: Cardinal;
B: Boolean;
B2: Boolean;
P: PChar;
Millis: Word;
begin
if FilledValueWasNull(TS)
then Text := ''
else begin
B := DisplayText and (DisplayFormat <> '');
if B
then Frmt := DisplayFormat
else begin //improve the "C" token of FormatDateTime
if FindFirstDateFormatDelimiter({$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ShortDateFormat, Delim) and
(Delim <> {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DateSeparator)
then Frmt := ZSysUtils.ReplaceChar(Delim, {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DateSeparator, {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ShortDateFormat)
else Frmt := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ShortDateFormat;
if (FAdjSecFracFmt and (FScale > 0) and (TS.Fractions > 0) ) or
(TS.Hour <> 0) or (TS.Minute <> 0) or (TS.Second <> 0) then begin
Frmt := Frmt + ' ';
if FindFirstTimeFormatDelimiter({$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}LongTimeFormat, Delim) and
(Delim <> {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}TimeSeparator)
then Frmt := Frmt + ZSysUtils.ReplaceChar(Delim, {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}TimeSeparator, {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}LongTimeFormat)
else Frmt := Frmt + {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}LongTimeFormat;
end;
end;
if Frmt <> FLastFormat[B] then begin
FLastFormat[B] := Frmt;
FSimpleFormat[b] := IsSimpleDateTimeFormat(Frmt);
if FAdjSecFracFmt and (FScale > 0)
then FFractionFormat[b] := ConvertAsFractionFormat(Frmt, FScale, not FSimpleFormat[b], FFractionLen[b])
else FFractionFormat[b] := Frmt;
end;
if FSimpleFormat[b] then begin
P := @FBuff[0];
Fraction := ts.Fractions;
if not FAdjSecFracFmt then
Fraction := RoundNanoFractionTo(Fraction, FScale);
I := {$IFDEF UNICODE}DateTimeToUni{$ELSE}DateTimeToRaw{$ENDIF}(
TS.Year, TS.Month, TS.Day, TS.Hour, TS.Minute,
TS.Second, Fraction, P, FFractionFormat[B], False, TS.IsNegative);
System.SetString(Text, P, I);
end else begin
B2 := False;
if TryEncodeDate(TS.Year, TS.Month, TS.Day, d) then begin
if FAdjSecFracFmt
then Millis := 0
else Millis := RoundNanoFractionToMillis(TS.Fractions);
B2 := TryEncodeTime(TS.Hour, TS.Minute, TS.Second, Millis, DT);
if B2 then
if d < 0
then DT := D - DT
else DT := D + DT;
end;
if B2 then begin
//let the compiler do the complex stuff i.e. AM/PM and user defined additional tokens, week days etc.
DateTimeToString(Text, FFractionFormat[b], DT);
if FAdjSecFracFmt then begin
//if shortformat the position may be variable. no chance to cache that info
I := ZFastCode.Pos(MilliReplaceUnQuoted[FScale], Text);
if I > 0 then begin
P := Pointer(Text);
Inc(P, I-1);
Fraction := ts.Fractions;
Fraction := RoundNanoFractionTo(Fraction, FScale);
Fraction := Fraction div FractionLength2NanoSecondMulTable[FScale];
{$IFDEF UNICODE}IntToUnicode{$ELSE}IntToRaw{$ENDIF}(Fraction, P, Byte(FScale));
if FScale > FFractionLen[B] then begin
J := I+FScale;
P := Pointer(Text);
Inc(P, j-2);
Millis := 0;
while (J>I) and (P^ = ('0')) do begin
Inc(Millis);
Dec(J);
Dec(P);
end;
if Millis > 0 then
Delete(Text, J, Millis);
end;
end;
end;
end else begin
if DisplayText
then Text := FInvalidText
else Text := '';
Exit;
end;
if TS.IsNegative then
Text := '-'+Text;
end;
end;
end;
-Mark