paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 15:49:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix from mantis #22156 to wholly implement iunknown or not.

Browse Source 
TAbstractEventSink no longer descends from Tinterfacedobject.
   Patch by Ludo

git-svn-id: trunk@21652 -
This commit is contained in:
marco 2012-06-19 08:55:40 +00:00
parent e0b41141d2
commit 3ffa6bf2f3
1 changed files with 20 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
packages/winunits-base/src/eventsink.pp
View File

@ -41,7 +41,9 @@ type
const IID: TGUID; LocaleID: Integer; Flags: Word;
Params: TDispParams; VarResult, ExcepInfo, ArgErr: Pointer) of object;
TAbstractEventSink = class(TInterfacedObject, IDispatch)
{ TAbstractEventSink }
TAbstractEventSink = class(TObject, IDispatch,IUnknown) // see mantis #22156
private
FDispatch: IDispatch;
FDispIntfIID: TGUID;
@ -49,7 +51,10 @@ type
FOwner: TComponent;
protected
{ IUnknown }
frefcount : longint;
function QueryInterface(constref IID: TGUID; out Obj): HRESULT; stdcall;
function _AddRef : longint;stdcall;
function _Release : longint;stdcall;
{ IDispatch }
function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; stdcall;
@ -166,6 +171,20 @@ begin
Result := S_OK;
end;
function TAbstractEventSink._AddRef: longint; stdcall;
begin
frefcount:=frefcount+1;
_addref:=frefcount;
end;
function TAbstractEventSink._Release: longint; stdcall;
begin
frefcount:=frefcount-1;
_Release:=frefcount;
if frefcount=0 then
self.destroy;
end;
procedure TAbstractEventSink.Connect(AnAppDispatch: IDispatch;
const AnAppDispIntfIID: TGUID);
begin