Joachim Mohr   Mathematik Musik Delphi
zurück     Hinweis

Lösungen


Lösung zu Aufgabe 2.1
   a) a='Hallo'   b='Welt'   c='Hallo Welt'
   b) a=5 b=7 c=9
      a=7 b=9 c=7
      a=8 b=8 c=6
   c) a=1,3 b=-0,3
      a=1,4 b=-0,4
      c=1   d=-2,22E-16

      Theoretisch ist d=0, praktisch wegen der Ungenauigkeit der
      gespeicherten Zahlen nicht: Hier ist das Ergebnis "zufällig"
      von der Größenordnung 10^(-16).
   d) a=-7 b=11 c=13
      a=-1 b=-1 c=2
      a=-1 b=1  c=-1
      a=-2 b=-2 c=-5
   e) s := 1 -1/3 + 1/5 -1/7 + 1/9 - 1/11
      Bem.: Pi = 4*(1 -1/3 + 1/5 -1/7 + ...)
                
Lösung zu Aufgabe 3.1
Falls a kleiner als die Hälfte von b ist wird im Fall a) zwei Meldungen, im Fall b) nur eine Meldung ausgegeben.
Lösung zu Aufgabe 4.1 a) procedure TForm1.Button1Click(Sender: TObject); var i:integer; s:real; begin s := 0; for i := 1 to 9999 do s := s + 1/i; showmessage('s='+FloatToStr(s)); //Größenordnung ln(10000) end; Grober Fehler in: procedure TForm1.Button1Click(Sender: TObject); var i:integer; s:real; begin s := 0; for i := 1 to 10000 do; s := s + 1/i; showmessage('s='+FloatToStr(s)); //Größenordnung ln(10000) end; Fehler: Nach do steht der leere Befehl s := s + 1/i; wird erst nach Abarbeitung der Schleife durchgeführt. Für Pascal ist i dann undefiniert! Der Compiler liefert deshalb die Warnung: For-Schleifenvariable i könnte undefiniert sein! (Bei Delphi scheint i = 10000 zu sein und deshalb hier s = 1/1000. Auch dies war nicht beabsichtigt!) b) procedure TForm1.Button1Click(Sender: TObject); var i,s:integer; begin s := 0; for i := 1000 to 1999 do s := s+i; showmessage('s=' + IntToStr(s)); end; c) procedure TForm1.Button1Click(Sender: TObject); var i:integer; p:real; begin p := 1; for i := 1 to 16 do p := p*2; showmessage('p=' + FloatToStr(p)); end; Lösung zu Aufgabe 4.2 a) s = 1 - 1/3 + 1/5 - 1/7 + 1/9 - 1/11 p = 4*(1 - 1/3 + 1/5 - 1/7 + 1/9 -1/11) = 2,976 046 b) p = 4*(s = 1 - 1/3 + 1/5 -1/7 + ... +/- 1/(2*n+1)) Nach Leibniz: p ——> Pi
Lösung zu Aufgabe 5.1 Man benötigt zwei Edit-, eine Memo- und eine Buttonkomponente. procedure TForm1.Button1Click(Sender: TObject); var x, a, b :integer; y :real; begin a := strToInt(edit1.text); b := strToInt(edit2.text); memo1.Lines.clear; for x := a to b do Begin y := 1/3*x*x*x - 3*x; memo1.lines.Add(IntToStr(x) + ' ' + FloatToStr(y)); End; end; Lösung zu Aufgabe 5.2 Das Programm rechnet eine Wertetafel für die Sinusfunktion für von -360° bis 360° in Zehnerschritten aus: Der Inhalt von memo1 ist: -360 -1,0842021724855E-19 theoretisch = Null -350 0,17364817766693 -340 0,342020143325669 -330 0,5 ... 0 0 10 0,17364817766693 20 0,342020143325669 30 0,5 ... Lösung zu Aufgabe 5.3 Setze außer dem Button noch drei Edierkomponenten auf die Form. OOP Ändere im Objektinspektor um: Name von edit1,edit2 und edit3 auf editx1, editx2 und edits Text auf -5, 5 und 0,5 procedure TForm1.Button1Click(Sender: TObject); var x, x1, x2, s, y:real; begin x1 := strToFloat(editx1.text); x2 := strToFloat(editx2.text); s := strToFloat(edits.text); x := x1; //Anfangswert //.. Rest unverändert mit while oder repeat end;


Lösung zu Aufgabe 5.4 

   a)   a = 2     b = -10  c = 0
        a = 6     b = -6   c = 4
        a = -2    b = 2    c = 0
        x = 7
        x = 7^2
        x = 7^4
        y = 7^4
        x = 7^8
        x = 7^16
        y = 7^20

   b)   a = 6     b = -5     c = -25;
        d = 625
        w = 25
        x = 2,5
        Allgemein: Eine der zwei Lösungen der Gleichung ax^2+b^+c = 0
   c)
k 1 2 3 4 5 6
a 1 4 9 16 25 1/36
x 0 1 1+1/4 1+1/4+1/9 1+1/4+1/9+16 1+1/4+1/9+1/16+1/25 1+1/9+1/16+1/25+1/36
      d)
a   1 9 25
x 0 1 1+1/9 1+1/9 + 1/25
k 1 3 5 7
      e)
a   2 4 6 8 10
b   3 5 7 9 11
x 1 2/3 2/3·4/5 2/3·4/5·6/7 2/3·4/5·6/7·8/9 2/3·4/5·6/7·8/9·10/11
k 1 2 3 4 5 6
Hier wird also x=(2·4·6·8·10)/(3·5·7·9·11) berechnet

Lösung zu Aufgabe 5.5 a) (i)  button1
               (ii)  button2
          und (iii) button3

procedure TForm1.Button1Click(Sender: TObject);
   var k: integer;
       x,y:real;
begin
  memo1.lines.clear;
  for k := -20 to 20 do Begin
    x := k/10;
    y := x*x - 2*x;
    memo1.lines.add(floatToStr(x)+'  '+floatToStr(y));
  End;
end;


procedure TForm1.Button2Click(Sender: TObject);
   var x1, x2, x, y, s: real;
begin
  x1 := -2;
  x2 := 2;
  s  := 1/10;
  x := x1; //Startwert
  memo1.lines.clear;
  while x < x2 + s/2 do Begin
    {"+s/2", da x statt 2 nur 1.999..9 erreichen könnte}
    y := x*x - 2*x;
    memo1.lines.add(floatToStr(x)+'  '+floatToStr(y));
    x := x + s;
  End;
end;

procedure TForm1.Button3Click(Sender: TObject);
   var x1, x2, x, y, s: real;
begin
  x1 := -2;
  x2 := 2;
  s  := 1/10;
  x := x1; //Startwert
  memo1.lines.clear;
  repeat
    y := x*x - 2*x;
    memo1.lines.add(floatToStr(x)+'  '+floatToStr(y));
    x := x + s;
  until x > x2 + s/2;
end;

Hinweis: Man sieht (ii) und (iii) rechnet mit Ungenauigkeiten.
         (die 15. Dezimale weicht vom genauen Ergebnis ab!)
         Deshalb empfiehlt sich statt floatToStr die formatierte Ausgabe:
         memo1.lines.add(formatFloat('0.##',x)+'  '+formatfloat('0.##',y)).

Lösung zu Aufgabe 5.5 b)

procedure TForm1.Button1Click(Sender: TObject);
  var n,i: integer;
      s: real;
begin
  n := StrToInt(edit1.text);
  s := 0; //Anfangswert der Summe
  for i := 1 to n do s := s + 1/(i*i); //"Aufsummieren" !
  edit2.text := floatToStr(s);
end;

Lösung zu Aufgabe 5.5 c) 

procedure TForm1.Button1Click(Sender: TObject);
  var a,b,i: integer;
      p: real;
begin
  a := StrToInt(edit1.text);
  b := StrToInt(edit2.text);
  p := 1; //Anfangswert des Produkts
  for i := a to b do p := p*i; //"Aufmultiplizieren" !
  edit3.text := floatToStr(p);
end;

Lösung zu Aufgabe 5.6 Bildschirmaufnahme
procedure TForm1.Button1Click(Sender: TObject);
  var n: integer;
      a,s: real;
begin
  s := 0;
  n := 0;
  a := 20;
  repeat
    n := n + 1;
    s := s + 1/n;
  until s > a;
  showmessage('n = ' + inttoStr(n));
end;
Der Computer liefert nach einiger Zeit n = 272 400 600. Es handelt sich hierbei um die bestimmt divergente "harmonische" Reihe.
(Bestimmt divergent heißt: Die Summe überschreitet jede Schranke, wenn nur n genügend groß gewählt wird).
Um die Summe von 100 zu erreichen, würde man etwa n=e100 = 2,688·1043 erhalten. Ein Computer, der eine Billion Additionen in der Sekunde ausführt, bräuchte dafür etwa 1030 Jahre.
Übrigens: Rechnet der Computer nur auf 16 geltende Ziffern genau (Stand Anfang 3. Jahrtausend), dann ist
100 + 1/1014 = 100,000 000 000 000 01 = 100, d.h. ab n = 1014 wird s nicht mehr geändert.
Etwas ausführlicher zeigt Dir das Programm harmonische Reihe bei Einsteigerprogramme

Für mathematisch Interessierte:

  1 + 1/2 + 1/3 + 1/4 + 1/5 + 1/6 + 1/7 + 1/8 + 1/9  + 1/10 + ...
> 1 + 1/2 + 1/4 + 1/4 + 1/8 + 1/8 + 1/8 + 1/8 + 1/16 + 1/16 + ...
= 1 + 1/2 +    2/4    +           + 4/8              + 8/16 + ...
= 1 + 1/2 +    1/2(2 Summanden)   + 1/2(4 Summanden) + 1/2(8 Summanden) + ...
= 1 + 1/2 + 1/2 + 1/2 + 1/2 + 1/2 + 1/2 + 1/2 + 1/2 + ... = Unendlich
Zur Genauigkeit von Rechenoperationen siehe Anhang 2

Lösung zu Aufgabe 5.7
procedure TForm1.Button1Click(Sender: TObject);
  var p,q,k,a: real;
      n: integer;
      fertig: boolean;
      ns,aas,ks: string; //Zur besseren Darstellung
begin
  p := 5;       //Besser in Editfeld einlesen
  q := 1 + p/100;
  K := 1674000; //Besser in Editfeld einlesen
  a := 48000;   //Besser in Editfeld einlesen
  n := 0;
  fertig := false;
  memo1.text := 'Jahre Auszahlung Rest';
  repeat
    ns := intToStr(n);
    while length(ns) < 6 do ns := ns + ' ';
    aas := formatfloat('## ##0.00',a);
    while length(aas) < 15 do aas := aas + ' ';
    ks := formatfloat('# ### ##0.00',K);
    memo1.lines.Add(ns+aas+ks);
    if k < 0 then fertig := true;
    a := a*q;
    K := (K - a)*q;
    n := n + 1; //oder inc(n)
  until fertig or (n > 200);
end;
Ergebnis: Das Programm zeigt: Nach 33 Jahren ist Schluss.

Bemerkung: Das Risiko, dass er für sein Vermögen zu lange lebt, kann er Rentenversicherungen übertragen. Dann hängt seine jährliche Verfügungsmasse von der durchschnittlichen Lebenserwartung ab (abzüglich den Teil, den die Versicherung kassiert).
Lösung zu Aufgabe 6.1
round rundet eine Integerzahl (Achtung: bei ",5" wird auf eine gerade Zahl gerundet), abs gibt den Absolutbetrag einer Zahl an.
a) 25.458   b) -35,445    c) 0        d) runden auf 3 Dezimalen
Lösung zu Aufgabe 6.2 Wertetafel

Dein Formular benötigt button1 und memo1

function f(alpha:real):real;
  var x:real;
begin
  x := alpha*Pi/180; //x muss zuerst ins Bogenmaß umgewandelt werden
  result := 2*sin(x)+sin(2*x)
end;


procedure TForm1.Button1Click(Sender: TObject);
  var alpha:integer;
begin
  memo1.Text :=
    'Wertetafel für f(alpha)=2sin(alpha) + sin(2*alpha)'#13#10#+
    'alpha     f(alpha)'#13#10#13#10; //#13#10 Zeilenumbruch
  alpha := -720;
  while alpha <= 720 do Begin
    memo1.Lines.Add(
      IntToStr(Alpha)+'° '+formatFloat('##0.###',f(alpha)));
    alpha := alpha + 30;
  End;
