Joachim Mohr   Mathematik Musik Delphi
≡

21. Lektion: Eigenschaften,Methoden und Ereignisse

Dazu:
Opendialog, Savedialog
Loadfromfile, Savetofile
Allmählich nähern wir uns der Beschreibung der objektorientierten Programmierung (OOP).
Zunächst beschreiben wir Objekte, die uns an Hand von Komponenten zur Verfügung stehen.
Hier zeigt sich der Vorteil von vorgefertigten visuellen Komponenten.

Beispiel 21.1 Datei in ein Memo einlesen, unter Umständen ändern und wieder abspeichern.

Lege von der Standardkomponentenleiste zwei Buttons und ein Memeofeld und von der Dialogekomponentenleiste einen Opendialog und eine Savedialog. Probiere sodann folgendes Programm aus: 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if opendialog1.Execute then Begin
     showmessage('Du hast gewählt:'+opendialog1.filename);
     memo1.Lines.LoadFromFile(opendialog1.filename);
  End;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if savedialog1.Execute then Begin
    showmessage('Du hast gewählt:'+savedialog1.filename);
    memo1.Lines.SaveToFile(savedialog1.filename);
  End;
end;
Du siehst: opendialog1.Execute öffnet ein Dateiauswahlfenster. Du kannst eine Datei auswählen. Opendialog.filename gibt Dir den Dateinamen samt Pfad zurück. Mit memo1.Lines.SaveToFile(savedialog1.filename) wird die ausgewählte Datei in das Memo eingelesen.

opendialog1.Execute gibt true oder false zurück, je nachdem, ob eine Datei ausgewählt oder abgebrochen wurde.

Ensprechend funktioniert das Abspeichern.

Zu den Eigenschaften, Methoden und Ereignissen:

Wie bei einem record haben Komponenten als Objekte Eigenschaften, die auch wie bei records nach einem "." gelesen und geschrieben werden.
Hier zum Beispiel
Opendialog.filename (Der Dateipfad)
Memo1.Lines (Die Zeilen des Memos vom Typ TStringlist. Stringlisten haben wiederum Eigenschaften wie count und Methoden wie LoadFromFile)
Komponenten sind Objekte und diesen sind nicht nur Eigenschaften wie bei Records zugewiesen sondern auch Methoden: spezielle Prozeduren, die bei der Definition des Objektes gekapselt programmiert werden.
Hier zum Beispiel:
Opendialog1.Execute (Eine Methode vom Typ TOpendialog angewandt auf die Instanz von TOpendialog Opendialog1)
Memo1.Lines.LoadFromFile (Eine Methode vom Typ TStringlist angewandt auf die Instanz von TStringlist Memo1.Lines)
Mit der with-Anweisung lässt sich der Quelltext vereinfachen: 
procedure TForm1.Button1Click(Sender: TObject);
begin
  with opendialog1 do with memo1.lines do Begin
    if Execute then BEgin
      showmessage('Du hast gewählt:'+filename);
      LoadFromFile(filename);
      {Loadfromfile ist eine Methode von memo1.lines,
       keine Methode von opendialog1.
       Filename eine Eigenschaft von opendialog1,
       keine Eigenschaft von memo1.lines.
       Sonst wären Missverständnisse möglich.}
    ENd;
  End;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  with savedialog1 do with memo1.lines do Begin
    if Execute then BEgin
      showmessage('Du hast gewählt:'+filename);
      SaveToFile(filename);
     ENd
  End;
end;
Schließlich haben wir es noch mit Ereignissen zu tun. Das sind Nachrichten, die von Objekten empfangen werden. So ruft zum Beispiel das Anklicken von Button1 in Windows ein Onclick-Ereignis aus. Button1 ist eine Eigenschaft der Instanz Form1 vom Typ TForm1. Und: In der Methode Button1click vom Typ TForm1 wird auf das Anklicken reagiert. Auf welche Ereignisse Button1 reagiert, kannst du im Objektinspektor inspizieren und wie die Syntax dafür aussieht, gibt Dir Delphi vor: Ein großer Vorteil der visuellen Programmierumgebung.

Schon in Lektion 1 hast du davon Gebrauch gemacht.

Nach dieser Theorie nun wieder zur Programmierpraxis:

Aufgabe 21.1
Schreibe ein Programm, das die Datei "c:\test1.txt" in Memo1 (Typ TMemo) und die Datei "c:\test2.txt" in Memo2 einliest und vergleicht, ob Memo1 und Memo2 gleich viele Zeilen hat (verwende die Eigenschaft count von memo1.lines) und wenn ja, ob alle Zeilen gleich sind. (verwende lines[i]!)
Aufgabe 21.2
Schreibe ein Programm, das alle Dateiennamen des Verzeichnisses "C:\" in ein Memo einliest und das den Inhalt des Memos in eine vom Benutzer gewählten Datei ausgibt. Gleichzeitig soll die Summe der Dateigrößen alle Dateien ausgegeben werden.
Lösung

22. Lektion: Klassen: Einführung

Beliebig viele Instanzen zur Laufzeit erzeugen

Beispiel 22.1   22.2   22.3   22.4   22.5 
Begriffe: Klasse
          Instanz
Eine Klasse ist im Grunde genommen ein Typ, so wie integer oder string oder -siehe Lektion 20- Tvector oder Tpoint. Nur können Klassen wesentlich komplexer sein. Leider ist die Verwendung der Begriffe der Objektorientierten Programmierung noch nicht einheitlich. In der Literatur kannst du erhebliche Abweichungen finden.

Eine Klasse (oder ein Klassentyp bzw. Objekttyp) ist eine Datenstruktur, die eine feste Anzahl von Bausteinen enthält. Die Objektvariablen einer Klasse nennt man Instanzen. Die Datenstruktur einer Klasse enthält:
Komponenten sind visuelle Klassen, die du zur Entwurfszeit bearbeiten kannst.
Selbst wenn sie wie beispielsweise Opendialog für den Endbenutzer nicht sichtbar sind, werden sie im Entwurf sichtbar auf dem Formular plaziert.


In diesem Kapitel werden wir noch keine Klassen definieren. Wir werden bereits definierte Klassen, die uns von der Komponentenpalette bekannt sind, verwenden. Der erste Schritt, sich von der visuellen Entwicklungsumgebung sich zu lösen, ist, Instanzen von Klassen zur Laufzeit zu erzeugen und zu zerstören.

Beispiel 22.1: Eine Editfeld wird zur Laufzeit erzeugt.

Beginne mit einer neuen Anwendung:

Schreibe unter "Var Form1: TForm1" noch "Myedit: Tedit" 
var Form1: TForm1;
    Myedit: Tedit; //Myedit ist im Grunde genommen ein Zeiger
Nun können wir auf eine Variable Myedit der Klasse TEdit zugreifen.

Aber: Für Myedit, das viele Datenelemente enthält und viel Speicher benötigt, ist noch kein Speicher reserviert. Wir müssen es erst erzeugen. Platziere Button1 auf dem Formular und ergänze die Button1Click-Prozedur: 
procedure TForm1.Button1Click(Sender: TObject);
begin
  //Vor Create ist Myedit = nil, d.h. Myedit (als Zeiger) weist ins Leere
  Myedit := Tedit.Create(Form1);
  //Nun zeigt Myedit auf die soeben erzeugte Instanz
  //Und: Wird Form1 geschlossen wird auch Myedit, falls noch da, freigegeben.
  Myedit.Parent := Form1; //Wo soll es hin? Auf Form1!
  Myedit.Text := 'Hallo Welt';
  button1.Hide;
  button2.show;
end;
Bei Klick auf Button1 erscheint das Editfeld, wenn nichts anderes angegeben (By default) links oben bei seiner elterlichen Komponente Form1.

Wir zerstören es nun wieder.

Platziere Button2 auf dem Formular und ergänze die Button2Click-Prozedur: 
procedure TForm1.Button2Click(Sender: TObject);
begin
  Myedit.free;   //Falls Myedit <> nil dasselbe wie Myedit.destroy;
  Myedit := nil; //Gleicher Zustand wie vor Create
  Button1.show;
  Button2.Hide;
end;
Button1 ist nur sichtbar, wenn Myedit noch erzeugt werden muss, Button2, wenn es zerstört werden kann.

Mit einem 3. Button machen wir einen gefährlichen Versuch: 
procedure TForm1.Button3Click(Sender: TObject);
begin
   if button1.Visible //Myedit ist nicht erzeugt
     then showmessage('Es wird was gezeigt, was nicht existiert');
   Myedit.text := 'Test';
   Myedit.Show; //Kann höchst fatel werden!
