Пример объектно-ориентированной программы: движение фигур по экрану.

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.