end;
Lösung zu Aufgabe 6.3 Das Pascalsche Dreieck:

function nuebk(n,k:integer):integer;
   var i:integer;
begin
  result := 1;
  for i := 1 to k do
  result := result*(n-i+1) div i; //Division bei Integer
end;

procedure TForm1.Button1Click(Sender: TObject);
 var k,n:integer;
     s:string;
begin
  memo1.Lines.Clear;
  memo1.Alignment := taCenter; //Text zentriert
  for n := 0 to 20 do Begin
    s := '';
    for k := 0 to n do s := s+' '+IntToStr(nuebk(n,k));
    memo1.lines.add(s);
  End;
end;

Noch etwas strukturierter könnte das Programm folgendermaßen aussehen:
function nuebk(n,k: integer): integer;
  var i: integer;
begin
  result := 1;
  for i := 1 to k do
    result := (n-i+1)*result div i;
end;

function  zeile(n: integer): string;
  var k: integer;
begin
  result := '';
  for k := 0 to n do
    result := result + inttostr(nuebk(n,k)) + ' '
end;


procedure TForm1.Button1Click(Sender: TObject);
   var n: integer;
begin
  form1.Windowstate := wsmaximized;
  memo1.Align := alClient;
  memo1.lines.Clear;
  for n := 1 to 20 do
  memo1.Lines.Add(zeile(n));
end;
Der Ausdruck ist dann folgender:
1
1 1
1 2 1
1 3 3 1
1 4 6 4 1
1 5 10 10 5 1
1 6 15 20 15 6 1
1 7 21 35 35 21 7 1
1 8 28 56 70 56 28 8 1
1 9 36 84 126 126 84 36 9 1
1 10 45 120 210 252 210 120 45 10 1
1 11 55 165 330 462 462 330 165 55 11 1
1 12 66 220 495 792 924 792 495 220 66 12 1
1 13 78 286 715 1287 1716 1716 1287 715 286 78 13 1
1 14 91 364 1001 2002 3003 3432 3003 2002 1001 364 91 14 1
1 15 105 455 1365 3003 5005 6435 6435 5005 3003 1365 455 105 15 1
u.s.w.

Lösung zu Aufgabe 6.4 Potenzfunktion x^n (n natürliche Zahl)
function hoch(x: real; n: integer):real;
  var i: integer;
begin
  result := 1;
  for i := 1 to n do result := result*x;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(floatTostr(hoch(2,10)));
  showmessage(floatTostr(hoch(1.5,2)));
  showmessage(floatTostr(hoch(5,0)));
end;
Bemerkung: Häufig wird auch die Formel b^x = (e^lnb)^x verwendet:
function hoch(b,x:real):real; //b > 0 und x <> 0
begin
 result := exp(x*ln(b));
end;
Hoch möglichst allgemein definiert: siehe Anhang.


Lösung zu Aufgabe 7.2 Wertetafel formatiert



Hier wird neben button1 noch memo1 benötigt.
Stelle im Objektinspektor die Schrift auf 'Courier New' und schalte
den Zeilenumbruch aus (wordwrap auf false ).

Hier ist angebenen, wie diese Eigenschaften auch zur Laufzeit
zugewiesen werden können.

function meinFormat(x:real):string;
  var n: integer;
begin
  result := formatfloat('### ### ##0.##',x);
  //Zuerst suchen, wo ist das Komma. Allgemein der Decimalseparator.
  n := pos(Decimalseparator,result);
  if n = 0 then result := result + '   ' else //3 Stellen
   if n = length(result) - 1 then result := result + ' ';
  //Drei Stellen "hinten". "Vorne sollen es 11 sein also zusammen 14
  while length(result) < 14 do result := ' ' + result;
end;

function f(x:real):real;
begin
  result := 1/3*x*x*x - 3*x;
end;

procedure TForm1.Button1Click(Sender: TObject);
   var x,y : real;
begin
   memo1.lines.clear;
   memo1.Font.Name := 'Courier New'; //Im Objektinspektor
   memo1.font.size := 12;            //Im Objektinspektor
   memo1.WordWrap  := false;         //Im Objektinspektor
   x := -5;
   while x <= 5 do Begin
     y := f(x);
     memo1.Lines.Add(MeinFormat(x)+ ' ' + MeinFormat(y));
  x := x + 1/4;
  End;
end;
Lösung zu Aufgabe 7.3: Alle Primzahlen bis 1000
function IstPrimzahl(n:integer):boolean;
  var k      : integer;
begin
  result := true; //solange kein Treffer gefunden
  //Zuerst wird geprüft, ob n gerade, dann werden alle ungeraden Zahlen
  //bis sqrt(n) getestet.
  //Warum bis sqrt(n): Siehe Beispiel 6.2
  if n mod 2 =0 then Begin
    result := false;
    exit
  End else Begin
    k := 3; //Alle ungeraden Zahlen werden getestet
    while k <= sqrt(n) do BEgin
      if n mod k = 0 then BEGin
        result := false;
        exit;
      END;
      k := k + 2;
    ENd;
  End;
end;

{Hinweis: exit bewirkt, dass die Funktion sofort verlassen
           wird. Hier sehr sinnvoll: Ist ein Teiler gefunden,
           interessieren die übrigen nicht mehr.}


procedure TForm1.Button1Click(Sender: TObject);
  var i:integer;
begin
   memo1.lines.clear;
   memo1.WordWrap  := true;
   for i := 2 to 1000 do
     if IstPrimzahl(i) then
       memo1.text := memo1.text + IntToStr(i) + '  ';
end;

Lösung zu Aufgabe 7.4: Passworteingabe. Einfache Version

procedure TForm1.Button1Click(Sender: TObject);
  const Passwort = '1001';
  var s: String;
begin
  edit1.PasswordChar := '*';
  if edit1.text = Passwort then
     showmessage('Sie haben das richtige Passwort eingegeben.') else
       showmessage('Das war das falsche Passwort'#13#10+
                   'Versuchen Sie es nocheinmal');
end;

NochLösung zu Aufgabe 7.4: Passworteingabe. Nur drei Versuche möglich!

Dies ist etwas komlizierter. Wir benötigen noch eine Variable:
Zaehler wird bei jedem Versuch hochgezählt.
Man kann sie als globale Variable deklarieren oder wie hier
(als Prinzip der maximalen Kapselung) als private Variable
der Form1 (dann ist sie von außen mit nicht beeinflussbar.)

type
  TForm1 = class(TForm)
    ...
  private
    Zaehler: Integer;   //<——— Hier den Zähler deklarieren
  ...

var
  Form1: TForm1;
  //Zaehler:Integer;     <—— Hier als globale Variable


//Initialisieren
procedure TForm1.FormCreate(Sender: TObject);
begin
   edit1.PasswordChar := '*';
   edit1.text := '';
   Zaehler := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
  const Passwort = '1001';
  var s: String;
begin
  Zaehler := Zaehler + 1;
  if edit1.text = Passwort then
    showmessage('Sie haben das richtige Passwort eingegeben.') else Begin
      if zaehler > 2 then BEgin
        showmessage('Falsche Passwort: Programm wird beendet');
        close;
      ENd else
      showmessage('Das war das falsche Passwort'#13#10+ //#13#10=Zeilenumbruch
                   'Versuchen Sie es nocheinmal'#13#10+
                   'Sie haben noch '+intToStr(3-Zaehler)+' Versuche.');
      edit1.text := ''
   End;
end;

Lösung zu Aufgabe 7.5:
a=0 b=0 c=2
a=0 b=1 c=3
a=1 b=0 c=5
a=1 b=1 c=7
Bemerkung:
Dasselbe Ergebnis würde man auch mit folgendem Programm, ohne BEgin und ENd erreichen.

 procedure TForm1.Button1Click(Sender: TObject);
   var a,b,c :integer;
 begin
   for a := 0 to 1 do for b := 0 to 1 do Begin
     if a = 0 then
       if b = 0 then c := 2 else c := 3
     else //bezieht sich auf if a = 0 then...
       if b = 0 then c := 5 else c := 7;
     memo1.lines.add('a='+IntToStr(a)+' b='+IntToStr(b)+
        ' c='+IntToStr(c));
   End;
 end;
 
Mit BEgin und ENd ist das Programm jedoch besser strukturiert.
Lösung zu Aufgabe 7.6:
Nenne die Buttons br, bd, bu und bA!

Procedure Berechnungen(r: real);
  var d,u,a:real;
//kann auch als Methode fon form1 deklariert werden. Siehe download
begin
  d := 2 *r;
  u := Pi*d;
  a := Pi*r*r;
  form1.er.text := FloatToStr(r);
  form1.ed.text := FloatToStr(d);
  form1.eu.text := FloatToStr(u);
  form1.a.text := FloatToStr(a);
end;

procedure TForm1.brClick(Sender: TObject);
  var r:real;
begin
  r := StrToFloat(er.text);
  berechnungen(r);
end;

procedure TForm1.bdClick(Sender: TObject);
  var r:real;
begin
  r := StrToFloat(ed.text)/2;
  berechnungen(r);
end;


procedure TForm1.buClick(Sender: TObject);
  var r:real;
begin
  r := StrToFloat(eu.text)/(2*Pi);
  berechnungen(r);
end;


procedure TForm1.baClick(Sender: TObject);
  var r:real;
begin
  r := sqrt(StrToFloat(ea.text)/Pi);
  berechnungen(r);
end;
Das ganze Projekt zum Download findest Du bei Kreisberechnungen
Lösung zu Aufgabe 8.1: Wertetafel Betriebszugehörigkeit -> Prämie

function f(n: integer): integer;
begin
  Case n of 0      : result := 0;
            1 .. 4 : result := 200;
            5 .. 10: result := 400;
            else     result := 800;
  End;
end;


procedure TForm1.Button1Click(Sender: TObject);
   var n:integer;
begin
  memo1.lines.clear;
  for n := 0 to 60 do
    memo1.lines.Add('Alter: '+inttoStr(n)+' Jahre  Prämie: '+IntToStr(f(n))+ ' EUR')
end;
Lösung zu Aufgabe 8.2: Fahrkartenautomat

Du benötigst eine radiogroup1 und ein label1.

Beschrifte im Objektinspektor die items der radiogroup1:
   Einzeltageskarten  für 1 Zone  zu EUR   2,00
   Gruppentageskarten für 1 Zone  zu EUR   3,00
   Einzeltageskarten  für 3 Zonen zu EUR   5,00
   Gruppentageskarten für 3 Zonen zu EUR   8,00
   Einzeltageskarten  für 6 Zonen zu EUR   9,00
   Gruppentageskarten für 6 Zonen zu EUR  14,00

Ergänze das Onklick-Ereignis der radiogroup1:

procedure TForm1.RadioGroup1Click(Sender: TObject);
  var preis: integer;
begin
  Case radiogroup1.itemindex of 0: preis :=  2;
                                1: preis :=  3;
                                2: preis :=  5;
                                3: preis :=  8;
                                4: preis :=  9;
                                5: preis := 14;
       else preis :=0 ;//unnötig, aber keine Warnung des Compilers
  End;
    label1.Caption :=
       'Ihrer Geldkarte wird abgebucht: ' +
         intToStr(preis) + ' ,00 EUR'
end;
Lösung zu Aufgabe 8.3: Punkte -> Note
function note(punktzahl: integer):string;
begin
  Case punktzahl of 15,14,13: result := 'sehr gut';
                    12,11,10: result := 'gut';
                     9, 8, 7: result := 'befriedigend';
                     6, 5, 4: result := 'ausreichend';
                     3, 2, 1: result := 'mangelhaft';
                           0: result := 'ungenügend';
    else result := 'Fehleingabe';
  End;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  edit1.text := note(spinedit1.value);
end;
Lösung zu Aufgabe 8.4: 7-3-1-Prüfsumme
function pruefsumme(s:string): integer;
  var k: integer;
begin
 result := 0;
 for k := 1 to length(s) do
   Case k mod 3 of 1: result := result + 7*StrToInt(s[k]);
                   2: result := result + 3*StrToInt(s[k]);
                   0: result := result + StrToInt(s[k]);
   End;