end;
Man kann alle Objekte, die man in Delphi benutzen kann, auch zur Laufzeit erstellen.
Hier ist eine kleine Auflistung:
Objekt Funktion
TFrame Container-Objekt für Steuerelemente
TMainMenuHauptmenü
TPopupMenu Mausmenü
TLabelBezeichnungsfeld
TEditeinfaches Textfeld
TMemoerweitertes Textfeld
TButtonBefehlsschaltfläche
TCheckBoxKontrollfeld
TRadioButtonOptionsfeld
TListBoxListenfeld
TComboBox Kombinationslistenfeld
TScrollBar Laufleiste
TGroupBox Container-Objekt mit Bezeichnung
TRadioGroupContainer-Objekt für spezielle Objektgruppen
TPanel Container-Objekt ohne Bezeichnung
TActionListBasisklasse für alle Objekte

Beispiel 22.2: Zehn Buttons button[0], button[1], ... , button[9] werden zur Laufzeit erzeugt.

Wir verwenden dafür einen Array of Tbuttons. Diese werden wieder unter "var Form1: TForm" als globale Variable deklariert. 
var Form1: TForm1;
    Mybuttons: array[0..9] of Tbutton; //oder unter private

Bemerkung: Mybuttons als dynamischer Array mit variabler Länge wird
           folgendermaßen deklariert.
                   Mybuttons: array of Tbutton
    Im Programm muss dann die Zeile
                   setlength(Mybuttons,10)
    noch eingefügt werden.
Die Grundprozeduren sind für i := 0 to 9: 
  Mybutton[i]:=TButton.Create(Form1);      //Speicherplatz reservieren
  Mybutton[i].Parent:=Form1;               //Ganz wichtig: Wohin?
  //  Neu: Form1 erhält eine Methode: Klick auf Mybutton
  Mybutton[i].OnClick:=Form1.MybuttonClick;
Hier die ganze Unit.
Wenn Du diese nur kopieren willst, gehe folgendermaßen vor:

Beginne mit einer Neuen Anwednung. Platziere 3 Buttons auf dem Formular und Klicke Button1, Button2, Button3 drei mal an, damit Delphi die Zeilen "procedure TForm1.MybuttonClick ... " einfügt.

Jetzt musst Du deine gesamte Unit Unit1 bis "end." löschen und die folgende Unit unit1 bis "end" einfügen.


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject); //Schreibt Delphi
    procedure Button2Click(Sender: TObject); //Schreibt Delphi
    procedure Button3Click(Sender: TObject); //Schreibt Delphi
    procedure MybuttonClick(Sender: Tobject);//Achtung: schreibst Du!
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var Form1: TForm1;
    Mybutton: array[0..9] of Tbutton;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
  var i:integer;
begin //Im Normalfall in Form1.oncreate
  for i:=0 to 9 do Begin
     Mybutton[i]:=TButton.Create(Form1);
     Mybutton[i].Parent:=Form1;
     Mybutton[i].width:=45;
     Mybutton[i].caption:='Nr.'+intToStr(i);
     Mybutton[i].top:=0;
     Mybutton[i].left:=50*i;
     Mybutton[i].OnClick:=Form1.MybuttonClick;
  End;
  button1.Hide; //Sonst werden Speicherleichen produziert;
  button2.show;
end;

procedure TForm1.Button2Click(Sender: TObject);
  var i:integer;
begin
  for i:=0 to 9 do Mybutton[i].free; //Automatisch bei Form1.ondestroy
  button2.hide;
  button1.show;
end;

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

//Achtung!    Hier wird nichts von Delphi geschrieben. Du mußt diese
//  Prozeur auch als Methode der Klasse TForm1 eintragen(siehe oben)
procedure TForm1.MybuttonClick(Sender: TObject);
  var i:integer;
begin
   for i:=0 to 9 do
     if sender = Mybutton[i] then
       showmessage('Ich bin die Nummer '+inttoStr(i));
end;


end.
Aufgabe 22.1: Baue diese unit als "Neue Anwendung" auf.

Die Lösung findest du unter Zur Laufzeit erzeugte Instanzen1 als ganzes Projekt.
Dort siehst du auch, wie man die Größe eines Arrays zur Laufzeit ändert.

Beispiel 22.3: Beliebig viele Dateien können eingelesen und bearbeitet werden.

Mit Hilfe der Komponente Tabcontrol können die zu bearbeitenden Dateien ausgewählt werden. (Ähnlich dem Editor von Delphi.) Wird eine neue Datei bearbeitet, wird zuvor zur Laufzeit ein Richeditfeld erzeugt. (Hier genügt zu wissen: Ein Richeditfeld ist mit der Eigenschaft plaintext:=true dasselbe wie ein Memofeld, es fasst nur mehr Zeilen.).

Hier die gesamte Unit. Download ganzes Projekt OOP Editoren. 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    TabControl1: TTabControl;
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    ffnen1: TMenuItem;
    Speichernunter1: TMenuItem;
    Beenden1: TMenuItem;
    Neu1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Makro1: TMenuItem;
    Makroerzeugen1: TMenuItem;
    Makroausfhern1: TMenuItem;
    procedure Beenden1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Neu1Click(Sender: TObject);
    procedure TabControl1Change(Sender: TObject);
    procedure EditorChange(Sender: TObject);
    procedure ffnen1Click(Sender: TObject);
    procedure Speichernunter1Click(Sender: TObject);
    procedure Makroerzeugen1Click(Sender: TObject);
    procedure Makroausfhern1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    {Bisher schrieb alles Delphi. Diese Zeilen mußt du selbst schreiben.
     Hier im Interface-Teil und ebenfalls unten im Implementation-Teil.
     Warum "private" ist hier unwichtig. Man könnte es auch global definieren.}
    editor: array of TRichedit; //Beliebig viele Dteien können eingelesen werden.
    pfad: array of String;      //Die Dateienpfade
    procedure NeuenEditor;      //Neben biher eingelesenen Dateien kann nooch
                                //eine weiter eingelesen werden-
    function eNr(Sender: TObject):integer; //Klick auf irgendeinen Editor liefert
                                           //hier seine Nummer
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

const neu = 'Neu'; //Für mehrmaligen Aufruf. Schreibfehler moniert Compiler.

var
  Form1: TForm1;

implementation

{$R *.DFM}

function TForm1.eNr(Sender: TObject):integer;
  var k:integer;
begin
  if sender is TMenuItem then Begin
    if tabcontrol1.Tabs.Count = 0 then BEgin
      NeuenEditor;
      result := 0
    ENd else result := tabcontrol1.TabIndex;
    exit;
  End;
  for k := 0 to tabcontrol1.Tabs.Count -1 do
    if sender as TRichedit = editor[k] then Begin
      result := k;
      exit;
    End;
  NeuenEditor;
  eNr := 0;
end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
  form1.WindowState := wsmaximized;
end;

procedure TForm1.NeuenEditor;
  var e: TRichedit;
      nr: Integer;
begin
  e := Trichedit.Create(Form1);
  e.parent := tabcontrol1;
  e.Align := alclient;
  e.Font.Name := 'Courier New';
  e.Font.Size := 12;
  e.Font.Style := [fsbold];
  e.PlainText := true;
  e.MaxLength := 1000000; //wg. Bug in Delphi
  e.OnChange := editorChange;
  nr := tabcontrol1.Tabs.count+1;
  tabcontrol1.Tabs.Add(IntToStr(nr));
  tabcontrol1.TabIndex := nr-1;
  setlength(editor,nr);
  editor[nr-1] := e;
  setlength(pfad,nr);
  pfad[nr - 1] := Neu;
  form1.Caption := Neu;
  e.SetFocus;
end;

procedure TForm1.Neu1Click(Sender: TObject);

begin
  NeuenEditor;
end;

//Klick auf ein Register. Nun wird entsprechender Editor gezeigt.
procedure TForm1.TabControl1Change(Sender: TObject);
  var k, nr_minuseins: integer;
begin
  nr_minuseins :=  tabcontrol1.TabIndex;
  for k := 0 to tabcontrol1.Tabs.Count - 1 do
   if k = nr_minuseins then Begin
     editor[k].Show;
     editor[k].SetFocus;
     form1.Caption := pfad[k];
   End else editor[k].hide;
end;

//"*" kennzeichnet geänderte Datei
procedure TForm1.EditorChange(Sender: TObject);
   var nr: Integer;
begin
 nr := eNR(Sender) + 1;
 tabcontrol1.Tabs[nr - 1] :=  IntToStr(nr)+'*';
end;

procedure TForm1.ffnen1Click(Sender: TObject);
  var nr:Integer;
