Графика

Приступая к решению задач этого раздела, необходимо вспомнить:

• Программа может выводить графику на поверхность объекта (формы или компонента image), которой соответствует свой ство Canvas.
• Для того чтобы на поверхности объекта появился графиче ский элемент (линия, окружность, прямоугольник и т. д.) или картинка, необходимо применить к свойству Canvas этого объекта соответствующий метод.
• Цвет, стиль и толщину линий, вычерчиваемых методами Line, Ellipse, Rectangle И Т. Д., определяет СВОЙСТВО Реп объекта Canvas.
• Цвет закраски внутренних областей геометрических фигур, вычерчиваемых методами Line, Ellipse, Rectangle И Т. Д., определяет свойство Brush объекта canvas.
• Характеристики шрифта текста, выводимого методом Textout, определяет свойство Font объекта canvas.
• Основную работу по выводу графики на поверхность формы должна выполнять функция обработки события onPaint.

23. Напишите программу, которая на поверхности формы рису ет олимпийский флаг (рис. 1.19).

Рис. 1.19. Олимпийский флаг

// рисует олимпийский флаг
procedure TForml.FormPaint(Sender: TObj ect);
begin
with Canvas do
begin
// полотнище
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clBlack;
Canvas.Brush.Color := clCream;
Rectangle(30,30,150,115);
// кольца
Pen.Width := 2;
Brush.Style := bsClear; // область внутри круга
// не закрашивать
Pen.Color : = clBlue;
Ellipse(40,40,80,80);
Pen.Color := clBlack;
Ellipse(70,40,110,80);
Pen.Color := clRed;
Ellipse(100,40,140,80);
Pen.Color : = clYellow;
Ellipse(55,65,95,105);
Pen.Color := clGreen;
Ellipse(85,65,125,105);
end;
end;

24. Напишите программу, которая на поверхности формы рисует флаг Российской Федерации. .

// обработка события OnPaint
// процедура рисует флаг Российской Федерации
procedure TForml.FormPaint(Sender: TObject);
const
L = 200; // ширина флага (полосы)
H = 40; // высота полосы
var
х,у: integer; // левый верхний угол
begin
х := 30;
у := 50; with Canvas do
begin
// Чтобы у прямоугольников не было
// границы, цвет границы должен
// совпадать с цветом закраски Brush.Color := clWhite; // цвет закраски
Pen.Color := clWhite; // цвет границы
Rectangle(х,у,x+L,y+H);
Brush.Color := clBlue;
Pen.Color := clBlue;
Rectangle(x,y+H,x+L,y+2*H); Brush.Color := clRed;
Pen.Color := clRed;
Rectangle(x,y+2*H,x+L,y+3*H) ; // контур
Pen.Color : = clBlack;
Brush.Style := bsClear; // "прозрачная" кисть
Rectangle(x,y,x+l,y+h*3); Font.Size := 24;
Font.Name := 'Times New Roman';
Font.Color := clWhite;
TextOut(50,200,'P о с с и я');
Font.Color := clBlack;
TextOut(51,201,'? о с с и я1);
end;
end;end.

25. Напишите профамму, в диалоговом окне которой, в точке щелчка кнопкой мыши, вычерчивается контур пятиконечной звезды (рис. 1.20).

Рис. 1.20. Звезда

unit Stars_;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtris;type
TFontil class (TForm)
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations I
procedure StarLine(xO,yO,r: integer); // рисует звезду
end;var
Forml: TForml;implementation{$R *.dfm}// рисует звезду
procedure TForml.StarLine(xO,yO, r: integer);
// xO,yO — координаты центра звезды
//г — радиус звезды
var
р : array[1..11] of TPoint; // массив координат лучей и впадин
a: integer; // угол между осью ОХ и прямой, соединяющей
// центр звезды и конец луча или впадину
i: integer;
begin
а := 18; // строим от правого гор. луча
for i:=l to 10 do
begin
if (i mod 2=0) then
begin // впадина
p[i].x := xO+Round(r/3*cos(a*2*pi/360)) ;
p[i].y:=yO-Round(r/3*sin(a*2*pi/360) ) ;
end
else
begin // луч
i].x:=xO+Round(r*cos(a*2*pi/360) ) ;
i].y:=yO-Round(r*sin(a*2*pi/360)) ;
end;
a := a+36;
end; p[ll].X := p[l].X; // чтобы замкнуть контур звезды
р[11].Y := р[1].Y; Canvas.Polyline(p); // начертить контур звезды
end;// нажатие кнопки мыши
procedure TForml.FonnMouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft // нажата левая кнопка?
then Canvas.Pen.Color := clBlack
else Canvas.Pen.Color := clRed;
StarLine(x, y, 30);
end;end.
26. Напишите программу, по поверхности окна которой пере-
мещается случайным образом (прыгает) изображение веселой
рожицы, на котором пользователь может сделать щелчок кноп-
кой мыши. Программа должна завершить работу после того, как
пользователь сделает 10 щелчков кнопкой мыши. Рекомендуе-
мый вид окна в начале работы программы приведен на рис. 1.21.
unit tir_;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
Рис. 1.21. Окно программы Тир

type
TForml class(TForm)
Timer: TTimer;
Label1: TLabel;
Buttonl: TButton;
procedure TimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ForrnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ButtonlClick(Sender: TObject);
private
I Private declarations j
public
/ Public declarations }
объявление процедур помещено сюда,
чтобы процедуры имели прямой доступ
к форме, на которой они рисуют
****************************** , procedure PaintFace(x,у: integer); // рисует рожицу
procedure EraseFace(x,у: integer); // стирает рожицу
end;var
Forml: TForml;
fx,fy: integer; // координаты рожицы
n: integer; // количество щелчков кнопкой мыши
р: integer; // количество попаданий
implementation// рисует рожицу
procedure TForml.PaintFace(x,y: integer);
begin
Canvas.Pen.Color := clBlack; // цвет линий
Canvas.Brush.Color := clYellow; // цвет закраски
// рисуем рожицу
Canvas.Ellipse(х,у,x+30,Y+30); // лицо
Canvas.Ellipse(x+9,y+10,x+11,y+13); // левый глаз
Canvas.Ellipse(x+19,y+10,x+21,y+13); // правый глаз
Canvas.Arc(x+4,y+4,x+26,y+26,x,y+20,x+30,y+20); // улыбка
end;// стирает рожицу
procedure TForml.EraseFace(x,у: integer);
begin
// зададим цвет границы и цвет закраски,
// совпадающий с цветом формы. По умолчанию
// цвет формы - clBtnFace (см. в Object Inspector)
Canvas.Pen.Color := clBtnFace; // цвет окружности
Canvas.Brush.Color := clBtnFace; // цвет закраски
Canvas.Ellipse(x,y,x+30, y+30) ;
end;{$R *.dfm)procedure TForml.TimerTimer(Sender: TObject);
begin
EraseFace(fx,fy);
// новое положение рожицы
fx:= Random(ClientWidth-30); // 30 - это диаметр рожицы
fy:= Random(ClientHeight-30) ;
PaintFace(fx,fy);
end;procedure TForml.FormCreate(Sender: TObject);
begin
// исходное положение рожицы
fx:=100;
fy:=100;
Randomize; // инициализация генератора
// случайных чисел
end;
// нажатие клавиши мыши
procedure TForml.ForroMouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inc(n); // кол-во щелчков if (x > fx) and (x < fx+30) and
(y > fy) and (y < fy+30)
then begin
// щелчок по рожице
inc(p);
end;
if n = 10 then
begin
// игра закончена
Timer.Enabled := False; // остановить таймер
ShowMessage('Выстрелов: 10. Попаданий: ' +
IntToStr(p)+'.'); EraseFace(fx,fy); •
Label1.Visible := True;
Buttonl.Visible := True;
// теперь кнопка и сообщение снова видны
end;
end;