end;
Eine Anwendung findest Du bei Ausweis. Beim Personalausweis werden die Prüfziffern von der Stadtkennzahl, dem Geburts- und Ablaufdatum und eine Gesamtprüfziffer gebildet.
Lösung zu Aufgabe 8.5: Bei Aufgabe 8.5 wird getestet, ob Du folgende Konstruktionen verstanden hast:
  a)  Ins Memo wird nacheinander geschrieben:

      Kreisfläche (r=5) = 78,5398163397448 [=25·Pi]
      Quadrat (a=3) = 9
      gleichseitiges Dreieck (a=10) = 0

   Vor der letzten Zeile erscheint die  Meldung:
      Unbekanntes Objekt

  b)  Folgende Wertetafel für i und f(i) wird geschrieben:

     -2    -4
     -1    -2
      0    0
      1    0,5
      2    1

  c)  Folgende Wertetafel für i und g(i,2·i) wird geschrieben:

      -4    16
      -2    8
       0    0
       2    16

  d) Die Wertetafel für die Fakultät h(n) = n! wird geschrieben:

       0    1
       1    1
       2    2
       3    6
       4    24
       5    120
Lösung zu Aufgabe 8.6: Die Lösungen der quadratischen Gleichung in Abhängigkeit von der Diskriminante:
procedure TForm1.Button1Click(Sender: TObject);
  var a, b, c, d, x1, x2: real;
begin
  a := StrToFloat(edit1.text);
  b := StrToFloat(edit2.text);
  c := StrToFloat(edit3.text);
  d := b*b - 4*a*c;
  if d < 0 then Begin
    edit4.text := 'Keine Lösung';
    edit5.hide;
  End else if d = 0 then Begin
    x1 := - b/(2*a);
    edit4.Text := floatToStr(x1);
    edit5.hide;
  End else Begin
    x1 := (-b + sqrt(d))/(2*a);
    x2 := (-b - sqrt(d))/(2*a);
    edit4.Text := floatToStr(x1);
    edit5.Text := floatToStr(x2);
    edit5.Show;
  End;
end;
Lösung zu Aufgabe 8.7:
procedure TForm1.Button1Click(Sender: TObject);
  var p: integer;
begin
  p := StrToInt(edit1.text);
  Case p of 0     : edit2.text := 'ung';
            1 .. 3: edit2.text := 'mgh';
            4 .. 6: edit2.text := 'ausr';
            7 .. 9: edit2.text := 'bfr';
            10..12: edit2.text := 'gut';
            13..15: edit2.text := 'sgt';
     else edit2.text := 'Fehler';
  End;
end;
Lösung zu Aufgabe 8.8:
function f(n:integer): real;
  var i:integer;
begin
  result := 0; //Anfangswert der Summe
  for i := 1 to n do
    result := result + 1/i;
end;

function g(n:integer): real;
  var i:integer;
begin
  result := 1; //Anfangswert des Produkts
  for i := 1 to n do
    result := result * (2*i - 1)/(2*i)
end;

         oder (Timo's geniale Lösung)

function g(n:integer): real;
  var i:integer;
begin
  result := 1; //Anfangswert des Produkts
  for i := 1 to 2*n do
    if i mod 2 = 1 then
      result := result*i
    else
        result := result/i
end;

        oder (Frank's geniale Lösung)

function g(n:integer): real;
  var zaehler, nenner: integer;
begin
  result := 1; //Anfangswert des Produkts
  zaehler := 1;
  nenner := 2;
  while zaehler <= 2*n - 1 do Begin
    result := result*zaehler/nenner;
    zaehler := zaehler + 2;
    nenner := nenner + 2;
  End;
end;

Lösung zu Aufgabe 8.9: Hast Du div und mod verstanden?
    a = 416   q = 2   r = 96   a1 = 416
    a = 160   q = 1   r = 64   a1 = 160
    a = 96    q = 1   r = 32   a1 = 96
    a = 64    q = 2   r = 0    a1 = 64
Du kannst hier erkennen: Stets ist:

        a := b·(a div b) + (a mod b). Beispiel: 13 div 3 = 4 Rest 1. Also 13 := 3·4 + 1.

Bei diesem Beispiel wurde übrigens ggT(416,160) = 32 berechnet. Bevor r = 0 wird, ist r = ggT(a,b). Dies wird in der nächsten Lektion ausführlich besprochen.

Lösung zu Aufgabe 8.10: Börsensimulation. Benötigte Komponenten: Timer. Die übrigen ergeben sich aus dem Programm. Man sollte diese zur besseren Wartung noch umbenennen: button2 in bschliessen u.s.w.
Hier wurde der ursprüngliche Namen beibehalten. Dann kann man das Programm einfacher nach Delphi kopieren. Zum Beispiel: Form1 anklicken und (im Objektinspektor) das Ereignis OnCreate doppelklicken. Dann

procedure TForm1.FormCreate(Sender: TObject);
begin
end;

ersetzten durch die entsprechenden Zeilen hier im Programm.

———————————— Programm Börse: Downloadseite Simulation Aktie
var
  Form1: TForm1;
  tempo: integer; //Timereinstellung (Anfangswert500 ms)
                 // Kann mit button4 geändert werden.
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Anfangswerte setzen.
  randomize; //Nötig wann immer random benötigt wird.
  label1.Caption := //Ein label mit Zeilenumbruch.
  'Eugen hat eine Aktie A im Wert von 1000 EUR. Josef hat 1000 EUR bar.'#13+
  'Täglich wechselt die Aktie den Besitzer. Der Wert der Aktie kann'#13+
  'täglich um maximal p% nach oben oder unten schwanken.'#13+
  'Wie viel hat jeder? Negativer Besitz heißt: Geld geliehen. Steigt/fällt'#13+
  'der Wert der Aktie ist der Besitz von Eugen + Josef höher/geringer.'#13+
  '(In Wahrheit ist die Aktie nichts wert, nur wissen die beiden es nicht.'#13+
  ' Zusammen besitzen sie - auch nach der Umverteilung - 1000 EUR)';
  //Hier sind die Anfangswerte sichtbar
  edit1.text := '5';       //Anfangswert p
  edit2.Text := '1000';    //Eugen bar
  edit3.text := '0';       //Josef bar
  edit4.text := '0';       //Eugen Aktie
  edit5.text := '1000';    //Aktie von Josef
  edit6.text := '';        //Summe Eugen
  edit7.text := '';        //Summe Joasef
  label5.Caption := '0';   //Zähler
  timer1.Enabled := false; //Disabled
  tempo := 512;            //Millisekunten
  button4.Caption := 'Schneller'; //Knopf, der Timer steuert.
end;

procedure TForm1.Button1Click(Sender: TObject); //Sart-Weiter-Knopf
begin
  if button1.Caption = 'Stop' then Begin //"Stop" wurde angeklickt.
     timer1.Enabled := false;            //Timer außer Betrieb
     button1.Caption := 'Weiter';        //Als nächstes kann "Weiter" angeklickt werden.
  End else Begin //"Start" oder "weiter" wurde angeklickt.
    timer1.Enabled := true;             //Timer in Betrieb
    button1.Caption := 'Stop';           //Als nächstes kann "Stop" angeklickt werden.
  End;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
   var eug, jos, eug_a, jos_a, vol: real;
begin
  label5.Caption := IntToStr(StrToInt(label5.caption) + 1); //Zähler
  eug := strToFloat(edit2.text);   //Kapital von Eugen bar
  jos := strToFloat(edit3.text);   //Kapital von Josef
  eug_a := strToFloat(edit4.text); //Wert der Aktie von Eugen
  jos_a := strToFloat(edit5.text); //Wert der Aktie von Josef
  vol := StrToFloat(edit1.Text)*(2*random-1); //Volatilität maximal +/- p/100
  vol := round(10*vol)/10;         //Gerundet auf 1 Dezimale
  label7.Caption := Formatfloat('0.###',vol)+ ' %';  //Zum Beispiel -2,4%
  if jos_a > 0 then Begin         //Eugen kauft von Josef die Aktie
    eug_a := jos_a*(1 + vol/100); //Jetzt hat Eugen die Aktie zum Tageskurs
    eug   := eug - eug_a;         //.. und  zahlt den Kaufpreis.
    jos   := jos + eug_a;         //Josef erhält den Kaufpreis
    jos_a := 0;                   //.. und hat keine Aktie mehr.
  End else Begin                  //Josef kauft von Eugen die Aktie
    jos_a := eug_a*(1 + vol/100); //Jetzt hat Josef die Aktie zum Tageskurs
    jos   := jos - jos_a;         //.. und  zahlt den Kaufpreis.
    eug   := eug + jos_a;         //Eugen erhält den Kaufpreis
    eug_a := 0;                   //.. und hat keine Aktie mehr.
  End; //Berechnung klar?
  edit2.text := formatfloat('0.##',eug);   //Besitz schreiben. Siehe oben.
  edit3.text := formatfloat('0.##',jos);
  edit4.text := formatfloat('0.##',eug_a);
  edit5.text := formatfloat('0.##',jos_a);
  edit6.text := formatfloat('0',eug+eug_a); //Zusammen
  edit7.text := formatfloat('0',jos+jos_a);
  application.ProcessMessages;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  tempo := tempo div 2;
  if tempo <= 1 then tempo := 1;
  timer1.Interval := tempo;
  button4.Caption := intToStr(tempo) + 'ms';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  close
end;
Bemerkung:
Der Bargeldbesitz kann auch negativ werden (Geld geliehen).

Steigt/fällt der Wert der Aktie ist der Besitz von Eugen + Josef höher/geringer. Es kann durchaus sein, dass die Aktie gar nichts wert ist. Eugen und Josef wissen das nur nicht.

(Alte Börsenweisheit: An der Börse geht kein Geld verloren. Es wechselt nur den Besitzer.)


Langfristig fällt der Wert der Aktie. Nehmen wir an, der Wert steigt oder fällt abwechselnd jeden Tag um p = ±50%. Dann hat man folgende Entwicklung:

1000 EUR 1500 EUR 750 EUR 1125 EUR 563 EUR 844 EUR 442 EUR 633 EUR 316 EUR 474 EUR 237 EUR 356 EUR 178 EUR 267 EUR 133 EUR 200 EUR
100 EUR 150 EUR 75 EUR 113 EUR 56 EUR 84 EUR 44 EUR 63 EUR 32 EUR 47 EUR 24 EUR 36 EUR 18 EUR 27 EUR 13 EUR 20 EUR
10 EUR 15 EUR 7,5 EUR 11,3 EUR 5,6 EUR 8,4 EUR 4,4 EUR 6,3 EUR 3,2 EUR 4,7 EUR 2,4 EUR 3,6 EUR 1,8 EUR 2,7 EUR 1,3 EUR 2 EUR
Der Grund liegt darin, dass additiv und nicht multiplikativ gerechnet wird.

Statt K1 := K0*(1 ± p/100)*K0 sollte man besser mit K1=K0*(1+p/100) bzw. K1=K0/(1+p/100) rechnen.

Also zum Beispiel alternierend +50% und -33,3%.

Allgemein: alternierend +p% und -100*p/(100+p)%.

Lösung zu Aufgabe 9.1: Kürzen.
function  ggT(a,b: integer):integer;
begin {siehe in der Lektion} end;

procedure TForm1.Button1Click(Sender: TObject);
  var a, b, c, d, q: integer;
begin
  a := spinedit1.Value;
  b := spinedit2.Value;
  if b <> 0 then q := ggT(a,b) else q := 1;
  c := a div q;
  d := b div q;
  spinedit3.Value := c;
  spinedit4.value := d;
end;

Aufgabe 9.2: In dieser Aufgabe wird ein schöner Algorithmus demonstriert: Die römische Multiplikation

Die Römer hatten ja bekanntlich ein nicht sehr übersichtliches Zahlensystem. (Siehe Römische Zahlen). Immerhin: Sie konnten die Hälfte und das Doppelte berechnen. Darauf konnten sie dann die Multiplikation zurückführen. In der Aufgbabe wurde der Algorithmus verwendet. (Im Grunde wird der erste Faktor ins Zweiersystem zerlegt.)

Lösung:
a=45 b=17 s=0
a=22 b=34 s=17
a=11 b=68 s=17
a=5 b=136 s=85
a=2 b=272 s=221
a=1 b=544 s=221
Erg.=765

Lösung zu Aufgabe 10.1: Wertetafel für die Fakultät

function f(n: integer): real;
begin
 if n < 1 then result := 1 else result := n*f(n-1)
end;


procedure TForm1.Button1Click(Sender: TObject);
   var n:integer;
begin
  memo1.lines.clear;
  for n := 0 to 100 do
    memo1.lines.Add(inttoStr(n)+'   '+FloatToStr(f(n)))
end;


Lösung zu Aufgabe 10.2: a) Funktionert für positive Werte von n wie bei
                Aufgabe 10.1
                f(5) = 5·4·3·2·1 = 5!
             b) f(-5) = -5*f(-6) mit
                f(-6) = -5*f(-7)
                ...
                Ende wird nie erreicht.
                Bedeutet "Computerabsturz" wegen "Stacküberlauf".

                Unter Delphi kannst Du allerdings dein Programm
                über Menü "Start|Programm zurücksetzen" stoppen.