begin
  if opendialog1.Execute then Begin
    if length(editor)=0 then Neueneditor;
    nr := eNr(Sender);
    if editor[nr].Text >'' then BEgin
       Neueneditor;
       nr := eNr(Sender);
     ENd;
     editor[Nr].Lines.LoadFromFile(opendialog1.filename);
     pfad[Nr] := opendialog1.filename;
     form1.Caption := pfad[Nr];
     tabcontrol1.Tabs[nr] := IntToStr(nr+1);  //ohne '*'
  End;
end;

procedure TForm1.Speichernunter1Click(Sender: TObject);
  var nr:Integer;
begin
  nr := eNr(Sender);
  with savedialog1 do Begin
    InitialDir := ExtractFileDir(pfad[Nr]);
    filename := ExtractFileName(pfad[nr]);
    if Execute then BEgin
      editor[Nr].lines.SaveToFile(filename);
      pfad[Nr] := filename;
      form1.Caption := filename;
      tabcontrol1.Tabs[nr] := IntToStr(nr+1); //ohne *
    ENd;
  End;
end;

function inidatei: string;
begin
 iniDatei := Lowercase(copy(paramstr(0),1,length(paramstr(0))-3) + 'ini'); //ini statt exe
end;

procedure TForm1.Makroerzeugen1Click(Sender: TObject);
  var k,nr: integer;
begin
   showmessage('Alle momentan eingelesenen Datein können Sie beim nächsten Start'#13+
               'mit Menü "Dateien einlesen" zusammen einlesen.'#13+
               'Sie können das Makro ändern und erneut abspeichern.');
   if length(editor) = 0 then  Begin
       showmessage('Abbruch!'#13'Zuerst Dateien schreiben oder einlesen!');
       exit;
     End;
   NeuenEditor;
   nr := length(editor);
   for k := 0 to nr - 2 do if pfad[k] = Neu then
     showmessage('Datei "'+neu+'" kann nicht eingelesen werden')
       else editor[nr-1].lines.Add(pfad[k]);
   editor[nr-1].Lines.SaveToFile(iniDatei);
   pfad[nr - 1] := iniDatei;
   form1.Caption := inidatei;
   tabcontrol1.Tabs[nr-1] := IntToStr(nr); //ohne *
end;

procedure TForm1.Makroausfhern1Click(Sender: TObject);
  var pu: Tstringlist;
      k, nr:integer;
begin
  //noch pu = nil
  pu := Tstringlist.Create; //falls erfolgreich pu <> nil
  try pu.LoadFromFile(inidatei);
  Except showmessage('Noch kein Makro erzeugt'); exit; End;
  try
    for k := 0 to pu.Count - 1 do Begin
      neuenEditor;
      nr := length(editor) - 1;
      editor[nr].Lines.LoadFromFile(pu[k]);
      tabcontrol1.Tabs[nr] := IntToStr(nr+1); //ohne *
      pfad[nr] := pu[k];
    End;
  finally pu.free End; //free = destroy, falls pu <> nil
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  var k:integer;
begin
  CanClose := true;
  for k := 0 to length(editor) - 1 do
    if pos('*',tabcontrol1.Tabs[k]) > 0 then
      if MessageDlg('Noch nicht alle Dateien sind gesichert. Trotzdem beenden?',
        mtConfirmation, [mbYes, mbNo], 0) = mrNo then CanClose := false;
end;

end.
Beispiel 22.4: Dies wird für Beispiel 22.5 benötigt.
Eine Zeicheenfläche wird mit Image1.Canvas bereitgestellt. Beim Ereignis OnMouseDown werden mit der Canvas-Methode moveto(x0,y0) die Anfangskoordinaten P(x0|y0) gesetzt. Beim Ereignis OnMouseUp wird mit mit der Canvas-Methode lineto(x,y) eine Linie von P(x0|y0) nach Q(x|y) gezeichnet.
Plaziere nun eine Timage-Komponente aus Delphis Komponentenpalette "Zusätlich" auf Dein Formular.
TForm1 erhält dabei noch private Felder. Siehe "<="! 
type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private-Deklarationen }
    zeichne: Boolean;               //<=
    x0,y0: integer;                 //<=
  public
    { Public-Deklarationen }
  end;
Ergänze die Ereignisse von Form1 folgendermaßen: 
procedure TForm1.FormCreate(Sender: TObject);
begin
  zeichne := false;
  Image1.Canvas.Rectangle(0,0,width,height);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  zeichne := true;
  Image1.canvas.moveto(x,y);
  x0 := x;
  y0 := y;
end;

