VPF::Эффект типа "Муравьи" - Форум программистов

Sunvas

Дата 30.3.2006, 00:54 (ссылка)

(нет голосов)

Загрузка ...

Соль и сахар

Профиль
Группа: Участник
Сообщений: 3388
Регистрация: 12.3.2006
Где: Тосно

Репутация: 28
Всего: 89

Кто работал в Ворде тот знает, что есть такой эффект. А как его прорисовать на канве? Вся "фишка" заключается в том, что муравьи должны двигаться и функция должна вызываться просто - например murav(x1,y1,x2,y2:integer; canv:tcanvas, interval:word);

--------------------

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

MBo

Дата 30.3.2006, 06:45 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 234
Регистрация: 10.6.2002

Репутация: 3
Всего: 18

Код


var
  Form1: TForm1;
  X1,Y1,X2,Y2:Integer;
  ShiftX,ShiftY:Integer;
  Counter:Integer=0;

implementation

{$R *.dfm}

procedure TForm1.EraseRect;
begin
  Canvas.Pen.Color:=Color;
  Canvas.Pen.Style:=psSolid;
  Canvas.Pen.Width:=3;
  Canvas.Rectangle(X1,Y1,X2,Y2);
  Canvas.Pen.Width:=1;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  EraseRect;
  X1:=X;
  Y1:=Y;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if ssLeft in Shift then begin
      EraseRect;
      X2 := X; Y2 := Y;
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Inc(Counter);
  EraseRect;
  DrawAnts;
end;

procedure TForm1.DrawAnts;
var
  cm:Integer;
begin
  cm:=Counter mod 6;
  Canvas.Pen.Color:=clRed;
  Canvas.Pen.Style:=psDot;
  Canvas.MoveTo(X1+cm,Y1);
  Canvas.LineTo(X2,Y1);
  Canvas.Moveto(X2,Y1+cm);
  Canvas.LineTo(X2,Y2);
  Canvas.MoveTo(X2-cm,Y2);
  Canvas.LineTo(X1,Y2);
  Canvas.MoveTo(X1,Y2-cm);
  Canvas.LineTo(X1,Y1);
end;

Alexeis

Дата 30.3.2006, 09:24 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

MBo, для экономии програмных ресурсов удобно линии рисовать по методу XOR, тогда для стираня нужно будет всего лишь повторить операцию рисования

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

MBo

Дата 30.3.2006, 12:28 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 234
Регистрация: 10.6.2002

Репутация: 3
Всего: 18

alexeis1,
Не всё так просто smile

Sunvas

Дата 31.3.2006, 00:16 (ссылка)

(нет голосов)

Загрузка ...

Соль и сахар

Профиль
Группа: Участник
Сообщений: 3388
Регистрация: 12.3.2006
Где: Тосно

Репутация: 28
Всего: 89

Цитата(alexeis1 @ 30.3.2006, 09:24

)

MBo, для экономии програмных ресурсов удобно линии рисовать по методу XOR, тогда для стираня нужно будет всего лишь повторить операцию рисования

А если я рисую на разноцветном фоне? - Выделение будет весьма уродливо.

MBo, Спасибо!

--------------------

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

MBo

Дата 31.3.2006, 05:35 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 234
Регистрация: 10.6.2002

Репутация: 3
Всего: 18

>А если я рисую на разноцветном фоне? - Выделение будет весьма уродливо
Тогда лучше запоминать область рамки, и перерисовывать ее при изменении позиции рамки

Sunvas

Дата 1.4.2006, 00:11 (ссылка)

(нет голосов)

Загрузка ...

Соль и сахар

Профиль
Группа: Участник
Сообщений: 3388
Регистрация: 12.3.2006
Где: Тосно

Репутация: 28
Всего: 89

MBo, но вот возникла неожиданная проблемка: если я хочу сделать эти "муравьи" немного жирнее (т.е. pen.width:=5). Как это можно реализовать? Ведь инетервал между psDot не регулируется.