Lösung zu Aufgabe 10.3 a)  1.5*1.5*1.5*1.5*1.5 = 1.5^5

                        1
            b)  ——————————————————— = 1.5^(-5)
                1.5*1.5*1.5*1.5*1.5


            c) h(x,n) = x^n für x beliebig und n ganze Zahl

Lösung zu Aufgabe 10.4 a) f(2) = 1/5 + f(1) mit
               f(1) = 1/3 + f(0) mit
               f(0) = 1/1 + 0
               Somit: f(2) = 1/5 + 1/3 + 1
            b) f(10) = 1/21 + f(9) mit
               f(8)  = 1/19 + f(8) mit
               ...
               f(0) = 1
               Somit: f(10) = 1/21 + 1/19 + 1/17 + ... + 1/3 + 1

           c) f(n) = 1 + 1/3 + 1/5 + 1/7 + ... + 1/(2n+1)
Lösung zu Aufgabe 10.5 Wertetafel für die Fibonacci-Folge:
function fib(n:integer):integer;
begin
  if n<2 then result := 1
      else result := fib(n-1) + fib(n-2)
   end;

procedure TForm1.Button1Click(Sender: TObject);
  var k: integer;
begin
  memo1.lines.clear;
  for k := 1 to 30 do
    memo1.lines.Add(intToStr(k)+ '   ' + intToStr(fib(k)));
end;


Lösung zu Aufgabe 10.6 Wieviel Addition werden bei fib(k) ausgeführt?

var
  Form1: TForm1;
  Zaehladd:integer; //Globale Variable

implementation

{$R *.DFM}

function add(a,b:integer): integer; //bei a + b wird Zaehladd um 1 erhöht
begin
  inc(Zaehladd);
  result := a + b
end;

function fib(n:integer): integer;
begin
  if n < 2 then result := 1 else
     result := add(fib(n-1), fib(n-2))
end;


procedure TForm1.Button1Click(Sender: TObject);
  var k: integer;
begin //wertetafel
  for k := 1 to 35 do Begin
    Zaehladd := 0;
    memo1.lines.Add(intToStr(k) + ' ' +
                    intToStr(fib(k)) + ' ' +
                    intToStr(ZaehlAdd));
  End;
end;

Der Ausdruck ist folgender:

1 1 0
2 2 1
3 3 2
4 5 4
5 8 7
6 13 12
7 21 20
8 34 33
9 55 54
...

35 14930352 14930351
Man sieht fib(k) benötigt, rekursiv berechnet, f(k) - 1 Additionen. Also bei f(35) fast 15 Millionen.

Lösung zu Aufgabe 10.7 Die Fibonacci-Folge nach der Binet'sche Formel:


Als Hilfsfunktion benötigt man noch hoch, in dieser Lektion natürlich rekursiv definiert.

function hoch(x:real; n:integer):real; //rekursiv
begin
  if n < 0 then result := 1/hoch(x,-n) //x^(-m)=1/x^m
    else if n = 0 then result := 1 //Anfangswert
      else result := x*hoch(x,n-1); //x ^n=x*x^(n-1)
end;

function fib(n:integer):integer;
  var x1,x2,y:real;
begin
 x1 := (1+sqrt(5))/2;
 x2 := (1-sqrt(5))/2;
 y := (hoch(x1,n) - hoch(x2,n))/sqrt(5);
 result := round(y);
end;

     oder

function fib(n:integer):integer;
begin
  result := round((hoch((1+sqrt(5))/2,n) - hoch((1-sqrt(5))/2,n))/sqrt(5));
end;

Lösung zu Aufgabe 10.8

                1   1   1   1
     a) s = 1 + - + - + - + -
                2   3   1   5

                1   1   1         1
     b) s = 1 + - + - + - + ... + ——
                2   3   4         10

     c) s = 0


                1   1   1         1
     b) s = 1 + - + - + - + ... + -
                2   3   4         n
Lösung zu Aufgabe 10.9:
n 0 1 2 3 4 5 6 7 8 9 10
f(n) 1 1 3 2+3 6+5 10+11 22+21 42+43 86+85 170+171 342+341
f(n) 1 1 3 5 11 21 43 85 171 341 683

a) f(3)=5 b) f(5)=21 c) f(10)=683 d( f(-2) fatal (Endlosschleife)
Lösung zu Aufgabe 11.1 Lösung der quadratischen Gleichung ax2 + bx + c =0.
Die Werte für a, b und c werden in edit1, edit2 und edit3 eingegeben.
Es ist nur folgende Prozedur zu ändern:
procedure TForm1.Button1Click(Sender: TObject);
  var anz: integer;
      a, b, c, x1,x2: real;
begin
  a := strToFloat(edit1.text);
  b := strToFloat(edit2.text);
  c := strToFloat(edit3.text);
  QuadrGl(a, b, c,anz,x1,x2);
  if anz = 0 then showmessage('Keine Lösung') else
    if anz = 1 then showmessage('Eine Lösung: x ='+floatToStr(x1))
     else showmessage('Lösungen: x1=' + FloatToStr(x1) + ' x2=' + FloatToStr(x2));
end;
Eine ausgefeiltere Programmversion steht bereit in Quadratische Gleichung
Dort werden noch die folgenden wiederverwendbare Funktionen eingesetzt:
Eingabe von Brüchen (Verwendung eines Parsers)
Ausgabe von Brüchen
Lösung zu Aufgabe 11.2
Procedure Kegel(r, h: real; var O, V: real);
  var s: real;
begin
  s := sqrt(r*r + h*h);
  O := Pi*r*(r + s);
  V := 1/3*Pi*r*r
end;

procedure TForm1.Button1Click(Sender: TObject);
   var r, h, V, O: real;
begin
  r := StrToFloat(edit1.text);
  h := StrToFloat(edit2.text);
  Kegel(r, h, V, O);
  edit3.text := 'Oberfläche = ' + floatToStr(O);
  edit4.text := 'Volumen = ' + floatToStr(V);
end;
Lösung zu Aufgabe 11.3
Hinweis: für arcCos muss die unit math eingebunden werden.
Ganz oben im Programm findest Du die uses-Klausel. Ergänze math zu den den veschieden Units.
uses math, Windows, ... (Suche in der ca 3. Zeile Deines Programms!)
...

Procedure dreieck(a,b,c: real; var al, be, ga: real);
 var x: real; //für cos(al)
begin
 x := (b*b + c*c - a*a)/(2*b*c); //cos al
 al := ArcCos(x)*180/Pi; //Gradmass
 x := (a*a + c*c - b*b)/(2*a*c); //cos be
 be := ArcCos(x)*180/Pi; //Gradmass
 x := (a*a + b*b - c*c)/(2*a*b); //cos al
 ga := ArcCos(x)*180/Pi; //Gradmass
end;

procedure TForm1.Button1Click(Sender: TObject);
   var a,b,c, alpha, beta, gamma: real;
begin
  a := StrToFloat(edit1.text);
  b := StrToFloat(edit2.text);
  c := StrToFloat(edit3.text);
  Dreieck(a, b, c, alpha, beta, gamma);
  memo1.lines.Clear;
  memo1.Lines.add('Alpha = ' + FloatToStr(alpha));
  memo1.Lines.add('Beta = ' + FloatToStr(beta));
  memo1.Lines.add('gamma = ' + FloatToStr(gamma));
end;
Elegantere Lösung von Björn:
function dreieck(a,b,c: real): real;
 var x: real; //für cos ...
begin
 x := (b*b + c*c - a*a)/(2*b*c); //cos al
 result := ArcCos(x)*180/Pi; //Gradmass
end;

procedure TForm1.Button1Click(Sender: TObject);
   var a,b,c, alpha, beta, gamma: real;
begin
  a := StrToFloat(edit1.text);
  b := StrToFloat(edit2.text);
  c := StrToFloat(edit3.text);
  alpha := Dreieck(a, b, c); //Achtung: alpha liegt der Seite a (1. Parameter) gegenüber
  beta := Dreieck(b, a, c);  //Analog beta liegt der Seite b gegenüber
  gamma := Dreieck(c, b, a); //Analog gamma liegt der Seite c gegenüber
  memo1.lines.Clear;
  memo1.Lines.add('Alpha = ' + FloatToStr(alpha));
  memo1.Lines.add('Beta = ' + FloatToStr(beta));
  memo1.Lines.add('gamma = ' + FloatToStr(gamma));
end;
Lösung zu Aufgabe 11.4
procedure LGS2(a, b, c, d, e, f: real; var lsg: boolean; var x, y: real);
{Die Gleichungen ax + cy = e
                 bx + dy = f

 haben die Lösung x = (ed - cf)/det y = (af - be)/det für det = ad - bc}
 var det:real;
begin
  det := a*d - b*c;
  if det = 0 then lsg := false else Begin
    lsg := true;
    x := (e*d - c*f)/det;
    y := (a*f - b*e)/det;
  End;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var a, b, c, d, e, f, x1, x2:real;
      lsg: boolean;
begin
  a := 5;  c := -7; e := 9;
  b := -3; d := 2;  f := 4;
  //Die primitivste Form die Aufgabe zu lösen
  LGS2(a, b, c, d, e, f, lsg, x1, x2);
  if lsg then
     showmessage('Die Lösung ist'#13+
                 'x1 = ' + formatfloat('0.######',x1) + #13+
                 'x2 = ' + formatfloat('0.######',x2))
  else showmessage('Keine eindeutige Lösung');
end;

Lösung zu Aufgabe 12.1:Heronverfahren:
  Anfangswert: x0    = 1
  Iteration:   x     = 1/2(xn + a/xn)
                n+1

  Abbruchbedingung: xn·xn = a (Nicht korrekt, da Computer nicht exakt rechnen)
                   |xn·xn - a| < 10^(-12)
      ("Daumenregel" 3 Dezimalen weniger als Rechengenauigkeit)

procedure TForm1.Button1Click(Sender: TObject);
  var a,x: real;
begin
  a := 2;
  x := 1;
  repeat
    x := 1/2*(x + a/x);
    memo1.Lines.add(FloatToStr(x));
  until abs(x*x - a) < 1E-15
end;

Lösung zu Aufgabe 12.1

1 0 1 1 1 2 1 3 1 4 1 5 a) f(2,5)= -·2 + ——·2 + ——·2 + ——·2 + ——·2 + ——·2 (genügt!) 0! 1! 2! 3! 4! 5! 1 1 1 1 = 1 + 1·2 + -·4 + -·8 + ——·16 + ———·32 = 7,266 2 6 24 120 Bemerkung: x 1 0 1 1 1 2 1 3 1 4 1 5 e = -·x + ——·x + ——·x + ——·x + ——·x + ——·x + ... (ad infinitum) 0! 1! 2! 3! 4! 5! f(x,n) nähert also die Exponentialfunktion an: Für genügend großes 1 n n ist —— so klein gegenüber x , dass man abbrechen kann. n! 2 Vergleiche e = 7,389 mit f(2,5) = 7,266 (siehe oben) b) f(-5) =0 (Die Schleife wird nicht durchlaufen)

Lösung zu Aufgabe 12.3
 

5 4 3 2 1 15 a) f(5) = (——)·(——)·(——)·(——)·(——)·(-1) = —— 2 2 2 2 2 4 b) Die Funktion ruft sich ohne Terminierung pausenlos selbst auf. Ein fataler Fehler!

Lösung zu Aufgabe 12.4
 

2 5 3 5 7 7 4 5 83 a) f(0) = 1, f(1) = 1, f(2) = 1 + - = -, f(3) = -·- + 1 = -; f(4) = 2·- + -·- = —— 3 3 2 3 2 2 3 3 9 b) f(-5) = 1, da für n = - 5 die Bedingung n <= 1 erfüllt ist

Lösung zu Aufgabe 12.5

**********
********
******
****
**

Lösung zu Aufgabe 12.6
function f(x:real):real; //Zum Beispiel
begin
  result :=x*x*x - 7/3*x - 20/27
end;

function fs(x:real):real; //fs = f'

begin
  result := 3*x*x - 7/3
end;

function newton(x0:real):real;
  var y0: real;
       n: integer; //Bremse
