Движение образа по удерживанию левой кнопки мыши

Постановка задачи. Сделайте проект, в котором компонент TImage будет перемещаться вслед за указателем мыши при нажатой левой кнопке. При отпускании кнопки мыши компонент стоит на месте. Если передвинуть мышь в другое место формы, кликнуть,
то опять картинка будет перемещаться вместе с мышью.

Реализация. Нарисуйте небольшую картинку какого-нибудь образа в редакторе Paint. Положите на форму один компонент TImage, через свойство Picture загрузите картинку в TImage. Нам понадобится одна глобальная переменная типа boolean, назовем ее pr.
В момент нажатия левой кнопки мыши делаем флажок pr:= true.
В момент отпускания кнопки делаем флажок pr:= false. Само движение описывается в обработчике события FormMouseMove. Для того чтобы инициировать обработчики FormMouseDown, FormMouseMove и FormMouseUp, найдите соответствующие события формы
и сделайте двойной клик либо Ctrl-Enter на пустом поле значения события. Delphi автоматически создаст в тексте модуля шаблонную процедуру и зарегистрирует ее в списке событий объекта как обработчик данного события.

После запуска приложения картинка как бы «прилипает» к указателю мыши. Первый раз после запуска проекта не кликайте по картинке, событие FormMouseDown не наступит, а по замыслу задачи обработчик ImageMouseDown не нужен.

Ниже дан код обработчиков FormCreate и FormMouseMove.

var pr:boolean;

procedure TForm1.FormCreate(Sender: TObject);

begin

Image1.Left:=Form1. ClientWidth div 2;

Image1.Top:=Form1. ClientHeight div 2;

Image1.Transparent:=true;

pr:=false;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

if pr then

begin

Image1.Left:=x;

Image1.Top:=y;

end;

end;

Задание. Сделайте аналогичный проект для картинки, «загружаемой» в переменную класса TBitMap.

3.1.5. Проект «Жизнь клеток»

Постановка задачи. Проект «Жизнь клеток» моделирует жизнь поколений гипотетической колонии живых клеток, которые выживают, размножаются или погибают по определенным правилам. Эти правила заключаются в следующем. Клетка выживает в том и только том случае, если она имеет двух или трех соседей из восьми возможных. Если у клетки только один сосед или вовсе ни одного, она погибает в изоляции. Если клетка имеет четырех или более соседей, она погибает от перенаселения. В любой пустой позиции, у которой ровно три соседа, в следующем поколении появляется новая клетка. Один из моментов жизни колонии изображен на рис. 22.

Рис. 22. Проект «Жизнь клеток»

Реализация. Жизнедеятельность колонии протекает на поле размером 15 х 15 позиций, каждую из которых может занять лишь одна клетка. Начальное размещение клеток на поле задается играющим
с помощью мыши. Мышью можно закрасить одну клетку по щелчку, а можно «возить» мышью по полю и перекрашивать клетки. Для простоты будем рисовать на компоненте TPaintBox. Также положим на форму таймер и три кнопки «Заселить колонию», «Старт»
и «Стоп».

Играющий может указать, какое число поколений исходной колонии следует отобразить на экране (это необязательно). Понадобятся следующие глобальные переменные:

const

n=15;

dx=20;

dy=20;

type Tpole=array[1..n,1..n]of integer;

var x0,y0,cw,ch:integer;

pr_kolonia:boolean;

pole,pole1:Tpole;

// Два массива для хранения текущего и следующего поколения

Напишем три своих процедуры mas_clear, put_kletka и DrawPole. Процедура mas_clear (var a:Tpole) обнуляет массив. Процедура put_kletka (i,k:integer; cl, cl_bordur:TColor) рисует закрашенную клетку с границей другого цвета. Процедура DrawPole выводит поле на форму. Разместим эти процедуры в разделе implementation.

implementation

{$R *.dfm}

procedure mas_clear(var a:Tpole);

var i,k:integer;

begin

for i:=1 to n do

for k:=1 to n do

a[i,k]:=0;

end;

procedure put_kletka(i,k:integer;cl,cl_bordur:TColor);

var x,y:integer;

begin

with Form1.PaintBox1.Canvas do

begin

Pen.Width:=1;

Pen.Color:=cl_bordur;

Brush.color:=cl;