--------------------

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

Sunvas

Дата 5.4.2006, 07:04 (ссылка)

(нет голосов)

Загрузка ...

Соль и сахар

Профиль
Группа: Участник
Сообщений: 3388
Регистрация: 12.3.2006
Где: Тосно

Репутация: 28
Всего: 89

Я решил свою проблемму. Привожу код, ибо может кому-то и понадобится.

Код


procedure ant_line(x1,y1,x2,y2:integer;canvas:tcanvas;otstup,interval:word);
  var i,d,a,b:word;
  znx,zny:smallint;
  px,py:integer;
  label kon;
  begin
  d:=trunc(sqrt(sqr(x2-x1)+sqr(y2-y1)));
  znx:=1;
  zny:=1;
  if x2-x1<0 then znx:=-1;
  if y2-y1<0 then zny:=-1;
  a:=trunc(interval*(x2-x1)*znx/d);
  b:=trunc(interval*(y2-y1)*zny/d);
  if otstup>=interval*2 then otstup:=otstup mod (interval*2);
  for i:=0 to trunc(d/interval) do
  begin
  if (i) mod 2 <> 0 then goto kon;
  px:=x1+(i*a)*znx+trunc(otstup*(x2-x1)/d);
  py:=y1+(i*b)*zny+trunc(otstup*(y2-y1)/d);
  if (d<trunc(sqrt(sqr(px-x1)+sqr(py-y1))))or((px*znx>x2)or(py*zny>y2)) then goto kon;
  canvas.MoveTo(px,py);
  px:=x1+((i+1)*a)*znx+trunc(otstup*(x2-x1)/d);
  py:=y1+((i+1)*b)*zny+trunc(otstup*(y2-y1)/d);
  if d<trunc(sqrt(sqr(px-x1)+sqr(py-y1))) then begin px:=x2; py:=y2; end;
  if (px*znx>x2) then px:=x2;
  if (py*zny>y2) then py:=y2;
  canvas.LineTo(px,py);
  if otstup>interval then
  begin
  canvas.MoveTo(x1,y1);
  px:=x1+trunc((otstup-interval)*(x2-x1)/d);
  py:=y1+trunc((otstup-interval)*(y2-y1)/d);
  canvas.LineTo(px,py);
  end;
  kon:
  end;
  end;

  procedure ant_Rectangle(x1,y1,x2,y2:integer;canvas:tcanvas;otstup,interval:word);
  var pogr,pogr1:word;
  begin
  if (x1=x2)or(y1=y2) then exit;
  ant_line(x1,y1,x2,y1,canvas,otstup,interval);
  pogr:=(abs(x2-x1) div interval) mod 2;
  if pogr=0 then pogr:=interval*2-(abs(x2-x1) mod (interval)) else pogr:=interval-(abs(x2-x1) mod (interval));
  ant_line(x2,y1,x2,y2,canvas,otstup+pogr,interval);
  pogr1:=(abs(y1-y2) div interval) mod 2;
  if pogr1=0 then pogr1:=interval*2-(abs(y1-y2) mod (interval)) else pogr1:=interval-(abs(y1-y2) mod (interval));
  ant_line(x2,y2,x1,y2,canvas,otstup+pogr+pogr1,interval);
  ant_line(x1,y2,x1,y1,canvas,otstup+2*pogr+pogr1,interval);
  end;

где x1,x2,y1,y2 - координаты; canvas - место где рисовать; otstup - сколько отступать, чтобы получились "муравьи", interval - интервал нарисованых линий (их длина).

Работать нужно так: ставим таймер с интервалом где-то 50, заводим глобальную переменную типа word. Все выглядит примерно так:

Код


var q:word;
{...........}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
form1.Refresh;
form1.Canvas.Pen.Width:=3;
ant_rectangle(0,0,200,200,form1.Canvas,q,10);
q:=q+2;
if q>=20 then q:=0;
end;

Интересно узнать ваше мнение.

--------------------

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »