Delphi implements 委托 转

Delphi 里的接口聚合的写法转 百毒空间，百毒不侵

unit Unit1;

{-----------------------------------------------------------------------------

  本程序演示接口委托聚合：

  TMyClass 拥有并实现了 IMyTask 接口

  TMyPlan 类拥有 IMyTask 接口，但没有去实现这个接口里的 SayHell 方法，而是通过

  property MyTask: IMyTask read FMyClass implements IMyTask; 语句，将这个实现委托给内部的 FMyClass 接口实现。

  传统的面向类的代码，当做一个包装类，包装多个子类在里面的时候，要在包装类的 public 里

  再实现一次子类里的方法，在实现的方法里再调用子类的方法。这种办法也有人称为【委托】。

  如果采用接口委托，则不用重复写代码，直接写一句：

  property MyTask: IMyTask read FMyClass implements IMyTask; 则包装类

  就不用在 public 里再次重复实现一次接口里的函数方法等等了。这种办法也有人称为【聚合】

  以下代码测试通过。

  pcplayer 2011-10-23 星期日。

-----------------------------------------------------------------------------}

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

type
IMyTask = Interface
    ['{1B9D204E-1662-4280-A8E6-D7F518A425F5}']
    function SayHello: string;
  End;

  TMyClass = class(TInterfacedObject, IMyTask)
  private
  public
    function SayHello: string;//实现
  end;
  TMyPlan = class(TInterfacedObject, IMyTask)
  private
    FMyClass: IMyTask;
  public
    constructor Create;  //没有实现   SayHello ,通过  FMyClass实现SayHello
    property MyTask: IMyTask read FMyClass implements IMyTask;
  end;
  TForm1 = class(TForm)

    Button1: TButton;

    Label1: TLabel;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyClass }

function TMyClass.SayHello: string;
begin
  Result := 'Hello';
end;

{ TMyPlan }
constructor TMyPlan.Create;
begin
  inherited;
  FMyClass := TMyClass.Create as IMyTask;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyPlan: IMyTask;
begin
  MyPlan := TMyPlan.Create;
  Label1.Caption := MyPlan.SayHello;
  MyPlan := nil;

end;

end.

delphi中接口的委托和聚合  转http://blog.163.com/liang_liu99/blog/static/884152162009827104444775/

委托：
当存在两个接口，和两个类；这两个类分别实现了两个接口；
现在需要一个创建一个类支持这两个接口，为了不采用重复的工作
就可以在Create方法中，创建实现了这两个接口的类，然后委托这两个实现了接口的方法去实现功能
代码如下：
type
ISomeIntf = interface
['{E3285C36-B73B-4F36-8AA1-904F76FBC9E8}']
    procedure Msg;
end;

IOtherIntf = interface
['{271DC3C3-E29E-4D2A-A05D-C3DAC641D723}']
    function Check: Boolean;
end;

TSome( ISomeIntf)
protected
    procedure Msg;
end;

TOther (IOtherIntf)
protected
    function Check: Boolean;
end;

TIntf (IUnknown, ISomeIntf, IOtherIntf)
private
    // declare objects to delegate to
    FSomeClass: ISomeIntf;
    FOtherClass: IOtherIntf;
protected
    // ISomeIntf
    procedure Msg;
    // IOtherIntf
    function Check: Boolean;
public
    constructor Create;
end;

{ TIntfClass }

constructor TIntfClass.Create;
begin
inherited;
// create objects for delegation
FSomeClass:= TSomeClass.Create;
FOtherClass:= TOtherClass.Create;
end;

function TIntfClass.Check: Boolean;
begin
// delegate work
Result:= FOtherClass.Check;
end;

procedure TIntfClass.Msg;
begin
// delegate work
FSomeClass.Msg;
end;

聚合
关键字implements使得一个类通过对象或者接口属性引用（已经实现了接口的类引用）来实现这个类所支持的接口，不用为起支持的接口编写代码。
示例代码如下：
type
ISomeIntf = interface
['{E3285C36-B73B-4F36-8AA1-904F76FBC9E8}']
    procedure Msg;
end;

IOtherIntf = interface
['{271DC3C3-E29E-4D2A-A05D-C3DAC641D723}']
    function Check: Boolean;
end;

TSome ISomeIntf)
protected
    procedure Msg;
end;

TOther IOtherIntf)
protected
    function Check: Boolean;
end;

TIntf IUnknown, ISomeIntf, IOtherIntf)
private
    FSomeClass: ISomeIntf;
    FOtherClass: TOtherClass;
