Форум: "Начинающим";
Текущий архив: 2008.03.16;
Скачать: [xml.tar.bz2];

Вниз

Создание рамки с бегущими муравьями   Найти похожие ветки 

← →
dmitry_12_08_73   (2008-02-19 10:40) [0]

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

---

← →
KilkennyCat ©   (2008-02-19 11:06) [1]

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

Pen + F1

---

← →
MBo ©   (2008-02-19 12:40) [2]


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;


---

← →
Johnmen ©   (2008-02-19 13:53) [3]

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

---

← →
ASMSoft ©   (2008-02-19 14:12) [4]

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;
:)

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.03.16;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.006 c