【问题标题】:Extend delphi class hierarchy扩展delphi类层次结构
【发布时间】:2012-08-06 16:22:05
【问题描述】:

我想知道如何按照以下要求扩展具有附加功能的类层次结构: 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 的“基本”实现?也许以某种方式处理界面?

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

谢谢,

【问题讨论】:

  • 你真的是说result := inherited SaveToText; 吗?
  • TDerivedClass_Text 继承自 TDerivedClass,没有 SaveToText
  • Delphi 中没有多重继承,因此您必须扩展层次结构的每个单独分支。
  • 我喜欢 Arioch 的 Helpers 解决方案,它可以工作。但我不能采用它,因为我需要在其他方向扩展这些类。示例 uClasses_Xml.pas、uClasses_DB.pas 等。而 Delphi 仅支持 1 个类帮助器
  • 也许你应该退一步考虑使用访客模式。

标签: delphi design-patterns interface


【解决方案1】:

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

借助类助手,您可以通过其他方式解决您的问题。 第一类助手TBaseClassHelper 添加了一个SaveToText 函数,第二类助手TDerivedClassHelper 也是如此。 查看第二个SaveToText 函数的实现。它调用inherited SaveToText

更新 2

OP 想要为不同的 SaveTo 实现单独的单元。在 David 和 Arioch 的 cmets 的帮助下,类助手可以从其他类助手继承。这是一个完整的例子:

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

阅读您的 cmets 关于实现 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 等,在不同的单元中使用相同的模式。

【讨论】:

  • 我也更新了答案以涵盖ITextable 角度。希望你不要介意!
  • 正如我在另一条评论中所写,我在技术上喜欢这个解决方案,它以一种干净的方式解决了问题。但是,我不能使用它,因为 Delphi 限制了 1 个类帮助器。我将需要以其他方式扩展我的类(SaveToXml、SaveToDB 等),每个都必须驻留在不同的单元中。谢谢
  • 助手也可以互相继承
  • @Arioch'The Can 可以帮助解决在代码问题的任何一点上都处于活动状态的 1 个助手?
  • @Arioch'类助手继承确实可以帮助解决 1 个活动助手问题。遗憾的是,由于某种原因,助手继承不适用于记录助手:QC#107781
【解决方案2】:

由于 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,当库像 DevEx 这样被彻底重新设计时,不得不移动旧的代码库,那么助手会提供很大的帮助。它们肯定是变通方法而不是解决方案。但对于某些类别的情况,它们有很大帮助。
  • 坦率地说,接口委托和镜像类树也不是漂亮的解决方案:-)
【解决方案3】:

根据......(不记得那首歌),诚实被高估了。我认为我们中的许多人都高估了继承,并且在解决继承问题而不是组合或委托方面往往过于迅速。

我真的怀疑是否希望将 SaveToFile 方法添加到您希望能够持久保存到文件的每个类中。

在我看来,类应该不知道不是它们存在的原因的职责。坚持是一种责任,印刷是另一种责任。一个打印类应该负责打印。当然,您不希望打印类成为 if 语句的黄蜂网来处理您想要打印的每个可感知的类。因此,您定义了一个 Printer 基类,并使用 PeoplePrinter、LocationPrinter 和 WhatPrinter 后代扩展它。每个都可以处理整个类层次结构。

如果您现在正在考虑装饰器模式,很好,很好。

这个想法是您为现有层次结构创建后代,但您为特定职责创建类和可能的类层次结构。如果要保存现有类的实例,而不是调用 SomeClass.SaveToText,您可以实例化 TSaver 并将其传递给要保存的类的实例。

非常幼稚的实现可能如下所示。

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 的使用是我能忍受的为数不多的 absolute 用例之一。对于硬演员来说,这是一种方便的简写,它通过提前退出约束而变得安全,这本身也是我可以忍受的为数不多的提前退出用例之一:-)

【讨论】:

  • 如果只有 IDE 解析器可以使用绝对关键字正确工作... PS 将“Absolute”作为类型声明的一部分而不是 var 名称声明是 Borland 的另一个疯狂:-)
  • 能否为您的解决方案提供完整的单元接口+实现?我不太明白如何将棋子组合在一起。
  • @OwK:嗯。我看看周末能不能找点时间。虽然没有承诺。
  • @OwK:为您编写一个示例项目,其中包含并行层次结构和匿名方法注册表的示例代码。甚至可以写一篇关于它的文章,但这将不得不等待。示例见:bjmsoftware.com/delphistuff/stackoverflow/…
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 2016-08-26
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多