COM-Object mit Events

[markus.waibel]

Ich habe in der TLB-Unit die mir Delphi beim Importieren der Typenbibliothek erstellt hat ein Interface __API das als

   __API = dispinterface deklariert wurde.

In diesem Interace gibt es dann die Prozedur ItemAdded welche dem Event entspricht.

   procedure ItemAdded(var BasketItem: _BasketItem; var Cancel: WordBool); dispid 7; Analog zu meinem Beispiel aus dem CODEGAR-Tutorial habe ich dann folgendes entwickelt:

Delphi-Quellcode:

....

type
  TTafmoEventSink=Class(TInterfacedObject,IUnknown,IDispatch)
   private
    FController:TForm2;
    function QueryInterface(const IID:TGUID; out Obj):HResult;stdcall;

    function GetTypeInfoCount(out Count:integer):HResult;stdCall;
    function GetTypeInfo(Index,LocaleID:Integer;out TypeInfo):HResult;Stdcall;
    function GetIDsOfNames(const IID:TGUID;Names:Pointer;NameCount,LocaleID:integer;DispIDs:Pointer):HResult;stdcall;
    function Invoke(DispID:Integer;const IID:TGUID;LocaleID:Integer;Flags:Word;Var Params;VarResult,ExcepInfo,ArgErr:Pointer):Hresult;STDCall;
   public
    Constructor create(Controller:TForm2);
   end;
....

Implementation


constructor TTafmoEventSink.create(Controller: TForm2);
begin
 inherited create;
 FController:=Controller;
end;

function TTafmoEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: integer; DispIDs: Pointer): HResult;
begin
 Result:=S_OK;
end;

function TTafmoEventSink.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
 Result:=S_OK;
end;

function TTafmoEventSink.GetTypeInfoCount(out Count: integer): HResult;
begin
 Result:=S_OK;
end;

function TTafmoEventSink.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): Hresult;
var Args: PVariantArgList;
    text:string;

begin
 Result:=S_OK;
 showmessage('Got Event '+inttostr(DispID));
 case DispID of
  7: begin
      Args := TDispParams(Params).rgvarg;
      text:=_BasketItem(Args^[0].dispVal).description;
      FController.OnItemAdded(text);
     end;
 end;
end;

function TTafmoEventSink.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
 if GetInterFace(IID,Obj) then
  Result:=S_OK
 else if isEqualIID(IID,ISimpleEventServerEvents) then
  Result:=QueryInterface(IDispatch,Obj)
 else
  Result:=E_NOINTERFACE;
end;

Die instanzierung bei ONCreate von Form2 sieht dann folgendermaßen aus:

Delphi-Quellcode:

 FTafmoAPI:=coAPI.Create;
 FTafmoEventSink:=TTafmoEventSink.create(Form2);
 InterfaceConnect(FTafmoApi,__API,FTafmoEventSink,FTafmoConnectionToken);

Leider tritt dabei nie ein Event auf. :cry:


Kann jemand damit was anfangen?