Скачиваний:
10
Добавлен:
15.06.2014
Размер:
3.81 Кб
Скачать
unit Unit2;

interface //объявляю то что будет нужно в моей программе
uses Graphics,Math;
var colrback:tcolor; //переменная хранящая цвет

type tviz=class(tobject) // абстрактный родительский класс
colrline:tcolor; //цвет линии
canvas:tcanvas; //объявляю окно в котором возможно рисование
x,y,r:word; //переменные почти как integer,но немного меньше умешают в себе
procedure ris; virtual; abstract; //перекрываемый метод для рисования
procedure draw(bl:boolean); //процедура рисующая картинки в зависимости от булевской переменной
procedure show; // показать изображение
procedure hide; //стереть изображение
end;

tarc=class(tviz) //класс рисования пустого круга
x1,y1,x2,y2,x3,y3,x4,y4:word;
Xc, Yc, rad, lambda: integer;
constructor create(x, y, r:integer; colrline0:tcolor;canvas0:tcanvas);
procedure ris;override;
end;


TTire = class(Tarc)
Xp, Yp, Xp1, Yp1, Xp2, Yp2, Xp3, Yp3: integer; alfa:extended;
constructor create(x, y, r:integer; colrline0:tcolor;canvas0:tcanvas);
procedure ris;override;
procedure MoveTo();
end;




implementation //описание процедур

procedure tviz.draw;// процедура которая рисует в зависимости от булевой переменной картинки либо цветом линии или цветом фона в последнем случае пройсходит стирание
begin
with canvas do begin
if bl then begin
pen.Color:=clgreen; brush.Color:=clgreen;
pen.Width:=3;
end
else begin
pen.Color:=colrback; brush.Color:=colrback
end;
ris;end;
end;

procedure tviz.show;
begin
draw(true);
end;

procedure tviz.hide;
begin
draw(false);
end;



constructor tarc.create;
begin
canvas:=canvas0;
Xc := x;
Yc := y;
rad := r;
lambda := 20;
end;

procedure tarc.ris; //рисует только круг
begin
canvas.Arc(Xc - rad, Yc - rad, Xc + rad, Yc + rad, Xc + lambda, Yc + lambda, Xc + 2 * lambda, Yc + 2* lambda);
end;

procedure ttire.ris; //рисует спицы
begin
inherited ris;
canvas.MoveTo(Xc, Yc);
canvas.LineTo(Xp, Yp);
canvas.MoveTo(Xc, Yc);
canvas.lineto(xp1,yp1);
canvas.MoveTo(Xc, Yc);
canvas.lineto(xp2,yp2);
canvas.MoveTo(Xc, Yc);
canvas.lineto(xp3,yp3);
end;

procedure Ttire.MoveTo;
begin
xc:=xc+1;
alfa:=alfa+1/rad;
xp:=xc+round(rad*cos(alfa));
yp:=yc+round(rad*sin(alfa));
xp1:=xc-round(rad*sin(alfa));
yp1:=yc+round(rad*cos(alfa));
xp2:=xc-round(rad*cos(alfa));
yp2:=yc-round(rad*sin(alfa));
xp3:=xc+round(rad*sin(alfa));
yp3:=yc-round(rad*cos(alfa));

{xc:=xc+1;//смещает центр круга //изменение альфа
yp:=yp+1; // текущая точка //заделать для четырех линии и переводить конец линии в начало!! там где это было!!!! с помощью двух последних строк!!!!!
xp:=round(sqrt(abs(sqr(rad)-sqr(yc-yp)))+xc); //чертит от правого крайнего до нижнего


xp1:=xp1;
yp1:=round(sqrt(abs(sqr(rad)-sqr(xc-xp1)))+yc);//чертит от нижнего до левого положения


yp2:=yp2-1;
xp2:=round(-sqrt(abs(sqr(rad)-sqr(yc-yp2)))+xc);

xp3:=xp3+2;
yp3:=round(-sqrt(abs(sqr(rad)-sqr(xc-xp3)))+yc);}//от вернего до правого !!!!!

if xp=xc then begin xp:=xc+rad;yp:=yc;
xp3:=xc;
yp3:=yc-rad;
xp1:=xc;
yp1:=yc+rad;
xp2:=xc-rad;
yp2:=yc;

end;

end;

constructor TTire.create;
begin
Inherited create(x, y, r, colrline0, canvas0);
Yp := Yc;
Xp := Xc + rad;
xp1:=xc;
yp1:=yc+rad;
xp2:=xc-rad;
yp2:=yc;
xp3:=xc;
yp3:=yc-rad;
alfa:=0;

end;







end.










Соседние файлы в папке вращаюшееся колесо
  • #
    15.06.20141.47 Кб10Unit1.pas
  • #
    15.06.201451 б11Unit1.~ddp
  • #
    15.06.2014898 б10Unit1.~dfm
  • #
    15.06.20141.47 Кб10Unit1.~pas
  • #
    15.06.20143.93 Кб10Unit2.dcu
  • #
    15.06.20143.81 Кб10Unit2.pas
  • #
    15.06.20143.79 Кб10Unit2.~pas