Joachim Mohr   Mathematik Musik Delphi
Suche

Anhang 1 hoch(x,n) = xn für reelle Zahlen x, n definiert

Die folgenden Funktion berechnet xn möglichst allgemein.
Wenn n ganze Zahl, dann rekursiv, sonst nach der Formel xn = e(n·lnx).
function hoch_nat(x: real; n:integer): real; //n kein Bruch!
begin
  if n < 0 then
    result := 1/hoch_nat(x,-n)
  else
    if n = 0 then result := 1
  else
    result := x*hoch_nat(x,n - 1)
end;

function hoch(x,n: real): real;
begin
  if n = 0 then
    result := 1 //hier also 0^0 = 1 siehe Bemerkung
  else
    if x = 0 then result := 0
  else
    if frac(n) = 0 then result := hoch_nat(x,round(n)) // x < 0
  else
    result :=  Exp(n*Ln(x)) //n Bruch oder irrational  //nur für x > 0
end;
Achtung: Zum Beispiel hoch(-2,0.5) ist nicht erlaubt.

0 0 0 Bemerkung: 0 kann definiert werden als 0  = 1 und 0  = 0 ohne den algebraischen Potenzgesetzten zu widersprechen: x x x x x+y x y x y x*y (a ·b )  =  a * b a  = a *a (a )  = a 0 Als Grenzwert kann man 0 auf zwei Arten gewinnen. 0 0 0 0 0 0 0 =  lim x = 1 Zum Beispiel: 2 = 1  = (1/2)  = (1/100)  = ... = 1 x->0 0 x 2 1 (1/2) (1/100) 0 =  lim 0 = 0 Zum Beispiel: 0 = 0  = 0  = 0  = ... = 0 x->0+ 0 In der Kombinatorik ist 0 = Anzahl der Abbildungen von {} auf {} = 1.

In Pascal ist die Funktion xn nicht als Standardfunktion implementiert. Der Programmierer muss sich selbst klar werden, wie er diese Funktion verwendet (Zum Beispiel für neagatives x, dann aber n nur ganzzahlig).

Ein effiziente programmiertes Verfahren findet man auch beim Thema Verschlüsselung.

Anhang 2 Genauigkeit bei der Gleitkommarechnung

Der Typ real wird als Gleitkommazahl im Dualsystem gespeichert.

Man hat dabei eine Mantisse mit einer gewissen Stellenzahl und einen Exponenten.


Zum besseren Verständnis erläutere ich es nicht im Dualsystem (Basis = 2)
mit der Mantissenlänge 32 sondern im Zehnersystem (Basis=10) mit der
Mantissenlänge 5.

Mit der Mantisse 54321 und dem Exponenten 3 wird die Zahl
                 5,4321·103 dargestellt.

Der besseren Lesbarkeit schreibe ich dafür
                 5,4321·1000

Es wird also gerundet gerechnet. Beispielsweise werden
die Zahlen 5432,05 und 5432,149 auf 5432,1 gerundet.
(Nebenbei bemerkt: Die meisten Programmiersprachen speichern ihre
Zahlen im Dualsystem und runden daher nicht immer kaufmännisch!)

Bei Mantissenlänge 5 beträgt der Fehler zum exakten Wert maximal 0,005%

Je nach Rechnung kann der Fehler unerwartet schnell anwachsen.

Beispiel:

  Wir vergleichen a·a - b·b und (a+b)·(a-b)
  für a = 45,431 und b= 45,421

a·a - b·b in Gleitkommaarithmetik ergibt
a·a = 4,5431·10 · 4,5431·10   = 2,0640·1000
b·b = 4,5421+10 · 4,5421·10   = 2,0631·1000
—————————————————————————————————————————
I  a·a - b·b                  = 9,0000·1/10

a + b = 4,5431·10 + 4,5421·10 = 9,0852·10
a - b = 4,5431·10 - 4,5421·10 = 1,0000·1/100
————————————————————————————————————————————
II (a+b)·(a-b)                = 9,0852·1/10

Exakt a·a - b·b = (a+b)·(a-b) = 0,90852

Fehler bei Rechnung I fast 1%,  bei Rechnung II 0%
Eine gute Erkenntnis dazu kann auch jeder mit dem Taschenrechner, der auch mit der Gleitkommaarithmetik rechnet, nachvollziehen:

Rechne mit Deinem Taschenrechner in einem Zug: 1012 + 100 - 1012

Dein Taschenrechner liefert als Ergebnis nicht 100 sondern 0.
Frage: Wieviel % ist 100 bezüglich 1012?
(Sollte Dein Tschenrechner schon genauer als die übrigen rechnen, dann rechne mit 10100 statt 1012

Noch komplizierter wird die Sache bei lg(1 000 000 000 100) - lg(1 000 000 000 000) = 0,000 000 000 043 429...
Dein Taschenrechner liefert wieder Null. (Wie man das genaue Ergebnis bekommt, lernt ein Ingenieur im 1. Semester. Stichwort: Taylorreihe.)

Für den Theoretiker und Parktiker interessant ist:
Das Assoziativgesetz (a + b) + c = a + (b + c) gilt nicht für Gleitkommazahlen:
Beispiel mit Mantisselänge 3 (wie oben dargestellt):
   (1.00 + 0.004) + 0.004)  = 1.00

    1.00 + (0.004 + 0.004)  = 1.01

                        -3
   Beachte: 0.004 = 4·10   hat die Mantisse 4 und als Exponent -3!
