扩展delphi类层次结构

问题描述

我想知道如何使用附加功能扩展类层次结构，遵循以下条件：
1）我无法触摸原始层次结构
2）我需要将新功能开发到不同的单元中

以 uClasses.pas 单位为例，以下课程层次结构：

  TBaseClass = class 
 ID：Integer; 
名称：String; 
结束
 
 TDerivedClass = class（TBaseClass）
年龄：整数
地址：String 
 end; 
  

我想为类附加其他功能，例如将其自己保存为文本（它只是一个例）。所以我想象以下单元 uClasses_Text.pas ：

 使用uClasses; 
 
 Itextable = interface 
函数SaveToText：String; 
结束
 
 TBaseClass_Text = class（TBaseClass，Itextable）
函数SaveToText：String; 
结束
 
 TDerivedClass_Text = class（TDerivedClass，ITextable）
函数SaveToText：String; 
结束
 
函数TBaseClass_Text.SaveToText：String; 
 begin 
 result：= Self.ID +''+ Self.Name; 
结束
 
函数TDerivedClass_Text.SaveToText：String; 
 begin 
 //派生类上的SaveToText必须从BaseClass调用SaveToText，然后附加其他字段
 result：= ???? //调用TBaseClass_Text.SaveToText。或者更好，ITextable（Self.ParentClass）.SaveToText; 
 result：= result + Self.Age +''+ Self.Address; 
结束
  

如何从TDerivedClass_Text.SaveToText中引用SaveToText的base实现？可能以某种方式处理界面？

或者，
在这种情况下是否存在一种更好和更干净的方法？

谢谢，

解决方案

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

与类帮助者可以以其他方式解决您的问题。
第一类帮助器 TBaseClassHelper 添加一个 SaveToText 函数，所以第二个类帮助器 TDerivedClassHelper 。
查看第二个 SaveToText 函数的实现。它调用继承的SaveToText 。

更新2

OP要求不同的 SaveTo 实现单元。在David和Arioch的评论的帮助下，类助手可以从其他班级助手继承。这是一个完整的例子：

  unit uClasses; 
 
 type 
 
 TBaseClass = class 
 ID：Integer; 
名称：String; 
结束
 
 TDerivedClass = class（TBaseClass）
年龄：整数; 
地址：String; 
结束
  

---

 单位uClasses_Text; 
 
使用uClasses，uClasses_SaveToText，uClasses_SaveToIni，uClasses_SaveToDB; 
 
 type 
 ITextable = interface 
函数SaveToText：string; 
函数SaveToIni：string; 
函数SaveToDB：string; 
结束
 
 //通过接口添加引用计数，因为多个继承
 //是不可能的（TInterfacedObject和TBaseClass）
 TBaseClass_Text = class（TBaseClass，IInterface，ITextable）
 strict private 
 FRefCount：Integer; 
 protected 
 function QueryInterface（const IID：TGUID; out Obj）：HResult;标准
 function _AddRef：Integer;标准
函数_Release：整数;标准
结束
 
 TDerivedClass_Text = class（TDerivedClass，IInterface，ITextable）
 strict private 
 FRefCount：Integer; 
 protected 
 function QueryInterface（const IID：TGUID; out Obj）：HResult;标准
 function _AddRef：Integer;标准
函数_Release：整数;标准
结束
 
实现
 
使用Windows; 
 
函数TBaseClass_Text.QueryInterface（const IID：TGUID; out Obj）：HResult; 
 begin 
如果GetInterface（IID，Obj）然后
结果：= 0 
 else 
结果：= E_NOINTERFACE; 
结束
 
函数TBaseClass_Text._AddRef：Integer; 
 begin 
结果：= InterlockedIncrement（FRefCount）; 
结束
 
函数TBaseClass_Text._Release：Integer; 
 begin 
结果：= InterlockedDecrement（FRefCount）; 
 if Result = 0 then 
 Destroy; 
结束
 
函数TDerivedClass_Text.QueryInterface（const IID：TGUID; out Obj）：HResult; 
 begin 
如果GetInterface（IID，Obj）然后
结果：= 0 
 else 
结果：= E_NOINTERFACE; 
结束
 
函数TDerivedClass_Text._AddRef：Integer; 
 begin 
结果：= InterlockedIncrement（FRefCount）; 
结束
 
函数TDerivedClass_Text._Release：Integer; 
 begin 
结果：= InterlockedDecrement（FRefCount）; 
 if Result = 0 then 
 Destroy; 
结束
  

---

  uClasses_SaveToText; 
 
接口
 
使用uClasses; 
 
 type 
 TBaseClassHelper = TBaseClass的类助手
函数SaveToText：string; 
结束
 
 TDerivedClassHelper = TDerivedClass的类助手
函数SaveToText：string; 
结束
 
实现
 