procedure TForm1.Image1MouseUp(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;
  image1.canvas.lineto(x,y);
end;
Beispiel 22.5 Nun werden beliebig viele Instanzen von Timage zur Laufzeit erzeugt. Gleichzeitig wird im Menüpunkt Fenster eine Umschaltmarke gesetzt.

Hier die gesamte Unit:
Download ganzes Projekt OOP Malen. 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    Neu1: TMenuItem;
    Beenden1: TMenuItem;
    Bearbeiten1: TMenuItem;
    Nurwaagrechtundsenkrecht1: TMenuItem;
    procedure ImageonMousedown(Sender: TObject; Button: TMouseButton;
              Shift: TShiftState; X, Y: Integer);
    procedure ImageOnMousemove(Sender: TObject; Shift: TShiftState; X,
                               Y: Integer);
    procedure ImageOnMouseUp(Sender: TObject; Button: TMouseButton;
                               Shift: TShiftState; X, Y: Integer);
    procedure Neu1Click(Sender: TObject);
    procedure Schliessen1Click(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
    procedure Nurwaagrechtundsenkrecht1Click(Sender: TObject);
  private
    zeichne: boolean;
    myimageArchiv:array of TImage;
    procedure ZeigeNurEines(nr: integer);
    procedure SchalteUm(Sender: TObject);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure UntermenuDazu(ZuVerlaengerndes: Tmenuitem; Beschriftung: string); //immer brauchbar
var Item: TMenuItem;
begin
  Item := TMenuItem.Create(Form1);
  Item.Caption := Beschriftung;
  Item.OnClick := Form1.schalteUm;
  item.Enabled := true;
  ZuVerlaengerndes.Add(Item);
end;

procedure TForm1.ZeigeNurEines(nr: integer);
    var k:integer;
begin
  for k := 0 to length(myimageArchiv) - 1 do
    if k = nr - 1 then Begin
      myimageArchiv[k].show;
      myimageArchiv[k].width := Clientwidth;
      myimageArchiv[k].height := clientheight;
    End else Begin
      myimageArchiv[k].hide;
      myImageArchiv[k].height := 0;
      myImageArchiv[k].width := 0; //sonst flackerts
    End;
end;

procedure TForm1.SchalteUm(Sender: Tobject);
  var nr :integer;
      s: string;
begin
  s := (sender as TMenuItem).caption;
  if pos('&',s) = 1 then s := copy(s,2,length(s) - 1);
  nr := StrToInt(s);
  ZeigeNurEines(nr);
End;

procedure TForm1.Neu1Click(Sender: TObject);
  var myimage: TImage;  //uses extctrls einfügen
      nr: integer;
begin
  form1.WindowState := wsmaximized;
  zeichne := false;
  myimage := Timage.create(application); //Damit beim Beenden automatisch free
  nr := MainMenu1.items[1].count + 1;
  UntermenuDazu(MainMenu1.Items[1],IntToStr(nr));
  setlength(myimageArchiv,nr);
  myimageArchiv[nr-1] := myimage;
  ZeigeNurEines(nr);
  with myimage do Begin
    parent := Form1;
    //Ereignisprozeduren werden zur Laufzeit zugewiesen
    //Diese müssen als Methoden von Form1 geschrieben werden
    onMousedown :=ImageonMousedown;
    onmousemove := ImageOnMousemove;
    onmouseup := ImageOnMouseUp;
    left := 0;
    top := 0; //height und with schon in ZeigeNurEines
    Canvas.Rectangle(0,0,width,height);
    show;
  End;
  caption:='Klicke mit der Maus und zeichne!'
end;

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

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

procedure TForm1.ImageOnMousemove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if zeichne then with (sender as Timage).canvas do lineto(x,y);
end;

procedure TForm1.ImageOnMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Zeichne := false;
end;

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

procedure TForm1.Nurwaagrechtundsenkrecht1Click(Sender: TObject);
begin
   showmessage('Aufgabe:'#13#10+
               'Programmiere diesen Teil');
   //Lösung
end;

end.

23. Lektion: Klassen selbst definieren

Beispiel 23.01  23.02  23.1   23.2   23.3   23.4a   23.4b

Beispiel 23.01:
Die Klasse TAuto mit den Feldern x-, und y-Position, Geschwindigkeit und den Methoden Gasgeben, Bremsen, Zeichnen wird hier demonstriert.
Zuerst mußt Du zwei Buttons "Gas" und "Bremse" und einen Timer aufs Formular ziehen. Dann kannst Du in die betreffenden OnCreate bzw. OnClick-Ereignisse den text kopieen.

Hier die gesamte Unit: 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Bgas: TButton;
    BBremse: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BgasClick(Sender: TObject);
    procedure BBremseClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

type TAuto = class(Tobject) //Klassendeklaration
     //Felder
     x, y, v, farbe: Integer; // x,y- Position; Geschwindigkeit, farbe
     //Methoden
     procedure Gasgeben(dv: integer); // erhöht v um dv
     procedure Bremsen(dv: integer);  // verringert vum dv
     procedure Zeichnen(canv: Tcanvas; farbe: Tcolor);
end;

var
  Form1: TForm1;
  auto1: Tauto;

implementation
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Canvas.Brush.Style := bsclear; // Füllmuster tarnsparent
  Auto1 := TAuto.create;
  timer1.Interval := 100;
  with Auto1 do Begin
    x := 100;
    y := 50;
    v := 10;
    farbe := clred;
    zeichnen(form1.canvas, farbe);
  end;
end;


procedure TAuto.Gasgeben(dv: integer); // erhöht v um dv
begin
  v := v + dv;
end;
procedure TAuto.Bremsen(dv: integer);  // verringert vum dv
begin
  v := v -dv;
end;
procedure TAuto.Zeichnen(canv: Tcanvas; farbe: Tcolor);
begin
  with Canv do Begin
    Pen.color := farbe;       //Stiftfarbe zuweisen
    rectangle(x,y,x+50,y+20); //Einfachmodell
  End;
end;

procedure anzeigen(auto: Tauto);
begin
  auto.Zeichnen(form1.canvas,Form1.color); //Alte Position verschwindet
  auto.x := auto.x + trunc(auto.v);        //Neue position
  if auto.x > form1.width then auto.x := 0;
  if auto.x <0 then auto.x := form1.width;
  auto.Zeichnen(form1.canvas,auto.farbe)
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
  anzeigen(auto1);
end;


procedure TForm1.BgasClick(Sender: TObject);
begin
   auto1.Gasgeben(2);
end;

procedure TForm1.BBremseClick(Sender: TObject);
begin
 auto1.Bremsen(2);
end;

end.
Aufgabe:Ändere das Programm so, dass 3 (besser gezeichnete) verschiedenfarbige Autos erzeugt werden, die ein Wettrennen veranstalten. Lösung siehe Downloadseite auto2pas

Beispiel 23.02
Bei letzten Beispiel brauchten wir uns um den Constructor und Destructor nicht zu kümmern. Wir benützten einfach den vom TObjekt ererbten. Dabei werden die einfachste Anfangswerte gesetzt. Dies ändern wir nun. Das Programm wird dadurch einfacher.

Du brauchst als einzige Komponente nur den Timer. 
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;
type TAuto = class(Tobject) //Klassendeklaration mit Felder und Methoden
     x, y, v, farbe: Integer; // x,y- Position; Geschwindigkeit, farbe
     constructor create(x1,y1: integer; farbe1: Tcolor);
     destructor destroy; override; //Freigeben und gemahltes löschen
     procedure Gasgeben(dv: integer); // erhöht v um dv
     procedure Bremsen(dv: integer);  // verringert vum dv
     procedure Zeichnen(canv: Tcanvas; farbe: Tcolor);
end;
const Anzahl = 20;
var
  Form1: TForm1;
  auto: array[1..Anzahl] of Tauto;
implementation
{$R *.DFM}
constructor TAuto.create(x1,y1: integer; farbe1: Tcolor);
begin
  inherited create; //Immer als erstes
  x := x1;
  y := y1;
  farbe := farbe1;
end;
destructor Tauto.destroy;
begin
  self.Zeichnen(form1.canvas,Form1.color); //Alte Position verschwindet
  inherited destroy; //immer als letztes
end;
procedure TAuto.Gasgeben(dv: integer); // erhöht v um dv
begin
  v := v + dv;
end;
procedure TAuto.Bremsen(dv: integer);  // verringert vum dv
begin
  v := v - dv;
  if v < 0 then v := 0;
end;
procedure TAuto.Zeichnen(canv: Tcanvas; farbe: Tcolor);
begin
  with Canv do Begin
    Pen.color := farbe;       //Stiftfarbe zuweisen
    rectangle(x,y,x+50,y+20); //Einfachmodell
  End;
end;
procedure anzeigen(auto: Tauto);
begin
  auto.Zeichnen(form1.canvas,Form1.color); //Alte Position verschwindet
  auto.x := auto.x + auto.v;        //Neue position
  if auto.x > form1.width then auto.x := 0;
  if auto.x <0 then auto.x := form1.width;
  auto.Zeichnen(form1.canvas,auto.farbe)
end;
procedure TForm1.Timer1Timer(Sender: TObject); //Das Wichtigste
  var k: integer;
begin
  auto[Random(Anzahl)+1].Gasgeben(1);
  auto[Random(Anzahl)+1].Bremsen(1);
  for k := 1 to Anzahl do anzeigen(auto[k]);
end;
procedure TForm1.FormCreate(Sender: TObject); //Start
  var k: integer;
begin
  randomize;
  color := clwhite;
  Canvas.Pen.Width := 5;
  for k := 1 to Anzahl do Auto[k] := TAuto.create(20,k*25,
    RGB(random(256),random(256),random(256)));
end;
end.


Beispiel 23.1:
Hier werden wir den Unterschied zwischen Record und Klasse am Beispiel der Kreises herausarbeiten.
Wir definieren die Klasse TKreis folgendermaßen.
(Download KreisOOP) 
                    Im Interface-Teil:

type TKreis = class(Tobject)

     private
         F_r: real;  //Das einzige Feld (nicht öffentlich)

     public

     function Getd:real;       //Für die Properties
     procedure Setd(d:real);
     function Getu:real;
     procedure Setu(u:real);
     function GetA:real;
     procedure SetA(a:real);
     procedure Tkreis.zeichne; //Eine Methode von Tkreis

     property r: real read F_r write F_r;   //Eigenschaft Kreis.r
     property d: real read Getd write Setd; //Eigenschaft Kreis.d
     property u: real read Getu write Setu; //Eigenschaft Kreis.u
     property A: real read GetA write SetA; //Eigenschaft Kreis.A
end;
                    Im Implementation-Teil

Function Tkreis.getd;
begin result := 2*r end;  //oder result := 2*F_r;

Procedure Tkreis.setd(d:real);
begin F_r := d/2 end;

Function Tkreis.getu;
begin result := Pi*d end;

Procedure Tkreis.setu(u:real);
begin F_r := u/(2*Pi) end;

Function Tkreis.getA;
begin result := Pi*r*r end;

Procedure Tkreis.setA(a:real);
begin F_r := sqrt(a/Pi) end;

Procedure Tkreis.zeichne;
  var m1, m2: integer;
      Radius: integer; //Rdius r (nicht maßstabsgerecht) skaliert
begin
  m1 := form1.width div 2;
  m2 := form1.height div 2;
  Radius := round(10*r);
  form1.Canvas.Rectangle(0,0,form1.width, form1.Height);
  form1.Canvas.Ellipse(m1 - Radius, m2 - Radius, m1 + Radius, m2 + Radius);
end;

Wir sehen:
  Nur ein Feld F_r wird definiert.
  Alle anderen werden in Methoden von Tkreis berechnet.
  Das Schlüsselwort hierfür heißt property.
  Dort werden die Methoden des Lesens und Schreibens deklariert.
Nun können wird zur Laufzeit beliebige Instanzen von TKreis erzeugen. Wir greifen das Beispiel von 7.6 auf und ändern folgende Prozedur: 
Procedure Berechnungen(r: real);
    //oder als Methode von TForm1
  var kreis: TKreis;
begin
  kreis := TKreis.Create;
  try
    kreis.r := r;
    Form1.er.text := FloatToStr(kreis.r);
    Form1.ed.text := FloatToStr(kreis.d);
    Form1.eu.text := FloatToStr(kreis.u);
    Form1.ea.text := FloatToStr(kreis.a);
  finally kreis.Free End;
end;
Beispiel 23.2: Klassen vererben. Von TPerson zu Tschueler. 
Hier die ganze Unit mit Erläuterungen. Die Klasse TKreis von Beispiel 23.1
ist abgewandelt, so dass Umfang und Fläche nur lesbar sind.  

(Download OOP)
{
 Das altererste  Beispiel zur Vererbung  bei der
 objektorientierte Programmierung)
 ===============================================

 TPerson hat die Eigenschaften "Name", "Geburtstag", "Geburtsort"
   und die Methode "anzeigen"
 Tschueler erbt alles von TPerson und hat zusätzlich die Eigenschaften
   "Klasse" und "Sprachen". TSchüler hat wie TPerson die Methode
   "anzeigen". Zum Ererbten wird jedoch noch etwas hinzugefügt.
 Die Klasse TPerson wird noch abgewandelt.
   *) mit einem Constructor
   *) mit einer Kapselung
 Die Kapselung wird auch noch an einem Kreis gezeigt. Seine
 Eigenschaft "Umfang" und "Flaeche" können nur gelesen werden.

 Stichworte: OOP
             Objektorientiertes Programmieren
             Felder
             Eigenschaften
             Methoden
             Constructor
             Vererbung
             Überschreiben
             Kapselung (read write)
}
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

