用TWordApplication的方式，有事件支持，但是，我用OLE的时候，如何也能支持事件呢？
请看下面的代码：
uses Word_TLB, activex, comobj, ConnectionObject
// ConnectionObject is the unit containing TWordConnection
// Follow link at the bottom of the page for TWordConnection sample code
procedure StartWordConnection(WordApp: _Application;
WordDoc: _Document;
var WordSink: TWordConnection);
var
PointContainer: IConnectionPointContainer;
Point: IConnectionPoint;
begin
try
// TWordConnection is the COM object which receives the
// notifications from Word. Make sure to free WordSink when
// you are done with it.
WordSink := TWordConnection.Create;
WordSink.WordApp := WordApp;
WordSink.WordDoc := WordDoc;
// Sink with a Word application
OleCheck(WordApp.QueryInterface(IConnectionPointContainer, PointContainer));
if Assigned(PointContainer) then begin
OleCheck(PointContainer.FindConnectionPoint(ApplicationEvents, Point));
if Assigned(Point) then
Point.Advise((WordSink as IUnknown), WordSink.AppCookie);
end;
// Sink with a Word document
OleCheck(WordDoc.QueryInterface(IConnectionPointContainer, PointContainer));
if Assigned(PointContainer) then begin
OleCheck(PointContainer.FindConnectionPoint(DocumentEvents, Point));
if Assigned(Point) then
Point.Advise((WordSink as IUnknown), WordSink.DocCookie);
end;
except
on E: Exception do ShowMessage(E.Message);
end;
end;
//////////////////////////////
unit ConnectionObject;
interface
uses Word_TLB;
type
TWordConnection = class(TObject, IUnknown, IDispatch)
protected
{IUnknown}
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{ IDispatch }
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
public
WordApp: _Application;
WordDoc: _Document;
AppCookie, DocCookie: Integer;
end;
implementation
{ IUnknown Methods }
uses windows, activex, main;
procedure LogComment(comment: string);
begin
Form1.Memo1.Lines.Add(comment);
end;
function TWordConnection._AddRef: Integer;
begin
Result := 2;
end;
function TWordConnection._Release: Integer;
begin
Result := 1;
end;
function TWordConnection.QueryInterface(const IID: TGUID;
out Obj): HResult;
begin
Result := E_NOINTERFACE;
Pointer(Obj) := nil;
if (GetInterface (IID, Obj)) then Result := S_OK;
if not Succeeded (Result) then
if (IsEqualIID(IID, DocumentEvents) or IsEqualIID(IID, ApplicationEvents)) then
if (GetInterface(IDispatch, Obj)) then Result := S_OK;
end;
{ IDispatch Methods }
function TWordConnection.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
function TWordConnection.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Pointer(TypeInfo) := nil;
Result := E_NOTIMPL;
end;
function TWordConnection.GetTypeInfoCount(out Count: Integer): HResult;
begin
Count := 0;
Result := E_NOTIMPL;
end;
function TWordConnection.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
begin
//This is the entry point for Word event sinking
Result := S_OK;
case DispID of
1: ; // Startup
2: ; // Quit
3: ; // Document change
4: ; // New document
5: ; // Open document
6: ; // Close document
else Result := E_INVALIDARG;
end;
end;
end.
使用方法，ConnectionObject是一个单独的单元，在其中的Invoke过程中的case DispID后面，你可以添加你的事件支持代码！如果需要全部的事件常量，请自己查看相关资料即可。
如果要OLE创建的东西支持事件，可以利用StartWordConnection函数来进行关联即可！
************************************
下面是Ex-Ex的解答，比较好的：
http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_10237322.html#1
Title: Word-close event with OLE and dp3.0
From: dr_gonzo
Date: 11/23/1999 04:16AM PST
Answer Grade: A Points: 60
Hi!
I have an app written in Delphi 3.0 that controles an instance of word via OLE. Word does not exactly behave the way one could expect in some cases.
I posted this to the Office group also, but since nowone of you reads those group I add it here too. I'm aware that this is a question that does not really commit to any area. This is the closest though.
I want my word document to tell me when the user has clicked the x-button(or control menu Close[Ctrl+F4].
If I make a template and writes an event handler for the Close-event it works so neat with a normal document, but my OLE-document never sends me any close-event it just kills the window...
How am I supposed to make word let my app know when it is closing rather than when it has closed. I want to be able to pop up some own dialogs before the actual close of the document...
by the way. It's the samething with the dirty-flag. It's always considered to be "False" if it's an OLE-document...
why the hell is that?
What can I do about it? How do I write my own Dirty-flag for a document?
Accepted Answer from vladika 11/24/1999 03:27AM PST
BTW when you close document you can process this event in the Delphi.
See example
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComObj, ActiveX;
const
WordDocEventIID: TGUID = '{000209F6-0000-0000-C000-000000000046}';
type
TForm1 = class;
// this class dispatch events from word
TWordDocumentEventDispatcher = class(TObject, IUnknown, IDispatch)
private
FOwner: TForm1;
FRefCount : Integer;
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: TForm1);
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FDispatcher: TWordDocumentEventDispatcher;
FConnection: Integer;
FDoc: Variant;
procedure OnClose;
procedure Connect;
procedure Disconnect;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TWordDocumentEventDispatcher }
constructor TWordDocumentEventDispatcher.Create(AOwner: TForm1);
begin
FOwner := AOwner;
FRefCount := 1;
end;
function TWordDocumentEventDispatcher.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
begin
Result := S_OK;
Exit;
end;
if IsEqualIID(IID, WordDocEventIID) then
begin
GetInterface(IDispatch, Obj);
Result := S_OK;
Exit;
end;
Result := E_NOINTERFACE;
end;
function TWordDocumentEventDispatcher._AddRef: Integer;
begin
FRefCount := FRefCount + 1;
Result := FRefCount;
end;
function TWordDocumentEventDispatcher._Release: Integer;
begin
FRefCount := FRefCount -1;
Result := FRefCount;
end;
function TWordDocumentEventDispatcher.GetTypeInfoCount(out Count: Integer): HResult;
begin
Count := 0;
Result:= S_OK;
end;
function TWordDocumentEventDispatcher.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
Pointer(TypeInfo) := nil;
Result := E_NOTIMPL;
end;
function TWordDocumentEventDispatcher.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
function TWordDocumentEventDispatcher.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params;
VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
try
case DispID of
-1: Exit; // DISPID_UNKNOWN
6: FOwner.OnClose;
end;
Result := S_OK;
except
Result := S_FALSE;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
WordApp : Variant;
Doc: Variant;
begin
Disconnect;
try
WordApp := GetActiveOleObject('Word.Application.8');
except on exception do
WordApp := CreateOleObject('Word.Application.8');
end;
WordApp.Visible := True;
WordApp.Activate;
FDoc := WordApp.Documents.Open('C:\My documents\Test.doc');
Connect;
end;
procedure TForm1.Connect;
begin
InterfaceConnect(FDoc, WordDocEventIID, FDispatcher, FConnection);
end;
procedure TForm1.Disconnect;
begin
InterfaceDisconnect(FDoc, WordDocEventIID, FConnection);
FDoc := Unassigned;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FDispatcher := TWordDocumentEventDispatcher.Create(Self);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Disconnect;
FDispatcher.Free;
end;
procedure TForm1.OnClose;
begin
MessageBox(0, 'OnClose', '', 0); // this procedure will be executed when you close document in the Word
end;
Comment from dr_gonzo 11/24/1999 04:14AM PST
Vladika.
This seems really intresting. I have problems making it work though. It doesn't compile cause Delphi 3.0 sais
"undeclared identifier: InterfaceConnect"
though I include the OleCtrl.pas
that beacuse the function is private.
Could you mail me the example source .zip-ed?
a.ohman@jit.se
This looks intresting. If the event ever go from Word at all that is.
Cause till now it's really look like Word doesn't send any events.
But I'd like to try this one out anyway.
\Dr. Gonzo
Comment from vladika 11/24/1999 04:47AM PST
Ok. I sent it.
Just in case I wrote source for this functions.
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;
Comment from RBertora 11/24/1999 04:55AM PST
Just watching now as you two seem to have things cooking nicely :-)
But I'd be very surprised if you can get D5 to work with D3.
Rob ;-)
Comment from vladika 11/24/1999 04:57AM PST
Ok. I sent it.
Just in case I wrote source for this functions.
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;
Comment from vladika 11/24/1999 05:05AM PST
Sorry for reposting.
To: RBertora
Why not?
I do not use special D5 features, classes or functions. I have not D3 at hand just now. But when I will back to home (4 hours later) I will convert it to D3 certainly. :)
Comment from vladika 11/24/1999 11:08AM PST
Also look at http://www.intac.com/~bly/com/resources/downloads.htm
"EventSinkImp is a utility that imports sink interfaces from COM server type libraries and automatically produces code for a Delphi non-visual component that publishes the sink methods as Delphi events."