【delphi开源代码栏目提醒】:本文主要为网学会员提供AutoImpl.pas,希望对需要AutoImpl.pas网友有所帮助,学习一下!
unit AutoImpl;
interface
// This Demo excersises the use of ActiveX Automation using Early Binding.
uses
Windows, Classes, ActiveX, Word97;
type
TWordEventSink = class(TInterfacedObject, IUnknown, IDispatch)
private
FOwner : TObject;
FAppDispatch: IDispatch;
FDocDispatch: IDispatch;
FAppDispIntfIID: TGUID;
FDocDispIntfIID: TGUID;
FAppConnection: Integer;
FDocConnection: Integer;
FOnQuit : TNotifyEvent;
FOnDocumentChange : TNotifyEvent;
FOnNewDocument : TNotifyEvent;
FOnOpenDocument : TNotifyEvent;
FOnCloseDocument : TNotifyEvent;
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(AnOwner: TObject; AnAppDispatch: IDispatch; const AnAppDispIntfIID, ADocDispIntfIID: TGUID);
destructor Destroy; override;
property OnQuit : TNotifyEvent read FOnQuit write FOnQuit;
property OnDocumentChange : TNotifyEvent read FOnDocumentChange write FOnDocumentChange;
property OnNewDocument : TNotifyEvent read FOnNewDocument write FOnNewDocument;
property OnOpenDocument : TNotifyEvent read FOnOpenDocument write FOnOpenDocument;
property OnCloseDocument : TNotifyEvent read FOnCloseDocument write FOnCloseDocument;
end;
TWordObject = class
private
FWordApp : _Application;
FEventSink : TWordEventSink;
function GetCaption : String;
procedure SetCaption(Value : String);
function GetVisible : Boolean;
procedure SetVisible(Value : Boolean);
function GetOnQuit : TNotifyEvent;
procedure SetOnQuit(Value : TNotifyEvent);
function GetOnDocumentChange : TNotifyEvent;
procedure SetOnDocumentChange(Value : TNotifyEvent);
function GetOnNewDocument: TNotifyEvent;
procedure SetOnNewDocument(Value : TNotifyEvent);
function GetOnOpenDocument: TNotifyEvent;
procedure SetOnOpenDocument(Value : TNotifyEvent);
function GetOnCloseDocument: TNotifyEvent;
procedure SetOnCloseDocument(Value : TNotifyEvent);
public
constructor Create;
destructor Destroy; override;
procedure NewDoc(Template : String);
procedure CloseDoc;
procedure InsertText(Text : String);
procedure Print;
procedure SaveAs(Filename : String);
published
property Application : _Application read FWordApp;
property Caption : String read GetCaption write SetCaption;
property Visible : Boolean read GetVisible write SetVisible;
property OnQuit : TNotifyEvent read GetOnQuit write SetOnQuit;
property OnDocumentChange : TNotifyEvent read GetOnDocumentChange write SetOnDocumentChange;
property OnNewDocument : TNotifyEvent read GetOnNewDocument write SetOnNewDocument;
property OnOpenDocument : TNotifyEvent read GetOnOpenDocument write SetOnOpenDocument;
property OnCloseDocument : TNotifyEvent read GetOnCloseDocument write SetOnCloseDocument;
end;
implementation
uses
ComObj, Variants;
{ TWordEventSink implementation }
constructor TWordEventSink.Create(AnOwner : TObject; AnAppDispatch: IDispatch; const AnAppDispIntfIID, ADocDispIntfIID: TGUID);
begin
inherited Create;
FOwner := AnOwner;
FAppDispIntfIID := AnAppDispIntfIID;
FDocDispIntfIID := ADocDispIntfIID;
FAppDispatch := AnAppDispatch;
// Hook the sink up to the automation server (Word97)
InterfaceConnect(FAppDispatch,FAppDispIntfIID,Self,FAppConnection);
end;
destructor TWordEventSink.Destroy;
begin
// Unhook the sink from the automation server (Word97)
InterfaceDisconnect(FAppDispatch,FAppDispIntfIID,FAppConnection);
inherited Destroy;
end;
function TWordEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
// We need to return the two event interfaces when they're asked for
Result := E_NOINTERFACE;
if GetInterface(IID,Obj) then
Result := S_OK;
if IsEqualGUID(IID,FAppDispIntfIID) and GetInterface(IDispatch,Obj) then
Result := S_OK;
if IsEqualGUID(IID,FDocDispIntfIID) and GetInterface(IDispatch,Obj