Question

我想知道如何使用其他功能扩展类层次结构，遵循以下要求： 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的“基础”实现？也许以某种方式处理界面？

或者，对这种情况确实存在更好，更清晰的方法吗？

谢谢，

Answer 1

正如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等。

Answer 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，则它们不存在。

Answer 3

根据......（不记得这首歌），诚实被高估了。我认为我们中的许多人都在高估继承权，而且往往过于迅速地解决继承问题而非组成或授权问题。

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

在我看来，课程应该不知道责任，而不是他们存在的原因。坚持就是这样一种责任，打印另一种。印刷类应负责印刷。当然，你不希望打印类成为if语句的大网，以处理你想要打印的每个可感知的类。因此，您定义了一个Printer基类，并使用PeoplePrinter，LocationPrinter和WhateverPrinter后代对其进行扩展。每个都可以处理整个类层次结构。

如果你现在正在考虑装饰模式，那么好，很好看。

我们的想法是，您不为现有层次结构创建后代，但您可以为特定职责创建类和可能的类层次结构。如果要保存现有类的实例，而不是调用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的其他任何其他主要责任。

哦，顺便说一下，绝对的上述使用绝对是我能忍受的绝对用例之一。对于通过提前退出限制而变得安全的硬铸造来说，这是一种方便的短手，这种限制本身也是我可以忍受的早期退出的少数用例之一： - ）

扩展delphi类层次结构

3 个答案: