implementation 
 
{$R *.DFM} 
 
uses Math; 
 
type 
  s1 = string[1]; 
  rcd = record 
    vorzeichen: s1; 
    ganze, nenner, zaehler: integer; 
    gleitkomma: extended; 
    txt: string; 
  end; 
 
var erg: rcd; 
 
function bruchwandeln(zaehler, nenner: integer; vorzeichenbeiplus: s1): rcd; 
var n, z, hlp: integer; 
  ganz, bruch: string; 
begin 
  result.ganze := 0; 
  if (nenner = 0) or (zaehler = 0) then begin 
    result.vorzeichen := ''; 
    result.txt := '0'; 
    result.nenner := 0; 
    result.zaehler := 0; 
    result.gleitkomma := 0; 
    exit; 
  end; 
  result.gleitkomma := zaehler / nenner; 
  if vorzeichenbeiplus <> '+' then vorzeichenbeiplus := ''; 
  if (zaehler xor nenner) < 0 then 
    result.vorzeichen := '-' 
  else result.vorzeichen := vorzeichenbeiplus; 
  if (zaehler < 0) then zaehler := -zaehler; 
  if (nenner < 0) then nenner := -nenner; 
  while zaehler >= nenner do begin 
    inc(result.ganze); 
    dec(zaehler, nenner); 
  end; 
  if zaehler = 0 then nenner := 0; 
  if result.ganze = 0 then ganz := '' 
  else ganz := inttostr(result.ganze) + ' '; 
  n := nenner; 
  z := zaehler; 
  while (n > z) and (n > 1) do begin 
    dec(n, z); 
    if n < z then begin 
      hlp := n; 
      n := z; 
      z := hlp; 
    end; 
  end; 
  if nenner = 0 then begin 
    result.nenner := 0; 
    result.zaehler := 0; 
  end else begin 
    result.nenner := nenner div n; 
    result.zaehler := zaehler div n; 
  end; 
  if result.zaehler = 0 then bruch := '' 
  else bruch := inttostr(result.zaehler) + '/' + inttostr(result.nenner); 
  if result.vorzeichen <> '' then result.txt := #32 
  else result.txt := ''; 
  result.txt := result.vorzeichen + result.txt + ganz + bruch; 
end; 
 
