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