AnnoZone Forum

Quellcode

program bruchrechnen;

uses crt;
var t1t,t2t,n1n,n2n,t3t,n3n,r,s,t,u,erg,xy,yx,a: integer; oper,q: char;
(* -----------------------------------------------------------------------------------------
t1t, t2t, n1n, n2n sind zähler und nenner der Brueche, die eingegeben werden
t3t und n3n sind zähler und nenner der Ausgabe-Brueche
r, s, t und u sind zähler und nenner der brüche zum rechnen damit
erg ist das ergebnis
xy und yz sind zähler und nenner der Ausgabe, die gekuertzt sind
in "a" wird das ergebnis des ggT von Zähler und Nenner des Ausgabe-Bruches gespeichert
oper ist der operator, also die rechenart (plus, minus, ...)
q ist eine hilfsvariable zum abfragen der schleife "neustarten"
------------------------------------------------------------------------------------------- *)

procedure ggT(x,y:integer; var teiler: integer);
var tausch,d: integer;  (* d für Rest, tausch als hilfsvariable zum tauschen der werte *)
begin
    if x<y then
       begin
       tausch := x;
       x := y;
       y := tausch
       end;
    repeat
          d := x mod y;
          x := y;
          y := r;
    until d=0;       (* bis Rest 0 ist *)
    teiler := x;
end;

procedure kgv(a,b:integer; var erg:integer);
begin
     ggT(a,b,erg);
     erg := a*b div erg;
end;

procedure kuerzen;
begin
     ggT(t3t,n3n,a);
     xy := t3t div a;
     yx := n3n div a;
end;

procedure ausgabe;
begin
     kuerzen;
     if yx = 1 then
          writeln('Aus ',t1t,'/',n1n,' ',oper,' ',t2t,'/',n2n,' ist ',xy,' berechnet worden!')
     else writeln('Aus ',t1t,'/',n1n,' ',oper,' ',t2t,'/',n2n,' ist ',xy,'/',yx,' berechnet worden!');
     readln;
end;

procedure plus;
var f,g:integer;
begin
     if n1n<>n2n then
         begin
             kgv(s,u,erg);       (* kgv für kleinsten gemeinsamen Nenner *)
             f := erg div s;     (* erweitern *)
             g := erg div u;     (* ... *)
             r := r*f;           (* ... *)
             t := t*g;           (* ... *)
             t3t := r+t;         (* Zähler ist addition von 1 und 2 *)
             n3n := erg;         (* Nenner ist kgv *)
         end
     else
         begin
         t3t := r+t;
         n3n := s;
         end;
     ausgabe;
end;

procedure minus;
var f,g:integer;
begin
     if n1n<>n2n then
         begin
             kgv(s,u,erg);       (* kgv für kleinsten gemeinsamen Nenner *)
             f := erg div s;     (* erweitern *)
             g := erg div u;     (* ... *)
             r := r*f;           (* ... *)
             t := t*g;           (* ... *)
             t3t := r-t;         (* Zähler ist differenz zwischen 1 und 2 *)
             n3n := erg;         (* Nenner ist kgv *)
         end
     else
         begin
         t3t := r-t;
         n3n := s;
         end;
     ausgabe;
end;

procedure mal;
begin
     t3t := r*t;
     n3n := s*u;
     ausgabe;
end;

procedure geteilt;
begin
     t3t := r*u;
     n3n := s*t;
     ausgabe;
end;


procedure analyse;
begin
     case oper of
     '+' : plus;
     '-' : minus;
     '*' : mal;
     '/' : geteilt;
     else writeln('Falsche Eingabe beim Operator!'); readln;
     end;
end;


BEGIN (* Hauptprogramm *)
repeat
      clrscr;
      writeln('Wir rechnen jetzt mit Bruechen!');
      write('Geben Sie den Zaehler von Bruch 1 ein!   ');
      readln(t1t);
      write('Geben Sie den Nenner von Bruch 1 ein!    ');
      readln(n1n);
      writeln;
      write('Geben Sie den Zaehler von Bruch 2 ein!   ');
      readln(t2t);
      write('Geben Sie den Nenner von Bruch 2 ein!    ');
      readln(n2n);
      writeln;
      write('Was moechten Sie tun? (+,-,* oder /)     ');
      readln(oper);
      writeln;
      r := t1t;
      s := n1n;
      t := t2t;
      u := n2n;
      analyse;

      writeln('Moechten Sie neustarten? J(a) oder N(ein)?');
      readln(q);
until (q <> 'j') and (q <> 'J');
END.  (* Hauptprogramm *)