扩展Delphi类层次结构

4
我希望能够在不改变原有继承关系的情况下扩展类功能,需要满足以下要求: 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的“base”实现?也许可以以某种方式处理接口?

或者,是否存在更好、更清晰的方法来解决这个问题?

谢谢。


你真的是想要只写 result := inherited SaveToText; 吗? - R-D
1
TDerivedClass_Text继承自TDerivedClass,而TDerivedClass没有SaveToText方法。 - OwK
我该如何在TDerivedClass_Text.SaveToText内部引用SaveToText的“base”实现呢?你不能这样做,因为它并不存在。实际上,你在注释中自己已经说明了这一点。你已经回答了自己的问题。 - David Heffernan
1
我喜欢Arioch的Helpers解决方案,它可能可行。但是我不能采用它,因为我需要将类扩展到其他方向。例如uClasses_Xml.pas、uClasses_DB.pas等。而Delphi仅支持一个类的帮助器。 - OwK
2
也许你应该退一步,考虑使用访问者模式。 - Uwe Raabe
显示剩余6条评论
3个回答

4
正如David所指出的,您不能引用不存在的基类方法。
使用类助手可以以另一种方式解决您的问题。第一个类助手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 对于一个类只允许 1 个类助手的限制,我无法使用它。我将需要以其他方式扩展我的类(如 SaveToXml、SaveToDB 等),每个类都必须驻留在不同的单元中。谢谢。 - OwK
@Arioch,这能帮助解决代码中一次只能激活一个辅助程序的问题吗? - David Heffernan
2
@Arioch'类助手继承确实可以帮助解决1个活动助手问题。不幸的是,由于某种原因,助手继承对记录助手无效:QC#107781 - David Heffernan
@DavidHeffernan,我不得不添加一个从TInterfacedObject继承的基对象,以使接口部分能够从您的编辑中正常工作。此外,还添加了一个完整的解决方案,基于类助手的继承。 - LU RD
@Arioch'The,感谢您关于类助手继承的提示。我以前从未听说过这个。在这里实现一个可行的解决方案确实是可能的。 - LU RD
显示剩余5条评论

1

由于Delphi不支持类的多重继承,因此您被推向这样的解决方案:

function BaseClassSaveToText(obj: TBaseClass): string;
begin
  Result := IntToStr(obj.ID) + ' ' + obj.Name;
end;

function TBaseClass_Text.SaveToText: String;
begin
  Result := BaseClassSaveToText(Self);
end;

function DerivedClassSaveToText(obj: TDerivedClass): string;
begin
  Result := BaseClassSaveToText(obj) + IntToStr(obj.Age) + ' ' + obj.Address;
end;

function TDerivedClass_Text.SaveToText: String;
begin
  Result := DerivedClassSaveToText(Self);
end;

DerivedClassSaveToText 中,您想要使用 inherited 关键字,但是由于这两个类没有共同的祖先,所以您不能使用它。 更新:@LU RD 展示了如何使用类助手完成所有操作。个人而言,我对类助手有点过敏。当然,您可能有其他不希望使用助手的原因。例如,如果您正在使用旧版本的 Delphi,则它们不存在。

谢谢你,David。这个方法可能可行,但是需要每个类知道它所属的层级。我想避免这种情况,因为我将处理非常复杂的层次结构。 - OwK
我知道,那是一个缺点。除了类助手,我看不到任何其他解决方法。 - David Heffernan
@David,当库被彻底重新设计(如DevEx)时,不得不移动旧代码库,这时候帮助程序确实非常有用。它们肯定是解决问题的权宜之计,而不是真正的解决方案。但对于某些情况下的类别,它们确实非常有用。 - Arioch 'The
坦白地说,接口委托和镜像类树也不是很优美的解决方案 :-) - Arioch 'The

1
诚实被高估了,这是根据...(我记不起来那首歌的名字了)。我认为我们中的许多人都过分评价继承,并且经常过于迅速地通过继承而不是组合或委托来解决问题。
我真的质疑每个类都要添加一个SaveToFile方法的愿望。
在我看来,类应该无知于它们存在的原因之外的责任。持久性就是这样的责任,打印另一个。打印类应该负责打印。当然,你不会希望打印类成为处理每个可感知的类的if语句的大蜂窝。所以你定义一个Printer基类,并用PeoplePrinter、LocationPrinter和WhateverPrinter后代扩展它。每个后代都可以处理整个类层次结构。
如果你现在想到了装饰器模式,很好,很敏锐。
这个想法是你不创建现有层次结构的后代,而是为特定的职责创建类和可能的类层次结构。当你想保存现有类的实例时,你会实例化一个TSaver并传递一个要保存的类的实例,而不是调用SomeClass.SaveToText。
一个非常天真的实现可能看起来像下面这样。
type
  TSaver = class(TObject)
    procedure SaveToText; virtual; abstract;
  end;

  TBaseHierarchySaver = class(TSaver)
  private
    FBase: TBaseClass;
  public
    constructor Create(aBase: TBaseClass);
    procedure SaveToText; override;

    class procedure Save(aBase: TBaseClass);
  end;