begin
  n := 0;
  y0 := f(x0);
  repeat
    x0 := x0 - y0/fs(x0); //fs = f'
    y0 := f(x0);
    n := n + 1;
    //{Alternative statt "or (n > 25)"}  if n > 25 then Begin
    //showmessage('Abbruch Newtonverfahren'); exit End;
  until (abs(y0) < 1E-9) or (n > 25);
  if n > 25 then showmessage('Newtonverfahren funktioniert nicht!');
  result := x0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage('Eine von drei NS ist:' + floatToStr(newton(0)));
end;
Lösung zu Aufgabe 12.7
   function f(x: real):real; //oder auch eine langwierige Berechnung
   //zum Beispiel Näherung von f(x) =x - x^2/2 + x^3/3 - x^4/4 +/- ...
   begin
     result := x*x - 2;
   end;

   function intervallh(x1, x2: real):real;
     var m:real;
   begin
     m  := (x1 + x2)/2;
     while abs(f(m)) >= 1E-15 do Begin
       m  := (x1 + x2)/2;
       if f(x1)*f(m) < 0  then x2 := m else x1 := m;
     End;
     result := (x1 + x2)/2;
   end;

   procedure TForm1.Button1Click(Sender: TObject);
     var x1, x2:real;
   begin
     x1 := strTofloat(edit1.text);
     x2 := strTofloat(edit2.text);
     if f(x1)*f(x2) >= 0 then showmessage('Kein VZW') else
       showmessage(floatToStr(intervallh(x1,x2)));
   end;
Zusatz: Ersetze "intervalh" durch
function intervallhalbierung(var x1, x2: real);
   var m, y1, ym:real;
begin
  y1 := f(x1);
  repeat
    m  := (x1 + x2)/2;
    ym := f(m);
    if y1*ym > 0 then Begin
      x1 := m;  //Neuer Wert für f(x1) ist alter Wert f(m)
      y1 := ym; //d.h. y1 schon berechnet!
    End else x2 := m;
  until abs(x2 - x1) > 1E-15
end;
Lösung zu Aufgabe 12.8
Berechnung der 3. Wurzel nach dem Intervallhalbierungsverfahren.
function dritteWurzel(a: real): real;
   function f(x: real): real;
     begin
       result := x*x*x - a;
     end;
   var x1,x2,xm: real;
begin
  //Einfädeln
  x2 := 0;
  repeat
    x2 := x2 + 1
  until f(x2) >= 0;
  if abs(f(x2)) < 1E-15 then Begin
     result := x2;
     exit;
  End; //Ergebnis ganzzahlig
  x1 := x2 - 1; //Jetzt f(x1) < 0 und f(x2) > 0
  //Intervallhalbierungsverfahren
  repeat
    xm := 1/2*(x1 + x2);
    if f(x1)*f(xm) < 0 then x2 := xm else x1 := xm
  until abs(x1 - x2) < 1E-12;
  result := (x1 + x2)/2
end;
Lösung zu Aufgabe 12.9
Berechnung der 4. Wurzel nach dem Newtonverfahren.
function vierteWurzel(a: real): real;
   function f(x: real): real;
     begin
       result := x*x;
       result := result*result - a; //= x^4 - a
     end;
   function fs(x: real): real;
     begin
       result := 4*x*x*x;
     end;
   var y0, y1, yalt: real;
begin
  y0 := 1;
  repeat
    y1 := y0 - f(y0)/fs(y0);
    yalt := y0; //Zum Vergleichen
    y0 := y1;   //zum Weiterrechnen
  until abs(y1 - yalt) < 1E-12;
  result := y1;
end;

Lösung zu Aufgabe 13.1:
function wort_n(const s:string; const n:integer): string;
  var p:integer;
begin
  p := pos(' ',s);
  if p = 0 then Begin
    if n > 1 then result :='' else result := trim(s);
  End else Begin //p > 0
    if n = 1 then result := trim(copy(s,1,p-1)) else
     result := wort_n(trim(copyab(s,p+1)),n-1);
  End;
end;
Bemerkung: trimright, trimleft bzw. trim entfernt Leerstellen am Anfang, am Ende bzw. am Anfang und am Ende eines Strings.
Lösung zu Aufgabe 14.1: Die 20 Namen in Memo1 werden geordnet in Memo2 gezeigt.
const anzahl = 20;
var
  Form1: TForm1;
  var aa: array[1..20] of string;

implementation

{$R *.DFM}

procedure tausche(var a,b: string);
  var x: string;
begin
  x := a;
  a := b;
  b := x;
end;


procedure bubblesort(n1,n2:integer); //sortiert von n1 bis n2
  var i:integer;
      fertig: Boolean;
begin
  repeat
    fertig:=true;
    for i:=n1 to n2-1 do Begin
      if aa[i] > aa[i+1] then BEgin
        tausche(aa[i],aa[i+1]);
        fertig:=false;
      ENd;
    End;
  until fertig;
end;


procedure TForm1.Button1Click(Sender: TObject);
  var k: integer;
begin
  for k := 1 to Anzahl do aa[k] := memo1.Lines[k-1];
   //Achtung: Memo1.lines zählt ab Null, und dann nur bis Anzahl - 1
  bubblesort(1,Anzahl);
  memo2.Lines.Clear;
  for k := 1 to anzahl do memo2.lines.Add(aa[k]);
end;
Lösung zu Aufgabe 14.1 b: Sechs Lottozahlen sollen geordnet ausgegeben werden.
type Tintergerarray = array[1..6] of integer;  // Eigene Type-Deklarationen vor ...

var                                   //... diese beiden Zeilen, die Delphi ...
  Form1: TForm1;                      //... schreibt, einfügen
...


function mindestensDreiZeichen(s: string): string;
begin
  result := s;
  while length(result) < 3 do result := ' ' + result;
end;

function zeile(a: Tintergerarray): string; //schreibt die 6 Lottozahlen in eine Zeile
  var i: integer;
begin
  result := '';
  for i := low(a) to High(a) do  //low, high = kleinster, größter Wert des Arrays
    result := result + mindestensDreiZeichen(intToStr(a[i]));
end;

procedure tausche(var a,b: integer);
  var x: integer;
begin
  x := a;
  a := b;
  b := x;
end;

procedure bubblesort(var a: Tintergerarray); //Array wird als Parameter übergeben
      //sortiert den array
  var i:integer;
      fertig: Boolean;
begin
  repeat
    fertig:=true;
    for i:=low(a) to high(a) - 1 do Begin
      if a[i] > a[i+1] then BEgin
        tausche(a[i],a[i+1]);
        fertig:=false;
      ENd;
    End;
  until fertig;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var lotto: Tintergerarray;
      i,j: integer;
      neu: boolean;
      s: string;
begin
  memo1.Font.Name := 'Courier New'; //gleiche Abstände
  memo1.WordWrap := false;
  for i := 1 to 6 do Begin
    repeat
      neu := true;
      lotto[i] := 1 + random(49);
      for j := 1 to i - 1 do
        if lotto[i] = lotto[j] then neu := false;
    until neu;
  End;
  s := zeile(lotto);
  bubblesort(lotto);
  s := s + ' geordnet: ' + zeile(lotto);
  memo1.Lines.Add(s);
end;

Lösungen zu Block 1

Lösungen zu Aufgabe 14.u1:
1. a) 4
   b) 0
   c) 9
   d) 4
   e) 3
   f) -3
Lösungen zu Aufgabe 14.u2:
       2         3        10            100
   a) 3      b) 2     c) 5       d) 0.75
Lösungen zu Aufgabe 14.u3:
      1        1         1              1            1
   a) -    b) ———  c) ———————    d) ————————————— = —————
      2       2*3     2*3*4*5       2*3*4*...*100   100!
Lösungen zu Aufgabe 14.u4:
procedure kegel(r,h: real;  //Eingansvariablen
                var O,V: real); //Ausgangsvariablen
   var s: real;
begin
  s := sqrt(sqr(h) + sqr(r)); //sqr=quadrat sqrt=quadratwurzel
  O := Pi*r*(s+r);
  V := 1/3*Pi*sqr(r)*h;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var radius, hoehe, oberflaeche, volumen: real;
begin
  radius := 5; //besser aus edit1 auslesen
  hoehe := 10; //besser aus edit2 auslesen
  kegel(radius, hoehe, oberflaeche, volumen);
  //hier möglich kegel(5,10,oberflaeche,volumen);
  showmessage('Oberfläche = ' + floattostr(oberflaeche));
  showmessage('Volumen = ' + floattostr(volumen));
end;
Lösungen zu Aufgabe 14.u5:
//Teil a)
procedure fuelle;
  var i: integer;
begin
  randomize;
  for i := 1 to 50 do
    aa[i] := 50 + random(100) + random;
  //ergibt Werte zwischen 50 und 150,
end;

//Zu Teil b)
procedure tausche(var a,b: real);
  var x: real;
begin
  x := a;
  a := b;
  b := x;
end;

//Zu Teil b)
procedure bubblesort(n1,n2:integer); //ordnet aa fallend
  var i:integer;
      fertig: Boolean;
begin
  repeat
    fertig:=true;
    for i:=n1 to n2-1 do Begin
      if aa[i] < aa[i+1] then BEgin
        tausche(aa[i],aa[i+1]);
        fertig:=false;
      ENd;
    End;
  until fertig;
end;


//In der Aufgabe nicht verlangtes Testprogramm
procedure zeigeIn(m: Tmemo);
  var i: integer;
begin
  m.Lines.Clear;
  for i := 1 to 50 do m.Lines.add(FloatToStr(aa[i]));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  fuelle;
  zeigeIn(memo1);
  bubblesort(1,50);
  zeigeIn(memo2);
end;


Lösungen zu Block 2

Lösungen zu Aufgabe 14.uu1:
   a) Ronald erhält 1 Notenpunkt(e)
       Gerhard erhält 5 Notenpunkte
       Joschka erhält 14 Notenpunkte
    b)
function oberstufeneu(p,m:real): integer;
  var n: real;
begin
  p := p * 60 / m;
  //Gute Schüler werden noch besser
  if p > 56 then n := 15 else
    if p > 55 then n := 14 else
      //Hauptformel
      if p > 23 then n := (p - 12) / 3 else
      //Nicht so gute Schüler werden noch schlechter
        if p > 22 then n := 4 else
          if p > 18 then n := 3 else
            if p > 14 then n := 2 else
              if p > 10 then n := 1 else
                n := 0;
  result := trunc(n + 1 / 4096); //trunc rundet ab. z.B. trunc(4.99)=4
end;

procedure TForm1.Button1Click(Sender: TObject);
  var max: real;
begin
  max := 30; //Maximale Punktezahl der Klassenarbeit
  showmessage('Ronald erhält  ' + inttostr(oberstufeneu(7,max)) + ' Notenpunkte');
  showmessage('Gerhard erhält ' + inttostr(oberstufeneu(14,max)) + ' Notenpunkte');
  showmessage('Joschka erhält ' + inttostr(oberstufeneu(27,max)) + ' Notenpunkte');
end;

Lösungen zu Aufgabe 14.uu2:
   a) f(2) = 1+1/4 (Rechnausdruck genügt)
      f(4) = 1 + 1/4 + 1/9 + 1/16
      f(4) = 1 + 1/4 + 1/9 + 1/16 + ... + 1/10000
      f(0) = 0  (Schleife wird nicht durchlaufen)
      f(-2) = 0 (Schleife wird nicht durchlaufen)

   b)

function f(n: integer): real;
  var k,a: integer;
begin
  result := 1;
  for k := 1 to n do Begin
    a := k*k;
    result := result * a;
  End;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage('f(2) = ' +floattoStr(f(2)) + #13+ //#13 "Neue Zeile!"
              'f(4) = ' +floattoStr(f(4)) + #13+
              //'f(100) = ' +floattoStr(f(100)) + #13+ ergibt Gleitkommaüberlauf
              'f(0) = ' +floattoStr(f(0)) + #13+
              'f(-2) = ' +floattoStr(f(-2)));
end;

Lösungen zu Aufgabe 14.uu3:

procedure QuadrGl(a,b,c: real; var n: Integer; var x1,x2: real);
  var d: real;
begin
  d := b*b - 4*a*c;
  if d < 0 then n := 0 else
    if d = 0 then Begin
      n := 1;
      x1 := -b/(2*a);
    End else Begin
      n := 2;
      x1 := (-b + sqrt(d))/(2*a);
      x2 := (-b - sqrt(d))/(2*a)
    End;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var anz: integer;
      x1,x2: real;
