Форум программистов [Powered by Invision Power Board]

Код


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;

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

)

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

Код


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;

Код


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;