在程序中先定义你的相应过程
procedure youProcedure;然后再程序中设置如下:TMessage.OnArrival:= youProcedure;

解决方案 »

  1.   

    我同意XUTIE的看法,不过你可以找一本“COM”来看
      

  2.   

    哈哈,TMessage里有这个事件吗?
      

  3.   

    你不是把它注册到ActiveX页上了吗?将它拖到form上,然后像普通的控件一样在Object Inspector里处理它的OnArrival事件不就完了,有什么问题?
      

  4.   

    我没有碰到任何问题,事实上,我根本无从下手。
    正常的思路应该是:
    在客户端建立一个event sink,然后与事件源连接,具体细节我找不到资料。
      

  5.   


      To CBuilder(),把你的类型库文件传给我。  [email protected]  注:Event Sink 早已经是Delphi4时代的事情了!
      

  6.   

    注册在ActiveX上的三个类都没有OnArrival事件?是不是类型库没有开放该事件?
      

  7.   


      我是说是.exe或.Dll或.OCX,不是*_TBL.pas!  下面是通用的Event Sink组件的源代码!unit EventSink;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      ActiveX;type
      TInvokeEvent = procedure(Sender: TObject; DispID: Integer;
        const IID: TGUID; LocaleID: Integer; Flags: Word;
        Params: TDispParams; VarResult, ExcepInfo, ArgErr: Pointer) of object;  TAbstractEventSink  = class(TInterfacedObject, IUnknown, IDispatch)
      private
        FDispatch: IDispatch;
        FDispIntfIID: TGUID;
        FConnection: Integer;
        FOwner: TComponent;
      protected
        { IUnknown }
        function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
        function _AddRef: Integer; stdcall;
        function _Release: Integer; stdcall;
        { IDispatch }
        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(AOwner: TComponent);
        destructor Destroy; override;
        procedure Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID);
        procedure Disconnect;
      end;  TEventSink = class(TComponent)
      private
        { Private declarations }
        FSink: TAbstractEventSink;
        FOnInvoke: TInvokeEvent;
      protected
        { Protected declarations }
        procedure DoInvoke(DispID: Integer; const IID: TGUID;
          LocaleID: Integer; Flags: Word; var Params;
          VarResult, ExcepInfo, ArgErr: Pointer); virtual;
      public
        { Public declarations }
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID);
      published
        { Published declarations }
        property OnInvoke: TInvokeEvent read FOnInvoke write FOnInvoke;
      end;procedure Register;implementationuses
      ComObj;procedure Register;
    begin
      RegisterComponents('YourPanel', [TEventSink]);
    end;{$IFDEF VER100}
    procedure InterfaceConnect(const Source: IUnknown; const IID: TIID;
      const Sink: IUnknown; var Connection: Longint);
    var
      CPC: IConnectionPointContainer;
      CP: IConnectionPoint;
    begin
      Connection := 0;
      if Succeeded(Source.QueryInterface(IConnectionPointContainer, CPC)) then
        if Succeeded(CPC.FindConnectionPoint(IID, CP)) then
          CP.Advise(Sink, Connection);
    end;procedure InterfaceDisconnect(const Source: IUnknown; const IID: TIID;
      var Connection: Longint);
    var
      CPC: IConnectionPointContainer;
      CP: IConnectionPoint;
    begin
      if Connection <> 0 then
        if Succeeded(Source.QueryInterface(IConnectionPointContainer, CPC)) then
          if Succeeded(CPC.FindConnectionPoint(IID, CP)) then
            if Succeeded(CP.Unadvise(Connection)) then Connection := 0;
    end;
    {$ENDIF}{ TAbstractEventSink }function TAbstractEventSink._AddRef: Integer;
    begin
      Result := -1;
    end;function TAbstractEventSink._Release: Integer;
    begin
      Result := -1;
    end;constructor TAbstractEventSink.Create(AOwner: TComponent);
    begin
      inherited Create;  FOwner := AOwner;
    end;destructor TAbstractEventSink.Destroy;
    begin
      Disconnect;  inherited Destroy;
    end;function TAbstractEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
    begin
      Result := E_NOTIMPL;
    end;function TAbstractEventSink.GetTypeInfo(Index, LocaleID: Integer;
      out TypeInfo): HRESULT;
    begin
      Result := E_NOTIMPL;
    end;function TAbstractEventSink.GetTypeInfoCount(out Count: Integer): HRESULT;
    begin
      Count := 0;
      Result := S_OK;
    end;function TAbstractEventSink.Invoke(DispID: Integer; const IID: TGUID;
      LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
      ArgErr: Pointer): HRESULT;
    begin
      (FOwner as TEventSink).DoInvoke(DispID, IID, LocaleID, Flags,
        Params, VarResult, ExcepInfo, ArgErr);  Result := S_OK;
    end;function TAbstractEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
    begin
      // We need to return the event interface when it's asked for
      Result := E_NOINTERFACE;
      if GetInterface(IID,Obj) then
        Result := S_OK;
      if IsEqualGUID(IID, FDispIntfIID) and GetInterface(IDispatch,Obj) then
        Result := S_OK;
    end;procedure TAbstractEventSink.Connect(AnAppDispatch: IDispatch;
      const AnAppDispIntfIID: TGUID);
    begin
      FDispIntfIID := AnAppDispIntfIID;
      FDispatch := AnAppDispatch;  // Hook the sink up to the automation server
      InterfaceConnect(FDispatch, FDispIntfIID, Self, FConnection);
    end;procedure TAbstractEventSink.Disconnect;
    begin
      if Assigned(FDispatch) then begin
        // Unhook the sink from the automation server
        InterfaceDisconnect(FDispatch, FDispIntfIID, FConnection);
        FDispatch := nil;
        FConnection := 0;
      end;
    end;{ TEventSink }procedure TEventSink.Connect(AnAppDispatch: IDispatch;
      const AnAppDispIntfIID: TGUID);
    begin
      FSink.Connect(AnAppDispatch, AnAppDispIntfIID);
    end;constructor TEventSink.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);  FSink := TAbstractEventSink.Create(self);
    end;destructor TEventSink.Destroy;
    begin
      FSink.Free;  inherited Destroy;
    end;procedure TEventSink.DoInvoke(DispID: Integer; const IID: TGUID;
      LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
      ArgErr: Pointer);
    begin
      if Assigned(FOnInvoke) then
        FOnInvoke(self, DispID, IID, LocaleID, Flags, TDispParams(Params),
          VarResult, ExcepInfo, ArgErr);
    end;end.