Используем компоненты для создания контроллера автоматизации Word

---

Текст модуля (там же и пояснения)

{
1. автозавершение синтаксиса действует (т к подключен в uses WordXP)
2. Полезно, что в инспекторе есть события для компонентов
 TWordApplication, TWordDocument
3. Для свойств, отображенных в инспекторе, есть справка Делфи
 (TOLEServer.* )
4. Описание доступных методов и свойств - тоже в WinXP.pas
5. Чтобы узнать, какие методы и свойства доступны, нужно опять же смотреть
  в WinXP.pas, но в описание классов TWordApplication, TWordDocument.
6. Этот проект получен из проекта Word_COM (где описан TWordObject) в основном -
заменой имен объектов. Новые объекты - компоненты классов
TWordApplication, TWordDocument, установленные на форме.
Выполнены рекомендованные в книге настройки (в инспекторе):
 WA1.AutoConnect := true; WA1.AutoQuit:= true; WA1.ConnectKind:= ckRunningOrNew;
 WD11.AutoConnect:= false; WD11.ConnectKind:= ckAttachToInterface;

---------- Некоторые описания из WordXP.pas --------
  TWordApplication = class(TOleServer)
    FAutoQuit:    Boolean;
    property AutoQuit: Boolean read FAutoQuit write FAutoQuit;
    property Name: WideString read Get_Name;
    property Documents: Documents read Get_Documents;
    property Windows: Windows read Get_Windows;
    property ActiveDocument: WordDocument read Get_ActiveDocument;
      и т д , т е имена совпадают с именами св-в интерфейсов.

procedure TWordApplication.DisConnect;
begin
  if Fintf <> nil then
  begin
    DisconnectEvents(FIntf);
    if FAutoQuit then
      Quit();
    FIntf := nil;
  end;
end;

  TWordGlobal = class(TOleServer)
  private
    FIntf:        _Global;

  TWordDocument = class(TOleServer)
  private
    FIntf:        _Document;

   и аналогично 

-----
 предполагал, что свойства и методы классов TWordApplication, TWordDocument идентичны
 свойствам и методам интерфейсов, использованным в предыдущем проекте, так что 
 для справок пользовался  распечаткой из предыдущего проекта.
}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WordXP, StdCtrls, ComCtrls, ExtCtrls, ExtDlgs,
  OleServer;

type
  TForm1 = class(TForm)
    SB1: TStatusBar;
    Panel1: TPanel;
    Memo1: TMemo;
    OPD1: TOpenDialog;
    FD1: TFontDialog;
    WA1: TWordApplication;
    WD11: TWordDocument;
    btnAdd: TButton;
    btnVisible: TButton;
    btnFormat: TButton;
    btnInsPict: TButton;
    btnClose: TButton;
    btnInsText: TButton;
    procedure btnAddClick(Sender: TObject);
    procedure btnVisibleClick(Sender: TObject);
    procedure btnFormatClick(Sender: TObject);
    procedure btnInsPictClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnInsTextClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1; {WordObj: TWordObject = nil; }
  Wapp: WordApplication = nil;  WD: WordDocument = nil;

implementation uses ComObj;

{$R *.dfm}

procedure WD2Close(var s22: boolean);
var  a,b,c: OLEVariant;
begin
 s22:= false;
 if Form1.WA1.Documents.Count < 1 then
   begin
     showmessage('Все ушли на фронт. Закрывать некого');
     exit;
   end;
//  a:= wdPromptToSaveChanges;
    a:= wdSaveChanges;

  b:= EmptyParam; c:= EmptyParam;
  try
  Form1.WA1.ActiveDocument.Close(a,b,c);
  s22:= true;
  except
    showmessage('Ошибка закрытия');
  end;
end;

procedure TForm1.btnAddClick(Sender: TObject);
begin
  WA1.Width:= 400;
  WA1.Height:= 400;
  WA1.Left:= 6;
  WA1.Top:= 6;

  WA1.Documents.Add(Emptyparam, Emptyparam, Emptyparam, Emptyparam);
  WD11.ConnectTo(WA1.ActiveDocument);
  WA1.Visible:= true;
end;

procedure TForm1.btnVisibleClick(Sender: TObject);
begin
  WA1.Visible:= not WA1.Visible;
end;

procedure TForm1.btnFormatClick(Sender: TObject);
var RR: Range; FF: TFont;
  WDF: WordFont;
begin
 if WA1.Documents.Count < 1 then
   begin
     showmessage('Нет документов. Создайте новый документ'); exit;
   end;

 RR:= WA1.Selection.Range;
 WDF:= RR.Font;

 RR.Select;

 if FD1.Execute then
   begin
     try
     FF:= FD1.Font;
      if fsBold in FF.Style then WDF.Bold:= 1
        else WDF.Bold:= 0;
      if fsItalic in FF.Style then WDF.Italic:= 1
        else WDF.Italic:= 0;

      WDF.Name:= FF.Name;
      if FF.Color < 0 then
      WDF.Color:= 0 else
      WDF.Color:= FF.Color;
    { WDF.Color: WdColor;
      WdColor = TOleEnum;
      TOleEnum = type LongWord; (см ActiveX.pas )
      TColor = -$7FFFFFFF-1..$7FFFFFFF;
      т е не всякий TColor преобразуется в WdColor
      }
      WDF.Size:= FF.Size;
     except
       showmessage('Недопустимый параметр шрифта');
     end;
   end;
end;

procedure TForm1.btnInsPictClick(Sender: TObject);
var ss: WideString; a,b,s,e,RR: OleVariant; Sh: InlineShape;
begin
 if WA1.Documents.Count < 1 then
   begin
     showmessage('Нет документов. Создайте новый документ'); exit;
   end;

  if OPD1.Execute then
  begin
    ss:= OPD1.FileName;
    a:= false;
    b:= true;
    s:=0;
    e:=0;
    RR:= WA1.Selection.Range;
    Sh:= WD11.InlineShapes.AddPicture(ss,a,b,RR);
  end;
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
  Form1.Close;
end;

procedure TForm1.btnInsTextClick(Sender: TObject);
var ss: WideString; RR: Range; S,E: OLEVariant;
begin
 if WA1.Documents.Count < 1 then
   begin
     showmessage('Нет документов. Создайте новый документ'); exit;
   end;
 ss:= Memo1.Text;
 S:= 0; E:=0;
 RR:= WD11.Range(S,E);
 RR.InsertBefore(ss);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
   WA1.Caption:= 'Word - Application. Winni & sons';
   WA1.Visible:= true;
end;

end.

Скачать RAR-архив исходников + .exe(200 Кб)