begin
  QuadrGl(1,5,6,anz,x1,x2);
  if anz = 0 then showmessage('Keine Lösung') else
    if anz = 1 then showmessage('Eine Lösung: x ='+floatToStr(x1))
     else showmessage('Lösungen: x1=' + FloatToStr(x1) + ' x2=' + FloatToStr(x2));
end;

Lösungen zu Aufgabe 14.uu4:
a)
function f(n: integer): real;
  var k: integer;
begin
  result := 0;
  for k := 1 to n do
    result := result + 1/k
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(floattostr(f(4))); //zum Beispiel
end;

b)
function f(n: integer): real;
  var k: integer;
begin
  result := 1;
  for k := 1 to n do
    result := result * (2*k-1)/(2*k)
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(floattostr(f(4)));
end;

Lösungen zu Aufgabe 14.uu5:
a) n willkürliche aus 3 Buchstaben bestehende "Namen" werden
     in Memo1 geschrieben

b)
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
      procedure fuelleMemo(n:integer);
  public
    { Public-Deklarationen }
  end;

const Anzahl = 100;
var
  Form1: TForm1;
  aa: array[1..Anzahl] of string;
implementation

{$R *.DFM}

procedure TForm1.fuelleMemo(n:integer);
begin
  memo1.lines.Clear;
    while memo1.Lines.Count <= n do
       memo1.lines.add(chr(65+random(25)) + chr(65+random(25)) + chr(65+random(25)));
end;

procedure tausche(var a,b: string);
  var x: string;
begin
  x := a;
  a := b;
  b := x;
end;

procedure bubblesort(n1,n2:integer);
      //sortiert den globalen array aa von n1 bis n2
  var i:integer;
      fertig: Boolean;
begin
  repeat
    fertig:=true;
    for i:=n1 to n2-1 do Begin
      if aa[i] > aa[i+1] then BEgin
        tausche(aa[i],aa[i+1]);
        fertig:=false;
      ENd;
    End;
  until fertig;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var k: integer;
begin
  fuellememo(Anzahl);
  for k := 0 to Anzahl - 1 do aa[k+1] := memo1.lines[k];
  bubblesort(1,Anzahl);
  memo2.Lines.Clear;
  for k := 1 to Anzahl do
   memo2.Lines.Add(aa[k]);
end;

end.

Lösungen zu Block 3

Lösung zu Aufgabe 14.z1:

a) f(10) = 1/2 - 1/3 + 1/4 - 1/5 + 1/6 - 1/7 + 1/8 - 1/9 + 1/10
b) f(-1) = 0
c)
function f(n: integer): real;
  begin
    //showmessage(intToStr(n));
    if n <=1  then result := 0 else
      if n mod 2 = 0  then result := f(n-1) + 1/n
        else result := f(n-1) - 1/n
  end;

procedure TForm1.Button1Click(Sender: TObject);
  var k: integer;
begin
  for k := 1 to 10 do
  memo1.lines.Add(IntToStr(k) + ' ' + floatToStr(f(k)))
end;
d) Das Meldungsfenster zeigt "10, 9, 8, 7, 6, 5, 4, 3 ,2 ,1". Es erscheint also 10 mal.

Lösung zu Aufgabe 14.z2:

a) f(1) = 2;
    f(2) = f(1)*f(1) = 2^2
    f(3) = f(2)*f(2) = 2^4
    f(4) = f(3)*f(3) = 2^8
    ...
    f(10) = 2^512 = 1,34*10^154
Allgemein ist f(n) = 2^(2^(n-1))

b) Bei f(-1) gibt es einen Stacküberlauf, die Berechnung ist nicht terminiert. (Fataler Laufzeitfehler.)

c) Bei f(3) wird nacheinander im Meldungsfenster gezeigt:
"3, 2, 1, 1, 2, 1 ,1". Es erscheint also 7 Mal das Meldungsfenster, allein vier Mal die "1" .
Bei f(4), f(5), f(6), ..., f(10) erscheint die "1" 8 Mal, 16 Mal, 32 Mal, ..., 512 mal (genügt als Angabe der Größenordnung. Genau erscheint bei f(10) das Meldungsfenster 512+256+...+1=1023 Mal).
Bemerkung: Die Effizienz ist O(2^n).

d) Die Effizienz der folgenden Funktion ist O(n):
function f(n: integer): real;
    var y: real;
  begin
    if n=1  then result := 2  else Begin
      y := f(n-1); //f wird nur einmal rekursiv aufgerufen
      result := y*y //Eleganter (Christian A.) result := sqr(f(n-1))
    End;
  end;
Lösung zu Aufgabe 14.z3:
procedure tausche(var a,b: string);
  var x: string;
begin
  x := a;
  a := b;
  b := x;
end;

procedure TForm1.Button1Click(Sender: TObject);
  const n = 100;
        h = 25;
        b = 50;
  var ee: array[0..n-1] of Tedit; //oder dynamisch: ee: array of Tedit
       k, rand: integer;
       p, q: string;
begin
  randomize;
  //setlength(ee,n); //falls Deklaration "ee: array of Tedit"
  for k := 0 to n - 1 do Begin
    ee[k] := Tedit.Create(Form1);
    //Bei Freigabe von Form1 werden auch die Editfelder freigegeben.
    ee[k].Parent := Form1;
    ee[k].Height := h;
    ee[k].Width := b;
    ee[k].Top := h*(k div 10);
    ee[k].left := b*(k mod 10);
    ee[k].Text := intToStr(k+1);
  End;
  button1.hide; {Beim 2 Klick würden die ersten 100 Editfelder
    nie mehr freigegeben. Schwerer Programmierfehler!}
  showmessage('Das war Aufgabe 14.z3');
  for k := 0 to n - 1 do Begin
    rand := random(n);
    p := ee[k].text;
    q := ee[rand].text;
    tausche(p,q);
    ee[k].text := p;
    ee[rand].text := q;
  End;
  showmessage('Das war der der Zusatz');
end;
Lösung zu Aufgabe 14.z4:
procedure tausche(var a,b: integer);
  var x: integer;
begin
  x := a;
  a := b;
  b := x;
end;

procedure bubblesort(var aa: array of integer); //das größte zuerst
  var i:integer;
      fertig: Boolean;
begin
  repeat
    fertig:=true;
    for i:=0 to length(aa) - 2 do Begin
      if aa[i] < aa[i+1] then BEgin
        tausche(aa[i],aa[i+1]);
        fertig:=false;
      ENd;
    End;
  until fertig;
end;

procedure TForm1.Button1Click(Sender: TObject);
  const n = 100;
  var aa: array[0..n-1] of integer;//oder dynamisch:aa: array of integer
begin
  randomize;
  //setlength(aa,n); //falls Deklaration "aa: array of integer"
  for k :=0 to n - 1 do aa[k] := random(100) + 1;
  bubblesort(aa);
  for k := 0 to n - 1 do showmessage(intToStr(aa[k]));
end;
Lösung zu Aufgabe 14.z5:
//Das folgende aus Aufgabe 14.z4 wird benötigt
procedure tausche(var a,b: integer);
  var x: integer;
begin
  x := a;
  a := b;
  b := x;
end;

procedure bubblesort(var aa: array of integer); //das größte zuerst
  var i:integer;
      fertig: Boolean;
begin
  repeat
    fertig:=true;
    for i:=0 to length(aa) - 2 do Begin
      if aa[i] < aa[i+1] then BEgin
        tausche(aa[i],aa[i+1]);
        fertig:=false;
      ENd;
    End;
  until fertig;
end;

procedure TForm1.Button1Click(Sender: TObject);
  const n = 100;
        h = 25;
        b = 50;
  var ee: array[0..n-1] of Tedit;
      aa: array[0..n-1] of integer;
       k, rand: integer;
  function ZahlNochNichterfasst(r, j:integer): boolean;
      var i:integer;
    begin
      result := false;
      for i := 0 to j do if strToInt(ee[i].text) = r then exit;
      result := true; //r ist neu
    end;
begin
  //Das folgende darf als gegeben vorausgesetzt sein
  randomize;
  for k := 0 to n - 1 do Begin
    ee[k] := Tedit.Create(Form1);
    ee[k].Parent := Form1;
    ee[k].Height := h;
    ee[k].Width := b;
    ee[k].Top := h*(k div 10);
    ee[k].left := b*(k mod 10);
    repeat
      rand := random(1000) + 1;
    until ZahlNochNichterfasst(rand,k-1);
    ee[k].Text := intToStr(rand);
  End;
  button1.hide; //Nur einmal erzeugen.
  //——————————— Nur dieser Teil war zu schreiben ———————————————
  showmessage('1. Version: Die ersten 10 Preisträger!');
  for k := 0 to n - 1 do aa[k] := StrToInt(ee[k].text);
  bubblesort(aa);
  //in aa[0] und aa[9] stehen nun die größten Werte
  for k := 0 to n - 1 do
    if StrToInt(ee[k].text) >= aa[9] then ee[k].color := clred;
  {Idee von Joahannes K. ohne bubblesort: Ergänze var wert, zaehl: integer;
  showmessage('2. Version: Die ersten 10 Preisträger!');
  for zaehl := 1 to 10 do Begin
    wert := 0;
    for k := 0 to n - 1 do
    if (StrToInt(ee[k].text) >= wert) and (ee[k].color <> clred) then
      wert := StrToInt(ee[k].text); //der höchste nicht rote Wert
      for k := 0 to n - 1 do
    if StrToInt(ee[k].text) >= wert  then ee[k].color := clred;}
  End;
  //Falls gleiche Werte erlaubt sind, müßte man noch diese zählen
end;

Lösung zu Aufgabe 14.2: Ein dynamisches Array wird mit Zahlen gefüllt, die Werte des Arrays in ein Memo geschrieben, dann durcheinandergewirbelt (permutiert) und in ein zweites Memo geschrieben. Schließlich geordnet und in ein drittes Memo geschrieben.
type TIntegerArray = array of Integer; // Eigene Type-Deklarationen vor ...
var                                  //... diese beiden Zeilen, die Delphi ...
Form1: TForm1;                       //... schreibt, einfügen ...

procedure tausche(var a,b: integer);
  var x: integer;
begin
  x := a;
  a := b;
  b := x;
end;


procedure permutiere(var aa: TIntegerArray);
  var i:integer;
begin
  for i := 0 to length(aa) - 1 do
     tausche(aa[i], aa[random(length(aa))]);
end;

procedure bubblesort(var aa: TIntegerArray);
  var i:integer;
      fertig: Boolean;
begin
  repeat
    fertig:=true;
    for i:=0 to length(aa) - 2 do Begin
      if aa[i] > aa[i+1] then BEgin
        tausche(aa[i],aa[i+1]);
        fertig:=false;
      ENd;
    End;
  until fertig;
end;


procedure TForm1.Button1Click(Sender: TObject);
  const Anzahl = 100;
  var k: integer;
      aa: TIntegerArray;
begin
  setlength(aa,Anzahl); //aa[0] bis aa[Anzahl - 1]
  for k := 0 to length(aa) - 1 do aa[k] := k;

  memo1.Lines.Clear;
  for k := 0 to length(aa) - 1 do memo1.lines.Add(intTostr(aa[k]));

  permutiere(aa);

  memo2.Lines.Clear;
  for k := 0 to length(aa) - 1 do memo2.lines.Add(intTostr(aa[k]));

  bubblesort(aa);

  memo3.Lines.Clear;
  for k := 0 to length(aa) - 1 do memo3.lines.Add(intTostr(aa[k]));
end;

Lösung zu Aufgabe 14.3: Sieb des Eratosthenes.
procedure TForm1.Button1Click(Sender: TObject);
  const n=100;
  var aa: array of boolean;
       k, j: integer;
       s: string;
begin
  setlength(aa,n+1);
  //Anfangswerte
  for k := 1 to n do aa[k] := true;
  //Die Nicht-Primzahlen "streichen"
    for k := 2 to round(sqrt(n)) do if aa[k] then //Primzahl
      for j := 2 to n div k do  aa[k*j] := false; //Maximal j*(n div j) = n
  //Das wars. Jetzt bleibt noch die Ausgabe.
  s := '';
  memo1.lines.clear;
  for k := 2 to n do Begin
    if aa[k] then s := s + intToStr(k) + ' ';
    if length(s) > 60 then BEgin
      memo1.lines.Add(s);
      s := '';
    ENd;
  End;
  memo1.lines.Add(s);
end;
Lösungen zu Aufgabe 14.4:
...
var
  Form1: TForm1;
  daten: array of string; //Global
  anzahl: integer;

  implementation

{$R *.DFM}

