-------接口单元文件UMyInterface.pas----------------- 
unit UMyInterface;

interface

uses Dialogs;

type
 //根接口
 ImyInterface = interface
 ['{70C1ACCA-9494-43B2-BE37-B7680C4F2543}']
    procedure getBaseMethod;
 end;

  //子接口
   IfirstInterface = interface(ImyInterface)
   ['{A340131E-DA63-4D22-B634-9D4847F23934}']
      procedure getChildMethod;
   end;

  //根接口基类
   baseClass = class(Tobject)
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
   end;

   //用于实现根接口中方法
   firstImp = class(baseClass,ImyInterface)
     procedure getBaseMethod;

  end;

   TImplClass = class(firstImp,IfirstInterface)
     procedure getChildMethod;

  end;

implementation

 

{ baseClass }

function baseClass._AddRef: Integer;
begin
   result := 1;
end;

function baseClass._Release: Integer;
begin
    result := 1;
end;

function baseClass.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
 if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

{ firstImp }

procedure firstImp.getBaseMethod;
begin
  showmessage('调用实现父接口方法');
end;

{ TImplClass }

procedure TImplClass.getChildMethod;
begin
  showmessage('调用实现自己接口方法');
end;

end.

----------测试窗体单元文件Ftest.pas----------
unit Ftest;

interface

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

type
  TFinteface = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  // 使用对象接口委托,充当适配器功能
  Ttest = class(Tobject,Ifirstinterface)
  private
    FImplService: Ifirstinterface;
  public
    Constructor Create;overload;
    Destructor Destroy;override;
    Constructor Create(aClass: TClass);overload;
    property MyService: Ifirstinterface read FImplService implements Ifirstinterface;
  end;
   //------模块插口1
   // 委托父类实现父接口方法 (getBaseMethod)
  studentImp = class(firstImp,Ifirstinterface)
     procedure getChildMethod;
  end;

  //封装一个学生类
  studentBean = class (studentImp)
    private name: String;
    public
      constructor Create(name: String);
      destructor Destroy; override;
      procedure setName(name: String);
      function getName: String;
    //  property name:String read getName write setName;
   end;

var
  Finteface: TFinteface;

implementation

{$R *.dfm}

{ studentBean }

constructor studentBean.Create(name: String);
begin
 self.name := name;
end;

destructor studentBean.Destroy;
begin
  self.Free;
  inherited;
end;

function studentBean.getName: String;
begin
  result := self.name;
end;

procedure studentBean.setName(name: String);
begin
  self.name := name;
end;

{ studentImp }

procedure studentImp.getChildMethod;
begin
  showmessage('调用学生自己接口方法');
end;

procedure TFinteface.BitBtn1Click(Sender: TObject);
var
  a : studentBean;
begin
  a := studentBean.Create('学生小张');
  showmessage(a.getName);
  a.setName('学生小王');
  showmessage(a.getName);
  a.getBaseMethod;   //调用父接口方法
  a.getChildMethod;   //调用自己接口方法
end;

{ test }

constructor Ttest.Create;
begin
  FImplService :=  TImplClass.Create;
end;

//充当适配器功能,由其他类实现Ifirstinterface中方法
constructor Ttest.Create(aClass: TClass);
var
  Instance: TImplClass;
begin
  Instance := TImplClass(aClass.NewInstance);
  FImplService := Instance.Create;
end;

destructor Ttest.Destroy;
begin
  FImplService := nil;
  inherited;
end;

procedure TFinteface.BitBtn2Click(Sender: TObject);
var
 aobj: Ttest;  //定义实现Ifirstinterface的类
 intf: Ifirstinterface;
begin
 //创建委托对象,委托类TImplClass实现Ifirstinterface方法
  aobj := Ttest.Create(TImplClass);
try
  intf := aobj;
  intf.getChildMethod;
 finally
   intf := nil;
   FreeAndNil(aobj);
  end;
end;

end.

 

 

本文来源：http://blog.csdn.net/eastyell/archive/2007/09/05/1772946.aspx