Zeoslib Portal

Code: Select all

procedure TZAbstractSecondFractionFormatSettings.EscapeFractionFormat(
  NanoFractions, Scale: Cardinal; IsNegative: Boolean; var Format: String);
var P, PEnd, PFractionSep, PSecond, PFractionStart, PFractionEnd, NewP, PYear, PHour: PChar;
  c: {$IFDEF UNICODE}Word{$ELSE}Byte{$ENDIF};
  EscapeCount, L, FractionDigitsInFormat, DigitsLeft: Cardinal;
  FormatSettings: PFormatSettings;
begin
  P := Pointer(Format);
  L := Length(Format);
  PEnd := P+L;
  FractionDigitsInFormat := 0;
  EscapeCount := 0;
  PFractionSep := nil;
  PSecond := nil;
  PFractionStart := nil;
  PYear := nil;
  PHour := nil;
  PFractionEnd := nil;
  FormatSettings := GetFormatSettings;
  { first count the fraction chars given by format, assign remainders for the
    fraction seperator and (if not given one of both) the last second pos }
  while P < PEnd do begin //overflow save (min last address if the zero char)
    C := {$IFDEF UNICODE}PWord(P)^ or $0020{$ELSE}PByte(P)^ or $20{$ENDIF};
    if P^ = Char('"') then
      if Odd(EscapeCount)// and ((P+1)^ <> '"') //each half quote gets an escape quote, nope compiler does it different
      then Dec(EscapeCount)
      else Inc(EscapeCount);
    if (EscapeCount = 0) then
      if ((C = Ord('z')) or (C = Ord('f'))) then begin
        if PFractionStart = nil then
          PFractionStart := P;
        PFractionEnd := P;
        Inc(FractionDigitsInFormat)
      end else if P^ = FormatSettings.DecimalSeparator then
        PFractionSep := P
      else if (C = Ord('s')) then
        PSecond := P
      else if (C = Ord('y')) and IsNegative then begin
        if PYear = nil then
          PYear := P;
        PHour := nil;
      end else if (C = Ord('h')) and IsNegative and (PYear = nil) then
        PHour := P;
    Inc(P);
  end;
  if (PSecond = nil) and (PFractionStart = nil) and (PHour = nil) and (PYear = nil) then
    Exit;
  { determine amount of fraction digits -> fix scale ? }
  if SecondFractionOption = foRightZerosTrimmed then begin
    DigitsLeft := 9;
    while (NanoFractions > 0) do begin
      Scale := NanoFractions mod 10;
      if Scale <> 0
      then Break
      else NanoFractions := NanoFractions div 10;
      Dec(DigitsLeft);
    end;
    if NanoFractions = 0
    then Scale := 0
    else Scale := DigitsLeft;
  end else begin
    if SecondFractionOption = foSetByFormat then
      Scale := FractionDigitsInFormat;
    if (Scale > 0) and (GetOrdinalDigits(NanoFractions) <> Scale) then begin
      NanoFractions := RoundNanoFractionTo(NanoFractions, Scale);
      NanoFractions := NanoFractions div FractionLength2NanoSecondMulTable[Scale];
    end;
  end;
  P := Pointer(Format);
  if PFractionStart <> nil then begin
    Dec(PEnd);
    if Scale = 0 then begin
      if PFractionSep = PFractionStart-1 then
        PFractionStart := PFractionSep;
      Move((PFractionEnd+1)^, PFractionStart^, (NativeUInt(PEnd)-NativeUInt(PFractionEnd))); //backward move
      SetLength(Format, L-NativeUInt(((PFractionEnd+1)-PFractionStart)){+Ord(IsNegative)});
      Exit;
    end else if ((Scale+2) < FractionDigitsInFormat) then begin  //backward move?
      Move((PFractionEnd+1)^, (PFractionStart+1+Scale)^, (NativeUInt(PEnd)-NativeUInt(PFractionEnd))); //backward move
      L := L-(FractionDigitsInFormat-(Scale+2));
      SetLength(Format, L);
      NewP := Pointer(Format);
      PFractionStart := NewP +(PFractionStart-P);
    end else if ((Scale+2) > FractionDigitsInFormat) then begin//forward move
      SetLength(Format, L+((Scale+2)-FractionDigitsInFormat));
      NewP := Pointer(Format);
      PFractionStart := NewP +(PFractionStart-P);
      NewP := NewP + (PFractionEnd+1-P);
      Move(NewP^, (NewP+((Scale+2)-FractionDigitsInFormat))^, (NativeUInt(PEnd)-NativeUInt(PFractionEnd)));
    end;
    (PFractionStart)^ := '"';
    if Scale > 0 then
      {$IFDEF UNICODE}IntToUnicode{$ELSE}IntToRaw{$ENDIF}(NanoFractions, PFractionStart+1, Byte(Scale));
    (PFractionStart+1+Scale)^ := '"';
  end else if (PSecond <> nil) and (Scale > 0) then begin
    PFractionEnd := PSecond+1;
    SetLength(Format, L+3+Scale);
    PFractionSep := Pointer(Format);
    Inc(PFractionSep, (PFractionEnd - P));
    EscapeCount := (NativeUInt(PEnd) - NativeUInt(PFractionEnd));
    if EscapeCount > 0 then begin
      P := PFractionSep + (3 + Scale);
      Move(PFractionSep^, P^, EscapeCount); //forward move
    end;
    (PFractionSep)^ := '"';
    (PFractionSep+1)^ := FormatSettings.DecimalSeparator;
    {$IFDEF UNICODE}IntToUnicode{$ELSE}IntToRaw{$ENDIF}(NanoFractions, PFractionSep+2, Byte(Scale));
    (PFractionSep+2+Scale)^ := '"';
  end;
end;