在程序中先定义你的相应过程
procedure youProcedure;然后再程序中设置如下:TMessage.OnArrival:= youProcedure;
procedure youProcedure;然后再程序中设置如下:TMessage.OnArrival:= youProcedure;
解决方案 »
- 请问如何post数据,数据包已经截下来,麻烦高手写个代码,谢谢了
- 想在DELPHI是捕获MAINFORM窗口的WM_SETFOCUS,完整的怎么写?
- 动态生成了几个SpeedButton控件,怎么样用Click事件来处理生成的每个不同的SpeedButton的Click事件
- 每分了,哪位大侠可以救济一点。。。。
- 分析网页上的内容(200分求解)
- 怎么获得其他程序有焦点的控件的句柄?
- Excel文件倒入SQL 速度奇慢?怎么办?
- 最优算法问题,求高手赐教!
- 一个小东西,希望大家喜欢
- 怎么搞得,为什么别人的问题10个8个的人回答看看,我的每人看
- 心情郁闷,散分,前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.