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;