Mal wieder HexToFloat

[Neutral General]

Korrigierte Version:

Delphi-Quellcode:

function HexToFloat16(hex: String): Single;

  function FractionToFloat(frac: Cardinal): Single;
  var i: Integer;
  begin
    Result := 0;
    for i:=0 to 10 do
    begin
      if ((frac shr i) and 1) <> 0 then
        Result := Result + Power(2, -(11-i));
    end;
  end;

var tmp: Word;
    resultBin: Cardinal;
    sign: Cardinal;
    exp: Cardinal;
    frac: Cardinal;
begin
  tmp := StrToInt('$' + hex);

  frac := (tmp and $3FF);
  exp := ((tmp shr 10) and $1F);;
  sign := (tmp shr 15);

  if (exp = $1F) then
  begin
    if (frac = 0) then
    begin
      if (Sign = 0) then
        Result := Infinity
      else
        Result := NegInfinity;
    end
    else
      Result := NaN;
  end
  else
  if (exp = 0) then
  begin
    if (frac = 0) then
    begin
      if (Sign = 0) then
        Result := 0
      else
        Result := -0;
    end
    else
    begin // Subnormals
      if (sign = 0) then
        Result := Power(2,-14) * FractionToFloat((frac shl 1))
      else
        Result := -Power(2,-14) * FractionToFloat((frac shl 1));
    end;
  end
  else
  begin
    resultBin := (frac shl 13) or ((exp - 15 + 127) shl 23) or (sign shl 31);
    Move(resultBin, Result, SizeOf(Cardinal));
  end;
end;