На этом шаге мы рассмотрим использование рисунка в качестве заливки.

Рассмотрим способ заливки, при котором фоном для надписи является рисунок. Метод UserPicture объекта Fill позволяет реализовать этот способ. Аргумент данного метода содержит путь и имя графического файла.

Следующая процедура, применяющая метод UserPicture, позволяет выбрать рисунок для заливки.

procedure TForm1.Button11Click(Sender: TObject);
//Выбор рисунка в качестве узора
begin
  if OpenPictureDialog1.Execute then
    Fill.UserPicture(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;
    Label11: TLabel;
    ComboBox6: TComboBox;
    Button9: TButton;
    Button10: TButton;
    ColorDialog2: TColorDialog;
    Button11: TButton;
    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);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure ComboBox6Change(Sender: TObject);
    procedure Button11Click(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;

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

procedure TForm1.Button10Click(Sender: TObject);
//Задание цвета фона
begin
   if ColorDialog1.Execute then
     Fill.BackColor.RGB:=ColorDialog1.Color;
end;

procedure TForm1.ComboBox6Change(Sender: TObject);
//Задание заливки в виде узора
begin
   Fill.Patterned(ComboBox6.ItemIndex+1);
end;

procedure TForm1.Button11Click(Sender: TObject);
//Выбор рисунка в качестве узора
begin
  if OpenPictureDialog1.Execute then
    Fill.UserPicture(OpenPictureDialog1.FileName);
end;

end.

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

На следующем шаге мы рассмотрим выноски.

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