有谁擅长接口的,帮忙看个问题。
是这样的,我对系统的TInterfacedObject类进行修改如下:
  TXInterfacedObject = class(TObject, IInterface)
  protected
    FManageByInfterface: Boolean;
    FRefCount: Integer;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    constructor Create;
    destructor Destroy; override;
    //对象生命周期决定权
    property ManageByInterface: Boolean read FManageByInfterface write FManageByInfterface;    
  public
    function GetObject: Pointer; stdcall;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property RefCount: Integer read FRefCount;
  end;{ TXInterfacedObject }function InterlockedIncrement(var I: Integer): Integer;
asm
      MOV   EDX,1
      XCHG  EAX,EDX
 LOCK XADD  [EDX],EAX
      INC   EAX
end;function InterlockedDecrement(var I: Integer): Integer;
asm
      MOV   EDX,-1
      XCHG  EAX,EDX
 LOCK XADD  [EDX],EAX
      DEC   EAX
end;function TXInterfacedObject._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;function TXInterfacedObject._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if FManageByInfterface and (Result = 0) then
    Destroy;
end;procedure TXInterfacedObject.AfterConstruction;
begin
  // Release the constructor's implicit refcount
  InterlockedDecrement(FRefCount);
end;procedure TXInterfacedObject.BeforeDestruction;
begin
  if RefCount <> 0 then
    Error(reInvalidPtr);
end;class function TXInterfacedObject.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TXInterfacedObject(Result).FRefCount := 1;
end;function TXInterfacedObject.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;
就多加了一个属性ManageByInterface,当这个属性为True时,对象的生命周期掌握在接口手中,反之
掌握在自己(对象)手中。如下实现:
function TXInterfacedObject._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if FManageByInfterface and (Result = 0) then
    Destroy;
end;那么现在我有一个TXField类,从上面的TXInterfacedObject继承下来,并实现接口IXField。代码如下:
  ////类
  TXField = class(TXInterfacedObject, IXField)
  private
    FFieldName: string;
    FValue: Variant;
  protected
    //IXField
    function GetAsFloat: Double; stdcall;
    function GetAsInteger: Integer; stdcall;
    function GetAsString: WideString; stdcall;
    function GetFieldName: WideString; stdcall;
    function GetValue: Variant; stdcall;
    procedure SetAsFloat(const Value: Double); stdcall;
    procedure SetAsInteger(const Value: Integer); stdcall;
    procedure SetAsString(const Value: WideString); stdcall;
    procedure SetFieldName(const Value: WideString); stdcall;
    procedure SetValue(const Value: Variant); stdcall;
  public
    constructor Create;
    destructor Destroy; override;
  public
    procedure Clear;
    property FieldName: WideString read GetFieldName write SetFieldName;
    property Value: Variant read GetValue write SetValue;
    property AsString: WideString read GetAsString write SetAsString;
    property AsInteger: Integer read GetAsInteger write SetAsInteger;
    property AsFloat: Double read GetAsFloat write SetAsFloat;
  published  end;
  .......
  
  //接口代码
  IXField = interface
    ['{824CE5DD-36BD-44CD-A2AC-1BA40F2DE2CE}']
    //method
    
    //property accessor
    function GetAsFloat: Double; stdcall;
    function GetAsInteger: Integer; stdcall;
    function GetAsString: WideString; stdcall;
    function GetFieldName: WideString; stdcall;
    function GetValue: Variant; stdcall;
    procedure SetAsFloat(const Value: Double); stdcall;
    procedure SetAsInteger(const Value: Integer); stdcall;
    procedure SetAsString(const Value: WideString); stdcall;
    procedure SetFieldName(const Value: WideString); stdcall;
    procedure SetValue(const Value: Variant); stdcall;
    
    //property
    property FieldName: WideString read GetFieldName write SetFieldName;
    property Value: Variant read GetValue write SetValue;
    property AsString: WideString read GetAsString write SetAsString;
    property AsInteger: Integer read GetAsInteger write SetAsInteger;
    property AsFloat: Double read GetAsFloat write SetAsFloat;        
  end;
  
好了,现在我写了如下的代码:
procedure TForm1.btn4Click(Sender: TObject);
var
  XFieldObj: TXField;
  XFieldIntf: IXField;
begin
  XFieldObj := TXField.Create;
  with XFieldObj do
  begin
    ManageByInterface := False;
    FieldName := 'XXX';
    Value := '1245';
  end;  XFieldIntf := XFieldObj as IXField;  //XFieldIntf := nil;  //没加这句时老出错  XFieldObj.Free;
end;  现在我的问题是,有没有办法不加“XFieldIntf := nil”。另注:不是在过程里面操作就正常了。比如说我把XFieldObj放在某个窗体的Private,然后在在窗体的OnCreate里
创建XFieldObj,在窗体的OnDestroy里释放XFieldObj,那么就不存在刚才的问题了。