Zugriff auf Unterklasse absichern

[Blup]

Destructor Destroy natürlich immer "override". "reintroduce" unterdrückt zwar die Warnung des Compilers wenn "override" vergessen wurde. Das führt aber dazu, das dieser Destructor z.B. beim Aufruf von Free nicht aufgerufen wird.

Ein Beispiel für eine Lösung mit Nullobject:

Delphi-Quellcode:

  TMethode = class
  protected
    class var FNullObject: TMethode;
    class function CreateNullObject: TMethode;
    class function GetNullObject: TMethode;
  public
    class property NullObject: TMethode read GetNullObject;
  private
    FNo: Integer;
    FName: String;
  protected
    procedure SetNo(AValue: Integer); virtual;
    procedure SetName(const AValue: string); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    function IsNullObject: Boolean;
    property No: Integer read FNo write SetNo;
    property Name: String read FName write SetName;
  end;

  TAnalyse = class
  private
    FNo: Integer;
    FName: String;
    FMethode : TMethode;
    function GetMethode: TMethode;
    procedure SetMethode(AValue: TMethode);
  public
    constructor Create;
    destructor Destroy; override;
    property No: Integer read FNo write FNo;
    property Name: String read FName write FName;
    property Methode: TMethode read GetMethode write SetMethode;
  end;

implementation

class function TMethode.CreateNullObject: TMethode;
begin
  Result := TMethode.Create;
end;

class function TMethode.GetNullObject: TMethode;
begin
  if not Assigned(FNullObject) then
    FNullObject := CreateNullObject;

  Result := FNullObject;
end;

procedure TMethode.SetNo(AValue: Integer);
begin
  if IsNullObject then
    Exit;

  FNo := AValue;
end;

procedure TMethode.SetName(const AValue: string);
begin
  if IsNullObject then
    Exit;

  FName := AValue; 
end;

function TMethode.IsNullObject: Boolean;
begin
  Result := (Self = FNullObject);
end;

destructor TMethode.Destroy;
begin
  if IsNullObject then
    FNullObject := nil;

  inherited;
end;

function TAnalyse.GetMethode: TMethode;
begin
  if Assigned(FMethode) then
    Result := FMethode
  else
    Result := TMethode.NullObject;
end;

procedure TAnalyse.SetMethode(AValue: TMethode);
begin
  if AValue.IsNullObject then
    FMethode := nil
  else
    FMethode := AValue;
end;

finalization
  TMethode.FNullObject.Free; // oder im class-destructor

end.