Ein drastisches Beipiel liefert die Addition 1.00 + 0.001 + 0.001 + .... + 0.001 (1000 mal)
Von vorne addiert ist das Ergebnis 1.00 und von hinten 2.00 Daraus ergibt sich die Regel, dass bei einer Reihenaddition positive Summanden wenn möglich in aufsteigender Reihenfolge addiert werden sollen.

Weitere Tücken bei der Gleikommarechnung sind in Umwandlung einer Dezimalzahl in eine Binärzahl beschrieben.

Anhang 3: Ein Programmmanager

Im Memo1 werden alle Programme gesammelt, die du mit Button2 ("Neu") auswählst und mit button1 ("OK") startest. Mit Klick auf ein Programm in Memo1 wird dieses dann gestartet.
uses shellapi;

function IniPfad:string;
  var exepfad, exefile: string;
begin
  exepfad := extractFilepath(paramstr(0));
  exefile := extractFilename(paramstr(0));
  result:=exepfad //der exe-pfad des Programms
          + copy(exefile,1,length(exefile) - 3) //der Name ohne "exe"
          + 'ini'; //die Ini-Datei
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 with Form1 do Begin
    caption:='Programm Starten';
    label1.Caption:='Klicke "Neu" oder das Programm an. Dann "OK"!';
    label2.Caption:= 'evtl. Parameter';
    try
      memo1.Lines.LoadFromFile(Inipfad);
    except {bis aufs erste Mal} End;
  End;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   try
      memo1.Lines.SaveToFile(Inipfad);
   except {keine Schreibrechte} End;
end;

procedure TForm1.Schlieen1Click(Sender: TObject);
begin
  close;
end;


function spacesf(n:integer):string; //n beliebig !
  const s='                                                              ';
          //Achtung spacec ————————————————————————————————————————————>
begin
  result:=copy(s,1,n);
  while length(result) < n do result:=result+copy(s,1,n-length(result));
end;

//Bemerkung: In Delphi kann man StringOfChar(' ',n) verwenden.

function glSpf(s:string):boolean;
begin
  result:=(s=spacesf(length(s)));
end;

procedure loescheleerezeilen(m:TMemo);
  var k:integer;
begin
  k := 0;
  while k < m.Lines.Count do
    if glspf(m.lines[k]) then m.Lines.Delete(k) else inc(k)
end;


procedure TForm1.Neu1Click(Sender: TObject);
begin
  with opendialog1 do Begin
     options:=[ofFileMustExist,ofAllowMultiselect,ofHideReadOnly,ofShareAware,
                ofEnableSizing, ofNoTestFileCreate,ofNoValidate];
     Filter :='EXE-Dateien (*.exe)|*.exe|Batchdateien (*.bat)|*.bat|'
              +'Alle Dateien (*.*)|*.*';
     DefaultExt:='exe';
  End;
  if opendialog1.Execute then Begin
    edit1.text := opendialog1.filename;
    if pos(edit1.text,Memo1.Text) = 0
     then Memo1.lines.add(edit1.text);
  loescheleerezeilen(memo1);
  End;
end;

function ShellexecuteFehler(i: integer): string;
begin
  Case i of 0: result := 'The operating system is out of memory or resources.';
    ERROR_FILE_NOT_FOUND: result := 'The specified file was not found.';
    ERROR_PATH_NOT_FOUND: result := 'The specified path was not found.';
    ERROR_BAD_FORMAT: result := 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).';
    SE_ERR_ACCESSDENIED: result := 'The operating system denied access to the specified file.';
    SE_ERR_ASSOCINCOMPLETE: result := 'The filename association is incomplete or invalid.';
    SE_ERR_DDEBUSY: result := 'The DDE transaction could not be completed because other DDE transactions were being processed.';
    SE_ERR_DDEFAIL: result := 'The DDE transaction failed.';
    SE_ERR_DDETIMEOUT: result := 'The DDE transaction could not be completed because the request timed out.';
    SE_ERR_DLLNOTFOUND: result := 'The specified dynamic-link library was not found.';
       //SE_ERR_FNF          : result:='The specified file was not found.';
    SE_ERR_NOASSOC: Begin
         //result:='Unbekannter Extender. TTW versucht einzulesen.';
         //if gg then exit;
         //Dateidazu(pfadplusname)
      End;
    SE_ERR_OOM: result := 'There was not enough memory to complete the operation.';
       //SE_ERR_PNF          : result:='The specified path was not found.';
    SE_ERR_SHARE: result := 'A sharing violation occurred.';
  End;
end;

procedure programmstarten(pfad, parameter: string);
  var name: String;
      code: integer;
begin
  name := extractFilename(Pfad);
  pfad := extractFilepath(pfad); //Jetzt nur Pfad
  code := ShellExecute(application.handle,
          Pchar('open'),
          Pchar(name),
          Pchar(Parameter),
          Pchar(Pfad),
          sw_ShowNormal);
  if code < 32 then showmessage(ShellexecuteFehler(code));
end;

procedure TForm1.Ok1Click(Sender: TObject);
  var n:integer;
begin
  programmstarten(edit1.text, edit2.text);
end;

function ZeileDesCursorsI(ed: TCustomEdit): integer;
var k: integer;
  s: string;
begin
  s := ed.Text; //ohne schafft es der Comp. nicht
  result := 1;
  for k := 1 to ed.Selstart do
    if s[k] = #13 then inc(result);
end;

function ZeileDesCursorsS(ed: TCustomMemo): string;
var i: integer;
begin i := ZeileDesCursorsI(ed) - 1;
  if ed.Lines.count > i then result := ed.lines[i] else result := '';
end;



procedure TForm1.Memo1Click(Sender: TObject);
begin
   edit1.text := ZeileDesCursorsS(Memo1)
end;

Anhang 4 Lektion in Graphik

Siehe auch Programm Parabel zeichnen und Einführung.

Beispiel Graphik1 Ein Kreis wird gezeichnet und verschwindet nach einer Sekunde wieder.

Dies erreichen wir dadurch, dass wir auf eine Leinwand (engl: canvas) malen. Mit der Methode canvas.ellipse(x1,y1,x2,y2) können wir in ein Rechteck, das von den Punkten P(x1|y1) (links oben) und Q(x2|y2) (rechts unten) begrenzt wird, eine Ellipse zeichnen. Mit den Eigenschaften canvas.pen ("stift") können wir die Farbe und die Dicke des Randes und mit canvas.brush ("Pinsel") die Farbe des Inneren bestimmen.

Die x- und y-Koordinaten werden in Pixel nach rechts und nach unten gerechnet (Ein Bildschirm hat zum Beispiel 800 Pixel nach rechts und 600 nach unten).

sleep(x) bedeutet: Warte bis zum nächsten Befehl x Millisekunden.

Wenn wir nach einer Sekunde die Ellipse in der Farbe Form1.canvas.color ("die Farbe der Zeichenfläche unseres Formulars") zeichen, verschwindest sie wieder. die Ellipse in der Farbe unseres Formulars wieder zeichnen, verschwindet sie Canvas hat die Eigenschaften pen (Zeichenstift), der wir eine Farbe und Dicke geben können
procedure zeichneKreis(canv: Tcanvas; x, y, r: integer; farbeRand, farbeInnen:Tcolor);
begin
  with canv do Begin
    Pen.Color := farbeRand;
    Pen.Width := 5;
    Brush.Style := bssolid;
    Brush.Color := farbeInnen;
    Ellipse(x-r,y-r,x+r,y+r)
   End
end;

procedure TForm1.Button1Click(Sender: TObject);
  var w, h:integer;
begin
  w := form1.Width;
  h := form1.Height;
  zeichneKreis(canvas, w div 2, h div 2, h div 4, clblack, clred);
  sleep(1000);
  zeichneKreis(canvas, w div 2, h div 2, h div 4, color, color);
  //hier canvas = Form1.canvas und color = Form1.color