// щелчок на кнопке Ok
procedure TForml.ButtonlClick(Sender: TObject);
begin
Labell.Visible := False; // скрыть сообщение
Buttonl.Visible := False; // скрыть кнопку
Timer.Enabled := True; // пуск таймера
end;end.

27. Напишите программу, которая на поверхности формы вы черчивает кривую Гильберта (рис. 1.22). Пример кривой Гиль берта пятого порядка приведен на рис. 1.23.

Рис. 1.22. Кривые Гильберта

Рис. 1.23. Кривая Гильберта пятого порядка

var
р: integer = 5; // порядок кривой
u: integer =7; // длина штриха{ Кривая Гильберта состоит из четырех соединенных
прямыми элементов: а, Ъ, с и б.
Каждый элемент строит соответствующая процедура. }
procedure a(i:integer; canvas: TCanvas); forward;
procedure b(i:integer; canvas: TCanvas); forward;
procedure c(i:integer; canvas: TCanvas); forward;
procedure d(i:integer; canvas: TCanvas); forward;// Элементы кривой
procedure a(i: integer; canvas: TCanvas);
begin
if i > 0 then begin
d(i-l, canvas);
canvas.LineTo(canvas.PenPos.X+u, canvas.PenPos.Y);
a (i-1, canvas);
canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y+u);
a (i-1, canvas);
canvas.LineTo(canvas.PenPos.X-u, canvas.PenPos.Y);
с(i-1, canvas);
end;
end;procedure b(i: integer; canvas: TCanvas);
begin
if i > 0 then
begin
с (i-1, canvas);
canvas.LineTo(canvas.PenPos.X-u, canvas.PenPos.Y);
b(i-l, canvas);
canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y-u);
b(i-l, canvas);
canvas.LineTo(canvas.PenPos.X+u,canvas.PenPos.Y);
d(i-l, canvas);
end;
end;procedure c(i: integer; canvas: TCanvas);
begin
if i > 0 then
begin
b(i-l, canvas);
canvas.LineTo(canvas.PenPos.X, canvas.PenPos.Y-u);
с(i-1, canvas) ;
canvas.LineTo(canvas.PenPos.X-u, canvas.PenPos.Y);
с(i-1, canvas);
canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y+u);
a(i-1, canvas);
end;
end;
procedure d(i: integer; canvas: TCanvas);
begin
if i > 0 then
begin
a (i-1, canvas);
canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y+u);
d(i-l, canvas);
canvas.LineTo(canvas.PenPos.X+u,canvas.PenPos.Y);
d(i-l, canvas);
canvas.LineTo(canvas.PenPos.X,canvas.PenPos.Y-u);
b(i-l, canvas);
end;
end;// обработка события OnPaint
procedure TForml.FormPaint(Sender: TObject);
begin
Forml.Canvas.MoveTo(u,u);
a(5,Forml.Canvas); // вычертить кривую Гильберта
and;

28. Напишите профамму, которая на поверхность формы выво дит изображение оцифрованной координатной сетки (рис. 1.24).

Рис. 1.24. Координатная сетка

/ обработка события OnPaint
procedure TForml.FormPaint(Sender: TObject);
var
xO,yO:integer; // координаты начала координатных осей
dx,dy:integer; // шаг координатной сетки (в пикселах)
h,w:integer; // высота и ширина области вывода координатной
// сетки
х,у:integer; lx,ly:real; // метки (оцифровка) линий сетки по X и Y
dlx,dly:real; // шаг меток (оцифровки) линий сетки по X и Y
cross:integer; // счетчик не оцифрованных линий сетки
dcross:integer; // количество не оцифрованных линий
// между оцифрованными
begin
х0:=30; у0:=220; // оси начинаются в точке (40,250)
dx:=40; dy:=4O; // шаг координатной сетки 40 пикселов
dcross:=1; // помечать линии сетки X: 1 — каждую;
// 2 — через одну;
// 3 ~ через две;
dlx:=0.5; // шаг меток qch X
dly:=1.0; // шаг меток оси У, метками будут: 1,2,3
// и т. д.
h:=200;
w:=300; with forml.Canvas do
begin
cross:=dcross ;
MoveTo(xO,yO); LineTofxO,yO-h); // ось X
MoveTo(xO,yO); LineTo(xO+w,yO); // ось Y // засечки, сетка и оцифровка по оси X
x:=xO+dx;
lx:=dlx;
repeat
MoveTo(x,yO-3);LineTo(x,yO+3) ; // засечка
cross:=cross-l;
if cross = 0 then //оцифровка
begin
TextOut(x-8,yO+5,FloatToStr(lx)) ;
cross:=dcross;
end;
Pen.Style:=psDot;
MoveTo(x,yO-3);LineTo(x,yO-h); // линия сетки
Pen.Style:=psSolid;
lx:=lx+dlx;
x:=x+dx;
until (x>xO+w);
// засечки, сетка и оцифровка по оси Y
y:=yO-dy;
ly:=dly;
repeat
MoveTo(xO-3, у);LineTo(xO+3,y) ; // засечка
TextOut(xO-20,y,FloatToStr(ly)) // оцифровка
Pen.Style:=psDot ;
MoveTo(xO+3,y); LineTo(xO+w,y); // линия сетки
Pen.Style:=psSolid;
y:=y-dy;
ly:=ly+dly;
until (y<yO-h);
end;
end;

29. Напишите программу, которая на поверхности формы вычерчивает график функции, например 2 sin(x) e*/5. Вид окна во время работы профаммы приведен на рис. 1.25.

Рис. 1.25. Окно программы График функции

// Функция, график которой надо построить
Function f(x:real):real;
begin
f:=2*Sin(x)*exp(x/5);
end;// строит трафик функции
procedure GrOfFunc;
var
xl,x2:real; // границы изменения аргумента функции
yl,y2:real; // границы изменения значения функции
x:real; // аргумент функции
у:real; // значение функции в точке х
dx:real; // приращение аргумента
l,b:integer; // левый нижний угол области вывода графика
w,h:integer; // ширина и высота области вывода графика
mx,my:real; // масштаб по осям X и Y
хО,уО:integer; // точка — начало координатbegin
// область вывода графика "
1:=10; // X — координата левого верхнего
// угла
b:=Forml.ClientHeight-20; // Y — координата левого верхнего
// угла
h:=Forml.ClientHeight-40; // высота
w:=Forml.Width-40; // ширина xl:=0; // нижняя граница диапазона аргумента
х2:=25; // верхняя граница диапазона аргумента
dx:=0.01; // шаг аргумента // найдем максимальное и минимальное значения
// функции на отрезке [xl,x2]
yl:=f(xl); // минимум
y2:=f(xl); //максимум
х:=xl;
repeat
у := f(x);
if у < yl then yl:=y;
if у > у2 then y2:=y;
x:=x+dx;
until (x>=x2);
// вычислим масштаб
my:=h/abs(y2-yl); // масштаб по оси Y
mx:=w/abs(x2-xl); // масштаб по оси X // оси
хО:=1;
уО:=b-Abs(Round(yl*my)); with forml.Canvas do
begin
// оси
MoveTo(l,b);LineTo(l,b-h);
MoveTo(xO,yO);LineTo(xO+w, yO) ;
TextOut (l+5,b-h,FloatToStrF(y2,ffGeneral,6,3) ) ;
TextOut(1+5,b,FloatToStrF(yl,ffGeneral, 6,3) ) ;
// построение графика
x:=xl;
repeat
y:=f(x);
Pixels[xO+Round(x*mx),yO-Round(y*my)]:=clRed;
x:=x+dx;
until (x>=x2);
end;
end;
procedure TForml.FormPaint(Sender: TObject);
begin
GrOfFunc;
end;// изменился размер окна программы
procedure TForml.FormResize(Sender: TObject);
begin
// очистить форму
forml.Canvas.FillRect(Rect(0,O,ClientWidth,ClientHeight));
// построить график
GrOfFunc;
end;

30. Напишите программу, которая выводит на экран гистограм му, например, результатов контрольной работы. Пример окна программы во время ее работы приведен на рис. 1.26.

Рис. 1.26. Окно программы Гистограмма

