На этом шаге мы рассмотрим способ задания шрифта текста в таблице.

Шрифт в Word представляет собой объект, имеющий свойства и методы, часть которых аналогична свойствам и методам объекта TFont в Delphi. Отличия заключаются в следующем: в Delphi можно задать цвет шрифта как сочетание красного, зеленого и синего, а в Word цвет выбирается из палитры возможных значений. В Word шрифт имеет больше дополнительных визуальных параметров, чем шрифт в Delphi. Сравним диалоги выбора и настройки шрифта в Word (рис. 1) и Delphi (рис. 2).

Рис.1. Диалог выбора шрифта в Word

Рис.2. Диалог выбора шрифта в Delphi

Мы будем задавать шрифт из программ, разработанных в Delphi, поэтому нам нужно будет преобразовать параметры объекта TFont Delphi в параметры объекта Font Word. Поскольку аналогичные по назначению свойства этих двух объектов имеют разные типы, нам придется использовать следующую специальную процедуру.

function FontToWFont(font:TFont;WFont:variant):boolean; 
const
  wdUnderlineNone=0;
  wdUnderlineSingle=1;
begin
  FontToWFont:=true;
  try
    WFont.Name:=font.Name;
    if fsBold in font.Style then WFont.Bold:=True   //Полужирный
    else WFont.Bold:=False;   //Светлый
    if fsItalic in font.Style then WFont.Italic:=True  //Курсив
    else WFont.Italic:=False; //Прямой
    WFont.Size:=font.Size;   //Размер
    if fsStrikeOut in font.Style then WFont.StrikeThrough:=True //Зачеркнутый
    else WFont.StrikeThrough:=False;   //Незачеркнутый
    if fsUnderline in font.Style then 
           WFont.Underline:=wdUnderlineSingle //Подчеркивание
    else WFont.Underline:=wdUnderlineNone; //Нет подчеркивания
  except
    FontToWFont:=false; 
  end; 
end;

Далее используем эту процедуру для преобразования шрифта и рассмотрим демонстрационную программу.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComObj;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    Button4: TButton;
    Button5: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Label3: TLabel;
    Edit2: TEdit;
    Label4: TLabel;
    Edit3: TEdit;
    Label5: TLabel;
    Edit4: TEdit;
    Button6: TButton;
    Button8: TButton;
    Label6: TLabel;
    Memo1: TMemo;
    Button7: TButton;
    FontDialog1: TFontDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
var
  W:Variant;
  table: Variant;

{$R *.dfm}

function FontToWFont(font:TFont;WFont:variant):boolean;
const
  wdUnderlineNone=0;
  wdUnderlineSingle=1;
begin
  FontToWFont:=true;
  try
    WFont.Name:=font.Name;
    if fsBold in font.Style then WFont.Bold:=True   //Полужирный
    else WFont.Bold:=False;   //Светлый
    if fsItalic in font.Style then WFont.Italic:=True  //Курсив
    else WFont.Italic:=False; //Прямой
    WFont.Size:=font.Size;   //Размер
    if fsStrikeOut in font.Style then WFont.StrikeThrough:=True //Зачеркнутый
    else WFont.StrikeThrough:=False;   //Незачеркнутый
    if fsUnderline in font.Style then 
            WFont.Underline:=wdUnderlineSingle //Подчеркивание
    else WFont.Underline:=wdUnderlineNone; //Нет подчеркивания
  except
    FontToWFont:=false;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
//Создание таблицы
begin
  W.ActiveDocument.Tables.Add(Range:=W.ActiveDocument.Range, 
            NumRows:=2, NumColumns:=3);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  W:=CreateOleObject('Word.Application');
  W.Visible:=True;
  W.Documents.Add;
end;

procedure TForm1.Button3Click(Sender: TObject);
//Таблица в конце документа
var
   MyRange:Variant;
begin
   W.ActiveDocument.Range.InsertAfter(' ');
   MyRange:=W.ActiveDocument.Range(W.ActiveDocument.Range.End-1,
                  W.ActiveDocument.Range.End-1);
   W.ActiveDocument.Tables.Add(Range:=MyRange, NumRows:=2, NumColumns:=3);
end;

procedure TForm1.Button4Click(Sender: TObject);
//Количество таблиц
var a: integer;
begin
  ListBox1.Items.Clear;
  for a:=1 to W.ActiveDocument.Tables.Count do
    begin
      ListBox1.Items.Add('Таблица - '+IntToStr(a));
    end;
end;

procedure TForm1.Button5Click(Sender: TObject);
//Удаление выбранной таблицы
begin
  W.ActiveDocument.Tables.Item(ListBox1.ItemIndex+1).Select;
  W.ActiveDocument.Tables.Item(ListBox1.ItemIndex+1).Delete;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
//Запомнить параметры выбранной таблицы
begin
  table:=W.ActiveDocument.Tables.Item(ListBox1.ItemIndex+1);
  Edit1.Text:=IntToStr(table.Columns.Count);
  Edit2.Text:=IntToStr(table.Columns.Width);

end;

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

procedure TForm1.Button8Click(Sender: TObject);
//Процедура добавления текста в выбранную ячейку
begin
  table.Cell(StrToInt(Edit4.Text),StrToInt(Edit3.Text)).Range.Text:=Memo1.text;
end;

procedure TForm1.Button7Click(Sender: TObject);
//Изменение шрифта ячейки
begin
  if not FontDialog1.Execute then exit;
  FontToWFont(FontDialog1.Font,
     table.Cell(StrToInt(Edit4.Text),StrToInt(Edit3.Text)).Range.font);
end;

end.

Текст этого приложения можно взять здесь (9,3 Кб).

Результат работы приложения можно увидеть на рисунках 3 и 4:

Рис.3. Результат работы приложения

Рис.4. Выбор шрифта

Процедура Button7Click, используя возвращаемый диалогом FontDialog1 шрифт, изменяет шрифт ячейки Cell(StrToInt(Edit4.Text),StrToInt(Edit3.Text)).

На следующем шаге мы рассмотрим задание цвета шрифта в ячейке.

Предыдущий шаг Содержание Следующий шаг