Patches to TZTimeField and TZDateTimeField GetText

Code patches written by our users to solve certain "problems" that were not solved, yet.

Moderators: gto, cipto_kh, EgonHugeist, mdaems

Post Reply
MJFShark
Expert Boarder
Expert Boarder
Posts: 218
Joined: 04.06.2020, 13:59

Patches to TZTimeField and TZDateTimeField GetText

Post by MJFShark »

Here's the TZTimeField patch:

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;
Here's the TZDateTimeField patch:

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;
I've tested these with MySQL and Oracle timestamps, multiple scales, both simple and non-simple date formats (with/without AM/PM indicators.)

-Mark
marsupilami
Platinum Boarder
Platinum Boarder
Posts: 1956
Joined: 17.01.2011, 14:17

Re: Patches to TZTimeField and TZDateTimeField GetText

Post by marsupilami »

Hello Mark,

I submitted your patches into subversion. The test suite will take a while to run all tests. The patches should show up in the git repository tomorrow.

thanks and best regards,

Jan
Post Reply