implementation •{$R *.dfm}const
NR = 4; // кол-во строк в таблице
var
n: array[1..NR] of real; // значения категорий
p: array[1..NR] of real; // процент категории в общей сумме
h: array[1..NR] of integer; // высота столбиков диаграммы // цвет столбиков диаграммы
BarColor: array[1..4] of TColor = (clRed,clGreen,clBlue,clYellow);// ввод и обработка
// если исходные данные введены, то Obr = TRUE
function Obr : boolean;
var
sum: real; // сумма категорий
га: integer; // номер категории, имеющей максимальное значение
i: integer;
begin
obr := FALSE; // пусть исх. данные не введены
// скопируем содержимое второго столбца
// в массив исходных данных
for i:=l to NR do
// здесь возможно исключение (ошибка) преобразования,
// если пользователь не ввел данные
begin
try
n[i] := StrToFloat(Forml.StringGridl.Cells[1,i]);
except
on EConvertError do
begin
ShowMessage('Надо ввести данные во все' + #13 +
'ячейки второй колонки.');
exit;
end;
end;
end;
// вычислим сумму категорий (эл-тов второго столбца)
sum := 0;
for i:=l to NR do
sum := sum + n [ i ]; // вычислим процент каждой категории
for i:=l to NR do
p[i] := n[i] / sum; // определим категорию с максимальным значением
m := 1;
for i := 2 to NR do
if n[i] > n[m] then m:=i; // пусть максимальному значению соответствует
// столбик высотой в Imagel.Height-20 пикселов
// вычислим высоту остальных столбиков
for i :=1 to NR do
h[i] := Round((Forml.Imagel.Height - 20) *
n[i] /n[m]) ; // все готово
// можно строить диаграмму
obr := TRUE;
end;
// диаграмма
procedure diagr;
const
WR = 25; // ширина столбика
DP. = 10; // расстояние между столбиками
var
х,у. integer; .// левый нижний угол столбика i: integer;
begin
with Forml. Imagel do
begin
x:=10;
y.=Height;
Canvas.Brush.Color := clWindow;
Canvas.Rectangle(0,0,Width,Height);
// *** рисуем столбики ***
for i:=l to 4 do
begin
Canvas.Brush.Color := BarColor[i]; // цвет столбика
«
Canvas.Rectangle(x,у,x+WR,y-h[i]); // столбик
Canvas.Brush.Color := clWindow; // чтобы область
// за текстом
// не была окрашена
// подпись данных (над столбиком)
Canvas.TextOut(x,y-h[i]-15,
FloatToStrF(p[i]*100,ffGeneral,3,2)+'%');
x := x + WR + DR;
end; // *** легенда ***
// здесь х — координата левой границы
// последнего столбика
х := х + 20;
у:=20; // 20 пикселов от верхнего края Imagel
for i:=l to 4 do
begin
Canvas.Brush.Color := BarColor[i]; // цвет прямоугольника
11 легенды
Canvas.Rectangle(x,у,x+25,y+14); // прямоугольник легенды
Canvas.Brush.Color := clWindow;
Canvas.TextOut(x+WR+10,у,
Forml.StringGridl.Cells[0,i]);
у := у + 20;
end;
end; // with Forml.Imagel
end;procedure TForml.FormCreate(Sender: TObject);
begin
// определим заголовки колонок
StringGridl.Cells[0,0] := 'Категория';
StringGridl.Cells[1,0] := 'Кол-во1;
StringGridl.Width :=
StringGridl.ColWidths[01 + StringGridl.ColWidths[l]+5;end;// нажатие клавиши в ячейке таблицы (компонента StringGrid)
// в результате нажатия клавиши <Enter> курсор переходит
// в следующую ячейку
procedure TForml.StringGridlKeyPress(Sender: TObject;
var Key: Char);
begin
// Col, Row — номер колонки и строки,
// в которой находится курсор (нумерация с нуля).
// ColCount и RowCount — кол-во колонок и строк if Key = #13 then
begin
// нажата клавиша <Enter>
if StringGridl.Col < StringGridl.ColCount - 1
then
// ячейка не в последнем столбце
StringGridl.Col := StringGridl.Col + 1 // к след. столбцу
else
// ячейка в последнем столбце
if ( StringGridl.Row < StringGridl.RowCount — 1) then
begin
// в первый столбец следующей строки
StringGridl.Col :=0;
StringGridl.Row := StringGridl.Row +1;
end
else Buttonl.SetFocus;
exit;
// во вторую колонку разрешается вводить
// только числа
if StringGridl.Col = 1 then
// клавиша нажата в ячейке
'// второй колонки
case Key of
1 0' . . ' 9', # 8 :;
iii i .
begin
Key := DecimalSeparator;
if Pos(DecimalSeparator,
StringGridl.Cells[StringGridl.Row,
StringGridl.Col]) о О
then Key := Char(O);
end;
else Key := Char(O);
end;
end;// щелчок на кнопке Построить
procedure TForml.ButtonlClick(Sender: TObject);
begin
if Obr // исходные данные введены
then diagr; // строим диаграмму
end;end.

31. Напишите программу, которая выводит на поверхность фор мы круговую диаграмму, отражающую, например, товарооборот книжного магазина (рис. 1.27).

32. Напишите программу, которая в отдельном окне строит гра фик функции. Функция задается таблицей, первая строка кото рой содержит значения аргументов, вторая — соответствующие
значения функции. Рекомендуемый вид главной формы приве ден на рис. 1.28. Вид формы, на поверхности которой вычерчи вается график, представлен на рис. 1.29.

Рис. 1.27. Круговая диаграмма, отражающая товарооборот книжного магазина

Рис. 1.28. Главная форма приложения График

Рис. 1.29. Форма, на поверхности которой будет построен график

// Модуль главной формы приложенияunit grafikOl;interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls, Grids;type
TForml = class(TForm)
StringGridl: TStringGrid;
Labell: TLabel;
Buttonl: TButton;
CheckBoxl: TCheckBox;
procedure ButtonlClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations )
public •
/ Public declarations )
end;var
Forml: TForml;// Процедуру gr вызывает процедура обработки
// события onPaint для формы Form2, на поверхности
// которой вычерчивается график и которая
// находится в другом модуле. Поэтому объявление
// функции надо поместить в раздел Interface.
procedure gr; // чтобы процедуру можно было вызвать
// из другого модуля
implementationuses grafikO2;{$R *.dfm}/ Во время создания формы установить
свойства компонента StringGrid:
FixedRows := 0;
RowCount := 2;
Opt ions. goEdit ing := True;
Options. goTab := True;
const
COLCOUNT = 15;
var
// аргументы и значения функции
х: array[1..COLCOUNT] of real;
у: array[1..COLCOUNT] of real;// строит график по содержимому массивов х,у
procedure gr;
var
i: integer; xl,x2:real; // границы изменения аргумента функции
yl,y2:real; // границы изменения значения функции
l,b:integer; // левый нижний угол области вывода графика
w,h: integer; // ширина и высота области вывода графика
mx,my:real; // масштаб по осям X и Y
хО,уО:integer; // точка пересечения координатных осей
рх,ру: integer; // координаты точки графика на поверхности
// формы
np: integer; // кол-во точек графикаbegin
Form2.Canvas.Rectangle(0,0,Form2.ClientWidth,Form2.ClientHeight);
// область вывода графика
l:=10; // X — координата левого верхнего угла
b:=Form2.ClientHeight-20; //Y — координата левого нижнего угла
h:=Form2.ClientHeight-40; // высота
w:=Form2.Width-40; // ширина
// определим границы изменения аргумента
// и количество точек (элементы массива X
// должны образовывать возрастающую последовательность)
xl:=x[l];
i:=l;
while (x[i+l] > x[i]) and (i < COLCOUNT) do
1.— i+l; x2:= x[i]; //x[COLCOUNT-1];
np:=i; // количество точек
if np < 2 then begin
ShowMessage('Количество точек графика не может быть меньше
двух');
exit;
end;// найдем максимальное и минимальное значения функции
yl:=0; //у[1]; // минимум
у2:=0; //у[1]; // максимум
for i: =1 to np do
begin
if y[i] < yl then yl:=y[i];
if y[i] > y2 then y2:=y[i];
end;// вычислим масштаб
my:=h/abs(y2-yl); // масштаб по оси Y
mx:=w/abs(x2-xl); // масштаб по оси X// точка пересечения координатных осей
xO:=l+Abs(Round(xl*mx));
yO:=b-Abs(Round(yl*my));with form2.Canvas do
begin
MoveTo(xO,b);LineTo(xO,b-h); // ось Y
MoveTo(l,yO) ;LineTo(l+w,yO) ; // ось X TextOut(l+5,b-h,FloatToStrF(y2,ffGeneral,6,3));
TextOut(1+2,b+2,FloatToStrF(yl,ffGeneral,6,3})г // построить график
for i :=1 to np do
begin
px := xO+Round(x[i]*mx);
py := yO-Round(y[i]*my); Form2.Canvas.Pen.Color := clRed;
Rectangle(px-2,py-2,px+2,py+2) ; // маркер if Forml.CheckBoxl.Checked then
// соединительная линия
if i = 1
then MoveTo(px,py)
else LineTo(px,py);
Form2.Canvas.Pen.Color := clBlack; // значение функции и аргумент
TextOut(px-5,py-15,FloatToStr(y[i]) ) ;
TextOut(px-5,yO+2, FloatToStr(x[i]));
MoveTo(px,py) ; // вернуть перо в точку рх, ру,
// т. к. TextOut меняет положение пера
end;
end;
end;procedure TForml.FormCreate(Sender: TObject);
var
i: integer;
begin
StringGridl.ColCount := COLCOUNT;
StringGridl.Cells[0,0] := ' X1;
StringGridl.Cells[0,1] := ' Y1;
// отладка: заполним таблицу
for i:=l to COLCOUNT do
begin
StringGridl.Cells[i,0] := IntToStr(i-1);
StringGridl.Cells[i, 1] := IntToStr(i-1);
end;
end;// щелчок на кнопке Построить
procedure TForml.ButtonlClick(Sender: TObject);
var
i: integer;
begin
// перепишем содержимое таблицы в массивы
// аргументов и значений функции
for i:=l to COLCOUNT-1 do
begin
x[i] := StrToFloat(Forml.StringGridl.Cells[i,0]);
y[i] := StrToFloat(Forml.StringGridl.Cells[i,l]);
end; // функцию вывода графика вызывает процедура
// обработки события OnPaint для Form2
if not Form2.Showing
then Form2.Show // отобразить окно Form2
else Form2.Repaint;
end;end.
// Модуль формы, на поверхности которой
// вычерчивается график unit grafikO2;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, grafikOl; // *** эта ссылка вставлена вручную!type
TForm2 = class(TForml
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: T?>bject);
private
{ Private declarations }
public
{ Public declarations )
end;var
Form2: TForm2;implementation{$R *.dfm}// событиеОпРаint происходит при первом появлении
// окна на экране и тогда, когда окно
// или его часть надо перерисовать
procedure TForm2.FormPaint(Sender: TObject);
begin
gr; // вывести график
end;// событие OnResize происходит, если
// пользователь изменил размер окна
procedure TForm2.FormResize{Sender: TObject);
begin
gr; // вывести график
end;end.

33. Напишите программу, по поверхности окна которой перемещается графический объект, например кораблик (рис. 1.30). Вид окна программы приведен на рис. 1.31.

Рис. 1.30. Кораблик

Рис. 1.31. Простая мультипликация — кораблик, плывущий по морю

unit ship_;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls;type
TForml = class(TForm)
Timerl: TTimer;
procedure TimerlTimer(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations )
public
I Public declarations }
end;var
Forml: TForml;implementation{$R *.DFM}
x,y: integer; // координаты корабля (базовой точки)// вычерчивает на поверхности формы кораблик
// или стирает его
procedure Parohod(x,y: integer; mode: boolean);
// x,y — координаты базовой точки кораблика
// mode: True — нарисовать, False — стереть
const
/ Базовые точки кораблика находятся в узлах сетки,
шаг которой определяет размер кораблика )
dx = 5; // шаг сетки по X
dy = 5; // шаг сетки по У
var
// корпус и надстройку будем рисовать
// при помощи метода Polygon
pi: array[1..7]of TPoint; // координаты точек корпуса
р2: array[1..8]of TPoint; // координаты точек надстройки
pc,bc: TColor; // текущей цвет карандаша и кистиbegin
if not mode then
begin
// стереть
Forml.Canvas.Brush.Color := clNavy;
Forml.Canvas.Pen.Color : = ClNavy;
Forml.Canvas.Rectangle(x,y+l,x+17*dx,y-10*dy);
Forml.Canvas.Brush.Color := clNavy;
// небо
if y-10*dy < 80 then
begin
// конец мачты на фоне неба
Forml.Canvas.Pen.Color := clSkyBlue;
Forml.Canvas.Brush.Color := ClSkyBlue;
Forml.Canvas.Rectangle(x,y-10*dy,x+17*dx,80);
end;
exit;
end; // рисуем
with Forml.Canvas do
begin
pc := Pen.Color; // сохраним текущий цвет карандаша
be := Brush.Color; // и кисти Pen.Color := clBlack; // установим нужный цвет
Brush.Color := clWhite;
// рисуем . . .
// корпус
pl[i]-х = х; Pl [1] -У = y;
pl[2] .х = х; Pl [2].Y = y-2 *dy,
pi[3].х =x+10*dx; Pl [3] .Y - y-2 *dy,
pl[4] .X =x+ll*dx; pl [4].Y = y-3 +dy,
pl[5] .X =x+17*dx; pl [5].Y = y-3 *dy,
р1[б] .X =x+14*dx; Pl [6] .Y = y;
pl[7].X =x; Pl [7].Y ¦ У''
Polygon(pl);
// надстройка
p2[l].X := x+3*dx; p2[l].Y := y-2*dy;
p2[2].X := x+4*dx; p2[2].Y := y-3*dy;
р2[3].Х = x+4*dx; p2[3].Y = y-4*dy;
р2[4] .X = x+13*dx; p2[4].Y = y-4*dy;
р2[5].Х = x+13*dx; p2[5].Y = y-3*dy;
р2[6].Х = x+ll*dx; p2[6].Y = y-3*dy;
р2[7].Х = x+10*dx; p2[7].Y = y-2*dy;
р2[8].Х = x+3*dx; p2[8].Y = y-2*dy;
Polygon(p2);
MoveTo(x+5*dx,y-3*dy) ;
LineTo(x+9*dx,y-3*dy);
// капитанский мостик
Rectangle(x+8*dx,y-4*dy,x+ll*dx,y-5*dy);
// труба
Rectangle(x+7*dx,y-4*dy,x+8*dx,y-7*dy) ;
// иллюминаторы
Ellipse(x+ll*dx,y-2*dy,x+12*dx,y-l*dy) ;
Ellipse(x+13*dx,y-2*dy,x+14*dx,y-l*dy);
// мачта
MoveTo(x+10*dx,y-5*dy);
LineTo(x+10*dx,y-10*dy);
// оснастка •
Pen.Color := clwhite;
MoveTo(x+17*dx,y-3*dy);
LineTo(x+10*dx,y-10*dy) ;
LineTo(x,y-2*dy) ;
Pen.Color := pc; // восстановим старый цвет карандаша
end;
end;// обработка сигнала таймера
procedure TForml.TimerlTimer(Sender: TObject);
begin
Parohod(x,y, False); // стереть рисунок
if x < Forml.ClientWidth
then x := x+2
else begin // новый рейс
x := 0;
у :- Random(50) + 100;
end;
Parohod(x,y,True); // нарисовать в новой точке
end;
procedure TForml.FormPaint(Sender: TObject);
begin
// небо
Canvas.Brush.Color := clSkyBlue;
Canvas.Pen.Color := clSkyBlue;
Canvas.Rectangle(0,0,ClientWidth, 80) ;
end;procedure TForml.FormCreate(Sender: TObj ect);
begin
x:=0; y:=80; // исходное положение парохода
Forml.Color:=clNavy; // цвет моря
Timerl.Interval := 50; // сигнал таймера каждые 50 мсек
end;end.