procedure tausche(var a,b:string);
  var x:string;
begin
  x:=a;
  a:=b;
  b:=x;
end;

procedure bubblesort(var aa:array of string; n1,n2:integer);
    //sortiert von n1 bis n2
  var i:integer;
      fertig: Boolean;
begin
  repeat
    fertig:=true;
    for i:=n1 to n2-1 do Begin
      if aa[i] > aa[i+1] then BEgin
        tausche(aa[i],aa[i+1]);
        fertig:=false;
      ENd;
    End;
  until fertig;
end;

function copyab(const s:string; const i:integer):string;  //Rest von s ab i. em Zeichen
  begin result:=copy(s,i,length(s)-i+1) end;


procedure bubblesortVorname(var aa:array of string; n1,n2:integer);
    //sortiert von n1 bis n2
  const posVorn = 15;
  var i:integer;
      fertig: Boolean;
begin
  repeat
    fertig:=true;
    for i:=n1 to n2-1 do Begin
      if copyab(aa[i],15) > copyab(aa[i+1],15) then BEgin
        tausche(aa[i],aa[i+1]);
        fertig:=false;
      ENd;
    End;
  until fertig;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var pfad: String;
      k: integer;
begin
  if opendialog1.Execute then
    pfad := opendialog1.FileName;
  memo1.Lines.LoadFromFile(pfad);
  // Gegestück mit savedialog1: memo1.Lines.SaveToFile(pfad);
  Anzahl := memo1.lines.Count - 1;
  setlength(daten,Anzahl);
  for k := 0 to Anzahl-1 do
    daten[k] := memo1.lines[k];
end;

procedure TForm1.Button2Click(Sender: TObject);
  var k:integer;
begin
  bubblesort(daten,0,Anzahl-1);
  memo2.Lines.clear;
  for k := 0 to Anzahl-1 do
    memo2.Lines.Add(daten[k]);
end;

procedure TForm1.Button3Click(Sender: TObject);
   var k:integer;
begin
  bubblesortVorname(daten,0,Anzahl-1);
  memo2.Lines.clear;
  for k := 0 to Anzahl-1 do
    memo2.Lines.Add(daten[k]);
end;

end.

Lösung zu Aufgabe 14.5:Sortieren durch geordnetes mischen von vier Stapeln.
procedure tausche(var a,b:real);
  var x:real;
begin
  x:=a;
  a:=b;
  b:=x;
end;

//Noch muss ein Teil sortiert werden. Primitv mit Bubblesort
procedure bubblesort(var aa:array of real; n1,n2:integer); //sortiert von n1 bis n2
  var i:integer;
      fertig: Boolean;
begin
  repeat
    fertig:=true;
    for i:=n1 to n2-1 do Begin
      if aa[i] > aa[i+1] then BEgin
        tausche(aa[i],aa[i+1]);
        fertig:=false;
      ENd;
    End;
  until fertig;
end;

procedure Einsortieren(var aa:array of real; n1,m,n2:integer);
  //aa[n1] <= aa[n1+1] <= ..<=aa[m] aa[m+1]<=aa[m+2]<=...<=aa[n2]
  //  i1——————————————————>     i2——————————————————————>
  //  k—————————— füllt Hilfsfeld———————————————————————>
  var i1,i2,k,n:integer;
      hilf: array of real;
begin
  n:=n2-n1+1; //Anzahl von aa[n1] ... aa[n2]
  setlength(hilf,n); //Platz für hilf[0] ... hilf[n-1]
  i1:=n1;
  i2:=m+1;
  for k:=0 to n-1 do //i1 > m und i2 > n2 auch abfangen!
    if (i1 > m) or ((i2 <= n2) and (aa[i1] > aa[i2])) then Begin
      hilf[k]:=aa[i2];
      inc(i2);
    End else  Begin
      hilf[k]:=aa[i1];
      inc(i1);
    End;
  for k:=0 to n-1 do aa[n1+k]:=hilf[k];
end;

procedure zeige(mm:Tmemo; aa:array of real);
  var i:integer;
begin
  mm.Lines.Clear;
  for i:=0 to length(aa)-1 do mm.Lines.Add(FloatToStr(aa[i]));
end;

procedure sortieren(var aa:array of real);
  var n,m:integer;
begin
  n:=length(aa);           //Bsp.: n=16
  m:=n div 4;              //      m=4
  bubblesort(aa,0,m-1);    //     0 bis 3
  bubblesort(aa,m,2*m-1);  //     4 bis 7
  bubblesort(aa,2*m,3*m-1);//     8 bis 11
  bubblesort(aa,3*m,n-1);  //     12 bis5
  //Zu Testzwecken
  zeige(form1.memo2,aa);
  Einsortieren(aa,0,m-1,2*m-1);   //0..3  und 4..7
  Einsortieren(aa,2*m,3*m-1,n-1); //8..11 und 12..15
  Einsortieren(aa,0,2*m-1,n-1);   //0..7  und 8..15
end;

procedure TForm1.BFuellenClick(Sender: TObject);
  var i,anzahl:integer;
      aa:array of real;
begin
  anzahl:=strToInt(EAnzahl.text);
  setlength(aa,anzahl);
  for i:=0 to Anzahl-1 do aa[i]:=i+1;
  //Durcheinanderwirbeln
  randomize;
  for i:=0 to Anzahl-1 do tausche(aa[i],aa[random(Anzahl)]);
  zeige(memo1,aa);
end;

procedure TForm1.BOrdnenClick(Sender: TObject);
  var aa:array of real;
     n,i:integer;
begin
  n:=strToInt(EAnzahl.text);
  setlength(aa,n); //n Plätze für aa[0] bis aa[n-1] reserviert
  for i:=0 to n-1 do aa[i]:=StrToFloat(memo1.lines[i]);
  sortieren(aa);
  zeige(memo3,aa);
end;
Lösung zu Aufgabe 14.6:Sortieren durch Mischen.
procedure Einsortieren(var aa:array of real; n1,m,n2:integer);
  //aa[n1] <= aa[n1+1] <= .. <= aa[m] aa[m+1] <= aa[m+2] <= ... <= aa[n2]
  //  i1——————————————————>     i2——————————————————————>
  //  k—————————— füllt Hilfsfeld———————————————————————>
  var i1,i2,k,n:integer;
      hilf: array of real;
begin
  n:=n2-n1+1; //Anzahl von aa[n1] ... aa[n2]
  setlength(hilf,n); //Platz für hilf[0] ... hilf[n-1]
  i1:=n1;
  i2:=m+1;
  for k:=0 to n-1 do //i1 > m und i2 > n2 auch abfangen!
    if (i1 > m) or ((i2 <= n2) and (aa[i1] > aa[i2])) then Begin
      hilf[k]:=aa[i2];
      inc(i2);
    End else  Begin
      hilf[k]:=aa[i1];
      inc(i1);
    End;
  for k:=0 to n-1 do aa[n1+k]:=hilf[k];
end;

procedure zeige(mm:Tmemo; aa:array of real);
  var i:integer;
begin
  mm.Lines.Clear;
  for i:=0 to length(aa)-1 do mm.Lines.Add(FloatToStr(aa[i]));
end;

procedure sortieren(var aa:array of real;n1,n2:integer);
  var m:integer;
begin
  if n1=n2 then exit;   //Bei einem Element ist nichts zu sortieren
  m:=(n1+n2) div 2;     //Mitte
  sortieren(aa,n1,m);   //Rekursiv
  sortieren(aa,m+1,n2); //Rekursiv
  Einsortieren(aa,n1,m,n2);
end;

procedure TForm1.BFuellenClick(Sender: TObject);
  var i,anzahl:integer;
      aa:array of real;
  procedure tausche(var a,b:real); //hier lokale Prozedur
    var x:real;
  begin
    x:=a;
    a:=b;
    b:=x;
  end;
begin
  anzahl:=strToInt(EAnzahl.text);
  setlength(aa,anzahl);
  for i:=0 to Anzahl-1 do aa[i]:=i+1;
  //Durcheinanderwirbeln
  randomize;
  for i:=0 to Anzahl-1 do tausche(aa[i],aa[random(Anzahl)]);
  zeige(memo1,aa);
end;

procedure TForm1.BOrdnenClick(Sender: TObject);
  var aa:array of real;
     n,i:integer;
begin
  n:=strToInt(EAnzahl.text);
  setlength(aa,n); //n Plätze für aa[0] bis aa[n-1] reserviert
  for i:=0 to n-1 do aa[i]:=StrToFloat(memo1.lines[i]);
  sortieren(aa,0,length(aa)-1);
  zeige(memo3,aa);
end;

Lösung zu Aufgabe 15.1
          k   k   k   k         k
S(n,k) = 1 + 2 + 3 + 4 + ... + n

              0      1      2      2              k+1
         = a·n + a ·n + a ·n + a ·n + ... + a   ·n        (k+2 Unbekannte)
            0     1      2      3            k+1
function hoch(x: real; n:integer): real; //n=0, 1, 2, ...
begin
  if n = 0 then result := 1 else
    result := x*hoch(x,n - 1)
end;


function s(n,k:integer): extended; //=1^k + 2^k + 3^k + ... + n^k
  var i:integer;
begin
  result := 0;
  for i := 1 to n do result := result + hoch(i,k);
end;

function mitBruchgerechnet(x: extended): extended;
begin
  result := TermToReal(reellZuBruch(x,g_eps));
end;

procedure probe(k: integer; a: array of extended);
  var n,j: integer;
      erg1,erg2,erg3: string;
      su: extended;
begin
  with form1.memo1.lines do Begin
    add('Probe');
    for n := 0 to k + 5 do BEgin
      erg1 := floatToStr(S(n,k)); //s := 1^k + 2^k + ... + n^k
      su := 0;
      for j := 0 to k + 1 do
        su := su + a[j]*hoch(n,j); //s := a0 + a1*n + ... + a(k+1)*n^(k+1)
      erg2 := floatToStr(su);
      su := 0;
      for j := 0 to k + 1 do
        su := su + mitBruchgerechnet(a[j])*hoch(n,j); //s := a0 + a1*n + ... + a(k+1)*n^(k+1)
        erg3 := floatToStr(su);
      add(intToStr(n) + ' ' + erg1 + ' ?=? ' + erg2 + ' ?=? ' + erg3);
    ENd;
  End;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var k, i, j: integer;
      koeff: TarrayOfArrayOfExtended;
      a: array of extended;
      erg, ai, nhochi :string;
begin
  k := StrToInt(edit1.text);//gesucht Formel für S(n,k)
  setlength(a, k+2); //s(n,k) = a0 + a1*n  ... a(k+1)*n^(k+1) (a0=0)
  setlength(koeff, length(a) + 1,length(a) + 2);
  for i := 0 to length(a) do Begin
    for j := 0 to length(a) - 1 do koeff[i,j] := hoch(i,j);
    koeff[i,length(a)] := s(i,length(a)-2)//rechte Seite
  End;
  ArrayInMemo(length(a),Koeff,memo1);
  LSG(length(a),koeff,a);
  erg := '';
  for i := k+1 downto 0 do Begin
    if i=1 then nhochi := 'n' else nhochi := 'n^' + intToStr(i);
    if a[i] = 1 then ai := ' ' else if a[i] = -1 then ai := '- '
      else BEgin
         if k > 15 then
         ai := ' ' + FloatToStr(a[i]) else
         ai := ' ' + ReellZuBruch(a[i],g_eps);
      ENd;
    if abs(a[i]) > 1E-8 then BEgin
      if (a[i] < 0) or (i = k+1) then erg := erg + ' ' + ai + nhochi else
      erg := erg + '+' + ai + nhochi;
    ENd;
  End;
  memo1.Lines.Add(erg);
  probe(k,a);
end;
Hinweis: Downloadseite "Summenf". Mit diesem Programm lassen sich alle Formeln berechnen, z.B.
S(n,k)=1k + 2k + ... nk mit den Lösungen:

Summenformeln für Potenzsummen

Siehe dazu auch: Vollständige Induktion und Errechnung der Summenformel mit Hilfe eines LGS sowie nach der Faulhaberformel.
                             1
1 + 2 + 3 + 4 + 5 + ... n  = -n·(n+1)
                             2

 2   2   2   2   2       2   1       1
1 + 2 + 3 + 4 + 5 + ... n  = -n·(n + -)·(n + 1)
                             3       2

 3   3   3   3   3       3   1
1 + 2 + 3 + 4 + 5 + ... n  = -n·n·(n+1)·(n+1)
                             4
