Пример программирования с использованием объектных типов

Обычно объектные типы описываются в отдельном модуле, в интерфейсной части которого приводится объявление объектного типа, а в исполняемой части - описание всех его методов. Такой модуль может поставляться пользователю в виде DCU-файла с распечаткой интерфейсной части модуля. На основе такого модуля можно создавать новые объекты, используя полиморфизм и наследование.

Покажем зто на примере. Создадим проект нового приложения и сохраним файл проекта под именем DemOOP, а модуль формы - под именем ООР.Pas (рис.18), включив в него объектные типы TPoints и TCircle, описанные выше.

+--------------------------------------------------------------+

¦ UNIT OOP; ¦

¦ INTERFACE ¦

¦ . . . ¦

¦ Type ¦

¦ TPoints=Class ¦

¦ X,Y:Integer; ¦

¦ Visible:Boolean; ¦

¦ Constructor Init(A,B:Integer); ¦

¦ Function GetX:Integer; ¦

¦ Function GetY:Integer; ¦

¦ Procedure Show;Virtual; ¦

¦ Procedure Hide;Virtual; ¦

¦ Procedure Move(DX,DY:Integer); ¦

¦ End; ¦

¦ Type ¦

¦ TCircle=Class(TPoints) ¦

¦ Radius:Word; ¦

¦ Constructor Init(A,B:Integer;R:Word); ¦

¦ Function GetR:Word; ¦

¦ Procedure Show;Override; ¦

¦ Procedure Hide;Override; ¦

¦ End; ¦

¦ . . . ¦

¦ IMPLEMENTATION ¦

¦ Constructor TPoints.Init(A,B:Integer); ¦

¦ Begin ¦

¦ X:=A; Y:=B; ¦

¦ Visible:=False ¦

¦ End; ¦

¦ Function TPoints.GetX:Integer; ¦

¦ Begin ¦

¦ GetX:=X; ¦

¦ End; ¦

¦ Function TPoints.GetY:Integer; ¦

¦ Begin ¦

¦ GetY:=Y; ¦

¦ End; ¦

¦ Procedure TPoints.Show; ¦

¦ Begin ¦

¦ Form1.Canvas.Pixels[X,Y]:=Form1.Canvas.Pen.Color; ¦

¦ Visible:=True ¦

¦ End; ¦

¦ Procedure TPoints.Hide; ¦

¦ Begin ¦

¦ Form1.Canvas.Pixels[X,Y]:= Form1.Color; ¦

¦ Visible:=False ¦

¦ End; ¦

¦ Procedure TPoints.Move(DX,DY:Integer); ¦

¦ Var B:Boolean; ¦

¦ Begin ¦

¦ B:=Visible; ¦

¦ If B Then Hide; ¦

¦ X:=X+DX; Y:=Y+DY; ¦

¦ If B Then Show ¦

¦ End; ¦

¦ Constructor TCircle.Init(A,B:Integer;R:Word); ¦

¦ Begin ¦

¦ inherited Init(A,B); ¦

¦ Radius:=R ¦

¦ End; ¦

¦ Function TCircle.GetR:Word; ¦

¦ Begin ¦

¦ GetR:=Radius; ¦

¦ End; ¦

¦ Procedure TCircle.Show; ¦

¦ Begin ¦

¦ Form1.Canvas.Arc(X-Radius,Y-Radius,X+Radius,Y+Radius, ¦

¦ X,0,X,0); ¦

¦ Visible:=True; ¦

¦ End; ¦

¦ Procedure TCircle.Hide; ¦

¦ Var Color:TColor; ¦

¦ Begin ¦

¦ Color:= Form1.Canvas.Pen.Color; ¦

¦ Form1.Canvas.Pen.Color := Form1.Color; ¦

¦ Show; ¦

¦ Visible:=False; ¦

¦ Form1.Canvas.Pen.Color:=Color; ¦

¦ End; ¦

¦ END. ¦

+--------------------------------------------------------------+

Рис.18

Теперь для управления закрашенным кругом на экране дисплея определим объектный тип CirFill, являющийся потомком объектного типа TCircle, и поместим этот новый объектный тип в модуль OOP.Pas (рис.19).

+--------------------------------------------------------------+

¦UNIT OOP; ¦

¦INTERFACE ¦

¦ . . . ¦

¦ Type . . . ¦

¦ CirFill = Class(TCircle) ¦

¦ Color:TColor; { Цвет круга } ¦

¦ Constructor Init(A,B:Integer;R:Word;C:TColor); ¦

¦ Function GetC:TColor; ¦

¦ Procedure Show;Override; ¦

¦ Procedure Hide;Override; ¦

¦ End; ¦

¦IMPLEMENTATION ¦

¦ . . . ¦

¦ Constructor CirFill.Init(A,B:Integer;R:Word;C: TColor); ¦

¦ Begin ¦

¦ inherited Init(A,B,R); { Задать центр и радиус }¦

¦ Color:=C { Задать цвет круга }¦

¦ End; ¦

¦ Function CirFill.GetC:TColor;{ Вернуть цвет круга }¦

¦ Begin ¦

¦ GetC:=Color ¦

¦ End; ¦

¦ Procedure CirFill.Show; {Нарисовать закрашенный круг }¦

¦ Var ¦

¦ C:TColor; ¦

¦ Begin ¦

¦ inherited Show; { Нарисовать окружность }¦

¦ Form1.Canvas.Brush.Color:= Color;{Установить цвет кисти}¦

¦ Form1.Canvas.Ellipse(X-Radius,Y-Radius, {Закрасить круг}¦

¦ X+Radius,Y+Radius); ¦

