有谁擅长接口的,帮忙看个问题。
是这样的,我对系统的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,那么就不存在刚才的问题了。
是这样的,我对系统的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,那么就不存在刚才的问题了。
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货