• Delphilektionen
• Fragen und Antworten
• Delphi-Quellcode erklärt
• Quellcode

21. Lektion: Eigenschaften,Methoden und Ereignisse

Dazu:

Opendialog, Savedialog

Loadfromfile, Savetofile

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;

Zu den Eigenschaften, Methoden und Ereignissen:

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)

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)

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;

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.

22. Lektion: Klassen: Einführung

Beliebig viele Instanzen zur Laufzeit erzeugen

Begriffe: Klasse
          Instanz

• Felder und Eigenschaften
  Felder enthalten wie record Daten eines bestimmten Typs. Sie sind im wesentlichen Variablen, die zu einem Objekt gehören. Sie definieren Datenelemente, die in jeder Instanz der Klasse vorhanden sind.
  
  Eigenschaften (Property) erscheinen für den Endbenutzer wie Felder. Hat man zum Beispiel die Klasse TKreis definiert, genügt es das Feld Radius zu speichern. Die Eigenschaft Umfang und Flaeche können ja aus Radius berechnet werden. Der Endbenutzer sieht jedoch keinen Unterschied in:
      x := kreis1.radius;
      y := kreis1.umfang;
      kreis1.flaeche := 5*Pi;
  Mit kreis1.flaeche := 5*Pi wird, falls überhaupt als Zuweisung zugelassen, das Feld Radius auf sqrt(5) gesetzt.
  
  Ein Feld oder eine Eigenschaft ist eine Schnittstelle zu den Daten eines Objekts. Eigenschaften verfügen im Gegensatz zu schlichten Feldern über Zugriffsangaben, die bestimmen, wie ihre Daten gelesen und geändert werden.
  
  So kommt es beispielsweise relativ häufig vor, dass du Formulare mit zwei Schaltflächen erstellst, welche die Beschriftung OK und Abbrechen tragen.
  Beide Schaltflächen sind eine Instanz der Klasse TButton. Durch die Zuweisung unterschiedlicher Werte an ihre Caption-Eigenschaften und unterschiedlicher Behandlungsroutinen an ihre OnClick-Ereignisse erhälst du zwei Instanzen, die ein unterschiedliches Verhalten zeigen.
  
• Methoden, die eine Operation für das Objekt durchführen.
  Die meisten Methoden führen Operationen mit Objekten (Instanzen) durch. Manche Methoden arbeiten jedoch mit den Klassentypen selbst.

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.

var Form1: TForm1;
    Myedit: Tedit; //Myedit ist im Grunde genommen ein Zeiger

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;

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;

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;

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.

  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.

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.

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;

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;

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

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.

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.

                    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.

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;

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;

• Geschwindigkeit ändern
• Zeichnen

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.

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;

//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;

24. Lektion: Nachkomme von TForm selbst schreiben

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;

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;

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.

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;

program Project1;
{$APPTYPE CONSOLE}
uses sysutils;

begin
  // Hier Anwender-Code
end.

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.