给你一个我的实际应用例子 unit PTMIS.Model.ListIntf;interfaceuses Controls;type IListModel = interface ['{8CC5D218-E92B-4C30-B2B4-BCA65670CEBC}'] procedure Add(const Item: IInterface); procedure Clear; function GetCount: Integer; function GetItem(Idx: Integer): IInterface; function IndexOf(const Item: IInterface): Integer; procedure Insert(const Item, Before: IInterface); procedure Move(const Item, Before: IInterface); procedure Remove(const Item: IInterface); function GetCaption: TCaption; property Count: Integer read GetCount; property Item[Idx: Integer]: IInterface read GetItem; property Caption: TCaption read GetCaption; end;implementationend.=================================unit PTMIS.Model.ListImpl;interfaceuses Classes, Controls, PTMIS.Model.ListIntf, PTMIS.Pattern.VisitorIntf, PTMIS.Pattern.VisitedIntf;type TListModel = class(TInterfacedObject, IListModel, IVisited) private FItems: IInterfaceList; FCaption: TCaption; protected property Items: IInterfaceList read FItems; property Caption: TCaption read FCaption write FCaption; //IListModel procedure Add(const Item: IInterface); procedure Clear; function GetCount: Integer; function GetItem(Idx: Integer): IInterface; function IndexOf(const Item: IInterface): Integer; procedure Insert(const Item, Before: IInterface); procedure Move(const Item, Before: IInterface); procedure Remove(const Item: IInterface); function GetCaption: TCaption; //IVisited procedure Accept(const Visitor: IVisitor); virtual; abstract; public destructor Destroy; override; end;implementation{ TListModel }procedure TListModel.Add(const Item: IInterface); begin if FItems = nil then FItems := TInterfaceList.Create; if FItems.IndexOf(Item as IInterface) < 0 then FItems.Add(Item as IInterface); end;procedure TListModel.Clear; begin if FItems <> nil then begin FItems.Clear; FItems := nil; end; end;destructor TListModel.Destroy; begin inherited; end;function TListModel.GetCount: Integer; begin if FItems <> nil then Result := FItems.Count else Result := 0; end;function TListModel.GetItem(Idx: Integer): IInterface; begin Result := nil; if Idx >= 0 then if FItems <> nil then if Idx < FItems.Count then Result := FItems[Idx]; end;function TListModel.GetCaption: TCaption; begin Result := FCaption; end;function TListModel.IndexOf(const Item: IInterface): Integer; begin Result := -1; if FItems <> nil then Result := FItems.IndexOf(Item as IInterface); end;procedure TListModel.Insert(const Item, Before: IInterface); var InsertIdx: Integer; begin if FItems = nil then FItems := TInterfaceList.Create; if FItems.IndexOf(Item as IInterface) < 0 then begin InsertIdx := FItems.IndexOf(Before as IInterface); if InsertIdx < 0 then InsertIdx := 0; FItems.Insert(InsertIdx, Item as IInterface); end; end;procedure TListModel.Move(const Item, Before: IInterface); var IdxItem: Integer; IdxBefore: Integer; MoveItem: IInterface; begin if FItems <> nil then begin IdxItem := FItems.IndexOf(Item as IInterface); if IdxItem >= 0 then begin MoveItem := FItems[IdxItem] as IInterface; FItems.Delete(IdxItem); IdxBefore := FItems.IndexOf(Before as IInterface); if IdxBefore >= 0 then FItems.Insert(IdxBefore, MoveItem as IInterface); end; end; end;procedure TListModel.Remove(const Item: IInterface); begin if FItems <> nil then if FItems.IndexOf(Item as IInterface) >= 0 then begin FItems.Remove(Item as IInterface); if FItems.Count = 0 then FItems := nil; end; end;end.
方法1: IField加一个返回对象的方法,参考:Classes单元的IInterfaceComponentReference接口。 这种方法比如安全可靠。方法2: 我的函数: function GetObjFromIntf(AClass: TClass; const Intf: IInterface): TObject; var PIntfTable: PInterfaceTable; IntfEntry: TInterfaceEntry; i: Integer; begin Result := nil; //取得接口表结构 PIntfTable := AClass.GetInterfaceTable; if PIntfTable = nil then Exit; while AClass <> nil do begin for i := 0 to PIntfTable^.EntryCount - 1 do begin IntfEntry := PIntfTable^.Entries[i]; //判断接口表指向的地址是否和传入接口指向的地址相同 if PPointer(Intf)^ = IntfEntry.VTable then begin//偏移到对象首地址 Result := TObject(Integer(Intf) - IntfEntry.IOffset); Exit; end; end; //继续在父类中找 AClass := AClass.ClassParent; end; end;这种方法不安全。
ADD(POInter(Field));这样是不行的
FFiledList: IInterfaceList;
......FFieldList := TInterfaceList.Create;
FFieldList.Add(Field);......
unit PTMIS.Model.ListIntf;interfaceuses
Controls;type
IListModel = interface
['{8CC5D218-E92B-4C30-B2B4-BCA65670CEBC}']
procedure Add(const Item: IInterface);
procedure Clear;
function GetCount: Integer;
function GetItem(Idx: Integer): IInterface;
function IndexOf(const Item: IInterface): Integer;
procedure Insert(const Item, Before: IInterface);
procedure Move(const Item, Before: IInterface);
procedure Remove(const Item: IInterface);
function GetCaption: TCaption;
property Count: Integer read GetCount;
property Item[Idx: Integer]: IInterface read GetItem;
property Caption: TCaption read GetCaption;
end;implementationend.=================================unit PTMIS.Model.ListImpl;interfaceuses
Classes, Controls, PTMIS.Model.ListIntf, PTMIS.Pattern.VisitorIntf, PTMIS.Pattern.VisitedIntf;type
TListModel = class(TInterfacedObject, IListModel, IVisited)
private
FItems: IInterfaceList;
FCaption: TCaption;
protected
property Items: IInterfaceList read FItems;
property Caption: TCaption read FCaption write FCaption;
//IListModel
procedure Add(const Item: IInterface);
procedure Clear;
function GetCount: Integer;
function GetItem(Idx: Integer): IInterface;
function IndexOf(const Item: IInterface): Integer;
procedure Insert(const Item, Before: IInterface);
procedure Move(const Item, Before: IInterface);
procedure Remove(const Item: IInterface);
function GetCaption: TCaption;
//IVisited
procedure Accept(const Visitor: IVisitor); virtual; abstract;
public
destructor Destroy; override;
end;implementation{ TListModel }procedure TListModel.Add(const Item: IInterface);
begin
if FItems = nil then
FItems := TInterfaceList.Create;
if FItems.IndexOf(Item as IInterface) < 0 then
FItems.Add(Item as IInterface);
end;procedure TListModel.Clear;
begin
if FItems <> nil then
begin
FItems.Clear;
FItems := nil;
end;
end;destructor TListModel.Destroy;
begin inherited;
end;function TListModel.GetCount: Integer;
begin
if FItems <> nil then
Result := FItems.Count
else
Result := 0;
end;function TListModel.GetItem(Idx: Integer): IInterface;
begin
Result := nil;
if Idx >= 0 then
if FItems <> nil then
if Idx < FItems.Count then
Result := FItems[Idx];
end;function TListModel.GetCaption: TCaption;
begin
Result := FCaption;
end;function TListModel.IndexOf(const Item: IInterface): Integer;
begin
Result := -1;
if FItems <> nil then
Result := FItems.IndexOf(Item as IInterface);
end;procedure TListModel.Insert(const Item, Before: IInterface);
var
InsertIdx: Integer;
begin
if FItems = nil then
FItems := TInterfaceList.Create;
if FItems.IndexOf(Item as IInterface) < 0 then
begin
InsertIdx := FItems.IndexOf(Before as IInterface);
if InsertIdx < 0 then
InsertIdx := 0;
FItems.Insert(InsertIdx, Item as IInterface);
end;
end;procedure TListModel.Move(const Item, Before: IInterface);
var
IdxItem: Integer;
IdxBefore: Integer;
MoveItem: IInterface;
begin
if FItems <> nil then
begin
IdxItem := FItems.IndexOf(Item as IInterface);
if IdxItem >= 0 then
begin
MoveItem := FItems[IdxItem] as IInterface;
FItems.Delete(IdxItem);
IdxBefore := FItems.IndexOf(Before as IInterface);
if IdxBefore >= 0 then
FItems.Insert(IdxBefore, MoveItem as IInterface);
end;
end;
end;procedure TListModel.Remove(const Item: IInterface);
begin
if FItems <> nil then
if FItems.IndexOf(Item as IInterface) >= 0 then
begin
FItems.Remove(Item as IInterface);
if FItems.Count = 0 then
FItems := nil;
end;
end;end.
IField加一个返回对象的方法,参考:Classes单元的IInterfaceComponentReference接口。
这种方法比如安全可靠。方法2:
我的函数:
function GetObjFromIntf(AClass: TClass; const Intf: IInterface): TObject;
var
PIntfTable: PInterfaceTable;
IntfEntry: TInterfaceEntry;
i: Integer;
begin
Result := nil;
//取得接口表结构
PIntfTable := AClass.GetInterfaceTable;
if PIntfTable = nil then Exit;
while AClass <> nil do
begin
for i := 0 to PIntfTable^.EntryCount - 1 do
begin
IntfEntry := PIntfTable^.Entries[i];
//判断接口表指向的地址是否和传入接口指向的地址相同
if PPointer(Intf)^ = IntfEntry.VTable then
begin//偏移到对象首地址
Result := TObject(Integer(Intf) - IntfEntry.IOffset);
Exit;
end;
end;
//继续在父类中找
AClass := AClass.ClassParent;
end;
end;这种方法不安全。