unit Figures;
interface
uses…;
type
tLocation=
object
X,Y:Integer;
procedure Init(X_,Y_:Integer);
function GetX:Integer;
function GetY:Integer;
end;
tpDot=^tDot; {тип 'указатель на экземпляр класса tDot'. См.далее}
tDot=
object(tLocation)
aсtive:Boolean;
constructor Init(X_,Y_:Integer); {конструктор. См. далее}
destructor Done;virtual; {деструктор. См. далее}
procedure Show;virtual; {виртуальный метод. См. далее}
procedure Hide;virtual;
function IsActive:Boolean;
procedure MoveBy(dX,dY:Integer);virtual;
procedure MoveTo(newX,newY:Integer);virtual;
end;
tpCircle=^tCircle; {указатель на экземпляр tCircle}
tCircle=
object(tDot)
R:Integer;
constructor Init(X_,Y_:Integer;R_:Integer);
procedure Show;virtual;
procedure Hide;virtual;
procedure ChangeRadius(dR:Integer);virtual;
end;
{——— секция реализации ———}
implementation
{методы tLocation}
procedure tLocation.Init(X_,Y_:Integer);
begin
X:=X_;
Y:=Y_;
end;
function tLocation.GetX:Integer;
begin
GetX:=X;
end;
function tLocation.GetY:Integer;
begin
GetY:=Y;
end;
{методы tDot}
constructor tDot.Init(X_,Y_:Integer);
begin
tLocation.Init(X_,Y_);
active:=false;
end;
destructor tDot.Done;
begin
Hide;{это tDot.Hide для объекта класса tDot}
end;
procedure tDot.Show;
begin
… {нарисовали текущим цветом}
active:=true; {пометили состояние как активное}
end;
procedure tDot.Hide;
begin
… {нарисовали цветом фона}
active:=false; {пометили состояние как неактивное}
end;
function tDot.IsActive:Boolean;
begin
Result:=active;
end;
procedure tDot.MoveBy(dX,dY:Integer);
begin
Hide;{ это tDot.Hideдля объекта dDot,tCircle.Hideдля aCircle и т.д.}
X:=X+dX;
Y:=Y+dY;
Show; {tDot.Show для aDot, tCircle.Show для aCirle и т.д.
end;
procedure tDot.MoveTo(newX,newY:Integer);
begin
Hide;
X:=newX;
Y:=newY;
Show;
end;
{методы tCircle}
constructor tCircle.Init(X_,Y_,R_:Integer);
begin
tDot.Init(X_,Y_); {инициализация прародителя}
R:=R_;
end;
procedure tCircle.Show;
begin
…{ рисование окружности }
Active:=true;
end;
procedure tCircle.Hide;
var TmpColor:tColor;
begin
TmpColor:=; {запомнили текущий цвет рисования}
…{установили текущим цвет фона}
…{нарисовали окружность цветом фона, т.е. скрыли}
…{восстановили текущий цвет рисования}
Active:=false; {пометили состояние как неактивное}
end;
procedure tCircle.ChangeRadius(dR:Integer);
begin
Hide;
R:=R+dR;
if R<0 then R:=0; {радиус не может быть отрицательным}
Show;
end;
end.
В качестве примера использования модуля Figures напишем программу, в которой используются классы модуля Figures, а также добавляется наследник класса tCircle. При этом для него статический метод Init и виртуальные методы Show и Hide переписываются заново (как говорят — перекрываются), а все другие методы (например, moveBy) наследуются.
Unit Figure1; {добавление наследника}
Uses…,Figures; {используем модуль Figures}
type
tArc=
object(tCircle)
angle1,angle2:Integer;
construсtor Init(X_,Y_,R_,angle1_,angle2_:Integer);
procedure Show;virtual; {метод перекрывается}
procedure Hide;virtual; {также перекрывается}
end;
var
aArc:tArc;
aCircle:tCircle;
pArc:^tArc;
{методы Arc}
constructor tАrc.Init(X_,Y_,R_,angle1_,angle2_:Integer);
begin
tCircle.Init(X_,Y_,R_);
angle1:=angle1_;
angle2:=angle2_;
end;
procedure tArc.Show;
begin
…{рисуем дугу текущим цветом}
Active:=true;
end;
procedure tArc.Hide;
var TmpColor:tColor;
begin
TmpColor:=…; {запоминаем текущий цвет}
…{устанавливаем цвет фона текущим цветом рисования}
…{рисуем дугу цветом фона}
Active:=false; {помечаем состояние как неактивное}
…{восстанавливаем текущий цвет}
end;
Form1.Button1Click(…);{по нажатию кнопки идет отрисовка фигур}
begin
aCircle.Init(100,100,50); {инициализировали поля окружности}
aCircle.MoveTo(10);{чтобы остановить перемещение окружности и начать
двигать дугу нажмите <Enter>}
aArc.Init(120,190,25,0,90); {инициализировали поля дуги}
aArc.MoveBy (5,14); *****
end.