函数TBaseClassHelper.SaveToText：string; 
 begin 
结果：='BaseClass Text info'; 
结束
 
函数TDerivedClassHelper.SaveToText：string; 
 begin 
结果：=继承SaveToText; 
结果：= Result +'DerivedClass Text info'; 
结束
  

---

  uClasses_SaveToIni; 
 
接口
 
使用uClasses，uClasses_SaveToText; 
 
类型
 TBaseClassHelperIni = TBaseClass的类助手（TBaseClassHelper）
函数SaveToIni：string; 
结束
 
 TDerivedClassHelperIni = TDerivedClass的类助手（TDerivedClassHelper）
函数SaveToIni：string; 
结束
 
实现
 
函数TBaseClassHelperIni.SaveToIni：string; 
 begin 
结果：='BaseClass Ini info'; 
结束
 
函数TDerivedClassHelperIni.SaveToIni：string; 
 begin 
结果：=继承SaveToIni; 
结果：= Result +'DerivedClass Ini info'; 
结束
  

---

  uClasses_SaveToDB; 
 
接口
 
使用uClasses，uClasses_SaveToText，uClasses_SaveToIni; 
 
键入
 TBaseClassHelperDB = TBaseClass的类助手（TBaseClassHelperIni）
函数SaveToDB：string; 
结束
 
 TDerivedClassHelperDB = TDerivedClass的类助手（TDerivedClassHelperIni）
函数SaveToDB：string; 
结束
 
实现
 
函数TBaseClassHelperDB.SaveToDB：string; 
 begin 
结果：='BaseClass DB info'; 
结束
 
函数TDerivedClassHelperDB.SaveToDB：string; 
 begin 
结果：=继承SaveToDB; 
结果：= Result +'DerivedClass DB info'; 
结束
  

---

 程序TestClasses; 
 
使用'uClasses.pas'中的
 uClasses，'uClasses_Text.pas'中的
 uClasses_Text，'uClasses_SaveToText.pas'中的
 uClasses_SaveToText，
 uClasses_SaveToIni在'uClasses_SaveToIni.pas'中，
 uClasses_SaveToDB在'uClasses_SaveToDB.pas'; 
 var 
 Textable：ITextable; 
 begin 
 Textable：= TDerivedClass_Text.Create; 
 WriteLn（Textable.SaveToText）; 
 WriteLn（Textable.SaveToIni）; 
 WriteLn（Textable.SaveToDB）; 
 ReadLn; 
结束。 
  

更新1

阅读您关于需要实施 SaveToText 的几个方面的意见我建议一个简单的背负式解决方案：

 键入
 ITextable = interface 
函数SaveToText：String; 
结束
 TMyTextGenerator = class（TInterfacedObject，ITextable）
 private 
 Fbc：TBaseClass; 
 public 
构造函数Create（bc：TBaseClass）; 
函数SaveToText：String; 
结束
 
 {TMyTextGenerator} 
 
构造函数TMyTextGenerator.Create（bc：TBaseClass）; 
 begin 
 Inherited Create; 
 Fbc：= bc; 
结束
 
函数TMyTextGenerator.SaveToText：String; 
 begin 
结果：= IntToStr（Fbc.ID）+''+ Fbc.Name; 
如果Fbc是TDerivedClass然后
 begin 
结果：= Result +''+ IntToStr（TDerivedClass（Fbc）.Age）+''+ 
 TDerivedClass（Fbc）.Address; 
结束
结束
  

以不同的单位实现相同模式的TSaveToIni，TSaveToDB等。

I am wondering how to extend a class hierarchy with additional capabilities, following this requisites:1) I cannot touch the original hierarchy2) I need to develop the new features into a different unit

Take for example the following class hierarchy in uClasses.pas unit:

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

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

I want to attach other functionality to the classes, for example saving itself to text (it is just an example). So I imagined the following unit 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;

How can I refer to "base" implementation of SaveToText from within TDerivedClass_Text.SaveToText? Maybe handling the interface in some way?

Or,does exists a better and cleaner approach to this case?

Thanks,

解决方案

As pointed out by David, you cannot refer to a method in your base class that does not exists.

With class helpers it's possible to solve your question in another way.The first class helper TBaseClassHelper adds a SaveToText function and so do the second class helper TDerivedClassHelper.Look at the implementation of this second SaveToText function. It calls inherited SaveToText.

Update 2

The OP wanted separate units for different SaveTo implementations. With the help from comments by David and Arioch, it turns out that class helpers can inherit from other class helpers. Here is a complete example:

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.

Update 1

Reading your comments about the need to implement several aspects of the SaveToText I propose a simple piggy-back solution:

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;

Implement TSaveToIni,TSaveToDB etc, with the same pattern in separate units.

这篇关于扩展delphi类层次结构的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！