Die Homepage von Joachim Mohr
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. 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).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.
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:
- Canvas.MoveTo(x,y:integer)
- Canvas.LineTo(x,y:integer)
- Canvas.Rectangle(x1,y1,x2,y2:integer)
- Canvas.Ellipse(x1,y1,x2,y2:integer)
- Canvas.PenPos.X:integer
- Canvas.PenPos.Y:Integer
- Canvas.Pixels[x,y:integer]:TColor
- Canvas.Font: TFont
- Canvas.TextOut(X, Y: Integer; const Text: string)
- Canvas.Pen.Color:TColor (=clBlack, clMaroon, clGreen, clOlive, clNavy, clPurble, clTeal, clGray, clSiver, clRed, clLime, clBlue, clFuchsia, clAqua, clWhite, ...)
- Canvas.Pen.Width:Integer
- Canvas.Pen.Style:TPenStyle(=psSolid, psDash, psDot, psClear)
- Canvas.Pen.Mode:TPenMode(=pmCopy, pmXor, ...)
- Canvas.Brush.Color:TColor
- Canvas.Brush.Style:TBrushStyle (=bsClear, bsSolid, bsCross)
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
- Mit der Maus kann auf ein Image gezeichnet werden.
- Bild kann in die Zwischenablage kopiert werden.
- Bild kann aus der Zwischenablage eingefügt werden.
- Bild kann als Bitmap- und JPEG-Grafik gespeichert werden.
- Bild kann eingelesen werden.
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.