end;
Erläuterungen: Canvas ist die "Zeichne-Eigenschaft" von Form1 oder image1 u.s.w.
Einige Eigenschaften und Methoden von canvas sind: Sein "Zeichenstift" (Canvas.Pen) legt das Aussehen der Linien und Umrandungen fest. Ihr "Pinsel" (Canvas.Brush legt das Füllmuster und die Füllfarbe z. B. für Rectangel fest. Aufgabe Graphik1 Schreibe ein Programm "procedure TForm1.Button1Click...", bei dem auf Form1 ein grünes Rechteck gezeichnet wird. In das grüne Rechteck soll eine Raute gezeichnet werden (mit "lineto" gelbe 5 Pixel breite Striche) und in die Raute ein blauer Kreis mit gelben Rand.
Lösung

Beispiel Graphik2 Zusätzlich: Ein Instanz von TImage wird verwendet. Die Komponente Timage findest du auf der Komponentenpalette "Zusätzlich".
procedure zeichneKreis(canv: Tcanvas; x, y, r: integer; farbeRand, farbeInnen:Tcolor);
begin
  with canv do Begin
    Pen.Color := farbeRand;
    Pen.Width := 5;
    Brush.Style := bssolid;
    Brush.Color := farbeInnen;
    Ellipse(x-r,y-r,x+r,y+r)
   End
end;

procedure TForm1.Button1Click(Sender: TObject);
  var w, h:integer;
begin
  w := image1.Width;
  h := image1.Height;
  zeichneKreis(image1.canvas, w div 2, h div 2, h div 4, clblack, clred);
  application.ProcessMessages; //Wichtig: Es soll gleich gezeichnet werden!
  sleep(1000);
  zeichneKreis(image1.canvas, w div 2, h div 2, h div 4, clwhite, clwhite);
end;
Beispiel Graphik3 Statt Buttons empfiehlt es sich eine Menüleiste zu verwenden. Du findest sie als Komponente TMainMenu.

Wichtig:
   Clipbrd und jpeg in die Uses-Klausel aufnehmen.
   Deklariere EsWirdGezeichnet als globale Variable.

  uses //Schrieb Delphi
  Clipbrd, jpeg, //Musst Du einfügen
  Windows, Messages, ...//schrieb Delphi


  var  Form1:             TForm1; //Schrieb Delphi
       EsWirdGezeichnet : Boolean = false; //Deine globale Variable
  //...

procedure TForm1.ZeichneClick(Sender: TObject); //Menü

begin
  showmessage('Mausklick und ziehen!');
end;

procedure TForm1.BildindieZwischenablage1Click(Sender: TObject);//Menü
begin
  Clipboard.Assign(image1.Picture.Bitmap); //"uses Clipbrd"
end;

procedure TForm1.BildausderZwischenablageholen1Click(Sender: TObject);
begin
  image1.Picture.Assign(Clipboard);  //"uses Clipbrd"
  //Größe des Bildes noch anpassen
  image1.Height := image1.Picture.Bitmap.Height;
  image1.Width := image1.Picture.Bitmap.Width;
end;

procedure TForm1.BMPspeichern1Click(Sender: TObject);//Menü
begin
  with SaveDialog1 do Begin
     Options:=[ofCreatePrompt,ofEnableSizing,ofHideReadOnly,ofShareAware,ofEnableSizing]; //Ohne Kästchen
     Filter :='Bitmap-Dateien (*.bmp)';
     filename := ChangeFileExt(filename, '.bmp');
     DefaultExt:='bmp';
     if execute then Begin
       image1.Picture.SaveToFile(Filename);
     End else showmessage('Nicht gespeichert');
   End;
end;

procedure TForm1.JPEGspeichern1Click(Sender: TObject);//Menü

 var jpg :TJPEGImage; //benötigt "uses jpeg"
begin
  jpg:=TJPEGImage.Create;
  try
    jpg.Assign(image1.Picture.Bitmap);
    jpg.CompressionQuality := 90; //Qualität 90%
    jpg.Compress;
  with SaveDialog1 do Begin
     Options:=[ofCreatePrompt,ofEnableSizing,ofHideReadOnly,ofShareAware,ofEnableSizing]; //Ohne Kästchen
     Filter :='JPG-Dateien (*.jpg)';
     filename := ChangeFileExt(filename, '.jpg');
     DefaultExt:='jpg';
     if execute then Begin
       jpg.SaveToFile(Filename);
     End else showmessage('Nicht gespeichert');
   End;
  finally jpg.Free end;
end;

procedure TForm1.BMPLaden1Click(Sender: TObject);//Menü
Begin
  with openDialog1 do Begin
     Options:=[ofCreatePrompt,ofEnableSizing,ofHideReadOnly,ofShareAware,ofEnableSizing]; //Ohne Kästchen
     Filter :='Bitmap-Dateien (*.bmp)';
     filename := ChangeFileExt(filename, '.bmp');
     DefaultExt:='bmp';
     if execute then Begin
       image1.Picture.LoadfromFile(Filename);
     End else showmessage('Nicht geladen');
   End;
end;

procedure TForm1.JPEGladen1Click(Sender: TObject);
 var jpg :TJPEGImage; //benötigt "uses jpeg"
begin
  jpg:=TJPEGImage.Create;
  try
  with openDialog1 do Begin
     Options:=[ofCreatePrompt,ofEnableSizing,ofHideReadOnly,ofShareAware,ofEnableSizing]; //Ohne Kästchen
     Filter :='JPG-Dateien (*.jpg)';
     filename := ChangeFileExt(filename, '.jpg');
     DefaultExt:='jpg';
     if execute then Begin
       jpg.loadfromFile(Filename);
       image1.Picture.Bitmap.assign(jpg);
     End else showmessage('Nicht gespeichert');
   End;
  finally jpg.Free end;
end;

procedure TForm1.Beenden1Click(Sender: TObject);//Menü
begin
  close;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);//Ereignis
begin
  EsWirdGezeichnet := true;
  image1.Canvas.MoveTo(x,y);
end;


procedure TForm1.Image1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer); //Ereignis
begin
    if EsWirdGezeichnet then image1.canvas.lineto(x,y);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer); //Ereignis
begin
  EsWirdGezeichnet := false;
end;
Beispiel Graphik4 Bei bewegten Figuren ist es wichtig die Zeichnung wieder zu löschen. Da geht mit der Canvas-Eigenschaft Pen.Mode = pmNotXor und CopyMode := cmSrcInvert.

Beim folgenden Beispiel werden mit button1 zwei Rechtecke mit der angegeben Farbe gezeichnet, mit button2 ein Kreis, dessen Farbe vom Hintergrund abhängig ist und der sich deshalb beim zweiten Aufruf wieder löscht.

Tipp: Ziehe zuerst Panel1 auf Form1 und setzte beim Panel1 die Eigenschaft align auf altop, ziehe dann image1 auf Form1 und mache es möglichst groß.
procedure zeichneKreis(canv: Tcanvas; x, y, r: integer; farbeRand, farbeInnen:Tcolor);
begin
  with canv do Begin
    Pen.Style := psSolid;
    Pen.Mode := pmNotXor;   //  zweifach zeichnen löscht !!!
    CopyMode := cmSrcInvert;//  zweifach kopieren löscht !!!
    Pen.Color := farbeRand;
    Pen.Width := 5;
    Brush.Style := bssolid;
    Brush.Color := farbeInnen;
    Ellipse(x-r,y-r,x+r,y+r)
   End