constructor TBaseHierarchySaver.Create(aBase: TBaseClass);
begin
  FBase := aBase;
end;

class procedure TBaseHierarchySaver.Save(aBase: TBaseClass);
var
  Me: TSaver;
begin
  Me := TBaseHierarchySaver.Create(aBase);
  Me.SaveToText;
end;

procedure TBaseHierarchySaver.SaveToText;
var
  Str: TStrings;
begin
  Str := TStringList.Create;
  try
    Str.Add(Format('%s (%d)', [FBase.Name, FBase.ID]));
    if FBase.InheritsFrom(TDerivedClass) then
    begin
      Str.Add(Format('%d', [TDerivedClass(FBase).Age]));
      Str.Add(Format('%s', [TDerivedClass(FBase).Address]));
    end;
  finally
    Str.SaveToFile('SomeFileName');
    Str.Free;
  end;
end;

我不太喜欢这个。它很脆弱。我们可以做得更好。

有许多方法可以使上述代码更加灵活和/或提供多态执行。例如,TSaver可以拥有一个与TBaseClass类相关联的匿名方法字典。然后,TSaver.SaveToText可以获取一个TBaseClass参数,并被实现为在传递给它的实例所继承的类与该匿名方法相关联时,执行该匿名方法的每个类。

type
  TBaseClassClass = class of TBaseClass;
  TAddInfoProc = reference to procedure(aBase: TBaseClass; aStr: TStrings);

  TSaver = class(TObject)
  class var
    FAddInfoClasses: TDictionary<TBaseClassClass, TAddInfoProc>;
  public
    class procedure RegisterAddInfoProc(aBase: TBaseClassClass; 
      aAddInfo: TAddInfoProc);

    class procedure SaveToText(aBase: TBaseClass);
  end;

TSaver.RegisterAddInfoProc(TBaseClass, procedure(aBase: TBaseClass; aStr: TStrings)
  begin
    aStr.Add(Format('%s (%d)', [aBase.Name, aBase.ID]));
  end
);

TSaver.RegisterAddInfoProc(TDerivedClass, procedure(aBase: TBaseClass; aStr: TStrings)
  begin
    aStr.Add(Format('%d', [TDerivedClass(FBase).Age]));
    aStr.Add(Format('%s', [TDerivedClass(FBase).Address]));
  end
);

这样可以使您摆脱继承层次结构的束缚,但如果您想要多态执行,可以将其更改为将特定的TBaseClass后代与匹配的“AddInfo”后代层次结构相关联的字典,其中每个AddInfo后代都会添加自己的信息:

type
  TAddInfo = class(TObject)
  public
    procedure AddInfo(aBase: TBaseClass; aStr: TStrings); virtual;
  end;

  TDerivedAddInfo = class(TAddInfo)
  public
    procedure AddInfo(aBase: TBaseClass; aStr: TStrings); override;
  end;

procedure TAddInfo.AddInfo(aBase: TBaseClass; aStr: TStrings);
begin
  aStr.Add(Format('%s (%d)', [aBase.Name, aBase.ID]));
end;

procedure TDerivedAddInfo.AddInfo(aBase: TBaseClass; aStr: TStrings);
var
  Derived: TDerivedClass absolute aBase;
begin
  inherited;
  if not aBase.InheritsFrom(TDerivedClass) then Exit;

  aStr.Add(Format('%d', [Derived.Age]));
  aStr.Add(Format('%s', [Derived.Address]));
end;

type
  TBaseClassClass = class of TBaseClass;
  TAddInfoClass = class of TAddInfo;

  TSaver = class(TObject)
  class var
    FAddInfoClasses: TDictionary<TBaseClassClass, TAddInfoClass>;
  public
    class procedure RegisterAddInfoClass(aBase: TBaseClassClass; 
      aAddInfo: TAddInfoClass);

    class procedure SaveToText(aBase: TBaseClass);
  end;

顺便说一下,这看起来非常像其他地方提出的类助手方法,但没有每次只能有一个类助手处于活动状态的限制。因此,您可以使用TSaver、TPrinter、TMailer和任何其他您想要执行的与TBaseClass无关的操作。

哦,顺便说一下,上面对absolute的使用是我能够接受的极少数绝对使用情况之一。它是硬转换的方便简写,由早期退出约束条件保证安全,而早期退出本身也是我能够接受的极少数早期退出用例之一 :-)


如果IDE解析器能够正确地使用“absolute”关键字就好了...顺便说一句,将“absolute”作为类型声明的一部分而不是变量名声明的一部分也是Borland的另一种疯狂做法 :-) - Arioch 'The
你能提供你的解决方案的完整单元接口+实现吗?我不太理解如何将它们组合在一起。 - OwK
@OwK:嗯,我会看看这个周末是否有时间。不过不能保证。 - Marjan Venema
@OwK: 为您提供一个示例项目,其中包括并行层次结构和匿名方法注册的示例代码。我甚至可能会写一篇关于这个的文章,但那得等等了。示例可以在以下网址找到:http://bjmsoftware.com/delphistuff/stackoverflow/extend-delphi-class-hierarchy%20(Q_11883474).zip - Marjan Venema

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接