delphi - 扩展delphi类层次结构

我想知道如何按照以下要求扩展具有附加功能的类层次结构:
1)我无法触及原始层次结构
2)我需要将新功能开发到不同的单元中

以 uClasses.pas 单元中的以下类层次结构为例:

TBaseClass = class
  ID : Integer;
  Name : String;
end;

TDerivedClass = class(TBaseClass)
  Age : Integer
  Address : String
end;

我想将其他功能附加到类，例如将自身保存为文本(这只是一个示例)。所以我想象了以下单位 uClasses_Text.pas :

uses uClasses;

Itextable = interface
  function SaveToText: String;
end;

TBaseClass_Text = class(TBaseClass, Itextable)
  function SaveToText: String;
end;

TDerivedClass_Text = class(TDerivedClass, ITextable)
  function SaveToText: String;
end;

function TBaseClass_Text.SaveToText: String;
begin
  result := Self.ID + ' ' + Self.Name;
end;

function TDerivedClass_Text.SaveToText: String;
begin
  // SaveToText on derived class must call SaveToText from the "BaseClass" and then append its additional fields
  result := ???? // Call to TBaseClass_Text.SaveToText. Or better, ITextable(Self.ParentClass).SaveToText;
  result := result + Self.Age + ' ' + Self.Address;
end;

如何从 TDerivedClass_Text.SaveToText 中引用 SaveToText 的“基本”实现？也许以某种方式处理界面？

或者，
对于这种情况，是否存在更好、更清洁的方法？

谢谢，

最佳答案

正如 David 所指出的，您不能引用基类中不存在的方法。

有了类(class)助手，就可以用另一种方式解决您的问题。
第一类助手 TBaseClassHelper 添加了一个 SaveToText 函数，第二类助手 TDerivedClassHelper 也是如此。
看看第二个 SaveToText 函数的实现。它调用 inherited SaveToText 。

更新 2

OP 希望为不同的 SaveTo 实现使用单独的单元。在 David 和 Arioch 评论的帮助下，类助手可以从其他类助手继承。这是一个完整的例子:

unit uClasses;

type

  TBaseClass = class
    ID: Integer;
    Name: String;
  end;

  TDerivedClass = class(TBaseClass)
    Age: Integer;
    Address: String;
  end;

unit uClasses_Text;

uses uClasses,uClasses_SaveToText,uClasses_SaveToIni,uClasses_SaveToDB;

type
  ITextable = interface
    function SaveToText: string;
    function SaveToIni: string;
    function SaveToDB: string;
  end;

  // Adding reference counting through an interface, since multiple inheritance
  // is not possible (TInterfacedObject and TBaseClass)
  TBaseClass_Text = class(TBaseClass, IInterface, ITextable)
  strict private
    FRefCount: Integer;
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

  TDerivedClass_Text = class(TDerivedClass, IInterface, ITextable)
  strict private
    FRefCount: Integer;
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

implementation

uses Windows;

function TBaseClass_Text.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TBaseClass_Text._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TBaseClass_Text._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
    Destroy;
end;

function TDerivedClass_Text.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TDerivedClass_Text._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TDerivedClass_Text._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
    Destroy;
end;

unit uClasses_SaveToText;

interface

uses uClasses;

type
  TBaseClassHelper = class helper for TBaseClass
    function SaveToText: string;
  end;

  TDerivedClassHelper = class helper for TDerivedClass
    function SaveToText: string;
  end;

implementation

function TBaseClassHelper.SaveToText: string;
begin
  Result := 'BaseClass Text info';
end;

function TDerivedClassHelper.SaveToText: string;
begin
  Result := inherited SaveToText;
  Result := Result + ' DerivedClass Text info';
end;

unit uClasses_SaveToIni;

interface

Uses uClasses,uClasses_SaveToText;

type
  TBaseClassHelperIni = class helper(TBaseClassHelper) for TBaseClass
    function SaveToIni: string;
  end;

  TDerivedClassHelperIni = class helper(TDerivedClassHelper) for TDerivedClass
    function SaveToIni: string;
  end;

implementation

function TBaseClassHelperIni.SaveToIni: string;
begin
  Result := 'BaseClass Ini info';
end;

function TDerivedClassHelperIni.SaveToIni: string;
begin
  Result := inherited SaveToIni;
  Result := Result + ' DerivedClass Ini info';
end;

unit uClasses_SaveToDB;

interface

Uses uClasses,uClasses_SaveToText,uClasses_SaveToIni;

Type
  TBaseClassHelperDB = class helper(TBaseClassHelperIni) for TBaseClass
    function SaveToDB: string;
  end;

  TDerivedClassHelperDB = class helper(TDerivedClassHelperIni) for TDerivedClass
    function SaveToDB: string;
  end;

implementation

function TBaseClassHelperDB.SaveToDB: string;
begin
  Result := 'BaseClass DB info';
end;

function TDerivedClassHelperDB.SaveToDB: string;
begin
  Result := inherited SaveToDB;
  Result := Result + 'DerivedClass DB info';
end;

program TestClasses;

uses
  uClasses in 'uClasses.pas',
  uClasses_Text in 'uClasses_Text.pas',
  uClasses_SaveToText in 'uClasses_SaveToText.pas',
  uClasses_SaveToIni in 'uClasses_SaveToIni.pas',
  uClasses_SaveToDB in 'uClasses_SaveToDB.pas';
var
  Textable: ITextable;
begin
  Textable := TDerivedClass_Text.Create;
  WriteLn(Textable.SaveToText);
  WriteLn(Textable.SaveToIni);
  WriteLn(Textable.SaveToDB);
  ReadLn;
end.

更新 1

阅读您关于需要实现 SaveToText 的几个方面的评论，我提出了一个简单的搭载解决方案:

type
  ITextable = interface
    function SaveToText: String;
  end;
  TMyTextGenerator = class(TInterfacedObject,ITextable)
  private
    Fbc : TBaseClass;
  public
    constructor Create( bc : TBaseClass);
    function SaveToText: String;
  end;

{ TMyTextGenerator }

constructor TMyTextGenerator.Create(bc: TBaseClass);
begin
  Inherited Create;
  Fbc := bc;
end;

function TMyTextGenerator.SaveToText: String;
begin
  Result := IntToStr(Fbc.ID) + ' ' + Fbc.Name;
  if Fbc is TDerivedClass then
  begin
    Result := Result + ' ' + IntToStr(TDerivedClass(Fbc).Age) + ' ' +
      TDerivedClass(Fbc).Address;
  end;
end;

在不同的单元中使用相同的模式实现 TSaveToIni、TSaveToDB 等。

关于delphi - 扩展delphi类层次结构，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/11883474/