//Eine Klasse TPerson mit den Feldern name, geburtsort und geburtsdatum und der
//Methode anzeigen.
type TPerson = class
       Fname : string;
       Fgeburtstag : string;
       Fgeburtsort : string;
       procedure anzeigen;
     end;
//Wir bilden eine Unterklasse Tschueler, die alle Attribute und Methoden von
//TPerson erbt und zusätzlich die Felder Klasse und Sprachen enthält.
     Tschueler = class(TPerson)
       Fklasse : string;
       Fsprachen : string;
       procedure anzeigen;
     end;
//Als nächstes erhält die Klasse Tperson einen eigenen Konstruktor,
// mit dem die Felder initialisiert werden.
     TPersonMitConstructor = class
       Fname : string;
       Fgeburtstag : string;
       Fgeburtsort : string;
       constructor Create(Fname,Fgeburtstag,Fgeburtsort:string);
       procedure anzeigen;
     end;
{Ein wichtiges Prinzip beim Objektorientierten Programmieren ist das der
 Kapselung. Nach Möglichkeit soll nicht direkt auf die Felder des Objekts
 zugegriffen werden, sondern nur über eigene Zugriffsmethoden.
 Wir verpassen daher unserer Klasse Tperson die Eigenschaften (properties)
 name, geburtstag und geburtstort.}
     TPersonMitKapselung = class(TObject)
       private
            Fname : string;
            Fgeburtstag : string;
            Fgeburtsort : string;
            function  Getname:string;
            procedure Setname(name:string);
            function  Getgebtag:string;
            procedure Setgebtag(geburtstag:string);
            function  Getgebort:string;
            procedure Setgebort(geburtsort:string);
       public
            constructor Create(Fname,Fgeburtstag,Fgeburtsort:string);
            property name:string read Getname  write Setname;
            property geburtstag:string read Getgebtag write Setgebtag;
            property geburtsort:string read Getgebort write Setgebort;
       end;
// Zur Kapselung noch ein weiteres Beispiel;
    TKreis=Class(Tobject)
       private
            Fradius : real; //Feld
            function  GetRadius:real;
            procedure SetRadius(radius:real);
            function  GetUmfang:real;
            function  GetFlaeche:real;
       public
            constructor Create(Radius:Real);
            property Radius:real  read GetRadius  write SetRadius; //Eigenschaft
            property Umfang:real  read GetUmfang;
            property Flaeche:Real read GetFlaeche;
            procedure zeichne(x,y:integer);
    end;
var
  Form1: TForm1;

implementation

{$R *.DFM}


procedure TPerson.anzeigen;
begin
     form1.memo1.lines.add('Name       : '+Fname+#13#10+
                           'Geburtstag : '+Fgeburtstag+#13#10+
                           'Geburtsort : '+Fgeburtsort);
end;

procedure Tschueler.anzeigen;
begin
     inherited anzeigen;
     Form1.memo1.lines.add('Klasse       :'+Fklasse+#13#10+
                             'Sprachen   :'+Fsprachen);
end;

constructor TPersonMitConstructor.Create(Fname,Fgeburtstag,Fgeburtsort:string);
begin
     inherited Create;
     self.Fname := Fname;
     self.Fgeburtstag := Fgeburtstag;
     self.Fgeburtsort := Fgeburtsort;
end;

procedure TPersonMitConstructor.anzeigen;
begin
 form1.memo1.lines.add('Name       : '+Fname+#13#10+
                           'Geburtstag : '+Fgeburtstag+#13#10+
                           'Geburtsort : '+Fgeburtsort);
end;
//————————————————— Mit Kapselung ———————————————————————————————
function TPersonMitKapselung.Getname;
begin
     result := Fname;
end;

function TPersonMitKapselung.Getgebtag;
begin
     result := Fgeburtstag;
end;

function TPersonMitKapselung.Getgebort;
begin
     result := Fgeburtsort;
end;

procedure TPersonMitKapselung.Setname;
begin
     Fname := name;
end;

procedure TPersonMitKapselung.Setgebtag;
begin
     Fgeburtstag := geburtstag;
end;

procedure TPersonMitKapselung.Setgebort;
begin
     Fgeburtsort := geburtsort;
end;

constructor TPersonMitKapselung.Create;
begin
     inherited Create;
     self.Fname := Fname;
     self.Fgeburtstag := Fgeburtstag;
     self.Fgeburtsort := Fgeburtsort;
end;
//———————— Zweites Beispiel für Kapselung: Kreis ———————————————
constructor TKreis.Create(radius:real);
begin
   inherited Create;
   fRadius:=Radius;
end;

function  TKreis.GetRadius:real;
begin result:=FRadius end;

procedure TKreis.SetRadius(radius:real);
begin FRadius:=Radius end;

function  TKreis.GetUmfang:real;
begin result:=2*PI*FRadius end;

function  TKreis.GetFlaeche:real;
begin result:=Pi*FRadius*Fradius end;

procedure TKreis.zeichne(x,y:integer);
begin
  form1.Canvas.Brush.Color := clRed;;
  form1.Canvas.Ellipse(x-round(Fradius*10),y-round(Fradius*10),
                       x+round(Fradius*10),y+round(Fradius*10));
end;



procedure TForm1.Button1Click(Sender: TObject);
  var  person1, person2 : TPerson;
begin
     person1 := TPerson.create;
     person2 := TPerson.create;
     person1.Fname := 'Karl Mayer';
     person1.Fgeburtstag := '13.7.1981';
     person1.Fgeburtsort := 'Rottenburg';

     person2.Fname := 'Viola Krautt';
     person2.Fgeburtstag := '1.7.1982';
     person2.Fgeburtsort := 'Hirrlingen';

     form1.Memo1.Clear;
     form1.memo1.lines.add('1. Person (3 Eigenschaften)');
     person1.anzeigen;
     form1.memo1.lines.add('2. Person');
     person2.anzeigen;

     person1.Free; //Das Leben ist kurz und zeitraubend und endet
     person2.Free; //meistens mit dem Tod.

end;

procedure TForm1.Button2Click(Sender: TObject);
   var schueler1:Tschueler;
begin
     schueler1 := Tschueler.create;
     schueler1.Fname := 'Karin Müller';
     schueler1.Fgeburtstag := '17.10.1981';
     schueler1.Fgeburtsort := 'Tübingen';
     schueler1.Fklasse := '12 Tutot A-K';
     schueler1.Fsprachen := 'Französisch Englisch';
     form1.Memo1.Clear;
     form1.memo1.lines.add('Schüler (5 Eigenschaften)');
     schueler1.anzeigen;
     schueler1.free; //Ein kurzes Leben
end;

procedure TForm1.Button3Click(Sender: TObject);
   var  person1, person2 : TPersonMitConstructor;
