我估计这个问题只有少数人能解答!!!!!! 在程序中先定义你的相应过程procedure youProcedure;然后再程序中设置如下:TMessage.OnArrival:= youProcedure; 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 我同意XUTIE的看法,不过你可以找一本“COM”来看 哈哈,TMessage里有这个事件吗? 你不是把它注册到ActiveX页上了吗?将它拖到form上,然后像普通的控件一样在Object Inspector里处理它的OnArrival事件不就完了,有什么问题? 我没有碰到任何问题,事实上,我根本无从下手。正常的思路应该是:在客户端建立一个event sink,然后与事件源连接,具体细节我找不到资料。 To CBuilder(),把你的类型库文件传给我。 [email protected] 注:Event Sink 早已经是Delphi4时代的事情了! 注册在ActiveX上的三个类都没有OnArrival事件?是不是类型库没有开放该事件? 我是说是.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. Borland,伤心的Borland....... Delphi木马DIY之代码藏后门的可能性 FastReport分页问题? 小弟刚开始学Delphi,有没有经常在线的高手加我QQ:71910482~~~~~~~~~~~ 一个应届生,迷茫中. 如何计算日期? 如您不怕控件问题,控件高手请进 帮帮我,谢谢你们!用WebBrowser时怎么才可以自动填写表单呢。 请问斑竹这儿有没有帖子的收藏功能, 如何编程给ToolBar控件加入一个按钮!(急)!肯定加分 心情郁闷,散分,前10位有分! 各位,昨天我把一个程序从BDE改用ADO,发现一个问题。。。
正常的思路应该是:
在客户端建立一个event sink,然后与事件源连接,具体细节我找不到资料。
To CBuilder(),把你的类型库文件传给我。 [email protected] 注:Event Sink 早已经是Delphi4时代的事情了!
我是说是.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.