Шаг 160.
Автоматизация Microsoft Excel. Работа с объектами в книге Excel.
Заливка. Использование текстуры

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

    Еще один способ заливки - использование текстуры. Этот способ основан на использовании рисунка, который, многократно повторяясь, заполняет всю область объекта TextBox. Если размеры рисунка превосходят размер объекта, то заливкой объекта служит часть этого рисунка. Рисунок выбирается из списка или загружается из графического файла. Поэтому есть два метода задания текстуры:

    Рассмотрим две процедуры, применяющие эти методы.

procedure TForm1.ComboBox5Change(Sender: TObject);
//Задание текстурной заливки из списка
begin
  Fill.PresetTextured(ComboBox5.ItemIndex+1);
end;

procedure TForm1.Button8Click(Sender: TObject);
//Задание текстурной заливки из файла
begin
  if OpenPictureDialog1.Execute then
      Fill.UserTextured(OpenPictureDialog1.FileName);
end;

    Первая процедура позволяет выбрать один из вариантов текстуры. Вторая, используя диалог выбора графического файла, загружает текстуру из файла. Варианты текстурной заливки представлены на рисунке 1.


Рис.1. Текстурная заливка надписи

    Вот полный текст приложения.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    ComboBox1: TComboBox;
    ListBox1: TListBox;
    Label3: TLabel;
    Button4: TButton;
    Button5: TButton;
    ColorDialog1: TColorDialog;
    Label4: TLabel;
    SpinEdit1: TSpinEdit;
    ScrollBar1: TScrollBar;
    Label5: TLabel;
    Label6: TLabel;
    ComboBox2: TComboBox;
    Label7: TLabel;
    Button6: TButton;
    Button7: TButton;
    Label8: TLabel;
    ComboBox3: TComboBox;
    Label9: TLabel;
    ComboBox4: TComboBox;
    Label10: TLabel;
    ComboBox5: TComboBox;
    Button8: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure ComboBox4Change(Sender: TObject);
    procedure ComboBox5Change(Sender: TObject);
    procedure Button8Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
var
  E:variant;
  TextBox:variant;
  Fill:Variant;
{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
//Создание объекта Excel и отображение окна
begin
  E:=CreateOleObject('Excel.Application');
  E.Visible:=True;
end;

procedure TForm1.Button2Click(Sender: TObject);
//Создание рабочей книги
begin
  E.WorkBooks.Add;
end;


procedure TForm1.Button3Click(Sender: TObject);
//Создание надписи
const msoTextOrientationHorizontal=1;
var
  left,top:Extended;
begin
  left:=10;
  top:=11;
  if E.ActiveWorkBook.ActiveSheet.Shapes.Count>0 then
  begin
   left:=E.ActiveWorkBook.ActiveSheet.Shapes.
      item(E.ActiveWorkBook.ActiveSheet.Shapes.count).Left+20;
   top:=E.ActiveWorkBook.ActiveSheet.Shapes.
      item(E.ActiveWorkBook.ActiveSheet.Shapes.count).Top+20;
  end;
  E.ActiveWorkBook.ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal,
     left, top, 200, 100);
end;

procedure TForm1.Button4Click(Sender: TObject);
//Заполнить список надписей
var
  a: Integer;
begin
  ListBox1.Items.Clear;
  for a:=1 to E.ActiveWorkBook.ActiveSheet.Shapes.Count do
    ListBox1.Items.Add(E.ActiveWorkBook.ActiveSheet.Shapes.Item(a).Name);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
// При активизации строки объекта ListBoxl, используя имя объекта,
// выделяем его из коллекции Shapes и записываем ссылку на этот объект
//в переменную TextBox.
begin
  TextBox:=E.ActiveWorkBook.ActiveSheet.Shapes.Item(
    ListBox1.Items.Strings[ListBox1.ItemIndex]);
  Fill:=TextBox.Fill; //Ссылка на объект Fill
end;

procedure TForm1.Memo1Change(Sender: TObject);
//Помещение текста в надпись
begin
  TextBox.TextFrame.Characters.Text:=Memo1.Text;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
//Направление (ориентация) текста
begin
 case ComboBox1.ItemIndex of
  0: TextBox.TextFrame.Orientation:=3; //msoTextOrientationDownward
  1: TextBox.TextFrame.Orientation:=1; //msoTextOrientationHorizontal
  2: TextBox.TextFrame.Orientation:=6; //msoTextOrientationHorizontalRotatedFarEast
  3: TextBox.TextFrame.Orientation:=-2;//msoTextOrientationMixed
  4: TextBox.TextFrame.Orientation:=2; //msoTextOrientationUpward
  5: TextBox.TextFrame.Orientation:=5; //msoTextOrientationVertical
  6: TextBox.TextFrame.Orientation:=4; //msoTextOrientationVerticalFarEast
 end;
end;

procedure TForm1.Button5Click(Sender: TObject);
//Задание цвета заливки
begin
  if ColorDialog1.Execute then
     Fill.ForeColor.RGB:=ColorDialog1.Color;
end;

procedure TForm1.SpinEdit1Change(Sender: TObject);
//Задание прозрачности заливки
begin
  Fill.Transparency:=SpinEdit1.Value*0.01;
end;

procedure TForm1.Button6Click(Sender: TObject);
//Одноцветная градиентная заливка
begin
 Fill.OneColorGradient(ComboBox2.ItemIndex+1,
     ComboBox3.ItemIndex+1, ScrollBar1.Position*0.01);
end;

procedure TForm1.Button7Click(Sender: TObject);
//Двухцветная градиентная заливка
begin
 Fill.TwoColorGradient(ComboBox2.ItemIndex+1,
     ComboBox3.ItemIndex+1);
end;

procedure TForm1.ComboBox4Change(Sender: TObject);
//Выбор заготовки градиентной заливки из списка
begin
  Fill.PresetGradient(ComboBox2.ItemIndex+1,
     ComboBox3.ItemIndex+1, ComboBox4.ItemIndex+1);
end;

procedure TForm1.ComboBox5Change(Sender: TObject);
//Задание текстурной заливки из списка
begin
  Fill.PresetTextured(ComboBox5.ItemIndex+1);
end;

procedure TForm1.Button8Click(Sender: TObject);
//Задание текстурной заливки из файла
begin
  if OpenPictureDialog1.Execute then
      Fill.UserTextured(OpenPictureDialog1.FileName);
end;

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

    В заключение приведем перечень текстур, которые мы использовали при создании приложения.

Таблица 1. Перечень текстур
Мнемоническое обозначение Константа
msoTexturePapyrus 1
msoTextureCanvas 2
msoTextureDenim 3
msoTextureWovenMat 4
msoTextureWaterDroplets 5
msoTexturePaperBag 6
msoTextureFishFossil 7
msoTextureSand 8
msoTextureGreenMarble 9
msoTextureWhiteMarble 10
msoTextureBrownMarble 11
msoTextureGranite 12
msoTextureNewsprint 13
msoTextureRecycledPaper 14
msoTextureParchment 15
msoTextureStationery 16
msoTextureBlueTissuePaper 17
msoTexturePinkTissuePaper 18
msoTexturePurpleMesh 19
msoTextureBouquet 20
msoTextureCork 21
msoTextureWalnut 22
msoTextureOak 23
msoTextureMediumWood 24

    На следующем шаге мы продолжим изучение этого вопроса.




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