Общаемся с сервером Word

Этот пример выполняет те же действия, что и два предыдущих, но позволяет выбрать тип доступа к серверу автоматизации Word:

• FWordintf: _Application; _Application = interface(IDispatch); FWordintf:= CoWordApplication.Create;
• FWordDispIntf: _ApplicationDisp; FWordDispIntf:= CreateComObject(CLASS_WordApplication) as _ApplicationDisp;
  к сожалению, этот вариант пока не работает.
• FOle: OleVariant; FOle:= CreateOleObject('Word.Application');

Текст модуля

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btnRunServ: TButton;
    btnServClose: TButton;
    SB1: TStatusBar;
    btnNewDoc: TButton;
    Panel1: TPanel;
    Memo1: TMemo;
    btnInsText: TButton;
    btnShowCmd: TButton;
    btnShowHide: TButton;
    btnInsPicture: TButton;
    OPD1: TOpenDialog;
    FD1: TFontDialog;
    btnQuit: TButton;
    btnFormat: TButton;
    RG1: TRadioGroup;
    procedure btnRunServClick(Sender: TObject);
    procedure btnServCloseClick(Sender: TObject);
    procedure btnNewDocClick(Sender: TObject);
    procedure btnInsTextClick(Sender: TObject);
    procedure btnShowCmdClick(Sender: TObject);
    procedure btnShowHideClick(Sender: TObject);
    procedure btnInsPictureClick(Sender: TObject);
    procedure btnQuitClick(Sender: TObject);
    procedure btnFormatClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RG1Click(Sender: TObject);
  private
    { Private declarations }
    FWordintf: _Application;
    FWordDispIntf:   _ApplicationDisp;
    FVari: integer;
    FOle: OleVariant;
    procedure pokaz(messa: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1; // WordObj: TWordObject = nil;
  Wapp: WordApplication = nil;  WD: WordDocument = nil;
  WD_Ole, Docs, Range_Ole: OleVariant; App: WordApplication;
  IDisp: IDispatch;

implementation uses ComObj, Variants;

{$R *.dfm}
var lada: integer;

procedure TForm1.pokaz(messa: string);
var ii: integer;
begin
  SB1.Font.Size:= 12;
  SB1.Font.Style:= [fsBold];
  for ii:=1 to 40 do
    begin
      messa:= ' ' + messa;
      SB1.SimpleText:= messa;
      sleep(5);
    end;
end;

procedure WDClose;
var  a,b,c: OLEVariant;
begin
 a:= wdDoNotSaveChanges; b:= wdPromptUser; c:= false;
 case Form1.FVari of
 0: if WD <> nil then
    begin
        try
        WD.Close(a,b,c);
        WD:= nil;
        except
        end;
    end;
  2: begin
        try
        WD_Ole.Close(a,b,c);
        WD_Ole:= UnAssigned;
        except
        end;
    end;
  end;
end;

procedure TForm1.btnRunServClick(Sender: TObject);
begin
 try
 case FVari of
  0: begin
       FWordintf:= CoWordApplication.Create;
       FWordintf.Visible:= true;
       FWordintf.Left:=2;
       FWordintf.Top:=2;
       FWordintf.Width:= 400;
       FWordintf.Height:=300;
  end;
  1: begin
       FWordDispIntf:= CreateComObject(CLASS_WordApplication) as _ApplicationDisp;
       FWordDispIntf.Visible:= true;
       FWordDispIntf.Left:=2;
       FWordDispIntf.Top:=2;
       FWordDispIntf.Width:= 400;
       FWordDispIntf.Height:=300;
  end;
  2: begin
      FOle:= CreateOleObject('Word.Application');
      FOle.Visible:= true;
       FOle.Left:=2;
       FOle.Top:=2;
       FOle.Width:= 500;
       FOle.Height:=200;
       FOle.Caption:= 'Word by OleObject';
  end;
 end;

  pokaz('Сервер открыт');
 except
  pokaz('Не могу открыть Сервер');
 end;
end;

procedure TForm1.btnServCloseClick(Sender: TObject);
var a,b,c: OLEVariant;
begin
  a:= wdPromptToSaveChanges; //  a:= wdSaveChanges;
  b:= wdWordDocument; //EmptyParam;
  c:= false; //EmptyParam;
  WDClose;

 case FVari of
  0:if FWordintf <> nil then
    begin
    FWordintf.Quit(a,b,c);
    FWordintf:= nil;
    pokaz('Сервер закрыт');
  end;
  1:if FWordDispIntf <> nil then
    begin
   { FWordDispIntf.Quit(a,b,c);
    FWordDispIntf:= nil;
    pokaz('Сервер закрыт'); }
  end;
  2: begin
       try
       FOle.Quit(a,b,c);
       except
       end;
        FOle:= UnAssigned;  //  Требует модуль Variant
        pokaz('Сервер закрыт');
     end;
 end;
end;

procedure TForm1.btnNewDocClick(Sender: TObject);
var visi,a,b,c: OLEvariant;
begin
  visi:= true;
  a:= EmptyParam;  // EmptyParam Требует Variant
  b:= false;
  c:= wdNewBlankDocument;

  case FVari of
  0: if FWordintf <> nil then
    WD:= FWordintf.Documents.Add(a,b,c,visi)
    else
  begin
    pokaz('Однако, сервер закрыт. Запустите ');
  end;
  1: if FWordDispIntf <> nil then
       begin
         { Docs:= FWordDispIntf.Application.Documents;
          Docs.Add;  }
         // FWordDispIntf.Application.Documents.Add(a,b,c,visi); //,c,visi);
        //  WD:= FWordDispIntf.Application.ActiveDocument;
         // WD:= FWordDispIntf.Documents.Add(a,b,c,visi)
       end
    else
      begin
        pokaz('Однако, сервер закрыт. Запустите ');
      end;
  2: begin
       FOle.Application.documents.add;
       WD_Ole:= FOle.Application.ActiveDocument;
       Range_Ole:= WD_Ole.Range;
     end;
  end{case};
end;

procedure TForm1.btnInsTextClick(Sender: TObject);
var ss: WideString; RR: Range; S,E: OLEVariant;
begin
 ss:= Memo1.Text;

  case FVari of
  0: begin
       if WD = nil then
         begin
           pokaz('Документ не открыт. Создайте новый документ');
           exit;
         end;
        S:= 0; E:=0;
        RR:= WD.Range(S,E);
        RR.InsertBefore(ss);
     end;
  2: begin
        S:= 0; E:=0;
        Range_Ole:= WD_Ole.Range(S,E);
        Range_Ole.InsertBefore(ss);
     end;
  end{case};
end;

procedure TForm1.btnShowCmdClick(Sender: TObject);
begin
 case FVari of
 0: if FWordintf <> nil then
  FWordintf.ListCommands(true) else
  pokaz('Нет сервера. Запустите сервер');
 1: if FWordDispIntf <> nil then
  FWordDispIntf.ListCommands(true) else
  pokaz('Нет сервера. Запустите сервер');
 2:FOle.Application.ListCommands(true);
 end;
end;

procedure TForm1.btnShowHideClick(Sender: TObject);
begin
 case FVari of
  0: begin
     if FWordintf <> nil then
     FWordintf.Visible:= not FWordintf.Visible else
     pokaz('Нет сервера. Запустите сервер');
  end;
  1: begin
     if FWordDispIntf <> nil then
     FWordDispIntf.Visible:= not FWordDispIntf.Visible else
     pokaz('Нет сервера. Запустите сервер');
  end;
  2: begin
//   if FOle <> Unassigned then
     FOle.Visible:= not FOle.Visible;
  end;

 end;
end;

procedure TForm1.btnInsPictureClick(Sender: TObject);
var ss: WideString; a,b,s,e,RR: OleVariant; Sh: InlineShape;
 Sh_Ole: OleVariant;
begin
  case FVari of
  0,1: begin
       if WD = nil then
         begin
           pokaz('Документ не открыт. Создайте новый документ');
           exit;
         end;

         if FVari = 0 then
         RR:= FWordintf.Selection.Range else
         RR:= FWordDispIntf.Selection.Range;

         if OPD1.Execute then
           begin
             ss:= OPD1.FileName;
             a:= false;
             b:= true;
             s:=0;
             e:=0;
             RR:= FWordintf.Selection.Range;
             Sh:= WD.InlineShapes.AddPicture(ss,a,b,RR);
           end;
     end;
  2: begin
        Range_Ole:= FOle.Application.Selection.Range;
         if OPD1.Execute then
           begin
             ss:= OPD1.FileName;
             a:= false;
             b:= true;
             s:=0;
             e:=0;
             Sh_Ole:= WD_Ole.InlineShapes.AddPicture(ss,a,b,Range_Ole);
           end;
     end;
  end{case};

end;

procedure TForm1.btnQuitClick(Sender: TObject);
begin
 btnServCloseClick(Sender);
 Application.Terminate;
end;

procedure TForm1.btnFormatClick(Sender: TObject);
var RR: Range; FF: TFont;
  WDF: WordFont; WDF_OLe: OleVariant;
begin
  case FVari of
  0: begin
       if WD = nil then
         begin
           pokaz('Документ не открыт. Создайте новый документ');
           exit;
         end;

         if FVari = 0 then
         RR:= FWordintf.Selection.Range else
         RR:= FWordDispIntf.Selection.Range;
         WDF:= RR.Font;
         RR.Select;

         if FD1.Execute then
           begin
             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.Size:= FF.Size;
           end;
     end;
  2: begin
        Range_Ole:= FOle.Application.Selection.Range;
         WDF_Ole:= Range_Ole.Font;
         Range_Ole.Select;

         if FD1.Execute then
           begin
             FF:= FD1.Font;
             if fsBold in FF.Style then WDF_Ole.Bold:= 1
               else WDF_Ole.Bold:= 0;
             if fsItalic in FF.Style then WDF_Ole.Italic:= 1
               else WDF_Ole.Italic:= 0;
             WDF_Ole.Name:= FF.Name;
             if FF.Color < 0 then
             WDF_Ole.Color:= 0 else
             WDF_Ole.Color:= FF.Color;
             WDF_Ole.Size:= FF.Size;
           end; 
     end;
  end{case};
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Fvari := 0;  // FOle:= UnAssigned; - требует Variant
end;

procedure TForm1.RG1Click(Sender: TObject);
begin
  FVari := RG1.ItemIndex;
end;

end.

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