Janilabo | LFrac() / HFrac()

const
  TEST_VALUE = 12345.6789;

function LFrac(e: Extended): Extended;
var
  a, d: Extended;
  i: Integer;
  s: string;
begin
  d := DecRet(e);
  if (d <> 0) then
  begin
    a := Abs(d);
    if (a < 0.1) then
      a := (a + 0.1);
    s := FloatToStr(a);
    try
      while (('0.' + IntToStr(Round(a * Pow(10, i))) <> s) and (i < 15)) do
        Inc(i);
    except
    end;
    if (d < 0) then
    begin
      Result := StrToFloat('0.' + StringOfChar('9', i));
      Result := (Result * -1);
    end else
      Result := StrToFloat('0.' + StringOfChar('0', (i - 1)) + '1');
  end;
end;

function HFrac(e: Extended): Extended;
var
  a, d: Extended;
  i: Integer;
  s: string;
begin
  d := DecRet(e);
  if (d <> 0) then
  begin
    a := Abs(d);
    if (a < 0.1) then
      a := (a + 0.1);
    s := FloatToStr(a);
    try
      while (('0.' + IntToStr(Round(a * Pow(10, i))) <> s) and (i < 15)) do
        Inc(i);
    except
    end;
    if (d < 0) then
    begin
      Result := StrToFloat('0.' + StringOfChar('0', (i - 1)) + '1');
      Result := (Result * -1);
    end else
      Result := StrToFloat('0.' + StringOfChar('9', i));
  end;
end;

begin
  ClearDebug;
  WriteLn('LFrac: ' + FloatToStr(LFrac(TEST_VALUE)));
  WriteLn('HFrac: ' + FloatToStr(HFrac(TEST_VALUE)));
end.