Abgeleitete Klasse eines Singleton Objekts

[t2000]

Für die Interessierten, hier der Code, der anscheinend funktioniert:

Delphi-Quellcode:

//*******************
// Basisunit
//*******************
type
  TsngColumnsOwnerClass = class of TsngColumnsOwner;

  TsngColumnsOwner = class
  private
    FInitialized: Boolean;
  protected
    function CreateColumns: TsngColumns; virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    property Initialized: Boolean read FInitialized write FInitialized;
  end;

  TsngColumnDescription = class
  private
    class var FInstance: TsngColumnDescription;
  protected
    FsngColumnsOwner: TsngColumnsOwner;
    function GetSngColumnsOwner: TsngColumnsOwner; virtual;
  public
    constructor Create( AClass: TsngColumnsOwnerClass);
    class function this( AClass: TsngColumnsOwnerClass): TsngColumnDescription; virtual;
    class destructor Destroy;
    property CD: TsngColumnsOwner read GetSngColumnsOwner;
  end;


{ TsngColumnsOwner }

constructor TsngColumnsOwner.Create;
begin
  inherited Create;
  FInitialized := False;
end;

destructor TsngColumnsOwner.Destroy;
begin
  inherited Destroy;
end;

function TsngColumnsOwner.CreateColumns: TsngColumns;
begin
  Result := TsngColumns.Create(Self);
end;

{ TsngColumnDescription }

class destructor TsngColumnDescription.Destroy;
begin
  if Assigned( FInstance) then begin
    FInstance.FsngColumnsOwner.Free;
    FreeAndNil( FInstance);
  end;
end;

constructor TsngColumnDescription.Create( AClass: TsngColumnsOwnerClass);
begin
  Inherited Create;
  FsngColumnsOwner := AClass.Create;
end;

class function TsngColumnDescription.this( AClass: TsngColumnsOwnerClass): TsngColumnDescription;
begin
  if not Assigned( FInstance) then begin
    FInstance := TsngColumnDescription.Create( AClass);
  end;
  Result := FInstance;
end;

function TsngColumnDescription.GetSngColumnsOwner: TsngColumnsOwner;
begin
  Result := FsngColumnsOwner;
end;


//***************************
// Beispiel Unit Ableitung   
//***************************

type
  TColKaoPfand = class( TsngColumnDescription)
  protected
    function GetSngColumnsOwner: TkaoPfandColumnDescription; reintroduce;
  public
    class function this: TColKaoPfand; reintroduce;
    property CD: TkaoPfandColumnDescription read GetSngColumnsOwner;
  end;

class function TColKaoPfand.this: TColKaoPfand;
begin
  Result := TColKaoPfand( inherited this( TkaoPfandColumnDescription));
end;

function TColKaoPfand.GetSngColumnsOwner: TkaoPfandColumnDescription;
begin
  Result := TkaoPfandColumnDescription( inherited GetSngColumnsOwner);
end;

Das Object TkaoPfandColumnDescription: TSngColumnsOwner kann dann beliebig aussehen.