end;

procedure zeichneRechteck(canv: Tcanvas; x1, y1, x2, y2: integer; farbeRand, farbeInnen:Tcolor);
  const dicke = 50;
begin
  with canv do Begin
    Pen.Width := dicke;
    Pen.Color := farbeRand;
    Brush.Style := bssolid;
    Brush.Color := farbeInnen;
    Rectangle (x1 , y1, x2 - dicke, y2 - dicke);
   End
end;

procedure TForm1.Button1Click(Sender: TObject);
 var w, h:integer;
begin
    w := form1.Width;
    h := form1.Height;
    with image1 do Begin
      zeichneRechteck(image1.canvas,0, 0, w, h div 2,clyellow, clblue);
      zeichneRechteck(image1.canvas,0 , h div 2, w, h, clred, clgreen);
    End;
end;

procedure TForm1.Button2Click(Sender: TObject);
  var w, h:integer;
begin
  w := form1.Width;
  h := form1.Height;
  zeichneKreis(image1.canvas, w div 2, h div 2, h div 4, clblack, clred);
end;
Beispiel Graphik5 Jetzt wollen wir den Kreis noch in Bewegung setzten. Dafür ziehen wir noch den Taktgeber Timer1 von der Systemkomponententabelle auf das Formular. Wir können dann angeben, nach wieviel Millisekunden, der alte Kreis gelöscht und daneben ein neuer Kreis gezeichnet wird. Es sieht dann aus, als würde sich der Kreis bewegen. Die alte Position des Kreises und den Radius merken wir uns in den globen Variablen x0, y0 und r0. (Den Experten wird es grausen, aber es geht auch ohne objektorientierte Programmierung. Die kommt eine Klassenstufe später später.)
var
  Form1: TForm1;        //Schrieb Delphi
  x0, y0, r0: integer;  //Hier die "globen" Variablen!

implementation        //Schrieb Delphi
{$R *.DFM}            //Schrieb Delphi
procedure zeichneKreis(canv: Tcanvas; x, y, r: integer; farbeRand, farbeInnen:Tcolor);
begin
  with canv do Begin
    Pen.Style := psSolid;
    Pen.Mode := pmNotXor;   //  zweifach zeichnen löscht !!!
    Pen.Color := farbeRand;
    CopyMode := cmSrcInvert;//  zweifach kopieren löscht !!!
    Pen.Width := 5;
    Brush.Style := bssolid;
    Brush.Color := farbeInnen;
    Ellipse(x-r,y-r,x+r,y+r);
    x0 := x;
    y0 := y;
    r0 := r;
   End
end;

procedure TForm1.Button1Click(Sender: TObject);
 var w, h:integer;
begin
    w := form1.Width;
    h := form1.Height;
    with image1 do Begin //alles löschen
      Brush.Color := clwhite;
      canvas.Rectangle(0, 0, w,  h);
    End;
end;

procedure TForm1.Button2Click(Sender: TObject);
  var w, h:integer;
begin
  w := form1.Width;
  h := form1.Height;
  timer1.Interval := 10;
  zeichneKreis(image1.canvas, random(w), random(h), 10, clblack, clred); //Zum ersten Mal
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  zeichneKreis(image1.canvas, x0, y0, r0, clblack, clred); //lösche alten Kreis
  x0 := x0 + random(100);
  if x0 <= 0 then x0 := form1.Width;
  if x0 >= form1.Width then x0 := 0;
  y0 := y0 + random(10);
  if y0 <= 0 then y0 := form1.height;
  if y0 >= form1.height then y0 := 0;
  zeichneKreis(image1.canvas, x0, y0, r0, clblack, clred); //zeichne neuen Kreis
end;

Aufgabe Graphik2: Gib dem Kreis eine gewisse Geschwindigkeit. Falls er an den Rand stößt, soll er reflektiert werden. (Einfach die x- oder y-Komponente der Geschwindigkeit invertieren.).
Zusatz: Füge zwei Button "Schneller" und "Langsamer" hinzu und programmiere dieselben.
Lösung

Anhang 5 Lektion in Bildbearbeitung

Downloadseite "Bildpas.zip"

Beispiel Bild 1 Eine BMP-Datei einlesen, zeigen und abspeichern.
Dazu brauchst Du die Komponente Timage.
procedure TForm1.Openpicture1Click(Sender: TObject);
begin
    with openpicturedialog1 do Begin
      Filter := //GraphicFilter(TGraphic);
        'Bitmaps (*.bmp)|*.bmp|' +
        'Alle (*.*)|*.*';
      if execute then image1.Picture.Bitmap.LoadFromFile(filename);
      //Schon ist das Bild sichtbar
  end;
end;

procedure TForm1.BMPSpeichern1Click(Sender: TObject);
begin
  with SaveDialog1 do Begin
     Filter :='Bitmap-Dateien (*.bmp)';
     DefaultExt:='bmp';
     if execute then
       image1.Picture.SaveToFile(Savedialog1.Filename);
         else showmessage('Nicht gespeichert');
   End;