begin
  person1:=TPersonMitConstructor.Create('Adrian Möck','13.10.1992','Tübingen');
  person2:=TPersonMitConstructor.Create('Maren Oswald','05.07.1992','Böblingen');
  form1.Memo1.Clear;
  form1.memo1.lines.add('Zwei Personen'#13#10+'=================');
  person1.anzeigen;
  person2.anzeigen;
  person1.Free;
  person2.Free;
end;

procedure TForm1.Button4Click(Sender: TObject);
    var  person1 : TPersonMitKapselung;

begin
     person1 := TPersonMitKapselung.create('Mira Zöllner',
                        '05.07.1992','Reutlingen');
     //Person1 hat nun die Eigenschaften name, geburtstag, geburtsort
     form1.Memo1.Clear;
     form1.memo1.lines.add('Person mit Kapselung'+#13#10+
                           'Name       : '+person1.name+#13#10+
                           'Geburtstag : '+person1.geburtstag+#13#10+
                           'Geburtsort : '+person1.geburtsort);
     person1.free;
end;

procedure TForm1.Button5Click(Sender: TObject);
  var kreis1:TKreis;
begin
  kreis1:=TKreis.Create(5);
  form1.Memo1.Clear;
  form1.memo1.lines.add('Kreis'#13#10'======'#13#10+
                        'Radius:'+floatToStr(kreis1.radius)+#13#10+
                        'Umfang:'+floatToStr(kreis1.umfang)+#13#10+
                        'Fläche:'+floatToStr(kreis1.Flaeche));
  kreis1.zeichne(button5.left,button5.top);
  kreis1.Free;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  close;
end;
Beispiel 23.3 In einer eigenen Unit unit2 wird eine Klasse TKreis erzeugt. Zwei Methoden von Tkreis werden implementiert. Zunächst die unit2, dann das Hauptprogramm in unit1.
(Download OOP mit Graphik) 
unit unit2;  // stellt die TKreis-Klasse zur Verfügung
{ (c) Joachim Mohr
  An einer Graphik wird OOP demonstriert.
  Eine Einfache Klasse TKreis wird definiert: kurz und übersichtlich
  Stichworte: Klasse
              Instanz
              Felder
              Methoden
              Constructor
              Canvas
              Zeichne Ellipse}
interface
uses Graphics;

  type TKreis = class(TObject)  // Klassendeklaration von TKreis
   // Felder:
   x:Integer;          // x - Position
   y: Integer;         // y - Position
   vx,vy: Integer;     // aktueller Geschwindigkeitsvektor
   farbe: Integer;     // Aussehen
   // Methoden:
   constructor Create(x,y,vx,vy,farbe:Integer);
   procedure Geschwindigkeitaendern(dva,dvb:Integer);
   procedure Zeichnen(canv:TCanvas; colr: integer); // zeichnet Kreis auf Canvas in Farbe colr
  end;

 implementation
  // ———————————— Methoden implementieren:

 constructor TKreis.Create(x,y,vx,vy,farbe:Integer);
 begin
   inherited create;
   self.x:=x;
   self.y:=y;
   self.vx:=vx;
   self.vy:=vy;
   self.farbe:=farbe;
 end;

 procedure TKreis.Geschwindigkeitaendern(dva,dvb:Integer);
 begin
  vx := vx + dva;
  vy := vy + dvb;
 end;

 procedure TKreis.Zeichnen(canv:TCanvas; colr: integer);
  begin
   with canv do begin
    Pen.Color := colr;
    //Toller Effekt bei Pen.Color := clblack;
    Brush.Color := colr;
    Ellipse(x-10,y-10,x+10,y+10)
   end
  end;
end.
     

unit Unit1;
{Aussehen wie ein Bildschirmschoner:
   Stichworte: form1.WindowState:=wsmaximized;
               form1.borderstyle:=bsNone; //Im Gegensatz zu bsSizeable
               Instanzen werden dynamische erzeugt (Create/Free)
               Dynamischer Array (setlength)

Wichtig: Die Kreise werden in TForm1.FormCreate erzeugt.
         Sie müssen also wieder freigegeben werden.
         Wo? Spätestens in TForm1.FormClose!}

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

const AnzahlKreise=20;
var
  Form1: TForm1;


implementation

uses unit2;              // Einbinden der TKreis-Unit

{$R *.DFM}

var Kreis: array of TKreis;      //Objekte deklarieren

function ZufallsFarbe:integer;
begin result:=random(256)+256*random(256)+256*256*random(256) end;

procedure NeuerKreis;
  var k:integer;
begin
 k:=length(kreis);
 setlength(kreis,k+1);
 Kreis[k] := TKreis.Create(random(Form1.Width),random(Form1.Height),
             random(11)-5,Random(11)-5,zufallsfarbe);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
 showmessage('Beenden:Mausklick');
 randomize;
 Canvas.Brush.Style := bssolid;
 while length(kreis) < AnzahlKreise do NeuerKreis;
end;

procedure anzeigen(Kreis:TKreis);    // Anzeigeroutine für ein TKreis-Objekt
 begin
   Kreis.Zeichnen(Form1.Canvas, Form1.Color); // alte Position mit Hintergrundfarbe löschen
   Kreis.x := Kreis.x + Kreis.vx;             // Verschieben der x-Position
   Kreis.y := Kreis.y + Kreis.vy;
   If Kreis.x >= Form1.ClientWidth then Kreis.vx:=-Kreis.vx; // rückwärts
   if Kreis.x<=0 then Kreis.vx:=-Kreis.vx;                   //wieder vorwärts
   If Kreis.y >= Form1.ClientHeight then Kreis.vy:=-Kreis.vy; // aufwärts
   if Kreis.y <= 0 then Kreis.vy:=-Kreis.vy;                   //wieder runter
   Kreis.Zeichnen(Form1.Canvas, Kreis.farbe)      // an neuer Position zeichnen
 end;

procedure TForm1.Timer1Timer(Sender: TObject);  // periodisches Anzeigen
  var k:integer;
begin
 for k:=0 to length(kreis)-1 do Begin
   anzeigen(Kreis[k]);
   kreis[k].Geschwindigkeitaendern(-1+random(3),-1+random(3));  //in [-1;1] da 0 <= random(3) <=2
 End;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  var k:integer;
begin
  for k:=0 to length(kreis)-1 do Kreis[k].Free;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if MessageDlg('Jetzt beenden?',
                 mtConfirmation, [mbYes, mbNo], 0) = mrYes
    then close;
  color:=ZufallsFarbe;
  canvas.brush.color:=color;
  Canvas.Rectangle(0,0,width,height);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  if form1.top=0 then exit;
  WindowState:=wsmaximized;
  borderstyle:=bsNone; //bsSizeable
  Timer1Timer(Nil); //Zeichne zum 1. Mal
end;

end.
Beispiel 23.4a Hier soll der Unterschied zwischen Record und Class gezeigt werden.

Einige Systemeigenschaften sollen gezeigt werden. (Da diese bequem aus Windowsprozeduren, die in der Programmiersprache C++ geschrieben wurden, müssen wir uns mit Zeiger Pchar statt mit Strings herumschlagen. Die Syntax von Delphi erleichtert dies sehr.
Zunächst die Verwendung eines records: 
type
  TSystem = record
    ColorCount: Integer;
    TotalPhysMemory: Integer;
    AvailPhysMemory: Integer;
    TotalPageFile: Integer;
    AvailPageFile: Integer;
    WindowsDirectory: String;
    SystemDirectory: String;
    UserName: String;
    ComputerName: String;
    ProcessorType: String;
    ProcessorCount: Integer;
    System: String;
  end;

procedure LiesEigenschaften(var system: Tsystem);
var memory : TMEMORYSTATUS;
         P : PChar;
      size : DWord;
      systeminfo:TSystemInfo;
      os : TOSVERSIONINFO;
begin
  system.ColorCount := 1 shl GetDeviceCaps(GetDC(0),BITSPIXEL);
  GlobalMemoryStatus(memory);
  system.TotalPhysMemory:= memory.dwTotalPhys;
  system.AvailPhysMemory:= memory.dwAvailPhys;
  system.TotalPageFile:= memory.dwTotalPageFile;
  system.AvailPageFile:= memory.dwAvailPageFile;
  P:=StrAlloc(MAX_PATH+1); //uses sysutils
  windows.GetWindowsDirectory(P,MAX_PATH+1);
  system.WindowsDirectory:= P;
  windows.GetSystemDirectory(P,MAX_PATH+1);
  system.SystemDirectory:= P;
  StrDispose(P);
  size :=1024;
  P:=StrAlloc(size);
  windows.GetUserName(P,size);
  system.UserName:= P;
  StrDispose(P);
  size :=MAX_COMPUTERNAME_LENGTH+1;
  P:=StrAlloc(size);
  windows.GetComputerName(P,size);
  system.ComputerName:= P;
  StrDispose(P);
  GetSystemInfo(systeminfo);
  case systeminfo.dwProcessorType of
               386  : system.ProcessorType := 'Intel 386';
               486  : system.ProcessorType := 'Intel 486';
               586  : system.ProcessorType := 'Intel Pentium';
               860  : system.ProcessorType := 'Intel 860';
              2000  : system.ProcessorType := 'MIPS R2000';
              3000  : system.ProcessorType := 'MIPS R3000';
              4000  : system.ProcessorType := 'MIPS R4000';
             21064  : system.ProcessorType := 'ALPHA 21064';
               601  : system.ProcessorType := 'PPC 601';
               603  : system.ProcessorType := 'PPC 603';
               604  : system.ProcessorType := 'PPC 604';
               620  : system.ProcessorType := 'PPC 620';
  end;
  system.ProcessorCount := systeminfo.dwNumberOfProcessors;
  os.dwOSVersionInfoSize := sizeof(os);
  GetVersionEx(os);
  case os.dwPlatformId of
     VER_PLATFORM_WIN32s : system.system := 'Win32';
     VER_PLATFORM_WIN32_WINDOWS : system.system := 'Win95';
     VER_PLATFORM_WIN32_NT : system.system := 'WinNT';
   end;
end;


procedure TForm1.Button1Click(Sender: TObject);
  var  system1: TSystem;
begin
   LiesEigenschaften(system1);
   with memo1.lines do begin
     add('Farben:' + Formatfloat('### ### ###',system1.colorcount));
     add('Speicher:' + Formatfloat('### ### ###',system1.TotalPhysMemory));
     add('freier Speicher:' + Formatfloat('### ### ###',system1.AvailPhysMemory));
     add('TotalPageFile:' + Formatfloat('### ### ###',system1.TotalPageFile));
     add('AvailPageFile:' + Formatfloat('### ### ###',system1.AvailPageFile));
     add('WindowsDirectory:' + system1.WindowsDirectory);
     add('SystemDirectory:' + system1.SystemDirectory);
     add('UserName:' + system1.UserName);
     add('ComputerName:' + system1.ComputerName);
     add('ProcessorType:' + system1.ProcessorType);
     add('ProcessorCount:' + Formatfloat('### ### ###',system1.ProcessorCount));
     add('System:' + system1.system);
     //Dem Anwender wird jetzt was vorgegaukelt !!!!
     add('Nun wird der Speicher verdoppelt');
     system1.TotalPhysMemory :=  2*system1.TotalPhysMemory;
     add('PhysMemory:' + Formatfloat('### ### ###',system1.TotalPhysMemory));
   end;
end;
Die Zeile "system1.TotalPhysMemory := 2*system1.TotalPhysMemory" ist unsinnig. TotalPhysMemory ist wie alle anderen Eigenschaften eine nur Leseeigenschaft. Sie darf nicht verändert werden. Dies kann man in einer Klasse gut kapseln. Dann sieht das Beispiel folgendermaßen aus.

Beispiel 23.4b Dasselbe Programm wie Beispiel 23.4a jetzt aber mit der Klasse TSystem definiert. 
//Tsystem wird hier gekapselt. Nur was published ist, kann verwendet werden.
//Dies nun als Komponente zu schreiben ist nicht weiter schwierig. Siehe Doberenz/Kowalski
type
  TSystem = class(TComponent)
  private {geht niemand was an! Nur die Leseeigenschaften sind published}
    function GetColorCount:Integer;
    function getTotalPhysMemory:integer;
    function getAvailPhysMemory:integer;
    function getTotalPageFile:integer;
    function getAvailPageFile:integer;
    function getWindowsDirectory:String;
    function getSystemDirectory:String;
    function getUserName:String;
    function getComputerName:String;
    function getProcessorType:String;
    function getProcessorCount:Integer;
    function getSystem: String;
  published //Diese Eigenschaften waren im Record die Felder
     property ColorCount: Integer read GetColorCount;
     property TotalPhysMemory: integer read getTotalPhysMemory;
     property AvailPhysMemory: integer read getAvailPhysMemory;
     property TotalPageFile: integer read getTotalPageFile;
     property AvailPageFile: integer read getAvailPageFile;
     property WindowsDirectory: String read getWindowsDirectory;
     property SystemDirectory: String read getSystemDirectory;
     property UserName: String read getUserName;
     property ComputerName: String read getComputerName;
     property ProcessorType: String read getProcessorType;
     property ProcessorCount: Integer read getProcessorCount;
     property System: String read GetSystem;
  end;

function TSystem.GetColorCount:Integer;
begin
   GetColorCount := 1 shl GetDeviceCaps(GetDC(0),BITSPIXEL);
end;

function TSystem.getTotalPhysMemory:integer;
var memory : TMEMORYSTATUS;
begin
    GlobalMemoryStatus(memory);
    getTotalPhysMemory:= memory.dwTotalPhys;
end;

function TSystem.getAvailPhysMemory:integer;
var memory : TMEMORYSTATUS;
begin
    GlobalMemoryStatus(memory);
    getAvailPhysMemory:= memory.dwAvailPhys;
end;

function TSystem.getTotalPageFile:integer;
var memory : TMEMORYSTATUS;
begin
    GlobalMemoryStatus(memory);
    getTotalPageFile:= memory.dwTotalPageFile;
end;

function TSystem.getAvailPageFile:integer;
var memory : TMEMORYSTATUS;
begin
    GlobalMemoryStatus(memory);
    getAvailPageFile:= memory.dwAvailPageFile;
end;

function TSystem.getWindowsDirectory:String;
var P: PChar;
begin
     P:=StrAlloc(MAX_PATH+1);
     windows.GetWindowsDirectory(P,MAX_PATH+1);
     getWindowsDirectory:= P;
     StrDispose(P);
end;

function TSystem.getSystemDirectory:String;
var P: PChar;
begin
     P:=StrAlloc(MAX_PATH+1);
     windows.GetSystemDirectory(P,MAX_PATH+1);
     getSystemDirectory:= P;
     StrDispose(P);
end;

function TSystem.getUserName:String;
var P   : PChar;
    size: DWord;
begin
     size :=1024;
     P:=StrAlloc(size);
     windows.GetUserName(P,size);
     getUserName:= P;
     StrDispose(P);
end;

function TSystem.getComputerName:String;
var P   : PChar;
    size: DWord;
begin
     size :=MAX_COMPUTERNAME_LENGTH+1;
     P:=StrAlloc(size);
     windows.GetComputerName(P,size);
     getComputerName:= P;
     StrDispose(P);
end;

function TSystem.getProcessorType:String;
var systeminfo:TSystemInfo;
    zw : string;

begin
   GetSystemInfo(systeminfo);
   case systeminfo.dwProcessorType of
               386  : zw := 'Intel 386';
               486  : zw := 'Intel 486';
               586  : zw := 'Intel Pentium';
               860  : zw := 'Intel 860';
              2000  : zw := 'MIPS R2000';
              3000  : zw := 'MIPS R3000';
              4000  : zw := 'MIPS R4000';
             21064  : zw := 'ALPHA 21064';
               601  : zw := 'PPC 601';
               603  : zw := 'PPC 603';
               604  : zw := 'PPC 604';
               620  : zw := 'PPC 620';
   end;
   result := zw;
end;

function TSystem.getProcessorCount:Integer;
var systeminfo:TSystemInfo;
begin
   GetSystemInfo(systeminfo);
   result := systeminfo.dwNumberOfProcessors;
end;

function TSystem.getSystem:string;
var os : TOSVERSIONINFO;
begin
   os.dwOSVersionInfoSize := sizeof(os);
   GetVersionEx(os);
   case os.dwPlatformId of
     VER_PLATFORM_WIN32s : result := 'Win32';
     VER_PLATFORM_WIN32_WINDOWS : result := 'Win95';
     VER_PLATFORM_WIN32_NT : result := 'WinNT';
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var system1: TSystem;
begin
   system1 := Tsystem.Create(Form1); //Nach create immer try ... finally
   try
   with memo1.lines do begin
     add('Farben:' + Formatfloat('### ### ###',system1.colorcount));
     add('PhysMemory:' + Formatfloat('### ### ###',system1.TotalPhysMemory));
     add('AvailMemory:' + Formatfloat('### ### ###',system1.AvailPhysMemory));
     add('TotalPageFile:' + Formatfloat('### ### ###',system1.TotalPageFile));
     add('AvailPageFile:' + Formatfloat('### ### ###',system1.AvailPageFile));
     add('WindowsDirectory:' + system1.WindowsDirectory);
     add('SystemDirectory:' + system1.SystemDirectory);
     add('UserName:' + system1.UserName);
     add('ComputerName:' + system1.ComputerName);
     add('ProcessorType:' + system1.ProcessorType);
     add('ProcessorCount:' + Formatfloat('### ### ###',system1.ProcessorCount));
     add('System:' + system1.system);
   end;
   finally system1.Free End;
end;
Ein unsinniger Befehl wie zum Beispiel "system1.TotalPhysMemory := 2*system1.TotalPhysMemory" wird nun vom Compiler zurückgewiesen.

24. Lektion: Nachkomme von TForm selbst schreiben

Beispiel 24.1 An diesem Beispiel kann man schön verfolgen, wie Nachkommen eine Klasse bereichern können.

Du programmierst jetzt selbst, was sonst Delphi macht. Das erleichtert Dir, die Begriffsbildungen der OOP zu verstehen.

Es geht darum, einen Nachkommen des leeres Formulars Klasse TForm zu programmieren.

Den Nachkommen nennen wir TAForm.

Verwendet wird die Klasse TForm, ein leeres Formular. In der Unit2 wird Klasse TAForm programmiert: Ein Formular mit den Buttons "BHallo" und "BSchliessen". Diesen Buttons werden dann auch entsprechende Ereignisbehandlunsroutinen OnClick zugeordnet.

Ergänze Deine unit1 folgendermaßen: 
implementation

uses unit2;

{$R *.DFM} // Unit1 besitz eine DFM-Datei

//Hier wird Dein selbst programmiertes Formular TAForm aufgerufen
procedure TForm1.BShowmodalClick(Sender: TObject);
  var a:TAForm;
begin
  a := TAForm.create(Form1);
  try a.showmodal;      //Wichtig showmodal
  finally a.free; End;  //Wichtig: Auf jeden Fall wieder freigeben
end;
Bemerkung: Mit showmodal ist der Aufruf richtig! Erst wenn das zweite Formular geschlossen wird und die Ressourcen wieder freigegeben werden, erhält Form1 wieder den Modus. (Alternative siehe Lösung zur Aufgabe 24.1: Form1.enabled := false;)

Die folgende Abwandlung ist nur zur Demonstration geeignet, Bei jedem Klick werden neue Ressourcen verbraucht und irgendwann einmal wirdst Du feststellen: Dein Computer arbeitet immer langsamer oder verweigert seinen Dienst. 
procedure TForm1.BShowClick(Sender: TObject); //Nur zur Demonstartion ...
  //... da bei jedem Click Neue Ressourcen angefordert werden.
  var a:TAForm;
begin
  a := TAForm.create(Form1);
  a.Left := random(700);
  a.top := random(500);
  a.show; //Wird mit Form1.destroy freiggeben
end;
Nach dieser Bemerkung geht es folgendermaßen weiter:

Füge in Delphi mit "Datei|Neu|Unit" folgende unit zu:

Die unit2 leitet sich von TForm, einem leeren Formular ab, und bereichert es um den Knopf "Hallo" und "Schließen". 
unit Unit2;

interface

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

type
  TAForm = class(TForm)
  bhallo, bschliessen: TButton;
  procedure BhalloClick(Sender: TObject);
  procedure BschliessenClick(Sender: TObject);
  public
    Constructor Create(aOwner: TComponent); override;
    Destructor Destroy; override;
  end;

implementation

Constructor TAForm.Create;
begin
    inherited CreateNew(aOwner);
    //    bei Tform.Create wird eine Resource ".dfm" erwartet
    Caption := 'Mein Neues Fenster';
    bhallo := TButton.Create(self);
    bhallo.Parent := self;
    bhallo.Caption := 'OK';
    bhallo.OnClick := self.BHalloClick;

    bschliessen := TButton.Create(self);
    bschliessen.Parent := self;
    bschliessen.Left := bhallo.width;
    bschliessen.Caption := 'Schliessen';
    bschliessen.OnClick := self.BSchliessenClick;
end;

Destructor TAForm.Destroy;
begin
  beep; //Zur Kontolle
  inherited Destroy;
end;

procedure TAForm.BHalloClick(Sender: TObject);
begin
 showmessage('Hallo Welt');
end;

procedure TAForm.BschliessenClick(Sender: TObject);
begin
  self.close;
end;

end.
Aufgabe 24.1 Die folgende Prozedur prüft, ob n Primzahl ist. 
procedure TForm1.Button1Click(Sender: TObject);
  var i: integer;
      n: int64;
begin
  n := 18115587450017; //Besser aus Editfeld auslesen.
  for i := 2 to round(sqrt(1.0*n)) do
    if n mod i = 0 then Begin
      showmessage(intToStr(i) + ' ist Teiler');
      exit;
    End;
  showmessage('Primzahl');
end;
Der Benutzer muß jedoch einige Minuten warten.

Programmiere einen "Abbrechen-Knopf", d.h. der Anwender soll die Möglichkeit haben, diesen Programmpunkt abzubrechen.

Dazu sollst Du eine Form zur Laufzeit erzeugen.

Lösung

Beispiel 24.2 Beim folgenden Bildschirmschoner wird das Hauptformular schon beim Aufruf des Programms erzeugt. Im Entwurf braucht man also überhaupt kein Formular. Dazu müssen wir Delphi etwas überlisten: Rufe Menü "Neu|Konsolenanwendnung" auf. Dann erscheint nur eine DPR-Datei. 
program Project1;
{$APPTYPE CONSOLE}
uses sysutils;

begin
  // Hier Anwender-Code
end.
Ersetze diese Datei komplett durch folgenden Code und speichere es etwa unter dem Namen "MeinBildschirmschoner" ab (Mehr brauchst Du nicht zu machen. Du kannst das Programm sofort mit F9 kompilieren und aufrufen.)

Wenn Du die EXE-Datei "MeinBildschirmschoner.exe" in "MeinBildschirmschoner.scr" umbenennst und in des Systemordner (z.B. "c:\windows\system") kopierst, hast Du Deinen eigenen Bildschirmschoner installiert.

Siehe auch in der Rubrik Fragen und Antworten. 

program Bildschirmschoner;  //Als Digitale Uhr
//Exeprogramm umtaufen in ".scr" und im Windows-Systemverzeichnis abspeichern

uses
  extctrls, //für timer
  graphics, //für clblack
  controls, //für alNone
  SysUtils, //Für beep
  Windows, //THandle
  Classes,  //Für TComponent
  Forms,    // Für TForm
  Dialogs,  //für showmessage
  Messages, //für wm_sysCommand
  StdCtrls; //Für TButton
type
  TAForm = class(TForm)
  labelDigitaleUhr: TLabel;
  timer1: TTimer;
  procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  procedure TimerdigitaleUhr(Sender: TObject);
  private
    zaehl: integer; //Verzögert bei Mousemove close
  public
    Constructor Create(aOwner: TComponent); override;
    Destructor Destroy; override;
  end;

Constructor TAForm.Create;
  const clblau = TColor($00CF9030);
begin
    inherited CreateNew(aOwner);
    zaehl := 0;
    with self do Begin
      Formstyle   := fsStayOnTop;
      Bordericons := []; //
      Borderstyle := bsnone;
      WindowState := wsnormal;
      align       := alnone;
      Top         :=0;
      left        :=0;
      Width       := screen.Width;
      height      := screen.height;
      Color       := clBlack;
      cursor      := -1;    //Kein Cursor!
      onkeydown   := FormKeyDown;
      onmousemove := FormMousemove;
   End;
   labelDigitaleUhr := TLabel.Create(self);
   with labelDigitaleUhr do Begin
     Parent := self;
     top := 0;
     left := 0;
     font.Height := 40;
     font.Style := [fsbold];
     font.Name := 'Times Roman';
     color := clblau;
   End;
   timer1 := TTimer.Create(self);
   with timer1 do Begin
     interval := 1000*60; //Jede Minute
     ontimer := TimerdigitaleUhr;
   End;
   TimerdigitaleUhr(nil);
end;

Destructor TAForm.Destroy;
begin
  inherited Destroy;
end;

procedure TAForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState); //Reagiert auch auf Nicht ASCII-Zeichen
begin
  close; //Hauptfenster close heißt: Programm beenden
end;

procedure TAForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer); //Wird das erste Mal schon beim Starten aufgerufen
begin
  inc(zaehl);
  if zaehl > 5 then close;
end;

procedure TAForm.TimerdigitaleUhr(Sender: TObject);

begin
  labelDigitaleUhr.Caption := FormatDateTime('dddd," "d.mm.yyyy    hh:nn"', Now);
  labelDigitaleUhr.left := (self.width - labelDigitaleUhr.width) div 2;
  if labelDigitaleUhr.top > self.Height - 100 then labelDigitaleUhr.top := 0 else
    labelDigitaleUhr.top := labelDigitaleUhr.top + 1;
end;

procedure ZweimalVerhindern;
var h: HWND;
begin
  h:=FindWindow('TAForm','Bildschirmschoner (c) Joachim Mohr');
  if h<>0 then Begin SetForegroundWindow(h); halt End;
end;

//—————————— Hauptprogramm ———————————————
  var DigitaleUhr:TAForm;
begin
  ZweimalVerhindern;
  DigitaleUhr := TAForm.create(Nil);
  DigitaleUhr.Caption :='Bildschirmschoner (c) Joachim Mohr';
  DigitaleUhr.showmodal;
end.