x:=(k-1)*dx;

y:=(i-1)*dy;

Rectangle(x,y,x+dx,y+dy);

end;

end;

procedure DrawPole;

var i,k:integer;

begin

for i:=1 to n do

for k:=1 to n do

put_kletka(i,k,clwhite,clblack);

end;

Для каждого элемента массива pole обнуляем переменную sum
и в ней подсчитываем число соседей (перебором). В зависимости от значения переменной sum во второй массив pole 1 будем ставить 1 или 0. Массив pole 1 – это следующее поколение колонии. Затем копируем массив pole 1 в массив pole и делаем прорисовку массива pole. Ниже приведен код всех обработчиков.

procedure TForm1.FormCreate(Sender: TObject);

begin

cw:=clientwidth; {Вычисление ширины и высоты формы}

ch:=clientheight;

PaintBox1.Left:=10;

PaintBox1.Top:=10;

PaintBox1.Width:=n*dx;

PaintBox1.Height:=n*dy;

Timer1.Enabled:=false;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var sum,sum1,i,k:integer;

begin

for i:=1 to n do

for k:=1 to n do

begin

sum:=0;

{Подсчитаем, сколько соседей у каждой клетки}

if (i>1) then

begin

sum:=sum+pole[i-1,k];

if (k>1) then

sum:=sum+pole[i-1,k-1];

if (k<n) then

sum:=sum+pole[i-1,k+1];

end;

if (i<n)then

begin

sum:=sum+pole[i+1,k];

if(k>1)then

sum:=sum+pole[i+1,k-1];

if (k<n)then

sum:=sum+pole[i+1,k+1];

end;

if (k>1)then

sum:=sum+pole[i,k-1];

if (k<n)then

sum:=sum+pole[i,k+1];

{У пустой клетки три соседа, клетка начинает жить}

if (pole[i,k]=0)and(sum=3)then

pole1[i,k]:=1; // В массиве pole1 – следующее поколение

{Клетка погибает, если число соседей меньше 2 и больше 3}

if (sum<=1)or(sum>=4)then

pole1[i,k]:=0;

end;

pole:=pole1; {Копируем измененное поле1 в поле}

sum1:=0;

{Далее прорисовываем поле, одновременно считая

"живые" клетки}

for i:=1 to n do

for k:=1 to n do

begin

if pole[i,k]=1 then

begin

put_kletka(i,k,clskyblue,clblack);

sum1:=sum1+1;

end

else

put_kletka(i,k,clwhite,clblack);

end;

{Если "живых" клеток нет, то цикл прекращается}

if sum1=0 then

begin

timer1.Enabled:=false;

{При желании можно начать сначала}

mas_clear(pole);

mas_clear(pole1);

DrawPole;

pr_kolonia:=false;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

{Заселение колонии}

mas_clear(pole);

mas_clear(pole1);

DrawPole;

pr_kolonia:=false;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

{Запускаем таймер }

timer1.Enabled:=true;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

timer1.Enabled:=false;

end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var i,k:integer;

begin

if not timer1.Enabled then

begin

{Создание начальной колонии}

pr_kolonia:=true;

k:=x div dy+1; { Ищем координаты клетки[i,k]}

i:=y div dx+1;

{Проверим, лежат ли числа i, k в интервале от 1 до n,

а также клетка поля пустая или нет}

if ((k-1)*(k-n)<=0)and ((i-1)*(i-n)<=0)and(pole[i,k]=0) then

begin

pole[i,k]:=1;

put_kletka(i,k,clskyblue,clblack);

end;

end;

end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

var i,k:integer;

begin {Здесь тот же код, что и на MouseDown, зато можно

"возить" мышью и красить поле}

if pr_kolonia then

begin

k:=x div dy+1;

i:=y div dx+1;

if ((k-1)*(k-n)<=0)and ((i-1)*(i-n)<=0)and(pole[i,k]=0) then

begin

pole[i,k]:=1;

put_kletka(i,k,clskyblue,clblack);

end;

end;

end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

{Рисование клеток прекращается при отпускании мыши}

pr_kolonia:=false;

end;

Задание. Используйте разные цвета для окраски пяти или более поколений. Или задавайте цвета с помощью диалога TColorDialog.

Дата добавления: 2015-08-20