home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Runimage / Delphi50 / Demos / Activex / Oleauto / Word8 / AUTOIMPL.PAS next >
Pascal/Delphi Source File  |  1999-08-11  |  9KB  |  322 lines
  1. unit AutoImpl;
  2.  
  3. interface
  4.  
  5. // This Demo excersises the use of ActiveX Automation using Early Binding.
  6.  
  7. uses
  8.   Windows, Classes, ActiveX, Word97;
  9.  
  10. type
  11.   TWordEventSink = class(TInterfacedObject, IUnknown, IDispatch)
  12.   private
  13.     FOwner : TObject;
  14.     FAppDispatch: IDispatch;
  15.     FDocDispatch: IDispatch;
  16.     FAppDispIntfIID: TGUID;
  17.     FDocDispIntfIID: TGUID;
  18.     FAppConnection: Integer;
  19.     FDocConnection: Integer;
  20.     FOnQuit : TNotifyEvent;
  21.     FOnDocumentChange : TNotifyEvent;
  22.     FOnNewDocument : TNotifyEvent;
  23.     FOnOpenDocument : TNotifyEvent;
  24.     FOnCloseDocument : TNotifyEvent;
  25.   protected
  26.     { IUnknown }
  27.     function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
  28.     function _AddRef: Integer; stdcall;
  29.     function _Release: Integer; stdcall;
  30.     { IDispatch }
  31.     function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
  32.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; stdcall;
  33.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  34.       NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
  35.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  36.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; stdcall;
  37.   public
  38.     constructor Create(AnOwner: TObject; AnAppDispatch: IDispatch; const AnAppDispIntfIID, ADocDispIntfIID: TGUID);
  39.     destructor Destroy; override;
  40.     property OnQuit : TNotifyEvent read FOnQuit write FOnQuit;
  41.     property OnDocumentChange : TNotifyEvent read FOnDocumentChange write FOnDocumentChange;
  42.     property OnNewDocument : TNotifyEvent read FOnNewDocument write FOnNewDocument;
  43.     property OnOpenDocument : TNotifyEvent read FOnOpenDocument write FOnOpenDocument;
  44.     property OnCloseDocument : TNotifyEvent read FOnCloseDocument write FOnCloseDocument;
  45.   end;
  46.  
  47.   TWordObject = class
  48.   private
  49.     FWordApp : _Application;
  50.     FEventSink : TWordEventSink;
  51.     function GetCaption : String;
  52.     procedure SetCaption(Value : String);
  53.     function GetVisible : Boolean;
  54.     procedure SetVisible(Value : Boolean);
  55.     function GetOnQuit : TNotifyEvent;
  56.     procedure SetOnQuit(Value : TNotifyEvent);
  57.     function GetOnDocumentChange : TNotifyEvent;
  58.     procedure SetOnDocumentChange(Value : TNotifyEvent);
  59.     function GetOnNewDocument: TNotifyEvent;
  60.     procedure SetOnNewDocument(Value : TNotifyEvent);
  61.     function GetOnOpenDocument: TNotifyEvent;
  62.     procedure SetOnOpenDocument(Value : TNotifyEvent);
  63.     function GetOnCloseDocument: TNotifyEvent;
  64.     procedure SetOnCloseDocument(Value : TNotifyEvent);
  65.   public
  66.     constructor Create;
  67.     destructor Destroy; override;
  68.     procedure NewDoc(Template : String);
  69.     procedure CloseDoc;
  70.     procedure InsertText(Text : String);
  71.     procedure Print;
  72.     procedure SaveAs(Filename : String);
  73.   published
  74.     property Application : _Application read FWordApp;
  75.     property Caption : String read GetCaption write SetCaption;
  76.     property Visible : Boolean read GetVisible write SetVisible;
  77.     property OnQuit : TNotifyEvent read GetOnQuit write SetOnQuit;
  78.     property OnDocumentChange : TNotifyEvent read GetOnDocumentChange write SetOnDocumentChange;
  79.     property OnNewDocument : TNotifyEvent read GetOnNewDocument write SetOnNewDocument;
  80.     property OnOpenDocument : TNotifyEvent read GetOnOpenDocument write SetOnOpenDocument;
  81.     property OnCloseDocument : TNotifyEvent read GetOnCloseDocument write SetOnCloseDocument;
  82.   end;
  83.  
  84. implementation
  85.  
  86. uses
  87.   ComObj;
  88.  
  89. { TWordEventSink implementation }
  90.  
  91. constructor TWordEventSink.Create(AnOwner : TObject; AnAppDispatch: IDispatch; const AnAppDispIntfIID, ADocDispIntfIID: TGUID);
  92. begin
  93.   inherited Create;
  94.  
  95.   FOwner := AnOwner;
  96.   FAppDispIntfIID := AnAppDispIntfIID;
  97.   FDocDispIntfIID := ADocDispIntfIID;
  98.   FAppDispatch := AnAppDispatch;
  99.  
  100.   // Hook the sink up to the automation server (Word97)
  101.   InterfaceConnect(FAppDispatch,FAppDispIntfIID,Self,FAppConnection);
  102. end;
  103.  
  104. destructor TWordEventSink.Destroy;
  105. begin
  106.   // Unhook the sink from the automation server (Word97)
  107.   InterfaceDisconnect(FAppDispatch,FAppDispIntfIID,FAppConnection);
  108.  
  109.   inherited Destroy;
  110. end;
  111.  
  112. function TWordEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
  113. begin
  114.   // We need to return the two event interfaces when they're asked for
  115.   Result := E_NOINTERFACE;
  116.   if GetInterface(IID,Obj) then
  117.     Result := S_OK;
  118.   if IsEqualGUID(IID,FAppDispIntfIID) and GetInterface(IDispatch,Obj) then
  119.     Result := S_OK;
  120.   if IsEqualGUID(IID,FDocDispIntfIID) and GetInterface(IDispatch,Obj) then
  121.     Result := S_OK;
  122. end;
  123.  
  124. function TWordEventSink._AddRef: Integer;
  125. begin
  126. // Skeleton implementation
  127.   Result := 2;
  128. end;
  129.  
  130. function TWordEventSink._Release: Integer;
  131. begin
  132. // Skeleton implementation
  133.   Result := 1;
  134. end;
  135.  
  136. function TWordEventSink.GetTypeInfoCount(out Count: Integer): HRESULT;
  137. begin
  138. // Skeleton implementation
  139.   Count  := 0;
  140.   Result := S_OK;
  141. end;
  142.  
  143. function TWordEventSink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT;
  144. begin
  145. // Skeleton implementation
  146.   Result := E_NOTIMPL;
  147. end;
  148.  
  149. function TWordEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  150.   NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
  151. begin
  152. // Skeleton implementation
  153.   Result := E_NOTIMPL;
  154. end;
  155.  
  156. function TWordEventSink.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  157.   Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT;
  158. begin
  159.   // Fire the different event handlers when
  160.   // the different event methods are invoked
  161.   case DispID of
  162.     2 : if Assigned(FOnQuit) then
  163.           FOnQuit(FOwner);
  164.     3 : begin
  165.           if Assigned(FOnDocumentChange) then
  166.             FOnDocumentChange(FOwner);
  167.           // When we see a document change, we also need to disconnect the
  168.           // sink from the old document, and hook it up to the new document
  169.           InterfaceDisconnect(FDocDispatch,FDocDispIntfIID,FDocConnection);
  170.           try
  171.             FDocDispatch := _Application(FAppDispatch).ActiveDocument;
  172.             InterfaceConnect(FDocDispatch,FDocDispIntfIID,Self,FDocConnection);
  173.           except;
  174.           end;
  175.         end;
  176.     4 : if Assigned(FOnNewDocument) then
  177.           FOnNewDocument(FOwner);
  178.     5 : if Assigned(FOnOpenDocument) then
  179.           FOnOpenDocument(FOwner);
  180.     6 : if Assigned(FOnCloseDocument) then
  181.           FOnCloseDocument(FOwner);
  182.   end;
  183.  
  184.   Result := S_OK;
  185. end;
  186.  
  187. { TWordObject implementation }
  188.  
  189. constructor TWordObject.Create;
  190. begin
  191.   // Fire off Word97 and create the event sink
  192.   FWordApp := CoWordApplication.Create;
  193.   FEventSink := TWordEventSink.Create(Self,FWordApp,ApplicationEvents,DocumentEvents);
  194. end;
  195.  
  196. destructor TWordObject.Destroy;
  197. var
  198.   SaveChanges,
  199.   OriginalFormat,
  200.   RouteDocument  : OleVariant;
  201. begin
  202.   SaveChanges := WdDoNotSaveChanges;
  203.   OriginalFormat := UnAssigned;
  204.   RouteDocument := UnAssigned;
  205.   try
  206.     FWordApp.Quit(SaveChanges,OriginalFormat,RouteDocument);
  207.   except
  208.   end;
  209.   FEventSink := nil;
  210.   inherited Destroy;
  211. end;
  212.  
  213. function TWordObject.GetVisible : Boolean;
  214. begin
  215.   Result := FWordApp.Visible;
  216. end;
  217.  
  218. procedure TWordObject.SetCaption(Value : String);
  219. begin
  220.   FWordApp.Caption := Value;
  221. end;
  222.  
  223. function TWordObject.GetCaption : String;
  224. begin
  225.   Result := FWordApp.Caption;
  226. end;
  227.  
  228. procedure TWordObject.SetVisible(Value : Boolean);
  229. begin
  230.   FWordApp.Visible := Value;
  231. end;
  232.  
  233. function TWordObject.GetOnQuit : TNotifyEvent;
  234. begin
  235.   Result := FEventSink.OnQuit;
  236. end;
  237.  
  238. procedure TWordObject.SetOnQuit(Value : TNotifyEvent);
  239. begin
  240.   FEventSink.OnQuit := Value;
  241. end;
  242.  
  243. function TWordObject.GetOnDocumentChange : TNotifyEvent;
  244. begin
  245.   Result := FEventSink.OnDocumentChange;
  246. end;
  247.  
  248. procedure TWordObject.SetOnDocumentChange(Value : TNotifyEvent);
  249. begin
  250.   FEventSink.OnDocumentChange := Value;
  251. end;
  252.  
  253. function TWordObject.GetOnNewDocument : TNotifyEvent;
  254. begin
  255.   Result := FEventSink.OnNewDocument;
  256. end;
  257.  
  258. procedure TWordObject.SetOnNewDocument(Value : TNotifyEvent);
  259. begin
  260.   FEventSink.OnNewDocument := Value;
  261. end;
  262.  
  263. function TWordObject.GetOnOpenDocument : TNotifyEvent;
  264. begin
  265.   Result := FEventSink.OnOpenDocument;
  266. end;
  267.  
  268. procedure TWordObject.SetOnOpenDocument(Value : TNotifyEvent);
  269. begin
  270.   FEventSink.OnOpenDocument := Value;
  271. end;
  272.  
  273. function TWordObject.GetOnCloseDocument : TNotifyEvent;
  274. begin
  275.   Result := FEventSink.OnCloseDocument;
  276. end;
  277.  
  278. procedure TWordObject.SetOnCloseDocument(Value : TNotifyEvent);
  279. begin
  280.   FEventSink.OnCloseDocument := Value;
  281. end;
  282.  
  283. procedure TWordObject.InsertText(Text : String);
  284. begin
  285.   FWordApp.Selection.TypeText(Text);
  286. end;
  287.  
  288. procedure TWordObject.NewDoc(Template : String);
  289. var
  290.   DocTemplate,
  291.   NewTemplate : OleVariant;
  292. begin
  293.   DocTemplate := Template;
  294.   NewTemplate := False;
  295.   FWordApp.Documents.Add(DocTemplate,NewTemplate);
  296. end;
  297.  
  298. procedure TWordObject.CloseDoc;
  299. var
  300.   SaveChanges,
  301.   OriginalFormat,
  302.   RouteDocument  : OleVariant;
  303. begin
  304.   SaveChanges := WdDoNotSaveChanges;
  305.   OriginalFormat := UnAssigned;
  306.   RouteDocument := UnAssigned;
  307.   FWordApp.ActiveDocument.Close(SaveChanges,OriginalFormat,RouteDocument);
  308. end;
  309.  
  310. procedure TWordObject.Print;
  311. begin
  312.   OleVariant(FWordApp).PrintOut;
  313. end;
  314.  
  315. procedure TWordObject.SaveAs(Filename : String);
  316. begin
  317.   OleVariant(FWordApp).ActiveDocument.SaveAs(FileName);
  318. end;
  319.  
  320. end.
  321.  
  322.