На этом шаге мы рассмотрим способ задания цвета шрифта в ячейке таблицы.
Зададим цвет шрифта для текста ячейки.
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; Label7: TLabel; ComboBox1: TComboBox; 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); procedure ComboBox1Change(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; procedure TForm1.ComboBox1Change(Sender: TObject); //Изменение цвета шрифта в ячейке begin table.Cell(StrToInt(Edit4.Text),StrToInt(Edit3.Text)). Range.font.ColorIndex:=ComboBox1.ItemIndex; end; end.
Результат работы приложения можно увидеть на рисунке 1:
Рис.1. Результат работы приложения
На следующем шаге мы рассмотрим изменение направления текста.