procedure stringbruchwandeln(s: string; vorzeichenbeiplus: s1); 
var zaehler, nenner, p, v: integer; 
begin 
  s := trim(s); 
  if pos('/', s) = 0 then begin 
    nenner := 1; 
    zaehler := strtointdef(s, 0); 
  end else begin 
    v := 1; 
    while not (s[v] in ['0'..'9']) do inc(v); 
    for p := v + 1 to length(s) - 1 do begin 
      if s[p] = #32 then begin 
        s[p] := #1; 
        break; 
      end; 
    end; 
    s := stringreplace(s, #32, '', [rfreplaceall]); 
    p := pos(#1, s); 
    if (p = 0) or (pos(#1'/', s) > 0) or (p > pos('/', s)) 
      then begin 
      s := stringreplace(s, #1, '', [rfreplaceall]); 
      v := 0; 
    end else begin 
      v := strtoint(copy(s, 1, p - 1)); 
      delete(s, 1, p); 
    end; 
    p := pos('/', s); 
    nenner := strtointdef(copy(s, p + 1, length(s) - p), 0); 
    zaehler := strtointdef(copy(s, 1, p - 1), 0); 
    zaehler := (abs(zaehler) + abs(nenner * v)) * (-ord((zaehler or v) < 0) * 2 
      + 1); 
  end; 
  erg := bruchwandeln(zaehler, nenner, vorzeichenbeiplus); 
end; 
 
procedure floatbruchwandeln(wert: extended; nachkommastellen: byte; 
  vorzeichenbeiplus: s1); 
var s: string; 
  v, n: integer; 
  h: double; 
begin 
  if nachkommastellen > 5 then nachkommastellen := 5; 
  v := abs(trunc(wert)); 
  h := frac(wert); 
  s := floattostrf(h, fffixed, 7, nachkommastellen); 
  delete(s, 1, 2 + ord(wert < 0)); 
  n := trunc(power(10, length(s))); 
  v := (n * v + strtointdef(s, 0)) * (-ord(wert < 0) * 2 + 1); 
  erg := bruchwandeln(v, n, vorzeichenbeiplus); 
end; 
 
procedure stringfloatwandeln(s: string; nachkommastellen: byte; 
  vorzeichenbeiplus: s1); 
var ss: extended; 
begin 
  s := stringreplace(s, #32, '', [rfreplaceall]); 
  try 
    ss := strtofloat(s); 
  except ss := 0; 
  end; 
  floatbruchwandeln(ss, nachkommastellen, vorzeichenbeiplus); 
end; 
 
// Beispiele 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  erg := bruchwandeln(10 * 7, 15 * 2, ''); 
  showmessage(erg.txt); 
  // 2 1/3 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
var x: integer; 
begin 
  x := 700; 
  erg := bruchwandeln(x, -7, ''); 
  showmessage(erg.txt); 
  // - 100 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  erg := bruchwandeln(0, 100, '+'); 
  showmessage(erg.txt); 
  // 0 
end; 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  stringbruchwandeln('- 185 / 222 ', '+'); 
  showmessage(erg.txt); 
  // - 5/6 
end; 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  stringbruchwandeln('8 30/17', ''); 
  showmessage(erg.txt); 
  // 9 13/17 
end; 
 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  floatbruchwandeln(17.1608347, 4, '+'); 
  showmessage(erg.txt); 
  // + 17 201/1250 
end; 
 
procedure TForm1.Button7Click(Sender: TObject); 
begin 
  floatbruchwandeln(18.962891, 0, ''); 
  showmessage(erg.txt); 
  // 18 
end; 
 
procedure TForm1.Button8Click(Sender: TObject); 
begin 
  stringfloatwandeln('- 125,125', 3, ''); 
  showmessage(erg.txt); 
  // - 125 1/8 
end; 
 
procedure TForm1.Button9Click(Sender: TObject); 
begin 
  stringfloatwandeln('xyz', 5, ''); 
  showmessage(erg.txt); 
  // 0 
end; 
 
// -------------------------------------------------------------------- 
 
// Und so können Sie die gewonnenen Brüche wieder in Gleitkomma-Zahlen 
// zurückverwandeln: 
 
function BruchZuFliess(bruch: string; var fliess: double): boolean; 
var 
  ganz, teil: double; 
  pleer, pstrich, pminus, teil1, teil2: integer; 
begin 
  result := false; 
  bruch := trim(bruch); 
  if bruch[1] = '+' then begin 
    delete(bruch, 1, 1); 
    bruch := trim(bruch); 
  end; 
  pminus := pos('-', bruch); 
  if pminus > 0 then begin 
    delete(bruch, pminus, 1); 
    bruch := trim(bruch); 
  end; 
  pstrich := pos('/', bruch); 
  pleer := pos(#32, bruch); 
  if (pleer > 0) or (pstrich = 0) and (pleer = 0) then 
  try 
    if pleer = 0 then 
      ganz := strtofloat(bruch) else 
      ganz := strtofloat(copy(bruch, 1, pleer - 1)); 
  except 
    exit; 
  end else ganz := 0; 
  if pstrich > 0 then 
  try 
    teil1 := strtoint(copy(bruch, pleer + 1, pstrich - pleer - 1)); 
    teil2 := strtoint(copy(bruch, pstrich + 1, maxint)); 
    teil := teil1 / teil2; 
  except 
    exit; 
  end else teil := 0; 
  fliess := ganz + teil; 
  if pminus > 0 then fliess := -fliess; 
  result := true; 
end; 
 
// --- Beispielaufrufe --- 
 
var fliess: double; 
 
// fünf Ganze ein Sechstel 
procedure TForm1.Button7Click(Sender: TObject); 
begin 
  if not BruchZuFliess('5 1/6', fliess) then 
    showmessage('FEHLER') else 
    showmessage(floattostr(fliess)); 
end; 
 
// minus dreizehn Halbe 
procedure TForm1.Button8Click(Sender: TObject); 
begin 
  if not BruchZuFliess('- 13/2', fliess) then 
    showmessage('FEHLER') else 
    showmessage(floattostr(fliess)); 
end; 
 
// sieben Ganze 
procedure TForm1.Button9Click(Sender: TObject); 
begin 
  if not BruchZuFliess('+7', fliess) then 
    showmessage('FEHLER') else 
    showmessage(floattostr(fliess)); 
end;