Var gm,gd:Integer;

Xp:Point;

Xs:Square;

Xps:PaintSquare;

Procedure DragAny(Var AnyX : Point);

{Процедура перемещает любую фигуру, порожденную от объекта Point}

Const Left = #75; { , код клавиш управления курсором}

Right = #77; {  }

Up = #72; {  }

Down = #80; {  }

Gap = 11; {сдвиг при движении на столько точек}

Var

Ch : Char;

StartX,StartY : Integer;

Begin

AnyX.Show;

StartX:=AnyX.GetX;

StartY:=AnyX.GetY;

Repeat

Ch:=ReadKey;

If Ch=#0 Then Begin

Ch:=ReadKey;

Case Ch Of

Left : Dec(StartX,Gap);

Right : Inc(StartX,Gap);

Up : Dec(StartY,Gap);

Down : Inc(StartY,Gap);

End;

AnyX.Shift(StartX,StartY);

End;

Until Ch=#27; {окончание перемещения - клавиша Esc}

End;

{-----------------------------------}

Begin

Gd:=Detect;

InitGraph(Gd,Gm,'');

if GraphResult<>GrOk then Halt(1);

XP.Init(320,170); {инициализируется точка}

DragAny(XP);

XP.Hide;

XS.Init(320,170,50); {инициализируется квадрат}

XS.Show;

DragAny(XS);

XS.Hide;

XPS.Init(320,170,50,14); {инициализируется окрашенный квадрат}

DragAny(XPS);

XPS.Hide;

CloseGraph;

End.

Пример позднего связывания демонстрирует использование процедуры Shift объектами XS (квадрат) и XPS (окрашенный квадрат). Объекты этого типа наследуют метод Shift от Point. Метод Point.Shift обращается к виртуальным методам Point.Show и Point.Hide. Одноименные методы Show и Hide имеют типы Square и PaintSquare. С помощью ТВМ родительский метод Point.Shift "узнал" о существовании виртуальных методов Square.Show,Square.Hide, PaintSquare.Show и PaintSquare.Hide и использовал именно их при обращении к Square.Shift и PaintSquare.Shift. Поэтому на экране перемещаются соответственно точка, квадрат и окрашенный квадрат. Это и есть пример полиморфизма (перемещение разных фигур одним методом Shift).

2. Демонстрационные примеры

Пример 7.2.

program LAST_PROGRAM_BY_PASCAL;

{point - line -PerecrestLine }

uses crt,graph;

type

TCoord=object {координаты объекта}

X,y:integer;

constructor Init(ax,ay:integer); end;{специальный тип процедуры , которая выполняет некоторую установочную работу для механизма виртуальных методов. Более того, конструктор должен вызываться перед вызовом любого виртуального метода. Вызов виртуального метода без предварительного вызова конструктора может привести к блокированию системы, а у компилятора нет способа проверить порядок вызова методов.

Каждый экземпляр объекта должен инициализироваться отдельно вызовом конструктора. Недостаточно инициализировать один экземпляр объекта и затем присваивать этот экземпляр другим.}

constructor TCoord.Init;

begin

x:=ax;

y:=ay;

end;

type TPixel=object (TCoord) {дочерний объект , объекта TCoord }

color:integer; {новое свойство дочернего объекта}

constructor Init (ax,ay:integer;acolor:integer);

procedure Draw; {метод - рисование}

end;

constructor TPixel.Init; {реализационная часть нового объекта}

begin

inherited Init (ax,ay);{позволяет вызывать методы предка без указания имени типа предка и точки. Это очень пригодиться при использовании большой иерархии, когда запомнить все связи типа «предок-потомок» невозможно.}

color:=acolor;

end;

procedure TPixel.Draw;

begin

putpixel(x,y,color);{закрашивает пиксель с заданными координатами в цвет color}

end;

type TLine=object (TCoord)

l:integer;

constructor Init (ax,ay:integer;al:integer);

procedure Draw; virtual;

end;

constructor TLine.init;

begin