34. Напишите программу, которая на поверхность формы выво дит изображение идущих часов с часовой, минутной и секунд ной стрелками. Окно и форма приложения приведены на рис. 1.32.

Рис. 1.32. Окно и форма программы Часы

unit' clock_;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, ExtCtrls;
type
TForml = class(TForm)
Timerl: TTimer;
procedure FormCreate(Sender: TObject);
procedure ForraPaint(Sender: TObject);
procedure TimerlTimer(Sender: TObject); // эти объявления вставлены вручную
procedure Vector(xO,yO,a,1: integer);
procedure DrawClock; private
{ Private declarations )
public
I Public declarations }
end;var
Forml: TForml;implementation .
{$R *.dfm}uses
DateUtils; // для доступа к SecondOf,
// MinuteOf и HourOfconst
R = 75; // радиус циферблата часовvar
xO,yO: integer; // центр циферблата
ahr,amin,asec: integer; // положение стрелок (угол)// инициализация формы
procedure TForml.FormCreate(Sender: TObject);
var
t: TDateTime;
begin
// зададим размер формы
// в соответствии с размером циферблата
ClientHeight := (R+10)*2;
ClientWidth := (R+10)*2;
хО := R+1O;
уО := R+1O; t := Now(); // положение стрелок
ahr := 90 - HourOf(t)*30-(MinuteOf(Today)div 12)*6;
amin := 90 - MinuteOf(t)*6;
asec := 90 - SecondOf(Today)*6; Timerl.Interval := 1000; // период сигнало от таймера 1 сек
Timerl.Enabled := True; // пуск таймера
end;// вычерчивает вектор заданной длины из точки (х0,у0)
procedure TForml.Vector(x0,y0: integer; a, 1: integer);
// х0,у0 — начало вектора
//а — угол между осью х и вектором
// 1 — длина вектора
const
GRAD = 0.0174532; // коэффициент пересчета угла из градусов
// в радианы
var
х,у: integer; // координаты конца вектора
begin
Canvas.MoveTo(хО, y0) ;
х := Round(хО + l*cos(a*GRAD));
у := Round(y0 - l*sin(a*GRAD));
Canvas.LineTo(x, y);
end;// рисует стрелки
procedure TForml.DrawClock;
var
t: TDateTime;
begin
// шаг секундной и минутной стрелок 6 градусов,
// часовой — 30. // стереть изображение стрелок
Canvas.Pen.Color := clBtnFace;
Canvas.Pen.Width :=3;
// часовую
Vector(x0,y0, ahr, R-20) ;
// минутную
Vector(xO,yO, amin, R-15);
// секундную
Vector(xO,yO, asec, R-7); t := Now(); // новое положение стрелок
ahr := 90 - HourOf(t)*30-(MinuteOf(t)div 12) *6;
amin := 90 - MinuteOf(t)*6;
asec := 90 - SecondOf(t)* 6; // нарисовать стрелки
// часовая стрелка
Canvas.Pen.Width := 3;
Canvas.Pen.Color := clBlack;
Vector(x0,y0, ahr, R-20); // минутная стрелка
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clBlack;
Vector(xO,yO, amin, R-15); . // секундная стрелка
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clYellow;
Vector(xO,yO, asec, R-7);
end;// прорисовка циферблата и начальных стрелок
procedure TForml.FormPaint(Sender: TObject);
var
x,y: integer; // координаты маркера на циферблате
a: integer; // угол между ОХ и прямой (х0,у0) (х,у) рс: TColor; // цвет карандаша
pw: integer; // ширина карандаша
begin
рс := Canvas.Pen.Color;
pw := Canvas.Pen.Width; Canvas.Pen.Width := 1;
Canvas.Pen.Color := clBlack; a:=0; // метки ставим от 3-х часов, против часовой стрелки
// циферблат
while a < 360 do
begin
x:=xO+Round( R * cos(a*2*pi/360)) ;
y:=xO-Round( R * sin(a*2*pi/360));
Forml.Canvas.MoveTo(x,у);
if (a mod 30) - 0
then Canvas.Ellipse(x-2,y-2,x+3, y+3)
else Canvas.Ellipse(x-1,y-1,x+1,y+1);
a:=a+6; // 1 сунута — 6 градусов
end;
// восстановить карандаш-кисть
Canvas.Pen.Width := pw;
Canvas.Pen.Color := pc; DrawClock;
end;// прорисовка текущих положений стрелок часов
procedure TForml.TimerlTimer(Sender: TObject);
begin
DrawClock;
end;end.

35. Напишите программу, которая в диалоговом окне выводит изображение идущих часов с часовой, минутной и секундной стрелками (рис. 1.33).

Рис. 1.33. Окно программы Часы

unit clock2_;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialo.gs, ExtCtrls;type
TForml = class(TForm)
Timerl: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure TimerlTimer(Sender: TObject); // эти объявления вставлены вручную
procedure Vector(xO, yO, a, 1: integer);
procedure DrawClock; private
/ Private declarations j
public
( Public declarations }
end;var
Forml: TForral;implementation
{$R *.dfm}uses
DateUtils; // для доступа к SecondOf,
// MinuteOf и HourOfconst
R = 75; // радиус циферблата часовvar
xO,yO: integer; // центр циферблата
ahr,amin,asec: integer; // положение стрелок (угол)// инициализация формы
procedure TForml.FormCreate(Sender: TObject);
var
t: TDateTime;
begin
// зададим размер формы
// в соответствии с размером циферблата
ClientHeight := (R+30)*2;
ClientWidth := (R+30)*2;
xO := R+30;
yO := R+30; t := Now(); // положение стрелок
ahr := 90 - HourOf(t)*30-(MinuteOf(Today)div 12)*6;
amin := 90 - MinuteOf(t)*6;
asec := 90 - SecondOf(Today)*6; Timerl.Interval := 1000; // период сигналов от таймера 1 сек
Timerl.Enabled := True; // пуск таймера
end;// вычерчивает вектор заданной длины из точки (х0,у0)
procedure TForral.Vector(x0,y0: integer; a, 1: integer);
// х0,у0 — начало вектора
// а — угол между осью х и вектором
// 1 — длина вектора
const
GRAD = 0.0174532; // коэффициент пересчета угла из градусов
// в радианы
var
х,у: integer; // координаты конца вектора
begin
Canvas.MoveTo(x0, y0) ;
х := Round(xO + l*cos(a*GRAD));
у := Round(y0 - l*sin(a*GRAD));
Canvas.LineTo(x,y);
end;// рисует стрелки
procedure T Fo rml.DrawClock;
var
t: TDateTime;
begin
// шаг секундной и минутной стрелок 6 градусов,
// часовой — 30.

// стереть изображение стрелок
Canvas.Pen.Color := clBtnFace;
Canvas.Pen.Width :=3;
// часовую
Vector(xO,yO, ahr, R-20);
// минутную
Vector(xO,yO, amin, R-15);
// секундную
Vector(xO,yO, asec, R-7); t := Now(); // новое положение стрелок
ahr := 90 - HourOf(t)*30-(MinuteOf(t)div 12)*6;
amin := 90 - MinuteOf(t)*6;
asec := 90 - SecondOf(t)*6; // нарисовать стрелки
// часовая стрелка
Canvas.Pen.Width := 3;
Canvas.Pen.Color := clBlack;
Vector(x0,y0, ahr, R-20); // минутная стрелка
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clBlack;
Vector(x0,y0, amin, R-15); // секундная стрелка
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clYellow;
Vector(x0,y0, asec, R-7);
end;// прорисовка циферблата и начальных стрелок
procedure TForml.FormPaint(Sender: TObject);
var
x,y: integer; // координаты маркера на циферблате
a: integer; // угол между ОХ и прямой (х0,у0) (х,у)
h: integer; // метка часовой риски bs: TBrushStyle; // стиль кисти
рс: TColor; // цвет карандаша
pw: integer; // ширина карандаша
begin
bs := Canvas.Brush.Style;
pc := Canvas.Pen.Color;
pw := Canvas.Pen.Width; Canvas.Brush.Style := bsClear;
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clBlack; a:=0; // метки ставим от 3-х часов, против
// часовой стрелки
h:=3; // угол 0 градусов — это 3 часа // циферблат
while a < 360 do
begin
x:=xO+Round( R * cos(a*2*pi/360));
y:=xO-Round( R * sin(a*2*pi/360));
Forml.Canvas.MoveTo(x,y);
if (a mod 30) = 0 then
begin
Canvas.Ellipse(x-2,y-2,x+3, y+3);
// цифры по большему радиусу
x:=xO+Round( (R+15) * cos(a*2*pi/360));
y:=xO-Round( (R+15) * sin(a*2*pi/360));
Canvas.TextOut(x-5,y-7,IntToStr(h));
dec(h);
if h = 0 then h:=12;
end
else Canvas.Ellipse(x-l,y-l,x+l,y+l);
a:=a+6; // 1 минута — 6 градусов
end;
// восстановить карандаш-кисть
Canvas.Brush.Style := bs;
Canvas.Pen.Width := pw;
Canvas.Pen.Color :- pc; DrawClock;
end;// прорисовка текущих положений стрелок часов
procedure TForml.TimerlTimer(Sender: TObject);
begin
DrawClock;
end;end.

36. Напишите программу, по поверхности формы которой дви жется изображение (рис. 1.34). Изображение перемещающегося объекта и фоновый рисунок (рис. 1.35) должны загружаться из файла.

Рис. 1.34. Летящий над городом самолет

Рис. 1.35. Объект и фоновый рисунок

unit aplane_;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Buttons;
type
TForml = class (TForm)
Timerl: TTimer;
Image1: TImage;
procedure TimerlTimer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
f Public declarations }
end;var
Forml: TForml;implementation{$R +.DFM}
var
Back, Picture: TBitMap; // фон и картинка
BackRct : TRect; // положение и размер области фона,
// которая должна быть восстановлена
х,у:integer; // текущее положение картинки
W,H: integer; // размеры картинки
procedure TForml.FormCreate(Sender: TObject);
begin
{ Свойству AutoSize обязательно надо
присвоить значение False. Это можно
сделать во время создания формы.
I
Imagel.AutoSize := False;
// создать два объекта — битовых образа
Back := TBitmap.Create; // фон
Picture := TBitmap.Create; // картинка // загрузить и вывести фон
Back.LoadFromFile('factory.bmp');
Imagel.Width := Back:Width;
Imagel.Height : = Back.Height;
Imagel.Canvas.Draw(0,0,Back); // загрузить картинку, которая будет двигаться
Picture.LoadFromFile('aplane.bmp');
W := Picture.Width;
H := Picture.Height; // определим "прозрачный" цвет
Picture.Transparent := True;
// прозрачный цвет картинки определяет
// левый верхний пиксел картинки
Picture.TransParentColor := Picture.Canvas.Pixels[1,1]; // начальное положение картинкм
х := -W;
у := 20; // определим сохраняемую область фона
BackRct:=Bounds(х,у,W,Н);end;// обработка сигнала таймера
procedure TForml.TimerlTimer(Sender: TObj ect);
begin
// восстановлением фона удалим рисунок
Imagel.Canvas.CopyRect(BackRct,Back.Canvas, BackRct); x:=x+2;
if x > Imagel.Width then x:=-W; // определим сохраняемую область фона
BackRct:=Bounds(x,y,W,H); // выведем рисунок
Imagel.Canvas.Draw(x,у,Picture);
end;
// завершение работы программы
procedure TForml.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
// освободим память, выделенную
// для хранения битовых образов
Back.Free;
Picture.Free;
end;
end.

37. Напишите программу, в окне которой отображается "муль тик", загруженный из ВМР-файла. Вид формы приложения при веден на рис. 1.36, пример мультика (картинка, которая нахо дится в BMP-файле) — на рис. 1.37.

Рис. 1.36. Форма программы Мультипликация Delphi

Рис. 1.37. Пример "мультика" — содержимое ВМР-файла

implementation ($R *.DFM} const
FILMFILE = 'delphi.bmp1; // фильм - BMP-файл
N_KADR=12; // кадров в фильме (для данного файла)
var
Film: TBitMap; // фильм — все кадры
WKadr,HKadr: integer; // ширина и высота кадра
CKadr: integer; // номер текущего кадра
RectKadr: TRect; // положение и размер кадра в фильме
RectScr : Trect; // координаты и размер области
// отображения фильма
procedure TForml.FormCreate(Sender: TObject);
begin
Film := TBitMap.Create; // создать объект типа TBitMap
Film.LoadFromFile(FILMFILE); // загрузить "фильм" из файла
WKadr := Round(Film.Width/N_Kadr);
HKadr := Film.Height; RectScr := Bounds(10,10,WKadr,HKadr); Ckadr:=0; Timerl.Interval := 150; // период обновления кадров — 0.15 сек
Timer1.Enabled:=True; // запустить таймер
end;// обработка сигнала от таймера
procedure TForml.TimerlTimer(Sender: TObject);
begin
// определим положение текущего кадра в фильме
RectKadr:=Bounds(WKadr*CKadr,0,WKadr,HKadr); // вывод кадра из фильма
Forml.Canvas.CopyRect(RectScr,Film.Canvas,RectKadr); // подготовимся к выводу следующего кадра
CKadr := CKadr+1;
if CKadr = N_KADR
then CKadr-.=0;
end;
end.

38. Напишите программу, в окне которой прокручивается текст, подобный титрам в конце фильма. Титры могут быть на фоне иллюстрации, которая должна прокручиваться вместе с текстом. Рекомендуемый вид формы приведен на рис. 1.38.

Рис. 1.38. Форма программы Прокрутка

implementation[$R *.dfm}const
HB = 58; // высота области вывода
// картинки на форме
HR = 274; // высота плаката
{ В простейшем случае плакат в файле
должен быть продублирован по вертикали
два раза.
Высота прокручиваемой картинки
(битового образа в файле)
должна быть больше или равна
HB+HR.
var
pic :TBitMap; // прокручиваемая картинка
sRect,dRect: TRect; // область-источник
t: integer;procedure TForml.FormCreate(Sender: TObject);
begin
pic := TBitMap.Create;
pic.LoadFromFile('baner.bmp'); // загрузить картинку
dRect := Bounds(10,10,pic.Width,HB); // положение и размер
// области, в которой
// прокручивается картинка
sRect := Rect(0,0,pic.Width,HB); // отображаемая область
t:=0;
end;
// сигнал от таймера
procedure TFonnl.TimerITimer(Sender: TObject);
begin
Canvas.CopyRect(dRect,pic.Canvas,sRect); // отобразить часть
// картинки
inc(t) ;
if t = HR // длина ролика
then t:=0;
sRect := Bounds (0,t,pic.Width,HB) ; // следующей кадр
end;// щелчок на кнопке OK
procedure TFonnl.ButtonlClick(Sender: TObject);
begin
Forml.Close;
end;end.

39. Напишите программу, в окне которой в стиле бегущей стро ки прокручивается битовый образ (рис. 1.39). Битовый образ должен загружаться из ресурса программы (подготовить файл ресурса можно при помощи утилиты Image Editor).

Рис. 1.39. Окно программы Бегущая строка

Бегущая строка.
Битовый образ загружается из ресурса. }
unit hscroll_;interface
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
.
type
TForml = class(TForm)
Timer: TTimer;
Buttonl: TButton;
procedure FormCreate(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure ButtonlClick(Sender: TObject);
private
I Private declarations }
public
{ Public declarations )
end;var
Forml: TForml;implementation{$R *.dfm}{$R hbaner.res} // файл ресурсов, в котором
// находится битовый образ, можно создать
// при помощи Image Editor{ Высота битового образа в файле ресурсов
не может быть меньше 32 пикселов }const
WB = 350; // ширина области вывода
// картинки на форме
ТР = 573; // период рисунка бегущей строкиvar
pic :TBitMap; // картинка — бегущая строка
sRect,dRect: TRect; // область-источник и область-приемник
t: integer;procedure TForml.FormCreate(Sender: TObject);
begin
pic := TBitMap.Create;
pic.LoadFromResourceName(HInstance,'BANER2'); // загрузить
// картинку
dRect := Bounds(0,0,WB,pic.Height); // область, в которой
// бежит строка,
sRect := Rect(0,0,TP,pic.Height); // отображаемая в данный
// момент область рисунка
t:=0;
end;// сигнал от таймера
procedure TForml.TimerTimer(Sender: TObject);
begin
Canvas.CopyRect(dRect,pic.Canvas,sRect); // отобразить часть
// картинки
inc(t);
if t = TP // длина ролика
then t:=0;
sRect := Bounds(t,0,WB,pic.Height) ; // следующий кадр
end;// щелчок на кнопке OK
procedure TForml.ButtonlClick(Sender: TObject);
begin
Forml.Close;
end;end.