end;
Beispiel Bild 2 Eine eine JPEG-Grafikdatei laden
Das ist etwas komplizierter.
Du must dazu die Unit jpeg mit in die Uses-Klausel aufnehmen.

procedure Tform1.jpg_laden(datei:string);
var
  jpg :TJPEGImage; //uses jpeg;
begin
  jpg:=TJPEGImage.Create;
  try
    jpg.LoadFromFile(datei);
    image1.Picture.Bitmap.Assign(jpg);
   with form1 do caption := datei +
      '('+intToStr(jpg.width) + '*' + intToStr(jpg.height)+')';
   finally
    jpg.Free;
  end;
end;
Beim Abspeichern kann man auf Kosten der Schärfe die Komprimierung erhöhen. Im folgenden Beispiel werden mehreren Menüpunkten dasselbe OnClick-Ereignis zugewiesen. (Wenn Du im "Menüeditor" die Caption im Objektinspektor schreibst, dann allen gleichartigen Menüpunkten dieselbe Onclick-Prozedur unter "Ereignisse" zuweisen.)
procedure TForm1.s100Click(Sender: TObject);
var
  jpg :TJPEGImage;
begin
  jpg:=TJPEGImage.Create;
  try
    jpg.Assign(image1.Picture.Bitmap);
    with form1 do caption := intToStr(jpg.width) + '*' + intToStr(jpg.height);
    if sender = s100 then //das Menü hat den Namen "s100"
      jpg.CompressionQuality := 100 else
        if sender = s50 then
          jpg.CompressionQuality := 50 else
            if sender = s10 then
              jpg.CompressionQuality := 10 else
                if sender = s5 then
                  jpg.CompressionQuality := 5;
    jpg.Compress;
  with SaveDialog1 do Begin
     Filter :='JPG-Dateien (*.jpg)';
     DefaultExt:='jpg';
     if execute then Begin
       jpg.SaveToFile(Savedialog1.Filename);
     End else showmessage('Nicht gespeichert');
   End;
  finally
    jpg.Free;
  end;
end;
Damit ist es auch möglich, BMP-Bilder in JPEG-Graphiken zu komprimieren.

Beispiel Bild 3 Ein Bild beschriften.
Zuerst eine Schrift wählen (Plaziere einen TFont-Dialog auf Deinem Formular).
procedure TForm1.Schriftwaehlen1Click(Sender: TObject);
begin
  with fontdialog1 do
    if execute then  image1.Canvas.Font := font;
end;
Und am besten mit der Maus den Ort angeben, wo die Schrift erscheinen soll.
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
var s:string;
begin
   if shift = [ssright] then Begin
   if InputQuery('Beschriftung',
                 'Geben Sie den Text ein',s)
     then image1.Canvas.textout(x,y,s);
  End;
end;

Anhang 6 Die Timer-Komponente

