1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

destructor THaus.Destroy;
begin
  // Bild löschen
  with FContainer do
  begin
    Brush.Color := clWhite;
    Pen.Color := clWhite;
    Rectangle(FX-7,FY,FX+FWidth+7,FY-FHeight-2*FR-2);
  end;
  // Objekt entfernen
  inherited Destroy;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:

UNIT mTHaus;

interface

uses
  Graphics, Types;

type
  THaus = class

  private //Attribute
    FDoorOpen : boolean;
    FLightOn : boolean;
    FHeight : integer;
    FR : integer;
    FWidth : integer;
    FX : integer;
    FY : integer;
    FContainer : TCanvas;
    FRoofColor : TColor;
    FWallColor : TColor;

  private //Methoden
    procedure Delete; virtual;
    procedure DrawDoor; virtual;
    procedure DrawRoof; virtual;
    procedure DrawWall; virtual;
    procedure DrawWindow; virtual;

  public //Methoden
    constructor Create (x: integer; y: integer; w: integer; rc: tColor; wc: TColor; Container: TCanvas); virtual;
    procedure CloseDoor; virtual;
    procedure DrawHouse; virtual;
    procedure DrawNew (x: integer; y: integer; w: integer; rc: tColor; wc: TColor); virtual;
    procedure LightOff; virtual;
    procedure LightOn; virtual;
    procedure OpenDoor; virtual;
    function IsDoorOpen : boolean; virtual;
    function IsLightOn : boolean; virtual;
    destructor Destroy; virtual;

   end;

implementation                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

type
  TMyClass = class
  public
     procedure Test;
     destructor Destroy; override;
  end;
...
destructor TMyClass.Destroy;
begin
  inherited Destroy;
end;
...
  with TMyClass.Create do
   try
     Test;
   finally
      Free;
      Test; // Wird ohne Fehler aufgerufen
   end;                    

1:
2:
3:
4:
5:

procedure TMyclass.Test;
begin
  fZahl := 3;
  ShowMessage(IntToStr(fZahl));
end;                    

1:
2:
3:

destructor TObject.Destroy;
begin
end;                    

1:
2:
3:
4:
5:

procedure TObject.Free;
begin
  if Self <> nil then
    Destroy;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

procedure TFrmMain.BtnCreateHouseClick(Sender: TObject);
var
  x, y, b : integer;
  rc, wc : TColor;
begin
  GetParameter(x,y,b,rc,wc);
  Haus:= THaus.Create(x,y,b,rc,wc,FrmMain.Canvas);
  Haus.DrawHouse;
end;

...

constructor THaus.Create (x: integer; y: integer; w: integer; rc: tColor; wc: TColor; Container: TCanvas);
begin
  inherited Create;
  FX := x;
  FY := y;
  FWidth := w;
  FR := FWidth div 5;
  FHeight := FWidth;
  FLightOn := false;
  FDoorOpen := false;
  FRoofColor := rc;
  FWallColor := wc;
  FContainer := Container;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:

procedure TFrmMain.BtnDestroyHouseClick(Sender: TObject);
begin
  try
    FreeAndNil(Haus);
    FrmHouse.Hide;
  except
    ShowMessage('Haus kann nicht entfernt werden, da nicht mehr da.'); //sollte eigentlich nie eintreten
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

procedure TFrmMain.Change(Sender: TObject);
var
  x, y, w: integer;
  rc, wc: TColor;
begin
  try
    GetParameter(x,y,w,rc,wc);
    if Assigned(Haus) then       //  <--<<
      Haus.DrawNew(x,y,w,rc,wc);
  except
    ShowMessage('Haus wurde noch nicht erstellt.');
  end;
end;