¦ Visible:=True; { Установить признак светимости}¦

¦ End; ¦

¦ Procedure CirFill.Hide; { Стереть круг }¦

¦ Var ¦

¦ C:TColor; ¦

¦ Begin ¦

¦ C:=Color; { Запомнить цвет круга }¦

¦ Color:=Form1.Color; { Установить цвет круга равным }¦

¦ { текущему цвету фона }¦

¦ Show; { Закрасить круг цветом фона, }¦

¦ inherited Hide; { стереть окружность - }¦

¦ { в результате круг становится }¦

¦ { невидимым }¦

¦ Visible:=False; { Сбросить признак светимости }¦

¦ Color:=C { Установить прежний цвет круга}¦

¦ End; ¦

¦END. ¦

+--------------------------------------------------------------+

Рис.19

Таким образом, используя наследование и полиморфизм, мы создали новый объектный тип CirFill, поместив его в модуль OOP.pas.

Теперь дополним исполняемую часть модуля OOP.pas двумя процедурами, работающими с объектом TCircle и его наследником CirFill (рис.20):

- процедурой AnyHlop, которая "стягивает в точку" окружность и закрашенный круг на экране дисплея;

- процедурой AnyPolh, которая выполняет обратный процесс, т.е. "восстанавливает" из точки окружность и круг.

+--------------------------------------------------------------+

¦UNIT OOP; ¦

¦INTERFACE ¦

¦ . . . ¦

¦IMPLEMENTATION ¦

¦ . . . ¦

¦ Procedure AnyHlop(Any:TCircle); ¦

¦ Var ¦

¦ R:Word; ¦

¦ Begin ¦

¦ With Any Do ¦

¦ Begin ¦

¦ R:=Radius; { Запомнить радиус окружности }¦

¦ While Radius>0 Do{ "Стянуть" окружность в точку, }¦

¦ Begin { постепенно уменьшая её радиус }¦

¦ Show; ¦

¦ Hide; ¦

¦ Dec(Radius); ¦

¦ End; ¦

¦ Visible:=False; { Сбросить признак светимости }¦

¦ Radius:=R; { Восстановить исходный радиус }¦

¦ End; ¦

¦ End; ¦

¦ Procedure AnyPolh(Any:TCircle); ¦

¦ Var ¦

¦ R:Word; ¦

¦ Begin ¦

¦ With Any Do ¦

¦ Begin ¦

¦ R:=Radius; { Запомнить радиус окружности }¦

¦ Radius:=0; ¦

¦ While Radius<R Do{"Восстановить" окружность из точки}¦

¦ Begin { постепенно увеличивая её радиус }¦

¦ Hide; ¦

¦ Inc(Radius); ¦

¦ Show; ¦

¦ End; ¦

¦ Visible:=True; { Установить признак светимости }¦

¦ Radius:=R; { Восстановить исходный радиус }¦

¦ End; ¦

¦ End; ¦

¦ . . . ¦

+--------------------------------------------------------------+

Рис.20

Поместим в форму Form1 кнопку Button1, при нажатии которой будет вызываться процедура TForm1.Button1Click, обеспечивающая поочерёдное появление, схлопывание и восстановление окружностей и закрашенных кругов; радиусы и центры объектов зададим, используя датчик случайных чисел (рис.21).

+--------------------------------------------------------------+

¦ procedure TForm1.Button1Click(Sender : Tobject); ¦

¦ Var ¦

¦ C:TCircle; { Объект - окружность } ¦

¦ CF:CirFill; { Объект - закрашенный круг } ¦

¦ A,B:Integer; { Координаты центра круга } ¦

¦ R:Word; { Радиус круга } ¦

¦ Col:TColor; { Цвет круга } ¦

¦ Bool:Boolean; ¦

¦ i:Word; ¦

¦ BEGIN ¦

¦ Form1.Color := clGray; {Установить текущие цвета}¦

¦ Form1.Canvas.Pen.Color:= clBlack;{фона и линий }¦

¦ Randomize; ¦

¦ Bool:=True; ¦

¦ C :=TCircle.Create; ¦

¦ CF :=TCirFill.Create; ¦

¦ For i:=1 to 10 do ¦

¦ Begin ¦

¦ R:=Random(100)+50; { Выбрать радиус 50<=R<150 }¦

¦ A:=Random(Form1.ClientWidth-2*R)+R;{ Выбрать центр круга }¦

¦ B:=Random(Form1.ClientHeight-2*R)+R; ¦

¦ Col:=Random(65535); { Выбрать цвет круга }¦

¦ If Bool Then ¦

¦ Begin ¦

¦ C.Init(A,B,R); { Задать окружность }¦

¦ C.Show; { Нарисовать окружность }¦

¦ AnyHlop(C); { "Стянуть" её в точку }¦

¦ AnyPolh(C); { "Восстановить её из точки}¦

¦ End ¦

¦ Else ¦

¦ Begin ¦

¦ CF.Init(A,B,R,Col) ;{ Задать круг }¦

¦ CF.Show; { Нарисовать круг }¦

¦ AnyHlop(CF); { "Стянуть" круг в точку }¦

¦ AnyPolh(CF); { "Восстановить" круг }¦

¦ End; ¦

¦ Bool:=Not Bool; { Сменить признак выбора }¦

¦ { типа объекта }¦

¦ End; ¦

¦ C.Destroy; ¦

¦ CF.Destroy; ¦

¦ END; ¦

¦ ¦

+--------------------------------------------------------------+