Auf der Komponentenpalette "System" von Delphi findet sich die nützliche Timerkomponente. Ziehe sie aufs Formular (Im Objektinspekor siehst Du, dass das Timerintervall auf 10000 Millisekunden gesetzt ist. Setze es auf 0 ("inaktiv")

Beispiel timer.1 Ziehe zusätzlich noch ein Shape-Komponente von der Palette "Zusätzlich" und schreibe ...
       ... in das OnClick-Ereignis von Button1:
       (Auf button1 doppelklicken)

procedure TForm1.Button1Click(Sender: TObject);
begin
  panel1.DoubleBuffered := true; //Das muss man halt wissen: Verhindert flackern
  vx := 1; //Müssen als globale Integervariablen deklariert sein (unter var Form1)
  vy := 1;
  timer1.Interval := 10; //Millisekunden
end;

     ... in das timer-Ereignis von Timer1
     (Auf button1 doppelklicken)

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  shape1.top := shape1.top + vx;
  shpae1.left := shape1.left + 1;
end;
Ein Rechteck wandert nach rechts unten ... leider ohne Umkehrung.

Aufgabe timer1 Sorge dafür, dass das Shape rund ist, Farbe hat und und an den Rändern reflektiert wird. Der Rand wird erreicht, wenn zum Beispiel "shape1.left >= panel1.width-shape1.width".

Lösung

Wie Du 10 Bälle durcheinanderwirbelst, kannst Du im Programm Baelle studieren.

Beispiel timer.2 Eine schöne Anwendung sind Lissajoufiguren.
Dabei werden Kurven mit folgender Parameterdarstellung gezeichnet:

x(t) = A(sin(a*t + b)
y(t) = B(sin(c*t + d)
Das Frequenzverhältnis entspricht dabei c : a
die Phasenverschiebung den Parametern d-c



var
  Form1: TForm1;
  lissj_t, lissj_a, //Die Konstanten t,a,b,c,d als globale Variablen
  lissj_b, lissj_c,
  lissj_d: integer;

implementation

{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
  randomize;
  lissj_t := 0;
  lissj_a := StrToInt(edit1.text); //Frequenzverhältnis a:c
  lissj_c := StrToInt(edit2.text);
  lissj_b := StrToInt(edit3.text); //Phase d - b
  lissj_d := StrToInt(edit4.text);
  timer1.Enabled := true;
  timer1.Interval := 10;
end;


procedure zeichneKreisAufForm1(x,y:integer); //Kreis mit r = 4Pixel
  //Im Gegensatz zur Image-Komponente Zeichnung auf Form1 nicht dauerhaft
begin
  with form1.Canvas do Begin
    Pen.Color := clyellow;         //Außen gelb
    Pen.Width := 2;
    Brush.Style := bssolid;
    Brush.Color := clred;         //Innen rot
    Ellipse(x-4,y-4,x+4,y+4)
   End
end;

procedure TForm1.Timer1Timer(Sender: TObject); //Alle 10 ms
   var h,b,p: integer;
       teiler: real;
begin
  if  lissj_t < 900 then inc(lissj_t,3) //3 6 9 12 ... 300
    else inc(lissj_t);
  if lissj_t = 300 then  lissj_t := 301;   //304 307 ... 601
  if lissj_t = 601 then  lissj_t := 602;   //605 ... 902
  //Am Anfang wird mit Lücken gezeichnet. Diese werden dann aufgefüllt.
  h := form1.height div 4;  //Streckunsfaktoren
  b := form1.Width div 4;
  p := (lissj_a + lissj_c);
  teiler := 10/(180*p*sqrt(p)); //Sonst bei großem a+c Sprünge zu gross
  zeichneKreisaufForm1(2*b + round(b*sin(Pi*(lissj_a*lissj_t + lissj_b)*teiler)),
                       2*h + round(h*sin(Pi*(lissj_c*lissj_t + lissj_d)*teiler)));
end;

procedure TForm1.Button3Click(Sender: TObject); //Canvas löschen
begin
 lissj_t := 0;
 with form1.Canvas do Begin
    Brush.Color := claqua;
    Rectangle(0,0,form1.Width,form1.Height)
   End;
 Button1Click(nil);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  close
end;

Aufgabe timer2 Schreibe ein Programm, bei dem eine roter Kreis über einer Ebene (=Strich) schwebend hinabrollt.
Lösung

Wie sich selbst gezeichnete Objekte mit Hilfe der Timerkomponente bewegen, wird im Anhang 4 (Lektion in Graphik) ausgeführt.

Anhang 7 Wettrennen

Betrifft eine Frage aus der FAQ.

Nun ein Beispiel, wie ein Array als Rückgabewert einer Funktion verwendet werden kann.

Programm Wettrennen: Timage-Komponenten werden zur Laufzeit erzeugt, das zugehörige Bild wird geladen. Anschließend wird ein Wettrennen veranstaltet. Besonderheit: Die Hälfte startet später, dafür aber schneller.

Hier die ganze Unit:

unit Unit1;

interface

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

const Anzahl =10;
      Hoehe =35;

type Tmyarray= array of TImage;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    arraymitautos: Tmyarray;
    zweiterstart: boolean;
      {Private-Deklarationen }
  public
      {Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function gibmirarray: Tmyarray;
  var i:integer;
begin
  setlength(result,Anzahl);
  for i:= 0 to Anzahl-1 do Begin
     result[i]:= Timage.create(Form1); //Damit Freigabe bei Form1.destroy
     result[i].parent := form1;
     result[i].picture.loadfromfile('laeuffer.bmp');
     //Oder: Case i mod 3 = 0 of 0: result[i].picture.loadfromfile('Auto0.bmp');
     //        ...
     result[i].height:= hoehe;
     result[i].left:= 0;
     result[i].top := (hoehe+5)*(i+2);
       {Falls 'lauffer.bmp' nicht vorhanden
       result[i].Canvas.Brush.Color := RGB(255,random(256),255);
       result[i].width:= hoehe;
       result[i].height:= hoehe;
       result[i].left:= 0;
       result[i].top := (hoehe+5)*(i+2);
       result[i].Canvas.Ellipse(0,0,hoehe,hoehe);
       result[i].Canvas.TextOut(0,0,intToStr(i+1));
       Ende of "vereinfacht"}
   End;
End;

procedure zerstoereArray(x: Tmyarray);
  var i: integer;
begin
  for i := 0 to length(x) - 1 do x[i].free;
  setlength(x,0);
end;

procedure TForm1.Timer1Timer(Sender: TObject); //Vorwärts gehts!
  var i:integer;
begin
  for i := 0 to Anzahl-1 do Begin
    if i mod 2 = 0 then
      arraymitautos[i].Left := arraymitautos[i].Left + random(5)+1  else
      if zweiterStart then
        arraymitautos[i].Left := arraymitautos[i].Left + random(10)+1;
    if arraymitautos[i].Left > form1.Width - 3*Hoehe then Begin
      timer1.Interval := 0;
      label2.Caption := 'Gewonnen hat Nr.' + IntToStr(i+1);
    End;
  End;
  if arraymitautos[0].Left > form1.width div 2 - 5*Hoehe then zweiterstart := true;
end;

procedure TForm1.Button1Click(Sender: TObject);//Je nach Caption
begin
  if button1.Caption = 'Neu' then Begin
    zerstoereArray(arraymitautos);
    button1.Caption := 'Start';
    timer1.Enabled := false;
    exit;
  End;
  randomize;
  //Unwichtig!
    form1.top := 0;
    form1.left := 0;
    form1.Width := screen.Width;
    form1.Height := (Hoehe + 5)*(Anzahl + 4);
  //Ende "unwichtig"
  //timer1.enabled := false; Im Objektinspektor
  arraymitautos := gibmirarray;
  //Ein Wettrennen wird gestartet
    timer1.enabled := true;
    timer1.Interval := 100;
    zweiterStart := false;
  //Rest des Wettrennens siehe Procedure Timer1Timer
    button1.Caption := 'Neu'; //Zweiter Start erst nach free
    label2.Caption := '';
end;

end.
Downloadseite "Wettrennenpas.zip"



Anhang 8

Wie Delphi definieren wir selbst eine Form als Klasse.

Delphi macht es einem sehr bequem. Von der Objektorientierten Programmierung her gesehen wird die eigene Form Form1 als Instanz der Klasse Tform1, was wiederum ein Nachfolger der Klasse Tform ist, automatisch mit allen Buttons und was sonst noch gebraucht wird erzeugt. Es benötigt dabei mehrere Dateien

Im folgenden Programm schreiben (oder kopieren) wir alles selbst in eine Datei. Diese Datei genügt Delphi zum Compilieren und erzeugen der Exe-Datei.

Wenn wir dieses Projekt studieren, können wir einiges der projektorientirten Programmierung verstehen lernen.

Mit Menü "Neu|Konsolenanwendung" und entfernen von "{$APPTYPE CONSOLE}" (wir wollen ja tatsächlich eine Windowsanwendung schreiben) erhalten wir eine compilierbare Datei. Schreibe (oder kopiere) in diese Datei folgendes. (Die notwednigen weiteren Erklärungen findest Du als Kommentar).
program DPR_Datei_Genuegt; //Der Name soll sagen: Die Projektdatei genügt.

uses
  Classes,  Forms, Sysutils, StdCtrls;

type
  TMyForm = class(TForm)    //Myform wird vererbt von TForm
    mybOk: Tbutton;         //... wird nun eine Eigenschaft von TMyform
    mybSchliessen: TButton; //   "
    myLHalloWelt: TLabel;   //   "
    mySList: Tstringlist;   //   "
    procedure BOkClick(Sender: TObject);         // wird nun eine Methode von TMyform
                                                 // und wird noch implementiert.
    procedure BSchliessenClick(Sender: TObject); // "
  public
    Constructor Create(aOwner: TComponent); override; //Create und Destroy sind die wichtigsten Methoden
                                                      //einer Klasse (hier werden sie "überschrieben",
    Destructor Destroy; override;                     //Wenn der Speicher aufgeräumt werden soll.
  end;

//Implementierung der Methoden
Constructor TMyForm.Create(aOwner: TComponent);
begin
    inherited CreateNew(aOwner);   //vor dem "überschreiben" wird alles von TForm übernommen.
                                   //Darum brauchst Du dich nicht zu kümmern.
    mybok := TButton.Create(self); //Wird erst zur Laufzeit erzeugt
                                   //Wird mit Instanz von TMyform freigegeben (.free)
    mybok.Parent := self;          //Ganz wichtig !!! Wohin soll der Button!
    mybok.Caption := 'Ok';
    mybok.OnClick := self.BOkClick;
    mybschliessen := TButton.Create(self);
    mybschliessen.Parent := self;
    mybschliessen.Caption := 'Schließen';
    mybschliessen.Top := mybok.Height;
    mybschliessen.OnClick := self.BSchliessenClick;
    myLHalloWelt := TLabel.Create(self);
    mySList := Tstringlist.create; // Ohne Owner. Dafür free notwendig
    mySList.add('Hallo Welt!');
    mySList.Add('Gibts was Neues?');
    myLHalloWelt.Parent := self;
    myLHalloWelt.Top := 100;
    myLHalloWelt.left := 100;
end;

Destructor TMyForm.Destroy;
begin
   MySList.Free; //Speicher aufräumen!
                 // MySList hat keinen Eigentümer, der dies tut.
   inherited Destroy
end;

procedure TMyForm.BOKClick(Sender: TObject);
  var formb: TMyform;
begin
  myLHalloWelt.Caption := MySList.Text;
  formb:= TMyForm.Create(self);
  formb.Caption := 'Weitere Instanz';   //lauter neue Instanzen werden erzeugt
  formb.Top := random(550);
  formb.Left := random(750);
  formb.Show;
end;

procedure TMyForm.BSchliessenClick(Sender: TObject);
begin
 close;
end;

//Beginn des Programms
var forma: TMyForm;

begin //Hier beginnt das Programm
  application.Initialize; //Die erste Instanz wird mit application erzeugt
                          //einfach abschreiben (muß für OOP nicht verstanden werden)
  randomize;
  Application.CreateForm(TMyForm, Forma);
  forma.Caption := 'Hauptform';
  Application.Run;
end.
Aufgabe: Schreibe in dieser Form ein Programm mit drei Eingabeeditfenstern und zwei Ausgabeeditfenstern, das nach Eingabe von a,b,c die Lösung der Gleichung ax^2+bx+c=0 ausgibt.
Kommentieren  ↑nach oben