| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Создание рамки с бегущими муравьями [D7]

dmitry_12_08_73 ©   (2008-02-19 10:40:00) 

Как создать пустую рамку с бегущими муравьями на подобие рамки в Photoshop

---

ASMSoft   (2008-02-19 14:12:00) [1]

procedure TForm1.FormCreate(Sender: TObject);
begin
 with Canvas do begin
  Pen.Style:=psDot;
  Pen.Mode:=pmNotXor;
  Pen.Color:=clRed;
  Brush.Style:=bsClear;
 end;
 Timer1.Interval:=250;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 if Canvas.Pen.Style <> psSolid then begin
  Canvas.Rectangle(Rect(10,10,100,100));
  Canvas.Pen.Style:=psSolid;
 end;
 Canvas.Rectangle(Rect(10,10,100,100));
end;
:)

---

Johnmen   (2008-02-19 13:53:00) [2]

Не получится - зима. Муравьи спят...

---

MBo   (2008-02-19 12:40:00) [3]


X1,Y1,X2,Y2:Integer;

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
 EraseRect;
 Inc(Counter);
 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;


---

KilkennyCat   (2008-02-19 11:06:00) [4]

и что с ней потом делать? вставить фотографию и повесить на стену?

Pen + F1

---

Наверх