40. Напишите программу, используя которую можно просмот реть иллюстрации, находящиеся в одном из каталогов компью тера. Вид окна программы приведен на рис. 1.40.

[ Просмотр иллюстраций }
unit shpic_;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls, Menus;
type
TForml = class(TForm)
Imagel: TImage; // поле вывода иллюстрации
Buttonl: TButton; // кнопка Дальше
Label1: TLabel;
Editl: TEdit;
RadioButtonl: TRadioButton; // выбор: BMP - формат
RadioButton2: TRadioButton; // выбор: JPG - формат

Рис. 1.40. Окно программы Просмотр иллюстраций

GroupBoxl: TGroupBox;
procedure ButtonlClick(Sender: TObject);
procedure EditlKeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure RadioButtonlClick(Sender: TObject);
procedure RadioButton2Click(Sender: TObject); // эти объявления вставлены сюда вручную
procedure FirstPicture; // выводит первую иллюстрацию
procedure NextPicture; // выводит следующую иллюстрацию
procedure Scalelmage; // масштабирует картинку private
{ Private declarations }
public
( Public declarations )
end;var
Forml: TForml;
iw,ih: integer; // первоначальный размер компонента Image
implementation{$R *.DFM}
uses
•jpeg; // чтобы иметь возможность просмотра
// ЗРЯ — иллюстрацийvar
aSearchRec : TSearchRec;

aPath: String[128]; // каталог, в котором находятся иллюстрации
aFile: String[128]; // файл иллюстрации
aMask: String[5]; // расширение файла иллюстрации
n: integer = 0;procedure TForml.FormCreate(Sender: TObject);
begin
Imagel.AutoSize := False;
Imagel.Stretch := True; // разрешим масштабирование // запомним первоначальный размер области вывода иллюстрации
iw := Imagel.Width; *
ih : = imagel.Height; Buttonl.Enabled := False; // сделаем недоступной
// кнопку Дальше
FirstPicture; // вывести первую иллюстрацию
end;procedure TForml.EditIKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
if DirectoryExists(Editl.Text)
then FirstPicture
else ShowMessage('Каталог '+
Editl.Text +' указан неверно.');
end;// вывести первую иллюстрацию
procedure TForml.FirstPicture;
var
r : integer; // результат поиска файла
begin
aPath := Editl.Text;

if aPath [Length (aPath) ] о 'V
then aPath := aPath + 'V;
if RadioButtonl.Checked
then aMask := '*.bmp'
else aMask := '*-jpg';
r := FindFirst(aPath + aMask, faAnyFile, aSearchRec);
if r = 0 then
begin
aFile := aPath + aSearchRec.Name;
Imagel.Picture.LoadFromFile(aFile); // загрузить
// иллюстрацию
Scalelmage;
r := FindNext(aSearchRec); // найти следующий файл
if г = 0 then // еще есть файлы иллюстраций
Buttonl.Enabled := True;
end;
end;// вывести следующую иллюстрацию
Procedure TForml.NextPicture () ;
var
r : integer;
begin
aFile := aPath + aSearchRec.Name;
Imagel.Picture.LoadFromFile(aFile) ;
ScaleImage; // подготовим вывод след. иллюстрации
г := FindNext(aSearchRec) ; // найти следующий файл
if г о О
then // больше нет иллюстраций
Buttonl.Enabled := False;
end;// щелчок на кнопке Дальше
procedure TForml.ButtonlClick(Sender: TObject);
begin
NextPicture;
end;// изменение размера области вывода иллюстрации пропорционально
// размеру иллюстрации
Procedure Tforml.Scalelmage;
var
pw, ph : integer; // размер иллюстрации
scaleX, scaleY : real; // масштаб по Х и Y
scale : real; // масштаб
begin'
// иллюстрация уже загружена
// получим ее размеры
pw := Imagel.Picture.Width;
ph := Imagel.Picture.Height;
if pw > iw // ширина иллюстрации больше ширины компонента
// Image
then scaleX := iw/pw // нужно масштабировать
else scaleX := 1;
if ph > ih // высота иллюстр. больше высоты компонента
then scaleY := ih/ph // нужно масштабировать
else scaleY := 1; // выберем наименьший коэффициент
if scaleX < scaleY
then scale := scaleX
else scale := scaleY; • // изменим размер области вывода иллюстрации
Imagel.Height := Round(Imagel.Picture.Height*scale);
Imagel.Width : = Round(Imagel.Picture.Width*scale);
// т. к. Strech = True и размер области пропорционален
// размеру картинки, то картинка масштабируется
// без искажений
end;,// выбор ВМР-формата
procedure TForml.RadioButtonlClick(Sender: TObject);
begin
FirstPicture;
end;// выбор JPG-формата
procedure TForml.RadioButton2Click(Sender: TObject);
begin
FirstPicture;
end;end.

41. Напишите программу, диалоговое окно которой имеет фо новый рисунок, загружаемый из файла (рис. 1.41). Если размер рисунка меньше размера окна, то фоновый рисунок должен быть составлен по принципу кафельной плитки. В качестве фонового использовать один из стандартных рисунков Windows, например, находящийся в файле Колечки.bmp или Пузырьки.Ьтр.

Рис. 1.41. Окно с фоновым рисунком

implementationvar
Back : TBitmap; // фоновая картинка{$R *.dfm}procedure TForml.ForraCreate(Sender: TObject);
begin
Back := TBitmap.Create;
// Back. LoadFromResourceName (HInstance, 'PUZ');
Back.LoadFromFile ('пузырьки!..bmp') ; // загрузить картинкуend;procedure TForml.FormPaint(Sender: TObject);
var
x,y: integer; // левый верхний угол картинки
begin
x:=0; y:=0;
while у < Forml.Height do begin
while x < Forml.Width do begin
forml.Canvas.Draw(x,y,Back);
x:=x+Back.Width;
end;
x:=0;
у:=y+Back.He ight;
end;
end;end.