Bruch einlesen

[cruiser]

mh... mal eine Funktion, die einen String in eine Extended (Floatingpoint) Variable wandelt.

sollte die Eingabe ungültig sein gibt die Funktion NaN zurück

Beispieleingaben sind: '1,34', '-1,34', '2/3', '-2/3', '1 4/5', '-1 4/5'

Delphi-Quellcode:

function TextToFloat(const s: string): Extended;
const
  NaN = 0.0 / 0.0;
var
  allowed: set of Char;
  decpos,l,i: Integer;
  m, g, z, n: Extended;
  pc: ^Char;
  aftercomma, evalz, evaln: Boolean;

  // Hilfsfunktion fuer 10er Potenz
  function decposmul: Extended;
  begin
    Result := Exp(decpos * Ln(10));
  end;
begin
  // Ergebnis ist noch keine Zahl
  Result := NaN;

  // laenge ermitteln, bei bedarf rausgehn
  l := Length(s);
  if l = 0 then Exit;

  // Stati setzen
  allowed := ['0'..'9', ' ', '/'];
  aftercomma := False;
  evalz := False;
  evaln := False;

  // Position + Pointer auf Start setzen
  i := 1;
  pc := @s[i];

  // Positiv/Negativ Auswertung
  if pc^ = '-' then begin
    m := -1.0;
    Inc(pc);
    Inc(i);
  end else if pc^ = '+' then begin
    m := 1.0;
    Inc(pc);
    Inc(i);
  end else begin
    m := 1.0;
  end;

  // Werte setzen
  decpos := 0;
  g := 0.0;
  z := 0.0;
  n := 0.0;

  // Ganzzahl/Dezimalzal (X)
  while i <= l do begin
    // Zeichen nicht erlaubt -> Funktion beenden
    if not((pc^ in allowed) or (pc^ = DecimalSeparator)) then Exit;
    // Leerzeichen trennt ganze Zahl von Bruch
    if pc^ = ' ' then begin
      // Komma wurde vorher gefunden -> ungueltig
      if aftercomma then Exit;
      Inc(pc);
      Inc(i);
      evalz := True;
      Break;
    end;
    // Schraegstrich trennt Zaehler und Nenner
    if pc^ = '/' then begin
      // Komma wurde vorher gefunden -> ungueltig
      if aftercomma then Exit;
      z := g;
      g := 0.0;
      evaln := True;
      Inc(pc);
      Inc(i);
      Break;
    end;
    // Komma (oder Punkt) fuer Dezimalzahlen
    if pc^ = DecimalSeparator then begin
      aftercomma := True;
      Inc(pc);
      Inc(i);
      Continue;
    end;
    // Zahlen auswerten
    if aftercomma then begin
      Dec(decpos);
      g := decposmul * (Ord(pc^) - 48) + g;
    end else begin
      g := g * 10 + (Ord(pc^) - 48);
    end;
    Inc(i);
    Inc(pc);
  end;

  allowed := ['0'..'9', '/'];

  if evalz then begin
    while i <= l do begin
      // Zeichen nicht erlaubt -> Funktion beenden
      if not(pc^ in allowed) then Exit;
      if pc^ = '/' then begin
        if i = l then Exit;
        evaln := True;
        Inc(pc);
        Inc(i);
        Break;
      end;
      z := z * 10 + (Ord(pc^) - 48);
      Inc(decpos);
      Inc(pc);
      Inc(i);
    end;
  end;

  allowed := ['0'..'9'];

  if evaln then begin
    decpos := 0;
    while i <= l do begin
      // Zeichen nicht erlaubt -> Funktion beenden
      if not(pc^ in allowed) then Exit;
      n := n * 10 + (Ord(pc^) - 48);
      Inc(decpos);
      Inc(pc);
      Inc(i);
    end;
  end;

  if evalz and evaln then
    Result := m * (g + (z / n))
  else
    Result := m * g;
end;