Delphi的接口委托示例 (转)

{

  说明：该事例实现的效果，在单个应用或代码量小的项目中，可以完全不用接口委托来完成。

  之所以采用委托接口，主要是应用到：已经实现的接口模块中，在不改变原有代码的情况下，

  需要对其进行扩展；原始模块只需要开放部分功能，但又不能暴露实现细节的场合；

}

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;     //申明成虚拟方法，以便继承类可以重载

  //---------------------------------接口委托对象定义

  TTestMsgClass = class(TInterfacedObject, ITestMsg)

  private

    FTestMsg: ITestMsg;

    property Service: ITestMsg read FTestMsg implements ITestMsg;

    constructor Create(AClass: TClass);

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

    destructor Destroy; override;

  //----------------------------------外部引用的业务模块

  //完成具体业务的委托实例

  TETestMsg = class(TInterfacedObject, ITestMsg)

  TCTestMsg = class(TInterfacedObject, ITestMsg)

  TForm1 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    { Private declarations }

    { Public declarations }

    procedure DoTest(AClass: TClass; ACreateEx: Boolean = False);     //测试方法

var

  Form1: TForm1;

implementation

{$R *.dfm}

{ TBaseTestMsg }

procedure TBaseTestMsg.ShowTestMsg;

begin

end;

{ TTestMsgClass }

constructor TTestMsgClass.Create(AClass: TClass);

  vObj: TBaseTestMsg;

  vObj := TBaseTestMsg(AClass.NewInstance);

  FTestMsg := vObj.Create;

constructor TTestMsgClass.CreateEx(AClass: TClass);

  //该方法不采用TBaseTestMsg做为基类创建委托实例，更通用更灵活

  (AClass.NewInstance.Create).GetInterface(TestMsgGUID, FTestMsg);

destructor TTestMsgClass.Destroy;

  FTestMsg := nil;

  inherited;

{ TETestMsg }

procedure TETestMsg.ShowTestMsg;

  ShowMessage('TETestMsg Msg:' + 'OK');

{ TCTestMsg }

procedure TCTestMsg.ShowTestMsg;

  ShowMessage('TCTestMsg 消息:' + '好的');

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

procedure TForm1.DoTest(AClass: TClass; ACreateEx: Boolean);

  vClass: TTestMsgClass;

  vTest: ITestMsg;

  if ACreateEx then

    vClass := TTestMsgClass.CreateEx(AClass)

  else

    vClass := TTestMsgClass.Create(AClass);

  try

    vTest := vClass;

    vTest.ShowTestMsg;

  finally

    vTest := nil;

    FreeAndNil(vClass);

procedure TForm1.Button1Click(Sender: TObject);

  DoTest(TETestMsg);

  DoTest(TCTestMsg);

procedure TForm1.Button2Click(Sender: TObject);

  DoTest(TETestMsg, True);

  DoTest(TCTestMsg, True);

end.