Diese ersten drei Summen kann man sich in dieser Form leicht merken.
Die weiteren werden so wiedergegeben, wie sie das Programm liefert :
1^1 + 2^1 + 3^1 ...  + n^1 = 1/2*(n+1)*n
1^2 + 2^2 + 3^2 ...  + n^2 = 1/3*(n+1)*(n+1/2)*n
1^3 + 2^3 + 3^3 ...  + n^3 = 1/4*(n+1)*(n+1)*n*n
1^4 + 2^4 + 3^4 ...  + n^4 = (1/5*n^2 + 1/5*n - 1/15)*(n+1)*(n+1/2)*n
1^5 + 2^5 + 3^5 ...  + n^5 = (1/6*n^2 + 1/6*n - 1/12)*(n+1)*(n+1)*n*n
1^6 + 2^6 + 3^6 ...  + n^6 = (1/7*n^4 + 2/7*n^3 - 1/7*n + 1/21)*(n+1)*(n+1/2)*n
1^7 + 2^7 + 3^7 ...  + n^7
   = (1/8*n^4 + 1/4*n^3 - 1/24*n^2 - 1/6*n + 1/12)*(n+1)*(n+1)*n*n
1^8 + 2^8 + 3^8 ...  + n^8
   = (1/9*n^6 + 1/3*n^5 + 1/9*n^4 - 1/3*n^3 - 1/45*n^2 + 1/5*n - 1/15)*(n+1)*(n+1/2)*n
1^9 + 2^9 + 3^9 ...  + n^9
   = (1/10*n^7 + 2/5*n^6 + 7/20*n^5 - 7/20*n^4 - 7/20*n^3 + 7/20*n^2 + 3/20*n - 3/20)
     *(n+1)*n*n
1^10 + 2^10 + 3^10 ...  + n^10
   = (1/11*n^10 + 1/2*n^9 + 5/6*n^8 - n^6 + n^4 - 1/2*n^2 + 5/66)*n
1^11 + 2^11 + 3^11 ...  + n^11
   = (1/12*n^11 + 1/2*n^10 + 11/12*n^9 - 11/8*n^7 + 11/6*n^5 - 11/8*n^3 + 5/12*n)*n

Lösung zu Aufgabe 17.1:

a) 206(10) = 128 + 64 + 8 + 2 (10) = 11001110(2)

b) Verlaufsprotokoll:

i   1 2 3 4 5 6 7 8
n 128 78 14 14 14 6 2 0 0
s '' '1' '11' '011' '0011' '00111' '001111' '0011111' '00011111'
p 128 64 32 16 8 4 2 1 0

Das Programm gibt "00011111" aus. Es müßte aber 11001110 ausgeben! Die "0" wird jeweils falsch angehängt.

c) Die viertletzte Zeile muss statt
    "ENd else s := '0' + s;"
          lauten:
    "ENd else s := s + '0';"
Dann werden alle Dezimalzahlen kleiner als 256 richtig umgerechnet.

d) Die Umwandlung ist nicht allgemein genug, sondern nur für "kleine" Zahlen geeignet.

1. Verbesserungsvorschlag:
Wähle für p die für Integerzahlen maximale Zahl und ändere das Schleifenende der for-Schleife entsprechend.
Kritik am Verbesserungsvorschlag:
Maschinenabhängig.
2.Verbesserungsvorschlag:
Prüfe zuerst mit welcher Zweierpotenz man anfangen soll. Zum Beispiel:
   p := 2;
   while p < n do p := p*2;
Dritter Verbesserungsvorschlag:
Programmiere eine bewährte Methode: siehe Beispiel am Kopf des Abschnitts

Lösung zu Aufgabe 20.1 Rechnen mit 3-dim. Vektoren als Record.
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;
type Tvektor = record
              x1: real;
              x2: real;
              x3: real;
     End;
var
  Form1: TForm1;
implementation
{$R *.DFM}

function vektoraddition(a, b: Tvektor):Tvektor;
begin
  with result do Begin
    x1 := a.x1 + b.x1;
    x2 := a.x2 + b.x2;
    x3 := a.x3 + b.x3;
  End;
end;

function SMultiplikation(t: real; a: Tvektor):Tvektor;
begin
  with result do Begin
    x1 :=t*a.x1;
    x2 :=t*a.x2;
    x3 :=t*a.x3;
  End;
end;

function vektor(x1, x2, x3: real): Tvektor;
begin
  result.x1 := x1;
  result.x2 := x2;
  result.x3 := x3;
end;

{oder aber jetzt mit gutem Grund Parameter a, b und c
function vektor(a, b, c: real): Tvektor;
begin
  with result do Begin
    x1 := a;
    x2 := b;
    x3 := c;
  End;
end;}


procedure zeige(a: Tvektor);
begin
   Showmessage('Der Vektor hat die Koordinaten x1= '
     + FloatToStr(a.x1)
            + ' x2= ' + FloatToStr(a.x2)
            + ' x3= ' + FloatToStr(a.x3));
end;

function BerechnePunkt(stuetzvektor, Richtungsvektor: Tvektor; t:real):TVektor;
begin
 result := vektoraddition(stuetzvektor,SMultiplikation(t,Richtungsvektor));
end;


procedure TForm1.Button1Click(Sender: TObject);
  var stuetzvektor,Richtungsvektor,Ortsvektor:Tvektor;
      t: real;
begin
  stuetzvektor := vektor(2, -1, 5);
  Richtungsvektor := vektor(0, 1, 4);
  t := 4;
  Ortsvektor := BerechnePunkt(stuetzvektor,Richtungsvektor,t);
  Zeige(Ortsvektor);
end;

end.
Lösung zu Aufgabe aus Beispiel 22.5: Halte dich an Beispiel 22.5 Lokal wurden die Variablen x0,x0 eingeführt und folgende Prozeuren verändert.
  ...
  private
    zeichne: boolean;
    x0, y0: integer;                       <= Neu!
    myimageArchiv:array of TImage;


procedure TForm1.ImageonMousedown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with (sender as Timage).canvas do moveto(x,y);
  Zeichne := True;
  x0 := x;
  y0 := y;
end;

procedure TForm1.ImageOnMousemove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  //entfällt;
end;

procedure TForm1.ImageOnMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Zeichne := false;
  if abs(y - y0) < 20 then y := y0;
  if abs(x - x0) < 20 then x := x0;
  with (sender as Timage).canvas do lineto(x,y);
end;
Lösung zu Aufgabe 21.1 Vergleich zweier Dateien
procedure TForm1.Button1Click(Sender: TObject);
  var k,z: integer;
begin
  memo1.Lines.LoadFromFile('c:\test1.txt');
  memo2.Lines.LoadFromFile('c:\test2.txt');
  if memo1.Lines.Count <> memo2.Lines.Count then Begin
    showmessage('Die Dateien sind verschieden lang.');
  End else Begin
    z := 0;
    for k := 0 to memo1.lines.count - 1 do
      if memo1.lines[k] <> memo2.lines[k] then z := z + 1;
    if z > 0 then showmessage(IntToStr(z)+' Zeilen sind verschieden')
    else showmessage('Die Dateien sind identsch');
  End;
end;
Lösung zu Aufgabe 21.2 Dateinamen in Datei ausgeben und bestimmen, wie viel Platz sie beanspruchen.
procedure TForm1.Button1Click(Sender: TObject);
  var SR: TSearchRec;
      s : integer; //Summe der Dateigrößen
begin
    s := 0; //Anfangswert bei Summen
    if FindFirst('c:\*.*',faAnyFile,SR)=0 then Begin
      repeat
        memo1.lines.add(sr.name);
        s := s + sr.size;
      until FindNext(SR)<>0;
      FindClose(SR);
      memo1.Lines.Add('Belegt '+IntToStr(s)+' Bytes');
    End;
end;

Lösung zu Aufgabe 24.1: Einen "Abbrechenknopf" einblenden.

Füge folgende unit2 zu (Menü: Datei|Neu|unit. Lösche die Vorgabe und überschreibe mit folgendem):
unit unit2;

interface

uses
  Classes,  //Für TComponent
  Forms,    // Für TForm
  Dialogs,  //für showmessage
  StdCtrls; //Für TButton

type
  TFormabbrechen = class(TForm)
    babbrechen: TButton;
    labbrechen: Tlabel;
    procedure BabbrechenClick(Sender: TObject);
  public
    stop: boolean;
    Constructor Create(aOwner: TComponent); override;
    Destructor Destroy; override;
  end;

implementation

Constructor TFormabbrechen.Create(aOwner: TComponent);
begin
    inherited CreateNew(aOwner);
    //Aufbau der Form: Einen Button mit Onclick-Ereignisroutine und ein Label
    self.stop := false; //Anfangswert
    babbrechen := TButton.Create(self);
    babbrechen.Parent := self;
    babbrechen.Caption := 'Abbrechen';
    babbrechen.OnClick := self.BabbrechenClick;
    labbrechen := Tlabel.Create(Self);
    labbrechen.parent := self;
    labbrechen.caption := 'Bitte etwas Gelduld!';
    labbrechen.left := 10;
    self.BorderStyle := bssizeable;
    self.BorderIcons := [];
    self.width := 250;
    babbrechen.Top := labbrechen.Height + 5;
    babbrechen.left := (self.width - babbrechen.width) div 2;
    self.Top := (screen.height - self.Height) div 2;
    self.left := (screen.width - self.width) div 2;
    self.Height := 100;
    self.Show;
end;

Destructor TFormabbrechen.Destroy;
begin
  inherited Destroy;
end;

procedure TFormabbrechen.BabbrechenClick(Sender: TObject);
begin
  if MessageDlg('Wollen Sie wirklich abbrechen?',mtConfirmation,
     [mbYes, mbNo], 0) = 6 then Begin
        self.stop := true;
  End;
end;

end.
Ergänze Dein Programm so, dass die neue Form eingeblendet und auf Knopfdruck reagiert wird.

Zum Beispiel folgendermaßen:
uses unit2;

procedure TForm1.Button1Click(Sender: TObject);
  var i: integer;
      n: int64;
      Abbrechen: TFormabbrechen;
begin
  n := 18115587450017; //Besser aus Editfeld auslesen.
  Abbrechen:= TFormabbrechen.Create(self); //Abbrechen-Fenster wird eingeblendet
  Abbrechen.Caption := ' Test auf Primzahl';
  form1.enabled := false; //Dann kann der Button nicht nochmals
                          //gedrückt werden
  try
    for i := 2 to round(sqrt(1.0*n)) do Begin
      if i mod 10000 = 0 then BEgin  //genügt, sonst langsamer
        application.ProcessMessages; //Ein Klick wird registriert.
        Abbrechen.labbrechen.caption := 'Fertig, wenn ' +
          floatToStr(1.0*i*i) + ' > ' + inttostr(n);
        if abbrechen.stop then exit; //Falls Klick: Abbruch
      ENd;
      if n mod i = 0 then BEgin
        showmessage(intToStr(i) + ' ist Teiler');
        exit;
      ENd;
    End;
    showmessage('Primzahl');
  finally
    form1.enabled := true;
    form1.show;
    abbrechen.Free
  End;
end;

Hinweis:

Du kannst den Quelltext hier (Beispiele aus den Lektionen oder Lösungen) ohne weiteres in dein Delphi-Programm kopieren. Zum Beispiel:
function fakultaet(n:integer):real;
  var k: integer; //k: lokale Variable
begin
  result := 1;
  for k := 1 to n do result :=result*k;
end;

procedure TForm1.Button1Click(Sender: TObject);
 var i:integer;
begin
  memo1.text := 'n   fakultaet(n)';
  for i := 1 to 100 do
    memo1.lines.add(IntToStr(i)+'  '+floatToStr(fakultaet(i)));
end;

Dazu mußt Du folgendes beachten: Eine komplette Unit kannst Du nach dem Platzieren der entsprechenden Komponenten wie button1, memo1 u.s.w. direkt nach Löschen aller Zeichen komplett hineinkopieren. Ab Unit1 bis end. (mit Punkt!)
unit1
//komplette Unit1 ersetzten
end.
Aus diesem Grunde sind in allen Beispielen hier die Namen der Instanzen, so wie sie Delphi vorgibt, belassen.
Zum Beispiel:

     Button1(Caption von Button1)   Button2(Caption von Button2)
Dir bleibt die Beschriftung überlassen. Der Name sollte dann auch entsprechend geändert werden.
Zum Beispiel:

      Öffnen(Caption von Boeffnen)  Schliessen(Caption von Bschliessen)
zurück   Hinweis