protected
    // interface type reference property
    property SomeIntf: ISomeIntf read FSomeClass implements IUnknown, ISomeIntf;
    // object type reference property
    property OtherIntf: TOtherClass read FOtherClass implements IOtherIntf;
end;

但是必须在适当的时候对引用的类初始化；
constructor TIntfClass.Create;
begin
FSomeClass:= TSomeClass.Create;
FOtherClass:= TOtherClass.Create;
end;

聚合实际上是委托在代码上的一种简化；对于接口引用和对象引用，区别在于：接口引用比较安全，在它Relrease之前可以安全的引用，但对象引用可能被意外的
Free掉，所以在使用对象引用时，必须很好的控制对象引用的计数逻辑。一般通过接口控制类的生存周期。

Delphi的接口委托示例  http://www.cnblogs.com/MurphyAefe/articles/1741825.html

{
  说明：该事例实现的效果，在单个应用或代码量小的项目中，可以完全不用接口委托来完成。
  之所以采用委托接口，主要是应用到：已经实现的接口模块中，在不改变原有代码的情况下，
  需要对其进行扩展；原始模块只需要开放部分功能，但又不能暴露实现细节的场合；
}

unit TestUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

const
  TestMsgGUID: TGUID = '{4BE80D5E-D94B-42BE-9114-077DC2708451}';

type
  //原始接口中新增需要暴露给其它模块的接口定义，公用部分
  ITestMsg = interface
    ['{4BE80D5E-D94B-42BE-9114-077DC2708451}']
    procedure ShowTestMsg;
  end;

  //---------------------------------服务模块
  //基类对象，只需要开放ShowTestMsg方法给外部，所以做为按口的实现基类
  TBaseTestMsg = class(TInterfacedObject, ITestMsg)
  public
    //.... 模块已存在的老代码....

    //新开放的接口代码方法
    procedure ShowTestMsg; virtual;     //申明成虚拟方法，以便继承类可以重载
  end;

  //---------------------------------接口委托对象定义
  TTestMsgClass = class(TInterfacedObject, ITestMsg)
  private
    FTestMsg: ITestMsg;
  public
    property Service: ITestMsg read FTestMsg implements ITestMsg;

    constructor Create(AClass: TClass);
    constructor CreateEx(AClass: TClass);      //另一种用法, 不采用TBaseTestMsg做为基类创建委托实例
    destructor Destroy; override;
  end;

  //----------------------------------外部引用的业务模块
  //完成具体业务的委托实例
  TETestMsg = class(TInterfacedObject, ITestMsg)
  public
    procedure ShowTestMsg;
  end;

  //完成具体业务的委托实例
  TCTestMsg = class(TInterfacedObject, ITestMsg)
  public
    procedure ShowTestMsg;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure DoTest(AClass: TClass; ACreateEx: Boolean = False);     //测试方法
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TBaseTestMsg }

procedure TBaseTestMsg.ShowTestMsg;
begin
end;

{ TTestMsgClass }

constructor TTestMsgClass.Create(AClass: TClass);
var
  vObj: TBaseTestMsg;
begin
  vObj := TBaseTestMsg(AClass.NewInstance);
  FTestMsg := vObj.Create;
end;

constructor TTestMsgClass.CreateEx(AClass: TClass);
begin
  //该方法不采用TBaseTestMsg做为基类创建委托实例，更通用更灵活
  (AClass.NewInstance.Create).GetInterface(TestMsgGUID, FTestMsg);
end;

destructor TTestMsgClass.Destroy;
begin
  FTestMsg := nil;
  inherited;
end;

{ TETestMsg }

procedure TETestMsg.ShowTestMsg;
begin
  ShowMessage('TETestMsg Msg:' + 'OK');
end;

{ TCTestMsg }

procedure TCTestMsg.ShowTestMsg;
begin
  ShowMessage('TCTestMsg 消息:' + '好的');
end;

//--------------------以下为测试代码--------------------------------

procedure TForm1.DoTest(AClass: TClass; ACreateEx: Boolean);
var
  vClass: TTestMsgClass;
  vTest: ITestMsg;
begin
  if ACreateEx then
    vClass := TTestMsgClass.CreateEx(AClass)
  else
    vClass := TTestMsgClass.Create(AClass);

  try
    vTest := vClass;
    vTest.ShowTestMsg;
  finally
    vTest := nil;
    FreeAndNil(vClass);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  DoTest(TETestMsg);
  DoTest(TCTestMsg);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DoTest(TETestMsg, True);
  DoTest(TCTestMsg, True);
end;

end.