Лабораторная работа 8. Создание текстурных заливок

Задание 1.

1. Откройте новый проект и разместите на нем компонент Image1(Additional). 2. Установите следующие размеры этого компонента: Width=255, Height=255.

Таким образом, поле для рисования будет 255х255=50725 пикселей, причем каждый пиксель будет изображать отдельное число. Числа будут образовывать спираль, раскручивающуюся от центра. Если число простое, то соответствующую ему точку закрасим черным цветом, иначе – желтым цветом.

3. Для определения простого числа напишем функцию Good. После строки {$R *.DFM} наберите следующий код.

function good(Numb:integer):boolean;

var

i:integer;

begin

good:=true;

for i:=2 to Trunc(Sqrt(Numb)) do

if (Numb mod i) =0 then

begin

good:=false;

exit;

end;

end;

После указания имени функции в круглых скобках указывается параметр Numb. Функция должна определить простое это число или составное и результат определения поместить после круглых скобок. В данном случае тип Boolean означает, что функция произведет результат True или False. Принцип работы функции Good заключается следующем. В цикле по i , пробегающему значению от 2 до Trunc(Sqrt(Numb)), проверяется делится ли число Numb на i. Если делится, то число Numb составное, иначе простое.

5. Добавим на форму кнопку Пуск и опишем событийную процедуру.

Procedure Tform1.Button1Click(Sender: Tobject);

Label

up;

var

i, // Счетчик цикла

x,y, // Текущие координаты точки

n, // Текущее число

nx,ny:integer; // Количество шагов вдоль осей х,у

begin

// Начальная установка

n:=2;

x:=Image1.Width div 2+ 1;

y:=x-1 ;

with Image1.Canvas do //Стандартные средства рисования

begin

Brush.Color:=clYellow;

FillRect(ClientRect); // Закрашиваем фон в желтый цвет

Pixels[x,y]:=clBlack; // Рисуем первую черную точку

ny:=1;

up: for i:=1 to ny do //Двигаемся вверх

begin

dec(y) ;

inc(n) ;

if good(n) then Pixels[x,y]:=clBlack;

end;

nx:=ny+1;

for i:=1 to nx do //Двигаемся влево

begin

dec(x) ;

inc(n) ;

if good(n) then Pixels[x,y]:=clBlack;

end;

ny:=nx;

for i:=1 to ny do //Двигаемся вниз

begin

inc(y);

inc(n);

if good(n) then Pixels[x,y]:=clBlack;

end;

nx:=ny+1;

for i:=1 to nx do //Двигаемся вправо

begin

inc(x);

inc(n);

if good(n) then Pixels[x,y]:=clBlack;

end;

if n>=image1.Width*Image1.Height

then exit;

ny:=nx;

Application.ProcessMessages;

goto up; //Переход в новому такту цикла

end;

end;

Задание 2.

Закомментируйте строку Application.ProcessMessages. Просмотрите, что происходит на экране. Процедура ProcessMessages необходима для того, чтобы прервать выполнение приложения (Application) и начать обработку сообщений (Messages), накопившихся в очереди.

Задание 3.

Замените текст функции good на следующий:

function good(Numb:integer):boolean;

var

i:integer;

begin

good:=(Numb mod 33=0);

for i:=2 to Trunc(Sqrt(Numb)) do

if Frac(Sqrt(Numb))=0 then

begin

good:=false;

exit;

end;

end;

Просмотрите получившийся узор.

Задание 4.

Снова замените текст функции good на следующий:

function good(Numb:integer):54oolean;

var

i:integer;

begin

good:=true;

for i:=2 to Trunc(Sqrt(Numb)) do

if (Numb mod 33=0) then

begin

good:=false;

exit;

end;

end;

Задание 5.

Исследуйте другие свойства чисел. Узоры, которые будут получаться доставят вам удовольствие.