紧急!怎么在COM中实现事件的激发和处理?谢谢!!!(200分)

  • 主题发起人 主题发起人 qianting
  • 开始时间 开始时间
Q

qianting

Unregistered / Unconfirmed
GUEST, unregistred user!
在Automation Object Wizard 中选择了Generate Event support code选项,
在服务端定义了一个事件。如何在客户端捕获该事件?
好象要做一个的接收器,但具体该怎么实现呢?
请大虾们指点,介绍详细的实现方法,最好有源码。
万分感谢!!!
 
请到
http://delphi.mychangshu.com/dispdoc.asp?id=197
下载Master Delphi,里面介绍得很详细。
 
E文,看了就头大:)
《Delphi5开发人员指南》也有,已经解决。
谢谢!
 
Delphi5开发人员指南已有了,
下面我给出它的例子中的Client事件的处理代码:
unit CliMain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Server_TLB, ComObj;

type
TEventSink = class;

TMainForm = class(TForm)
SendButton: TButton;
CloseButton: TButton;
ClearButton: TButton;
Edit: TEdit;
Memo: TMemo;
procedure FormCreate(Sender: TObject);
procedure SendButtonClick(Sender: TObject);
procedure ClearButtonClick(Sender: TObject);
procedure CloseButtonClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FServer: IServerWithEvents;
FEventSink: TEventSink;
FCookie: Integer;
procedure OnServerMemoChanged(const NewText: string);
procedure OnClear;
public
{ Public declarations }
end;

TEventSink = class(TObject, IUnknown, IDispatch)
private
FController: TMainForm;
{ 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(Controller: TMainForm);
end;

var
MainForm: TMainForm;

implementation

uses ActiveX;

{$R *.DFM}

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
begin
FServer := CoServerWithEvents.Create;
FEventSink := TEventSink.Create(Self);
InterfaceConnect(FServer, IServerWithEventsEvents, FEventSink, FCookie);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
InterfaceDisconnect(FEventSink, IServerWithEventsEvents, FCookie);
FEventSink.Free;
end;

procedure TMainForm.SendButtonClick(Sender: TObject);
begin
FServer.AddText(Edit.Text);
end;

procedure TMainForm.ClearButtonClick(Sender: TObject);
begin
FServer.Clear;
end;

procedure TMainForm.CloseButtonClick(Sender: TObject);
begin
Close;
end;

procedure TMainForm.OnServerMemoChanged(const NewText: string);
begin
Memo.Text := NewText;
end;

procedure TMainForm.OnClear;
begin
Memo.Clear;
end;

{ TEventSink }

constructor TEventSink.Create(Controller: TMainForm);
begin
FController := Controller;
inherited Create;
end;

{ TEventSink.IUnknown }

function TEventSink._AddRef: Integer;
begin
// No need to implement, since lifetime is tied to client
Result := 1;
end;

function TEventSink._Release: Integer;
begin
// No need to implement, since lifetime is tied to client
Result := 1;
end;

function TEventSink.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
// First look for my own implementation of an interface
// (I implement IUnknown and IDispatch).
if GetInterface(IID, Obj) then
Result := S_OK
// Next, if they are looking for outgoing interface, recurse to return
// our IDispatch pointer.
else if IsEqualIID(IID, IServerWithEventsEvents) then
Result := QueryInterface(IDispatch, Obj)
// For everything else, return an error.
else
Result := E_NOINTERFACE;
end;

{ TEventSink.IDispatch }

function TEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;

function TEventSink.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Pointer(TypeInfo) := nil;
Result := E_NOTIMPL;
end;

function TEventSink.GetTypeInfoCount(out Count: Integer): HResult;
begin
Count := 0;
Result := S_OK;
end;

function TEventSink.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var
V: OleVariant;
begin
Result := S_OK;
case DispID of
1:
begin
// First parameter is new string
V := OleVariant(TDispParams(Params).rgvarg^[0]);
FController.OnServerMemoChanged(V);
end;
2: FController.OnClear;
end;
end;

end.
 
已经下载了Delphi5开发人员指南的源码。问题解决了。
谢谢大家!
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部